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

ensure the typed subword gets xref-ed by the compiler

db4
Joe Groff 2009-10-13 21:20:05 -05:00
parent c0d173ae9b
commit 99c0bcc683
2 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
extra/typed/typed-tests.factor
View File

@ -1,4 +1,4 @@
USING: accessors effects kernel layouts math quotations tools.test typed words ;
USING: accessors effects eval kernel layouts math quotations tools.test typed words ;
IN: typed.tests
TYPED: f+ ( a: float b: float -- c: float )
@ -53,3 +53,21 @@ TYPED: unboxy ( in: unboxable -- out: unboxable2 )
[ T{ unboxable2 { u T{ unboxable { x 12 } { y 3 } } } { xy 9 } } ]
[ T{ unboxable { x 12 } { y 3 } } unboxy ] unit-test
[ 9 ]
[
"""
USING: kernel math ;
IN: typed.tests
TUPLE: unboxable
{ x fixnum read-only }
{ y fixnum read-only }
{ z float read-only } ;
""" eval( -- )
"""
USING: accessors kernel math ;
IN: typed.tests
T{ unboxable f 12 3 4.0 } unboxy xy>>
""" eval( -- xy )
] unit-test

13
extra/typed/typed.factor
View File

@ -79,7 +79,7 @@ DEFER: make-boxer
! defining typed words
: (depends-on) ( types -- types )
dup [ inlined-dependency depends-on ] each ;
dup [ inlined-dependency depends-on ] each ; inline
MACRO: (typed) ( word def effect -- quot )
[ swap ] dip
@ -96,8 +96,8 @@ MACRO: (typed) ( word def effect -- quot )
PREDICATE: typed-gensym < word "typed-gensym" word-prop ;
: typed-gensym ( parent-word -- word )
name>> "( typed " " )" surround f <word>
dup t "typed-gensym" set-word-prop ;
[ name>> "( typed " " )" surround f <word> dup ]
[ "typed-gensym" set-word-prop ] bi ;
: unboxed-effect ( effect -- effect' )
[ effect-in-types unboxed-types [ "in" swap 2array ] map ]
@ -108,6 +108,8 @@ PREDICATE: typed-lambda-word < lambda-word "typed-word" word-prop ;
M: typed-gensym stack-effect
call-next-method unboxed-effect ;
M: typed-gensym crossref?
"typed-gensym" word-prop crossref? ;
: define-typed-gensym ( word def effect -- gensym )
[ 2drop typed-gensym dup ]
@ -150,4 +152,7 @@ M: typed-lambda-word definer drop \ TYPED:: \ ; ;
M: typed-word definition "typed-def" word-prop ;
M: typed-word declarations. "typed-word" word-prop declarations. ;
M: typed-word subwords "typed-word" word-prop 1array ;
M: typed-word subwords
[ call-next-method ]
[ "typed-word" word-prop ] bi suffix ;