compiler: Fix bitand on ratios, floats. Fix shift on ratios, floats. Add integer>fixnum. Fixes #500.

basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor

@@ -39,7 +39,7 @@ IN: compiler.tree.modular-arithmetic
 ! is a modular arithmetic word, then the input can be converted into
 ! a form that is cheaper to compute.
 {
-    >fixnum bignum>fixnum float>fixnum
+    >fixnum bignum>fixnum integer>fixnum float>fixnum
     set-alien-unsigned-1 set-alien-signed-1
     set-alien-unsigned-2 set-alien-signed-2
 }
@@ -181,7 +181,7 @@ MEMO: fixnum-coercion ( flags -- nodes )
     ] when ;
 
 : like->fixnum? ( #call -- ? )
-    word>> { >fixnum bignum>fixnum float>fixnum } member-eq? ;
+    word>> { >fixnum bignum>fixnum float>fixnum integer>fixnum } member-eq? ;
 
 : like->integer? ( #call -- ? )
     word>> { >integer >bignum fixnum>bignum } member-eq? ;

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -224,6 +224,7 @@ generic-comparison-ops [
 {
     { >fixnum fixnum }
     { bignum>fixnum fixnum }
+    { integer>fixnum fixnum }
 
     { >bignum bignum }
     { fixnum>bignum bignum }

basis/compiler/tree/propagation/propagation-tests.factor

@@ -9,7 +9,7 @@ compiler.tree.debugger compiler.tree.checker slots.private words
 hashtables classes assocs locals specialized-arrays system
 sorting math.libm math.floats.private math.integers.private
 math.intervals quotations effects alien alien.data sets
-strings.private vocabs ;
+strings.private vocabs generic.single ;
 FROM: math => float ;
 SPECIALIZED-ARRAY: double
 SPECIALIZED-ARRAY: void*
@@ -1025,3 +1025,19 @@ M: f derp drop t ;
 [
     [ dup maybe{ integer } instance? [ derp ] when ] { instance? } inlined?
 ] unit-test
+
+! Type-check ratios with bitand operators
+
+: bitand-ratio0 ( x -- y )
+    1 bitand zero? ;
+
+: bitand-ratio1 ( x -- y )
+    1 swap bitand zero? ;
+
+[ 2+1/2 bitand-ratio0 ] [ no-method? ] must-fail-with 
+[ 2+1/2 bitand-ratio1 ] [ no-method? ] must-fail-with
+
+: shift-test0 ( x -- y )
+    4.3 shift ;
+
+[ 1 shift-test0 ] [ no-method? ] must-fail-with

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

@@ -95,11 +95,11 @@ IN: compiler.tree.propagation.transforms
             }
             {
                 [ 2dup simplify-bitand? ]
-                [ 2drop [ >fixnum fixnum-bitand ] ]
+                [ 2drop [ integer>fixnum fixnum-bitand ] ]
             }
             {
                 [ 2dup swap simplify-bitand? ]
-                [ 2drop [ [ >fixnum ] dip fixnum-bitand ] ]
+                [ 2drop [ [ integer>fixnum ] dip fixnum-bitand ] ]
             }
             [ 2drop f ]
         } cond
@@ -114,7 +114,7 @@ IN: compiler.tree.propagation.transforms
     2^? [
         cell-bits tag-bits get - 1 -
         '[
-            >fixnum dup 0 < [ 2drop 0 ] [
+            integer>fixnum dup 0 < [ 2drop 0 ] [
                 dup _ < [ fixnum-shift ] [
                     fixnum-shift
                 ] if
@@ -309,10 +309,17 @@ M\ set intersect [ intersect-quot ] 1 define-partial-eval
     [ \ push def>> ] [ f ] if
 ] "custom-inlining" set-word-prop
 
+: custom-inline-fixnum ( x -- y )
+    in-d>> first value-info class>> fixnum \ f class-or class<=
+    [ [ dup [ \ >fixnum no-method ] unless ] ] [ f ] if ;
+
 ! Speeds up fasta benchmark
 \ >fixnum [
-    in-d>> first value-info class>> fixnum \ f class-or class<=
+    custom-inline-fixnum
-    [ [ dup [ \ >fixnum no-method ] unless ] ] [ f ] if
+] "custom-inlining" set-word-prop
+
+\ integer>fixnum [
+    custom-inline-fixnum
 ] "custom-inlining" set-word-prop
 
 ! We want to constant-fold calls to heap-size, and recompile those

core/math/integers/integers.factor

@@ -15,6 +15,7 @@ M: fixnum >fixnum ; inline
 M: fixnum >bignum fixnum>bignum ; inline
 M: fixnum >integer ; inline
 M: fixnum >float fixnum>float ; inline
+M: fixnum integer>fixnum ; inline
 
 M: fixnum hashcode* nip ; inline
 M: fixnum equal? over bignum? [ >bignum bignum= ] [ 2drop f ] if ; inline
@@ -45,7 +46,7 @@ M: fixnum /mod fixnum/mod ; inline
 M: fixnum bitand fixnum-bitand ; inline
 M: fixnum bitor fixnum-bitor ; inline
 M: fixnum bitxor fixnum-bitxor ; inline
-M: fixnum shift >fixnum fixnum-shift ; inline
+M: fixnum shift integer>fixnum fixnum-shift ; inline
 
 M: fixnum bitnot fixnum-bitnot ; inline
 
@@ -61,6 +62,7 @@ M: fixnum (log2) fixnum-log2 ; inline
 
 M: bignum >fixnum bignum>fixnum ; inline
 M: bignum >bignum ; inline
+M: bignum integer>fixnum bignum>fixnum ; inline
 
 M: bignum hashcode* nip >fixnum ;
 
@@ -92,7 +94,7 @@ M: bignum /mod bignum/mod ; inline
 M: bignum bitand bignum-bitand ; inline
 M: bignum bitor bignum-bitor ; inline
 M: bignum bitxor bignum-bitxor ; inline
-M: bignum shift >fixnum bignum-shift ; inline
+M: bignum shift integer>fixnum bignum-shift ; inline
 
 M: bignum bitnot bignum-bitnot ; inline
 M: bignum bit? bignum-bit? ; inline

core/math/math.factor

@@ -7,6 +7,7 @@ GENERIC: >fixnum ( x -- n ) foldable
 GENERIC: >bignum ( x -- n ) foldable
 GENERIC: >integer ( x -- n ) foldable
 GENERIC: >float ( x -- y ) foldable
+GENERIC: integer>fixnum ( x -- y ) foldable
 
 GENERIC: numerator ( a/b -- a )
 GENERIC: denominator ( a/b -- b )