diff --git a/basis/typed/prettyprint/prettyprint.factor b/basis/typed/prettyprint/prettyprint.factor index 68950dfbb8..5f03bd87a6 100644 --- a/basis/typed/prettyprint/prettyprint.factor +++ b/basis/typed/prettyprint/prettyprint.factor @@ -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 diff --git a/basis/typed/typed-tests.factor b/basis/typed/typed-tests.factor index 6e4b892b81..e1ee431c53 100644 --- a/basis/typed/typed-tests.factor +++ b/basis/typed/typed-tests.factor @@ -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 diff --git a/basis/typed/typed.factor b/basis/typed/typed.factor index fa6444675e..2d76d25b13 100644 --- a/basis/typed/typed.factor +++ b/basis/typed/typed.factor @@ -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 ;