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

basis/compiler/tree/propagation/transforms/transforms.factor

@@ -110,8 +110,7 @@ IN: compiler.tree.propagation.transforms
 : 2^? ( #call -- ? )
     in-d>> first value-info literal>> 1 eq? ;
 
-\ shift [
+: shift-2^ ( -- quot )
-    2^? [
     cell-bits tag-bits get - 1 -
     '[
         integer>fixnum dup 0 < [ 2drop 0 ] [
@@ -119,8 +118,27 @@ IN: compiler.tree.propagation.transforms
                 fixnum-shift
             ] if
         ] if
-        ]
+    ] ;
-    ] [ f ] 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 } [

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
-
+: 2/ ( x -- y ) -1 shift ; 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
-
 : sq ( x -- y ) dup * ; inline
 : neg ( x -- -x ) -1 * ; inline
 : sgn ( x -- n ) dup 0 < [ drop -1 ] [ 0 > 1 0 ? ] if ; inline