Specializer optimization

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 1df68b8ece6b2050889699acac74605b879fa634..579f039da7d065cb0a2e06ac89d9584158ca282a 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -3,7 +3,6 @@ should fix in 0.82:
 - type inference busted for tuple constructors
 - constant branch folding
 - fast-slot stuff
-- compile if-intrinsic even if there is no #if there
 - 3 >n fep
 - amd64 %box-struct
 - get factor running on mac intel

diff --git a/examples/raytracer.factor b/examples/raytracer.factor
index 38867117a7a594ba11102bf2c72c392319ff2d8b..60eafd6b32454d1703a7826d18370fffa6ae710f 100644 (file)
--- a/examples/raytracer.factor
+++ b/examples/raytracer.factor
@@ -2,7 +2,7 @@
 ! http://www.ffconsultancy.com/free/ray_tracer/languages.html
 
 USING: arrays compiler generic io kernel lists math namespaces
-sequences test ;
+sequences test words ;
 IN: ray
 
 ! parameters
@@ -27,24 +27,26 @@ GENERIC: intersect-scene ( hit ray scene -- hit )
 TUPLE: sphere center radius ;
 
 : sphere-v ( sphere ray -- v )
-    swap sphere-center swap ray-orig v- ;
+    swap sphere-center swap ray-orig v- ; inline
 
-: sphere-b ( ray v -- b ) swap ray-dir v. ;
+: sphere-b ( ray v -- b ) swap ray-dir v. ; inline
 
 : sphere-disc ( sphere v b -- d )
-    sq swap norm-sq - swap sphere-radius sq + ;
+    sq swap norm-sq - swap sphere-radius sq + ; inline
 
-: -+ ( x y -- x-y x+y ) [ - ] 2keep + ;
+: -+ ( x y -- x-y x+y ) [ - ] 2keep + ; inline
 
 : sphere-b/d ( b d -- t )
-    -+ dup 0.0 < [ 2drop 1.0/0.0 ] [ >r [ 0.0 > ] keep r> ? ] if ;
+    -+ dup 0.0 < [ 2drop 1.0/0.0 ] [ >r [ 0.0 > ] keep r> ? ] if ; inline
 
 : ray-sphere ( sphere ray -- t )
     2dup sphere-v tuck sphere-b [ sphere-disc ] keep
     over 0.0 < [ 2drop 1.0/0.0 ] [ swap sqrt sphere-b/d ] if ;
+    inline
 
 : sphere-n ( ray sphere l -- n )
     pick ray-dir n*v swap sphere-center v- swap ray-orig v+ ;
+    inline
 
 : if-ray-sphere ( hit ray sphere quot -- hit )
     #! quot: hit ray sphere l -- hit
@@ -69,20 +71,20 @@ M: group intersect-scene ( hit ray group -- hit )
         drop
     ] if-ray-sphere ;
 
-: initial-hit T{ hit f { 0.0 0.0 0.0 } 1.0/0.0 } ;
+: initial-hit T{ hit f { 0.0 0.0 0.0 } 1.0/0.0 } ; inline
 
 : initial-intersect ( ray scene -- hit )
-    initial-hit -rot intersect-scene ;
+    initial-hit -rot intersect-scene ; inline
 
 : ray-o ( ray hit -- o )
     over ray-dir over hit-lambda v*n
     swap hit-normal delta v*n v+
-    swap ray-orig v+ ;
+    swap ray-orig v+ ; inline
 
 : sray-intersect ( ray scene hit -- ray )
-    swap >r ray-o light vneg <ray> r> initial-intersect ;
+    swap >r ray-o light vneg <ray> r> initial-intersect ; inline
 
-: ray-g ( hit -- g ) hit-normal light v. ;
+: ray-g ( hit -- g ) hit-normal light v. ; inline
 
 : cast-ray ( ray scene -- g )
     2dup initial-intersect dup hit-lambda 1.0/0.0 = [
@@ -90,9 +92,10 @@ M: group intersect-scene ( hit ray group -- hit )
     ] [
         dup ray-g >r sray-intersect hit-lambda 1.0/0.0 =
         [ r> neg ] [ r> drop 0.0 ] if
-    ] if ;
+    ] if ; inline
 
