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

diff --git a/basis/typed/prettyprint/prettyprint.factor b/basis/typed/prettyprint/prettyprint.factor
index 68950dfbb8f72f78e8363794d94b58330256a234..5f03bd87a6b581eb2e30b1ac6c94229dd127ff6f 100644 (file)
--- 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 6e4b892b8183a22607b6e599b638f606fe45a73e..e1ee431c535d7496da2f90fcfd4f7542e1de2864 100644 (file)
--- 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 fa6444675e5e06770300a8c5ad5f11a6727689b7..2d76d25b1396ede0e2103017052d2c8ef1cb1fd6 100644 (file)
--- 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 ;