core: Throw an error when assigning a bignum to a fixnum tuple slot if the bignum doesn't fit. Fixes #594.
parent
16de2794de
commit
cd9dd9d752
|
@ -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? ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ]
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -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 )
|
||||
|
|
Loading…
Reference in New Issue