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

hints: allow hints on generic words, these are propagated to each method

db4
Slava Pestov 2009-03-26 21:25:21 -05:00
parent d35e50e807
commit caa89de401
1 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/hints/hints.factor
View File

@ -34,16 +34,18 @@ M: object specializer-declaration class ;
[ specializer-declaration ] map '[ _ declare ] pick append [ specializer-declaration ] map '[ _ declare ] pick append
] { } map>assoc ; ] { } map>assoc ;
: specialize-quot ( quot specializer -- quot' )
specializer-cases alist>quot ;
: method-declaration ( method -- quot ) : method-declaration ( method -- quot )
[ "method-generic" word-prop dispatch# object <array> ] [ "method-generic" word-prop dispatch# object <array> ]
[ "method-class" word-prop ] [ "method-class" word-prop ]
bi prefix ; bi prefix ;
: specialize-method ( quot method -- quot' ) : specialize-method ( quot method -- quot' )
method-declaration '[ _ declare ] prepend ; [ method-declaration '[ _ declare ] prepend ]
[ "method-generic" word-prop "specializer" word-prop ] bi
: specialize-quot ( quot specializer -- quot' ) [ specialize-quot ] when* ;
specializer-cases alist>quot ;
: standard-method? ( method -- ? ) : standard-method? ( method -- ? )
dup method-body? [ dup method-body? [
@ -52,9 +54,11 @@ M: object specializer-declaration class ;
: specialized-def ( word -- quot ) : specialized-def ( word -- quot )
[ def>> ] keep [ def>> ] keep
[ dup standard-method? [ specialize-method ] [ drop ] if ] dup generic? [ drop ] [
[ "specializer" word-prop [ specialize-quot ] when* ] [ dup standard-method? [ specialize-method ] [ drop ] if ]
bi ; [ "specializer" word-prop [ specialize-quot ] when* ]
bi
] if ;
: specialized-length ( specializer -- n ) : specialized-length ( specializer -- n )
dup [ array? ] all? [ first ] when length ; dup [ array? ] all? [ first ] when length ;