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

make type declarations in stack effects strong and throw an error if the inputs don't match

db4
Joe Groff 2009-09-01 15:49:08 -05:00
parent 19b10fb85e
commit 6b512e3187
1 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
basis/hints/hints.factor
View File

@ -36,14 +36,21 @@ M: object specializer-declaration class ;
[ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce [ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce
] if-empty ; ] if-empty ;
: specializer-cases ( quot word -- default alist ) ERROR: type-mismatch-error word expected-types ;
dup [ array? ] all? [ 1array ] unless [
[ make-specializer ] keep
[ specializer-declaration ] map '[ _ declare ] pick append
] { } map>assoc ;
: specialize-quot ( quot specializer -- quot' ) : fallback-def ( word -- quot )
specializer-cases alist>quot ; dup stack-effect effect-in-types dup specialized?
[ [ type-mismatch-error ] 2curry ]
[ drop def>> ] if ;
: specializer-cases ( quot specializer -- alist )
dup [ array? ] all? [ 1array ] unless [
[ nip make-specializer ]
[ [ specializer-declaration ] map swap '[ _ declare @ ] ] 2bi
] with { } map>assoc ;
: specialize-quot ( quot word specializer -- quot' )
[ drop nip fallback-def ] [ nip specializer-cases ] 3bi alist>quot ;
! compiler.tree.propagation.inlining sets this to f ! compiler.tree.propagation.inlining sets this to f
SYMBOL: specialize-method? SYMBOL: specialize-method?
@ -57,8 +64,8 @@ t specialize-method? set-global
: specialize-method ( quot method -- quot' ) : specialize-method ( quot method -- quot' )
[ specialize-method? get [ method-declaration prepend ] [ drop ] if ] [ specialize-method? get [ method-declaration prepend ] [ drop ] if ]
[ "method-generic" word-prop specializer ] bi [ dup "method-generic" word-prop specializer ] bi
[ specialize-quot ] when* ; [ specialize-quot ] [ nip ] if* ;
: standard-method? ( method -- ? ) : standard-method? ( method -- ? )
dup method-body? [ dup method-body? [
@ -69,7 +76,7 @@ t specialize-method? set-global
[ def>> ] keep [ def>> ] keep
dup generic? [ drop ] [ dup generic? [ drop ] [
[ dup standard-method? [ specialize-method ] [ drop ] if ] [ dup standard-method? [ specialize-method ] [ drop ] if ]
[ specializer [ specialize-quot ] when* ] [ dup specializer [ specialize-quot ] [ drop ] if* ]
bi bi
] if ; ] if ;