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

hints: fix regression with declarations

db4
Slava Pestov 2009-09-25 18:50:08 -05:00
parent 09eb06ad94
commit c0abb9ce95
3 changed files with 22 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/compiler/cfg/builder/builder-tests.factor
View File

@ -4,6 +4,7 @@ compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger
compiler.cfg.optimizer compiler.cfg.predecessors compiler.cfg.checker
compiler.cfg arrays locals byte-arrays kernel.private math
slots.private vectors sbufs strings math.partial-dispatch
hashtables assocs combinators.short-circuit
strings.private accessors compiler.cfg.instructions ;
IN: compiler.cfg.builder.tests
@ -204,4 +205,7 @@ IN: compiler.cfg.builder.tests
[ [ ##box-alien? ] contains-insn? ]
[ [ ##box-float? ] contains-insn? ] bi
] unit-test
] when
] when
! Regression. Make sure everything is inlined correctly
[ f ] [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test

12
basis/hints/hints-tests.factor Normal file
View File

@ -0,0 +1,12 @@
USING: math hashtables accessors kernel words hints
compiler.tree.debugger tools.test ;
IN: hints.tests
! Regression
GENERIC: blahblah ( a b c -- )
M: hashtable blahblah 2nip [ 1 + ] change-count drop ;
HINTS: M\ hashtable blahblah { object fixnum object } { object word object } ;
[ t ] [ M\ hashtable blahblah { count>> (>>count) } inlined? ] unit-test

10
basis/hints/hints.factor
View File

@ -37,8 +37,8 @@ M: object specializer-declaration class ;
[ [ specializer-declaration ] map swap '[ _ declare @ ] ] 2bi
] with { } map>assoc ;
: specialize-quot ( quot word specializer -- quot' )
[ drop nip def>> ] [ nip specializer-cases ] 3bi alist>quot ;
: specialize-quot ( quot specializer -- quot' )
[ drop ] [ specializer-cases ] 2bi alist>quot ;
! compiler.tree.propagation.inlining sets this to f
SYMBOL: specialize-method?
@ -52,8 +52,8 @@ t specialize-method? set-global
: specialize-method ( quot method -- quot' )
[ specialize-method? get [ method-declaration prepend ] [ drop ] if ]
[ dup "method-generic" word-prop specializer ] bi
[ specialize-quot ] [ drop ] if* ;
[ "method-generic" word-prop ] bi
specializer [ specialize-quot ] when* ;
: standard-method? ( method -- ? )
dup method-body? [
@ -64,7 +64,7 @@ t specialize-method? set-global
[ def>> ] keep
dup generic? [ drop ] [
[ dup standard-method? [ specialize-method ] [ drop ] if ]
[ dup specializer [ specialize-quot ] [ drop ] if* ]
[ specializer [ specialize-quot ] when* ]
bi
] if ;