diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor index 6a829cfa7f..41f1949a66 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor +++ b/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? ; diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 2ab4c1a4f7..d1793208ae 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/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 diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index acbe1a34e9..111b7d9631 100755 --- a/core/bootstrap/primitives.factor +++ b/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 diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 48a7e8cf0d..cc67109936 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/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 ] diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index fa5d9745d6..8e1aaba228 100644 --- a/core/math/integers/integers.factor +++ b/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? diff --git a/core/math/math.factor b/core/math/math.factor index 33d58769f7..b86cc9565c 100644 --- a/core/math/math.factor +++ b/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 )