-: create-center ( c r d -- c2 ) >r 3.0 12.0 sqrt / * r> n*v v+ ;
+: create-center ( c r d -- c2 )
+    >r 3.0 12.0 sqrt / * r> n*v v+ ; inline
 
 DEFER: create ( level c r -- scene )
 

diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor
index 29f717929aabb4942535693a20b7ace33fe37a5c..72ebb79b7925b551897f7876bc25353c2bd42531 100644 (file)
--- a/library/bootstrap/boot-stage1.factor
+++ b/library/bootstrap/boot-stage1.factor
@@ -117,6 +117,7 @@ vectors words ;
         "/library/compiler/inference/stack.factor"
         "/library/compiler/inference/known-words.factor"
 
+        "/library/compiler/optimizer/specializers.factor"
         "/library/compiler/optimizer/class-infer.factor"
         "/library/compiler/optimizer/kill-literals.factor"
         "/library/compiler/optimizer/optimizer.factor"

diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor
index ec7681d4ef87d8ab54e3b9e0aed3ce3e3aefb84e..9381b125078a02579a194bcdc93d87a0c3b3e888 100644 (file)
--- a/library/compiler/compiler.factor
+++ b/library/compiler/compiler.factor
@@ -7,7 +7,7 @@ namespaces optimizer prettyprint sequences test words ;
 : (compile) ( word -- )
     [
         [
-            dup word-def dataflow optimize generate
+            dup specialized-def dataflow optimize generate
         ] keep
     ] benchmark nip
     "compile-time" set-word-prop ;

diff --git a/library/compiler/optimizer/specializers.factor b/library/compiler/optimizer/specializers.factor
new file mode 100644 (file)
index 0000000..9fc239f
--- /dev/null
+++ b/library/compiler/optimizer/specializers.factor
@@ -0,0 +1,33 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: arrays generic kernel math namespaces sequences words ;
+
+: make-specializer ( quot class picker -- quot )
+    over \ object eq? [
+        2drop
+    ] [
+        [
+            , "predicate" word-prop % dup , , \ if ,
+        ] [ ] make
+    ] if ;
+
+: specialized-def ( word -- quot )
+    dup word-def swap "specializer" word-prop [
+        reverse-slice { dup over pick } [
+            make-specializer
+        ] 2each
+    ] when* ;
+
+{ vneg norm-sq norm normalize } [
+    { array } "specializer" set-word-prop
+] each
+
+\ n*v { object array } "specializer" set-word-prop
+\ v*n { array object } "specializer" set-word-prop
+\ n/v { object array } "specializer" set-word-prop
+\ v/n { array object } "specializer" set-word-prop
+
+{ v+ v- v* v/ vmax vmin v. } [
+    { array array } "specializer" set-word-prop
+] each

diff --git a/library/test/benchmark/fib.factor b/library/test/benchmark/fib.factor
index 2b9e76e683c2decebfd5150a56c3acfcdc9e9fb2..c9602a4458475242a4e83161c49d9b03067dbe9e 100644 (file)
--- a/library/test/benchmark/fib.factor
+++ b/library/test/benchmark/fib.factor
@@ -5,6 +5,7 @@ USE: math
 USE: test
 USE: math-internals
 USE: namespaces
+USE: words
 
 ! Five fibonacci implementations, each one slower than the
 ! previous.
@@ -31,8 +32,10 @@ USE: namespaces
 [ 9227465 ] [ 34 fixnum-fib ] unit-test
 
 : fib ( n -- nth fibonacci number )
-    dup 1 <= [ drop 1 ] [ 1- dup fib swap 1- fib + ] if ;
-    compiled
+    dup 1 <= [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ;
+
+\ fib { fixnum } "specializer" set-word-prop
+\ fib compile
 
 [ 9227465 ] [ 34 fib ] unit-test