typed: add TYPED:: word for typed local definitions, and throw in some unit tests

diff --git a/extra/typed/typed-tests.factor b/extra/typed/typed-tests.factor
new file mode 100644 (file)
index 0000000..2bfd837
--- /dev/null
+++ b/extra/typed/typed-tests.factor
@@ -0,0 +1,37 @@
+USING: kernel layouts math quotations tools.test typed ;
+IN: typed.tests
+
+TYPED: f+ ( a: float b: float -- c: float )
+    + ;
+
+[ 3.5 ]
+[ 2 1+1/2 f+ ] unit-test
+
+TYPED: fix+ ( a: fixnum b: fixnum -- c: fixnum )
+    + ;
+
+most-positive-fixnum neg 1 - 1quotation
+[ most-positive-fixnum 1 fix+ ] unit-test
+
+TUPLE: tweedle-dee ;
+TUPLE: tweedle-dum ;
+
+TYPED: dee ( x: tweedle-dee -- y )
+    drop \ tweedle-dee ;
+
+TYPED: dum ( x: tweedle-dum -- y )
+    drop \ tweedle-dum ;
+
+[ \ tweedle-dum new dee ] [ input-mismatch-error? ] must-fail-with
+[ \ tweedle-dee new dum ] [ input-mismatch-error? ] must-fail-with
+
+
+TYPED: dumdum ( x -- y: tweedle-dum )
+    drop \ tweedle-dee new ;
+
+[ f dumdum ] [ output-mismatch-error? ] must-fail-with
+
+TYPED:: f+locals ( a: float b: float -- c: float )
+    a b + ;
+
+[ 3.5 ] [ 2 1+1/2 f+locals ] unit-test

diff --git a/extra/typed/typed.factor b/extra/typed/typed.factor
index 1cfb3394d43963dce67f3ced7433053bfd90a6b2..f9dbbad61a16f08a55d1bed978387e0bc9449e30 100644 (file)
--- a/extra/typed/typed.factor
+++ b/extra/typed/typed.factor
@@ -1,7 +1,8 @@
 ! (c)Joe Groff bsd license
 USING: accessors combinators combinators.short-circuit
 definitions effects fry hints kernel kernel.private namespaces
-parser quotations see.private sequences words ;
+parser quotations see.private sequences words
+locals locals.definitions locals.parser ;
 IN: typed
 
 ERROR: type-mismatch-error word expected-types ;
@@ -53,7 +54,10 @@ ERROR: output-mismatch-error < type-mismatch-error ;
     [ [ swap ] dip typed-gensym-quot ]
     [ 2nip ] 3tri define-declared ;
 
-PREDICATE: typed < word "typed-word" word-prop ;
+PREDICATE: typed-standard-word < word "typed-word" word-prop ;
+PREDICATE: typed-lambda-word < lambda-word "typed-word" word-prop ;
+
+UNION: typed-word typed-standard-word typed-lambda-word ;
 
 : typed-quot ( quot word effect -- quot' )
     [ effect-in-types dup typed-stack-effect? [ typed-inputs ] [ 2drop ] if ] 
@@ -77,8 +81,12 @@ PREDICATE: typed < word "typed-word" word-prop ;
 
 SYNTAX: TYPED:
     (:) define-typed ;
+SYNTAX: TYPED::
+    (::) define-typed ;
+
+M: typed-standard-word definer drop \ TYPED: \ ; ;
+M: typed-lambda-word definer drop \ TYPED:: \ ; ;
 
-M: typed definer drop \ TYPED: \ ; ;
-M: typed definition "typed-def" word-prop ;
-M: typed declarations. "typed-word" word-prop declarations. ;
+M: typed-word definition "typed-def" word-prop ;
+M: typed-word declarations. "typed-word" word-prop declarations. ;