math: cleaner "2/" speedup by using custom inlining.

diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index 180413abb81c2170990b8bb226feb51bd0a9fb27..a7ec584b553f45e4e2f99f92c99286aabb309147 100644 (file)
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -110,17 +110,35 @@ IN: compiler.tree.propagation.transforms
 : 2^? ( #call -- ? )
     in-d>> first value-info literal>> 1 eq? ;
 
-\ shift [
-    2^? [
-        cell-bits tag-bits get - 1 -
-        '[
-            integer>fixnum dup 0 < [ 2drop 0 ] [
-                dup _ < [ fixnum-shift ] [
-                    fixnum-shift
-                ] if
+: shift-2^ ( -- quot )
+    cell-bits tag-bits get - 1 -
+    '[
+        integer>fixnum dup 0 < [ 2drop 0 ] [
+            dup _ < [ fixnum-shift ] [
+                fixnum-shift
             ] if
-        ]
-    ] [ f ] if
+        ] if
+    ] ;
+
+! Speeds up 2/
+: 2/? ( #call -- ? )
+    in-d>> second value-info literal>> -1 eq? ;
+
+: shift-2/ ( -- quot )
+    [
+        {
+            { [ over fixnum? ] [ fixnum-shift ] }
+            { [ over bignum? ] [ bignum-shift ] }
+            [ drop \ shift no-method ]
+        } cond
+    ] ;
+
+\ shift [
+    {
+        { [ dup 2^? ] [ drop shift-2^ ] }
+        { [ dup 2/? ] [ drop shift-2/ ] }
+        [ drop f ]
+    } cond
 ] "custom-inlining" set-word-prop
 
 { /i fixnum/i fixnum/i-fast bignum/i } [

diff --git a/core/math/math.factor b/core/math/math.factor
index 983eb826b37128f760952f87fde7048f33d5d1ce..20593bd48a89e1db518b1e3acf91e687f84adc9c 100644 (file)
--- a/core/math/math.factor
+++ b/core/math/math.factor
@@ -66,13 +66,7 @@ ERROR: log2-expects-positive x ;
     dup 0 <= [ log2-expects-positive ] [ (log2) ] if ; inline
 
 : zero? ( x -- ? ) 0 number= ; inline
-
-! the following lines are necessary because the "-1 shift"
-! definition doesn't (yet) compile as nicely...
-GENERIC: 2/ ( x -- y ) foldable
-M: bignum 2/ -1 bignum-shift ; inline
-M: fixnum 2/ -1 fixnum-shift ; inline
-
+: 2/ ( x -- y ) -1 shift ; inline
 : sq ( x -- y ) dup * ; inline
 : neg ( x -- -x ) -1 * ; inline
 : sgn ( x -- n ) dup 0 < [ drop -1 ] [ 0 > 1 0 ? ] if ; inline