From fb4e3ad9bc16d28fa04e43a9d025468063c9c1c5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 23 Jul 2012 09:27:17 -0700 Subject: [PATCH] compiler: Fix bitand on ratios, floats. Fix shift on ratios, floats. Add integer>fixnum. Fixes #500. --- .../modular-arithmetic.factor | 4 ++-- .../propagation/known-words/known-words.factor | 1 + .../tree/propagation/propagation-tests.factor | 18 +++++++++++++++++- .../propagation/transforms/transforms.factor | 17 ++++++++++++----- core/math/integers/integers.factor | 6 ++++-- core/math/math.factor | 1 + 6 files changed, 37 insertions(+), 10 deletions(-) diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor index 55669f06c1..6a829cfa7f 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor +++ b/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? ; diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index 147eeec745..3d263b5754 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/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 } diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index d56faf150e..3021bb6398 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/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 diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 5edbc617ff..2ab4c1a4f7 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/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<= - [ [ dup [ \ >fixnum no-method ] unless ] ] [ f ] if + custom-inline-fixnum +] "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 diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index 56d8fb5aba..18281bf88c 100644 --- a/core/math/integers/integers.factor +++ b/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 diff --git a/core/math/math.factor b/core/math/math.factor index 1810cc0ee2..33d58769f7 100644 --- a/core/math/math.factor +++ b/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 )