steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Joe Groff 2009-09-29 12:55:37 -05:00
parent 92e864b019
commit a4c134a1f3
2 changed files with 50 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
extra/typed/typed-tests.factor Normal file
View File

@ -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

18
extra/typed/typed.factor
View File

@ -1,7 +1,8 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: accessors combinators combinators.short-circuit USING: accessors combinators combinators.short-circuit
definitions effects fry hints kernel kernel.private namespaces 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 IN: typed
ERROR: type-mismatch-error word expected-types ; ERROR: type-mismatch-error word expected-types ;
@ -53,7 +54,10 @@ ERROR: output-mismatch-error < type-mismatch-error ;
[ [ swap ] dip typed-gensym-quot ] [ [ swap ] dip typed-gensym-quot ]
[ 2nip ] 3tri define-declared ; [ 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' ) : typed-quot ( quot word effect -- quot' )
[ effect-in-types dup typed-stack-effect? [ typed-inputs ] [ 2drop ] if ] [ effect-in-types dup typed-stack-effect? [ typed-inputs ] [ 2drop ] if ]
@ -77,8 +81,12 @@ PREDICATE: typed < word "typed-word" word-prop ;
SYNTAX: TYPED: SYNTAX: TYPED:
(:) define-typed ; (:) define-typed ;
SYNTAX: TYPED::
(::) define-typed ;
M: typed definer drop \ TYPED: \ ; ; M: typed-standard-word definer drop \ TYPED: \ ; ;
M: typed definition "typed-def" word-prop ; M: typed-lambda-word definer drop \ TYPED:: \ ; ;
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. ;