diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 180413abb8..a7ec584b55 100644 --- 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 983eb826b3..20593bd48a 100644 --- 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