core: Throw an error when assigning a bignum to a fixnum tuple slot if the bignum doesn't fit. Fixes #594.

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

@@ -39,7 +39,8 @@ 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 integer>fixnum float>fixnum
+    >fixnum bignum>fixnum integer>fixnum integer>fixnum-strict
+    float>fixnum
     set-alien-unsigned-1 set-alien-signed-1
     set-alien-unsigned-2 set-alien-signed-2
 }
@@ -181,7 +182,10 @@ MEMO: fixnum-coercion ( flags -- nodes )
     ] when ;
 
 : like->fixnum? ( #call -- ? )
-    word>> { >fixnum bignum>fixnum float>fixnum integer>fixnum } member-eq? ;
+    word>> {
+        >fixnum bignum>fixnum float>fixnum
+        integer>fixnum integer>fixnum-strict
+    } member-eq? ;
 
 : like->integer? ( #call -- ? )
     word>> { >integer >bignum fixnum>bignum } member-eq? ;

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

@@ -318,9 +318,9 @@ M\ set intersect [ intersect-quot ] 1 define-partial-eval
     custom-inline-fixnum
 ] "custom-inlining" set-word-prop
 
-\ integer>fixnum [
-    custom-inline-fixnum
-] "custom-inlining" set-word-prop
+{ integer>fixnum integer>fixnum-strict } [
+    [ custom-inline-fixnum ] "custom-inlining" set-word-prop
+] each
 
 ! We want to constant-fold calls to heap-size, and recompile those
 ! calls when a C type is redefined

core/bootstrap/primitives.factor

@@ -197,7 +197,7 @@ bi
 "null?" "kernel" vocab-words delete-at
 
 "fixnum" "math" create { } define-builtin
-"fixnum" "math" create "integer>fixnum" "math" create 1quotation "coercer" set-word-prop
+"fixnum" "math" create "integer>fixnum-strict" "math" create 1quotation "coercer" set-word-prop
 
 "bignum" "math" create { } define-builtin
 "bignum" "math" create ">bignum" "math" create 1quotation "coercer" set-word-prop

core/classes/tuple/tuple-tests.factor

@@ -533,9 +533,17 @@ unit-test
 must-fail-with
 
 ! Check fixnum coercer
-[ 0.0 "hi" declared-types boa n>> ] [ T{ no-method f 0.0 integer>fixnum } = ] must-fail-with
+[ 0.0 "hi" declared-types boa n>> ] [ T{ no-method f 0.0 integer>fixnum-strict } = ] must-fail-with
 
-[ declared-types new 0.0 >>n n>> ] [ T{ no-method f 0.0 integer>fixnum } = ] must-fail-with
+[ declared-types new 0.0 >>n n>> ] [ T{ no-method f 0.0 integer>fixnum-strict } = ] must-fail-with
+
+[ T{ declared-types f 33333 "asdf" } ]
+[ 33333 >bignum "asdf" declared-types boa ] unit-test
+
+[ 444444444444444444444444444444444444444444444444433333 >bignum "asdf" declared-types boa ]
+[
+    T{ out-of-fixnum-range f 444444444444444444444444444444444444444444444444433333 }
+] must-fail-with
 
 ! Check bignum coercer
 TUPLE: bignum-coercer { n bignum initial: $[ 0 >bignum ] } ;
@@ -562,10 +570,10 @@ TUPLE: integer-coercer { n integer } ;
 
 \ foo def>> must-infer
 
-[ 0.0 "hi" foo ] [ T{ no-method f 0.0 integer>fixnum } = ] must-fail-with
+[ 0.0 "hi" foo ] [ T{ no-method f 0.0 integer>fixnum-strict } = ] must-fail-with
 
 [ "hi" 0.0 declared-types boa ]
-[ T{ no-method f "hi" integer>fixnum } = ]
+[ T{ no-method f "hi" integer>fixnum-strict } = ]
 must-fail-with
 
 [ 0 { } declared-types boa ]
@@ -573,7 +581,7 @@ must-fail-with
 must-fail-with
 
 [ "hi" 0.0 foo ]
-[ T{ no-method f "hi" integer>fixnum } = ]
+[ T{ no-method f "hi" integer>fixnum-strict } = ]
 must-fail-with
 
 [ 0 { } foo ]

core/math/integers/integers.factor

@@ -16,6 +16,7 @@ M: fixnum >bignum fixnum>bignum ; inline
 M: fixnum >integer ; inline
 M: fixnum >float fixnum>float ; inline
 M: fixnum integer>fixnum ; inline
+M: fixnum integer>fixnum-strict ; inline
 
 M: fixnum hashcode* nip ; inline
 M: fixnum equal? over bignum? [ >bignum bignum= ] [ 2drop f ] if ; inline
@@ -64,6 +65,10 @@ M: bignum >fixnum bignum>fixnum ; inline
 M: bignum >bignum ; inline
 M: bignum integer>fixnum bignum>fixnum ; inline
 
+M: bignum integer>fixnum-strict
+    dup bignum>fixnum
+    2dup number= [ nip ] [ drop out-of-fixnum-range ] if ; inline
+
 M: bignum hashcode* nip bignum>fixnum ;
 
 M: bignum equal?

core/math/math.factor

@@ -8,6 +8,7 @@ GENERIC: >bignum ( x -- n ) foldable
 GENERIC: >integer ( x -- n ) foldable
 GENERIC: >float ( x -- y ) foldable
 GENERIC: integer>fixnum ( x -- y ) foldable
+GENERIC: integer>fixnum-strict ( x -- y ) foldable
 
 GENERIC: numerator ( a/b -- a )
 GENERIC: denominator ( a/b -- b )
@@ -57,6 +58,8 @@ GENERIC: (log2) ( x -- n ) foldable
 
 PRIVATE>
 
+ERROR: out-of-fixnum-range n ;
+
 ERROR: log2-expects-positive x ;
 
 : log2 ( x -- n )