From e46259bd338a33454ce41fa9b09e80670eb9b590 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 07:50:56 -0500 Subject: [PATCH] compiler.tree.propagation.transforms: fix problem with 'shift' transform when input was a bignum --- basis/compiler/tests/optimizer.factor | 2 ++ .../compiler/tree/propagation/transforms/transforms.factor | 6 +++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 0c9b1817c8..3a0fada735 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -443,5 +443,7 @@ M: object bad-dispatch-position-test* ; [ -1 ] [ 3 4 0 dispatch-branch-problem ] unit-test [ 12 ] [ 3 4 1 dispatch-branch-problem ] unit-test +[ 1024 bignum ] [ 10 [ 1 >bignum swap >fixnum shift ] compile-call dup class ] unit-test + ! Not sure if I want to fix this... ! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with \ No newline at end of file diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index b8ff96f833..3a75ee37e1 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -100,8 +100,12 @@ IN: compiler.tree.propagation.transforms ] each ! Speeds up 2^ +: 2^? ( #call -- ? ) + in-d>> first value-info + { [ literal>> 1 = ] [ class>> fixnum class<= ] } 1&& ; + \ shift [ - in-d>> first value-info literal>> 1 = [ + 2^? [ cell-bits tag-bits get - 1 - '[ >fixnum dup 0 < [ 2drop 0 ] [