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

instance? optimizes null checks

db4
Daniel Ehrenberg 2010-04-19 15:01:14 -05:00
parent 24ad579631
commit 750a96935f
2 changed files with 31 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -976,3 +976,21 @@ M: tuple-with-read-only-slot clone
! Should actually be 0 23 2^ 1 - [a,b] ! Should actually be 0 23 2^ 1 - [a,b]
[ string-nth ] final-info first interval>> 0 23 2^ [a,b] = [ string-nth ] final-info first interval>> 0 23 2^ [a,b] =
] unit-test ] unit-test
! Optimization on instance?
[ f ] [ [ { number } declare fixnum instance? ] { tag fixnum? } inlined? ] unit-test
UNION: ?fixnum fixnum POSTPONE: f ;
[ t ] [ [ { ?fixnum } declare fixnum instance? ] { tag fixnum? } inlined? ] unit-test
[ t ] [ [ { fixnum } declare fixnum instance? ] { tag fixnum? } inlined? ] unit-test
! Actually check to make sure that the generated code works properly
: instance-test-1 ( x -- ? ) { ?fixnum } declare fixnum instance? ;
: instance-test-2 ( x -- ? ) { number } declare fixnum instance? ;
: instance-test-3 ( x -- ? ) { POSTPONE: f } declare \ f instance? ;
[ t ] [ 1 instance-test-1 ] unit-test
[ f ] [ f instance-test-1 ] unit-test
[ t ] [ 1 instance-test-2 ] unit-test
[ f ] [ 1.1 instance-test-2 ] unit-test
[ t ] [ f instance-test-3 ] unit-test

18
basis/compiler/tree/propagation/transforms/transforms.factor
View File

@ -141,6 +141,19 @@ IN: compiler.tree.propagation.transforms
} case } case
] "custom-inlining" set-word-prop ] "custom-inlining" set-word-prop
:: inline-instance ( node -- quot/f )
node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj klass )
klass class? [
{
[ klass \ f = not ]
[ obj class>> \ f class-not class-and klass class<= ]
} 0&&
[ [ drop >boolean ] ]
[ klass "predicate" word-prop '[ drop @ ] ] if
] [ f ] if ;
\ instance? [ inline-instance ] "custom-inlining" set-word-prop
ERROR: bad-partial-eval quot word ; ERROR: bad-partial-eval quot word ;
: check-effect ( quot word -- ) : check-effect ( quot word -- )
@ -173,11 +186,6 @@ ERROR: bad-partial-eval quot word ;
\ new [ inline-new ] 1 define-partial-eval \ new [ inline-new ] 1 define-partial-eval
\ instance? [
dup class?
[ "predicate" word-prop ] [ drop f ] if
] 1 define-partial-eval
! Shuffling ! Shuffling
: nths-quot ( indices -- quot ) : nths-quot ( indices -- quot )
[ [ '[ _ swap nth ] ] map ] [ length ] bi [ [ '[ _ swap nth ] ] map ] [ length ] bi