steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix test failures from ratio/complex built-in removal

db4
Slava Pestov 2009-04-30 00:38:55 -05:00
parent 663db67b23
commit 964fbd0a24
5 changed files with 21 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/tests/codegen.factor
View File

@ -26,7 +26,7 @@ IN: compiler.tests.codegen
[ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-call ] unit-test [ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-call ] unit-test
[ { 1 2 3 } { 1 4 3 } 6 6 ] [ { 1 2 3 } { 1 4 3 } 2 2 ]
[ { 1 2 3 } { 1 4 3 } [ over tag over tag ] compile-call ] [ { 1 2 3 } { 1 4 3 } [ over tag over tag ] compile-call ]
unit-test unit-test

16
basis/compiler/tree/propagation/info/info.factor
View File

@ -70,18 +70,10 @@ DEFER: <literal-info>
dup literal>> class >>class dup literal>> class >>class
dup literal>> dup real? [ [a,a] >>interval ] [ dup literal>> dup real? [ [a,a] >>interval ] [
[ [-inf,inf] >>interval ] dip [ [-inf,inf] >>interval ] dip
{ dup tuple? [
{ [ dup complex? ] [ [ tuple-slots [ <literal-info> ] map ] [ class ] bi
[ real-part <literal-info> ] read-only-slots >>slots
[ imaginary-part <literal-info> ] bi ] [ drop ] if
2array >>slots
] }
{ [ dup tuple? ] [
[ tuple-slots [ <literal-info> ] map ] [ class ] bi
read-only-slots >>slots
] }
[ drop ]
} cond
] if ; inline ] if ; inline
: init-value-info ( info -- info ) : init-value-info ( info -- info )

5
basis/compiler/tree/propagation/slots/slots.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: fry assocs arrays byte-arrays strings accessors sequences USING: fry assocs arrays byte-arrays strings accessors sequences
kernel slots classes.algebra classes.tuple classes.tuple.private kernel slots classes.algebra classes.tuple classes.tuple.private
@ -8,9 +8,6 @@ IN: compiler.tree.propagation.slots
! Propagation of immutable slots and array lengths ! Propagation of immutable slots and array lengths
! Revisit this code when delegation is removed and when complex
! numbers become tuples.
UNION: fixed-length-sequence array byte-array string ; UNION: fixed-length-sequence array byte-array string ;
: sequence-constructor? ( word -- ? ) : sequence-constructor? ( word -- ? )

17
core/generic/math/math-tests.factor
View File

@ -1,5 +1,5 @@
IN: generic.math.tests IN: generic.math.tests
USING: generic.math math tools.test ; USING: generic.math math tools.test kernel ;
! Test math-combination ! Test math-combination
[ [ [ >float ] dip ] ] [ \ real \ float math-upgrade ] unit-test [ [ [ >float ] dip ] ] [ \ real \ float math-upgrade ] unit-test
@ -7,10 +7,15 @@ USING: generic.math math tools.test ;
[ [ [ >bignum ] dip ] ] [ \ fixnum \ bignum math-upgrade ] unit-test [ [ [ >bignum ] dip ] ] [ \ fixnum \ bignum math-upgrade ] unit-test
[ [ >float ] ] [ \ float \ integer math-upgrade ] unit-test [ [ >float ] ] [ \ float \ integer math-upgrade ] unit-test
[ number ] [ \ number \ float math-class-max ] unit-test [ number ] [ number float math-class-max ] unit-test
[ float ] [ \ real \ float math-class-max ] unit-test [ number ] [ float number math-class-max ] unit-test
[ fixnum ] [ \ fixnum \ null math-class-max ] unit-test [ float ] [ real float math-class-max ] unit-test
[ bignum ] [ \ fixnum \ bignum math-class-max ] unit-test [ float ] [ float real math-class-max ] unit-test
[ number ] [ \ fixnum \ number math-class-max ] unit-test [ fixnum ] [ fixnum null math-class-max ] unit-test
[ fixnum ] [ null fixnum math-class-max ] unit-test
[ bignum ] [ fixnum bignum math-class-max ] unit-test
[ bignum ] [ bignum fixnum math-class-max ] unit-test
[ number ] [ fixnum number math-class-max ] unit-test
[ number ] [ number fixnum math-class-max ] unit-test

8
core/generic/math/math.factor
View File

@ -22,11 +22,11 @@ PREDICATE: math-class < class
: math-precedence ( class -- pair ) : math-precedence ( class -- pair )
[ [
{ null fixnum bignum ratio float complex object } bootstrap-words { fixnum integer rational real number object } bootstrap-words
swap [ class<= ] curry find drop swap [ swap class<= ] curry find drop -1 or
] [ ] [
{ null fixnum integer rational real number object } bootstrap-words { fixnum bignum ratio float complex object } bootstrap-words
swap [ swap class<= ] curry find drop swap [ class<= ] curry find drop -1 or
] bi 2array ; ] bi 2array ;
: (math-upgrade) ( max class -- quot ) : (math-upgrade) ( max class -- quot )