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

View File

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

View File

@ -161,3 +161,9 @@ TYPED: forget-fail ( a: forget-class -- ) drop ;
[ ] [ [ \ forget-class 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

View File

@ -3,7 +3,8 @@ USING: accessors arrays classes classes.tuple combinators
combinators.short-circuit definitions effects fry hints
math kernel kernel.private namespaces parser quotations
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 ;
IN: typed
@ -18,6 +19,7 @@ PREDICATE: typed-word < word "typed-word" word-prop >boolean ;
: unboxable-tuple-class? ( type -- ? )
{
[ maybe? not ]
[ all-slots empty? not ]
[ immutable-tuple-class? ]
[ final-class? ]
@ -43,7 +45,7 @@ PREDICATE: typed-word < word "typed-word" word-prop >boolean ;
] [ drop [ ] ] if ;
:: 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 (unboxer)
compose compose ;