compiler.tree.propagation.known-words: better way to assign the
"outputs" to the mod words + some more testsdb4
Björn Lindqvist
parent
35b04f8ec1
commit
95fa3eba19
|
|
@ -1,21 +1,34 @@
|
|||
USING: compiler.tree.propagation.known-words kernel math math.intervals
|
||||
tools.test ;
|
||||
USING: accessors compiler.tree.propagation.info
|
||||
compiler.tree.propagation.known-words kernel kernel.private layouts math
|
||||
math.intervals math.private random tools.test words ;
|
||||
IN: compiler.tree.propagation.known-words.tests
|
||||
|
||||
{
|
||||
fixnum
|
||||
T{ interval { from { -19 t } } { to { 19 t } } }
|
||||
fixnum T{ interval { from { -19 t } } { to { 19 t } } }
|
||||
} [
|
||||
integer
|
||||
T{ interval { from { -19 t } } { to { 19 t } } }
|
||||
maybe>fixnum
|
||||
fixnum fixnum full-interval 0 20 [a,b] mod-merge-classes/intervals
|
||||
] unit-test
|
||||
|
||||
{
|
||||
object
|
||||
T{ interval { from { -19 t } } { to { 19 t } } }
|
||||
object T{ interval { from { -20 f } } { to { 20 f } } }
|
||||
} [
|
||||
object
|
||||
T{ interval { from { -19 t } } { to { 19 t } } }
|
||||
maybe>fixnum
|
||||
object object full-interval 0 20 [a,b] mod-merge-classes/intervals
|
||||
] unit-test
|
||||
|
||||
{ fixnum } [
|
||||
bignum <class-info>
|
||||
fixnum fixnum-interval <class/interval-info>
|
||||
\ mod "outputs" word-prop call( x y -- z )
|
||||
class>>
|
||||
] unit-test
|
||||
|
||||
! Since 10 >bignum 5 >bignum bignum-mod => fixnum, the output class
|
||||
! must be integer.
|
||||
{ integer } [
|
||||
bignum <class-info> dup \ bignum-mod "outputs" word-prop call class>>
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
100 random 2^ >bignum
|
||||
[ { bignum } declare 10 /mod ] call nip fixnum?
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -51,10 +51,6 @@ IN: compiler.tree.propagation.known-words
|
|||
: ensure-math-class ( class must-be -- class' )
|
||||
[ class<= ] most ;
|
||||
|
||||
: maybe>fixnum ( class interval -- class' interval )
|
||||
2dup [ integer class<= ] [ fixnum-interval interval-subset? ] bi*
|
||||
and [ nip fixnum swap ] when ;
|
||||
|
||||
: number-valued ( class interval -- class' interval' )
|
||||
[ number ensure-math-class ] dip ;
|
||||
|
||||
|
|
@ -98,12 +94,14 @@ IN: compiler.tree.propagation.known-words
|
|||
|
||||
\ absq [ interval-absq ] [ may-overflow real-valued ] unary-op
|
||||
|
||||
: binary-op-class ( info1 info2 -- newclass )
|
||||
[ class>> ] bi@
|
||||
: merge-classes ( class1 class2 -- class3 )
|
||||
2dup [ null-class? ] either? [ 2drop null ] [
|
||||
[ math-closure ] bi@ math-class-max
|
||||
] if ;
|
||||
|
||||
: binary-op-class ( info1 info2 -- newclass )
|
||||
[ class>> ] bi@ merge-classes ;
|
||||
|
||||
: binary-op-interval ( info1 info2 quot -- newinterval )
|
||||
[ [ interval>> ] bi@ ] dip call ; inline
|
||||
|
||||
|
|
@ -127,13 +125,30 @@ IN: compiler.tree.propagation.known-words
|
|||
\ /i [ [ interval/i ] [ may-overflow integer-valued ] binary-op ] each-derived-op
|
||||
\ /f [ [ interval/f ] [ float-valued ] binary-op ] each-derived-op
|
||||
|
||||
\ mod [ interval-mod ] [ real-valued maybe>fixnum ] binary-op
|
||||
\ fmod [ interval-mod ] [ real-valued ] binary-op
|
||||
\ mod-integer-integer [ interval-mod ] [ integer-valued ] binary-op
|
||||
\ bignum-mod [ interval-mod ] [ integer-valued maybe>fixnum ] binary-op
|
||||
\ fixnum-mod [ interval-mod ] [ fixnum-valued ] binary-op
|
||||
\ mod-fixnum-integer [ interval-mod ] [ fixnum-valued ] binary-op
|
||||
\ mod-integer-fixnum [ interval-mod ] [ fixnum-valued ] binary-op
|
||||
: mod-merge-classes/intervals ( c1 c2 i1 i2 -- c3 i3 )
|
||||
[ merge-classes dup bignum = [ drop integer ] when ]
|
||||
[ interval-mod ] 2bi*
|
||||
over integer class<= [
|
||||
integral-closure dup fixnum-interval interval-subset? [
|
||||
nip fixnum swap
|
||||
] when
|
||||
] when ;
|
||||
|
||||
: mod-outputs-info ( info1 info2 fixer-word -- info3 )
|
||||
[
|
||||
[ [ class>> ] bi@ ] [ [ interval>> ] bi@ ] 2bi
|
||||
mod-merge-classes/intervals
|
||||
] dip execute( cls int -- cls' int' ) <class/interval-info> ;
|
||||
|
||||
{
|
||||
{ mod real-valued }
|
||||
{ fmod real-valued }
|
||||
{ mod-integer-integer integer-valued }
|
||||
{ mod-fixnum-integer integer-valued }
|
||||
{ mod-integer-fixnum integer-valued }
|
||||
{ bignum-mod integer-valued }
|
||||
{ fixnum-mod fixnum-valued }
|
||||
} [ '[ _ mod-outputs-info ] "outputs" set-word-prop ] assoc-each
|
||||
|
||||
\ rem [ [ interval-rem ] [ may-overflow real-valued ] binary-op ] each-derived-op
|
||||
|
||||
|
|
|
|||
|
|
@ -1,15 +1,14 @@
|
|||
USING: kernel compiler.tree.builder compiler.tree
|
||||
compiler.tree.propagation compiler.tree.recursive
|
||||
compiler.tree.normalization tools.test math math.order accessors
|
||||
sequences arrays kernel.private vectors alien.accessors
|
||||
alien.c-types sequences.private byte-arrays classes.algebra
|
||||
classes.tuple.private math.functions math.private strings
|
||||
layouts compiler.tree.propagation.info compiler.tree.def-use
|
||||
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 generic.single ;
|
||||
USING: accessors alien alien.accessors alien.c-types alien.data arrays assocs
|
||||
byte-arrays classes classes.algebra classes.tuple.private compiler.tree
|
||||
compiler.tree.builder compiler.tree.checker compiler.tree.debugger
|
||||
compiler.tree.def-use compiler.tree.normalization compiler.tree.optimizer
|
||||
compiler.tree.propagation compiler.tree.propagation.info
|
||||
compiler.tree.recursive effects fry generic.single hashtables kernel
|
||||
kernel.private layouts locals math math.floats.private math.functions
|
||||
math.integers.private math.intervals math.libm math.order math.private
|
||||
quotations sets sequences sequences.private slots.private sorting
|
||||
specialized-arrays strings strings.private system tools.test vectors vocabs
|
||||
words ;
|
||||
FROM: math => float ;
|
||||
SPECIALIZED-ARRAY: double
|
||||
SPECIALIZED-ARRAY: void*
|
||||
|
|
@ -751,11 +750,42 @@ MIXIN: empty-mixin
|
|||
[ { float } declare 0 eq? ] final-classes
|
||||
] unit-test
|
||||
|
||||
! Here we can know both that 1) mod(integer, fixnum) = fixnum and 2)
|
||||
! mod(fixnum, integer) = fixnum
|
||||
[ V{ fixnum } V{ fixnum } ] [
|
||||
[ { integer fixnum } declare mod ] final-classes
|
||||
[ { fixnum integer } declare mod ] final-classes
|
||||
{
|
||||
{ fixnum integer integer fixnum }
|
||||
} [
|
||||
{
|
||||
{ integer fixnum }
|
||||
! These two are tricky. Possibly, they will always be
|
||||
! fixnums. But that requires a better interval-mod.
|
||||
{ fixnum integer }
|
||||
{ fixnum bignum }
|
||||
{ bignum fixnum }
|
||||
} [ '[ _ declare mod ] final-classes first ] map
|
||||
] unit-test
|
||||
|
||||
! Due to downpromotion, we lose the type here.
|
||||
{ V{ integer } } [
|
||||
[ { bignum bignum } declare bignum-mod ] final-classes
|
||||
] unit-test
|
||||
|
||||
! And here
|
||||
{ V{ bignum integer } } [
|
||||
[ { bignum bignum } declare /mod ] final-classes
|
||||
] unit-test
|
||||
|
||||
! So this code gets worse than it was.
|
||||
{
|
||||
[
|
||||
bignum-mod 20 over tag 0 eq?
|
||||
[ fixnum+ ] [ fixnum>bignum bignum+ ] if
|
||||
]
|
||||
} [
|
||||
[ { bignum bignum } declare bignum-mod 20 + ]
|
||||
build-tree optimize-tree nodes>quot
|
||||
] unit-test
|
||||
|
||||
{ V{ fixnum } } [
|
||||
[ fixnum-mod ] final-classes
|
||||
] unit-test
|
||||
|
||||
[ V{ integer } ] [
|
||||
|
|
|
|||
Loading…
Reference in New Issue