diff --git a/extra/typed/typed-tests.factor b/extra/typed/typed-tests.factor new file mode 100644 index 0000000000..2bfd837f30 --- /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 1cfb3394d4..f9dbbad61a 100644 --- 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 definer drop \ TYPED: \ ; ; -M: typed definition "typed-def" word-prop ; -M: typed declarations. "typed-word" word-prop declarations. ; +M: typed-standard-word definer drop \ TYPED: \ ; ; +M: typed-lambda-word definer drop \ TYPED:: \ ; ; + +M: typed-word definition "typed-def" word-prop ; +M: typed-word declarations. "typed-word" word-prop declarations. ;