From 750a96935f7d59ee990770dad0780dc403bab3d6 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 19 Apr 2010 15:01:14 -0500 Subject: [PATCH] instance? optimizes null checks --- .../tree/propagation/propagation-tests.factor | 18 ++++++++++++++++++ .../propagation/transforms/transforms.factor | 18 +++++++++++++----- 2 files changed, 31 insertions(+), 5 deletions(-) diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 17701e94c1..8c470bf6a2 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -976,3 +976,21 @@ M: tuple-with-read-only-slot clone ! Should actually be 0 23 2^ 1 - [a,b] [ string-nth ] final-info first interval>> 0 23 2^ [a,b] = ] 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 diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 3d2d7ac298..bd85882982 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -141,6 +141,19 @@ IN: compiler.tree.propagation.transforms } case ] "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 ; : check-effect ( quot word -- ) @@ -173,11 +186,6 @@ ERROR: bad-partial-eval quot word ; \ new [ inline-new ] 1 define-partial-eval -\ instance? [ - dup class? - [ "predicate" word-prop ] [ drop f ] if -] 1 define-partial-eval - ! Shuffling : nths-quot ( indices -- quot ) [ [ '[ _ swap nth ] ] map ] [ length ] bi