steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

typed: Teach typed about maybe: foo. Should maybe: foo satisfy unboxable-tuple-class? ?

db4
Doug Coleman 2011-11-22 02:08:37 -08:00
parent 067f9830ef
commit 0bdd87dace
3 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/typed/prettyprint/prettyprint.factor
View File

@ -1,5 +1,5 @@
USING: definitions kernel locals.definitions see see.private typed words USING: definitions kernel locals.definitions see see.private typed
summary make accessors classes ; words summary make accessors classes prettyprint ;
IN: typed.prettyprint IN: typed.prettyprint
PREDICATE: typed-lambda-word < lambda-word "typed-word" word-prop ; PREDICATE: typed-lambda-word < lambda-word "typed-word" word-prop ;
@ -15,7 +15,7 @@ M: input-mismatch-error summary
"Typed word “" % "Typed word “" %
dup word>> name>> % dup word>> name>> %
"” expected input value of type " % "” expected input value of type " %
dup expected-type>> name>> % dup expected-type>> unparse %
" but got " % " but got " %
dup value>> class-of name>> % dup value>> class-of name>> %
drop drop

6
basis/typed/typed-tests.factor
View File

@ -161,3 +161,9 @@ TYPED: forget-fail ( a: forget-class -- ) drop ;
[ ] [ [ \ forget-class forget ] with-compilation-unit ] unit-test [ ] [ [ \ forget-class forget ] with-compilation-unit ] unit-test
[ ] [ [ \ forget-fail forget ] with-compilation-unit ] unit-test [ ] [ [ \ forget-fail forget ] with-compilation-unit ] unit-test
TYPED: typed-maybe ( x: maybe: integer -- ? ) >boolean ;
[ f ] [ f typed-maybe ] unit-test
[ t ] [ 30 typed-maybe ] unit-test
[ 30.0 typed-maybe ] [ input-mismatch-error? ] must-fail-with

6
basis/typed/typed.factor
View File

@ -3,7 +3,8 @@ USING: accessors arrays classes classes.tuple combinators
combinators.short-circuit definitions effects fry hints combinators.short-circuit definitions effects fry hints
math kernel kernel.private namespaces parser quotations math kernel kernel.private namespaces parser quotations
sequences slots words locals effects.parser sequences slots words locals effects.parser
locals.parser macros stack-checker.dependencies ; locals.parser macros stack-checker.dependencies
classes.union ;
FROM: classes.tuple.private => tuple-layout ; FROM: classes.tuple.private => tuple-layout ;
IN: typed IN: typed
@ -18,6 +19,7 @@ PREDICATE: typed-word < word "typed-word" word-prop >boolean ;
: unboxable-tuple-class? ( type -- ? ) : unboxable-tuple-class? ( type -- ? )
{ {
[ maybe? not ]
[ all-slots empty? not ] [ all-slots empty? not ]
[ immutable-tuple-class? ] [ immutable-tuple-class? ]
[ final-class? ] [ final-class? ]
@ -43,7 +45,7 @@ PREDICATE: typed-word < word "typed-word" word-prop >boolean ;
] [ drop [ ] ] if ; ] [ drop [ ] ] if ;
:: unboxer ( error-quot word types type -- quot ) :: unboxer ( error-quot word types type -- quot )
type "coercer" word-prop [ ] or type word? [ type "coercer" word-prop ] [ f ] if [ ] or
type type word types error-quot '[ dup _ instance? [ _ _ _ @ ] unless ] type type word types error-quot '[ dup _ instance? [ _ _ _ @ ] unless ]
type (unboxer) type (unboxer)
compose compose ; compose compose ;