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

compiler.tree.propagation: be more careful with intervals, ensuring that the inferred interval of a value is a subset of the value class's interval. This improves accuracy, for example [ >fixnum 1 + >fixnum most-positive-fixnum <= ] constant-folds to true

db4
Slava Pestov 2009-08-10 01:16:49 -05:00
parent 50e366bbe1
commit 7e35723db0
8 changed files with 118 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/tree/debugger/debugger.factor
View File

@ -16,6 +16,7 @@ compiler.tree.builder
compiler.tree.optimizer
compiler.tree.combinators
compiler.tree.checker
compiler.tree.identities
compiler.tree.dead-code
compiler.tree.modular-arithmetic ;
FROM: fry => _ ;
@ -208,6 +209,7 @@ SYMBOL: node-count
normalize
propagate
cleanup
apply-identities
compute-def-use
remove-dead-code
compute-def-use

7
basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: compiler.tree.modular-arithmetic.tests
USING: kernel kernel.private tools.test math math.partial-dispatch
math.private accessors slots.private sequences strings sbufs
math.private accessors slots.private sequences sequences.private strings sbufs
compiler.tree.builder
compiler.tree.normalization
compiler.tree.debugger
@ -171,3 +171,8 @@ cell {
[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-8 ] test-modular-arithmetic ] unit-test
[ t ] [ [ { fixnum byte-array } declare [ + ] with map ] { + fixnum+ >fixnum } inlined? ] unit-test
[ t ] [
[ 0 10 <byte-array> 10 [ 1 pick 0 + >fixnum pick set-nth-unsafe [ 1 + >fixnum ] dip ] times ]
{ >fixnum } inlined?
] unit-test

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

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: assocs classes classes.algebra classes.tuple
classes.tuple.private kernel accessors math math.intervals namespaces
sequences words combinators combinators.short-circuit byte-arrays
strings arrays layouts cpu.architecture compiler.tree.propagation.copy
;
sequences sequences.private words combinators
combinators.short-circuit byte-arrays strings arrays layouts
cpu.architecture compiler.tree.propagation.copy ;
IN: compiler.tree.propagation.info
: false-class? ( class -- ? ) \ f class<= ;
@ -37,10 +37,6 @@ CONSTANT: null-info T{ value-info f null empty-interval }
CONSTANT: object-info T{ value-info f object full-interval }
: class-interval ( class -- interval )
dup real class<=
[ "interval" word-prop [-inf,inf] or ] [ drop f ] if ;
: interval>literal ( class interval -- literal literal? )
#! If interval has zero length and the class is sufficiently
#! precise, we can turn it into a literal
@ -85,6 +81,23 @@ UNION: fixed-length array byte-array string ;
[ [ class>> real class<= ] [ interval>> empty-interval eq? ] bi and ]
} 1|| ;
: min-value ( class -- n ) fixnum eq? [ most-negative-fixnum ] [ -1/0. ] if ;
: max-value ( class -- n ) fixnum eq? [ most-positive-fixnum ] [ 1/0. ] if ;
: class-interval ( class -- i ) fixnum eq? [ fixnum-interval ] [ full-interval ] if ;
: wrap-interval ( interval class -- interval' )
{
{ fixnum [ interval->fixnum ] }
{ array-capacity [ max-array-capacity [a,a] interval-rem ] }
[ drop ]
} case ;
: init-interval ( info -- info )
dup [ interval>> full-interval or ] [ class>> ] bi wrap-interval >>interval
dup class>> integer class<= [ [ integral-closure ] change-interval ] when ; inline
: init-value-info ( info -- info )
dup literal?>> [
init-literal-info
@ -93,8 +106,7 @@ UNION: fixed-length array byte-array string ;
null >>class
empty-interval >>interval
] [
[ [-inf,inf] or ] change-interval
dup class>> integer class<= [ [ integral-closure ] change-interval ] when
init-interval
dup [ class>> ] [ interval>> ] bi interval>literal
[ >>literal ] [ >>literal? ] bi*
] if
@ -107,8 +119,7 @@ UNION: fixed-length array byte-array string ;
init-value-info ; foldable
: <class-info> ( class -- info )
dup word? [ dup "interval" word-prop ] [ f ] if [-inf,inf] or
<class/interval-info> ; foldable
f <class/interval-info> ; foldable
: <interval-info> ( interval -- info )
<value-info>

25
basis/compiler/tree/propagation/known-words/known-words.factor
View File

@ -18,14 +18,6 @@ compiler.tree.propagation.call-effect
compiler.tree.propagation.transforms ;
IN: compiler.tree.propagation.known-words
\ fixnum
most-negative-fixnum most-positive-fixnum [a,b]
"interval" set-word-prop
\ array-capacity
0 max-array-capacity [a,b]
"interval" set-word-prop
{ + - * / }
[ { number number } "input-classes" set-word-prop ] each
@ -53,8 +45,8 @@ most-negative-fixnum most-positive-fixnum [a,b]
{ fixnum bignum integer rational float real number object }
[ class<= ] with find nip ;
: fits? ( interval class -- ? )
"interval" word-prop interval-subset? ;
: fits-in-fixnum? ( interval -- ? )
fixnum-interval interval-subset? ;
: binary-op-class ( info1 info2 -- newclass )
[ class>> ] bi@
@ -66,7 +58,7 @@ most-negative-fixnum most-positive-fixnum [a,b]
[ [ interval>> ] bi@ ] dip call ; inline
: won't-overflow? ( class interval -- ? )
[ fixnum class<= ] [ fixnum fits? ] bi* and ;
[ fixnum class<= ] [ fits-in-fixnum? ] bi* and ;
: may-overflow ( class interval -- class' interval' )
over null-class? [
@ -219,14 +211,7 @@ generic-comparison-ops [
{ >integer integer }
} [
'[
_
[ nip ] [
[ interval>> ] [ class-interval ] bi*
interval-intersect
] 2bi
<class/interval-info>
] "outputs" set-word-prop
'[ _ swap interval>> <class/interval-info> ] "outputs" set-word-prop
] assoc-each
{ numerator denominator }
@ -262,7 +247,7 @@ generic-comparison-ops [
[ string>number 8 * 2^ 1- 0 swap [a,b] ]
}
} cond
[ fixnum fits? fixnum integer ? ] keep <class/interval-info>
[ fits-in-fixnum? fixnum integer ? ] keep <class/interval-info>
'[ 2drop _ ] "outputs" set-word-prop
] each

14
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -713,6 +713,20 @@ TUPLE: littledan-2 { from read-only } { to read-only } ;
[ V{ 1 } ] [ [ { } length 1+ f <array> length ] final-literals ] unit-test
! generalize-counter is not tight enough
[ V{ fixnum } ] [ [ 0 10 [ 1 + >fixnum ] times ] final-classes ] unit-test
[ V{ fixnum } ] [ [ 0 10 [ 1 + >fixnum ] times 0 + ] final-classes ] unit-test
! Coercions need to update intervals
[ V{ f } ] [ [ 1 2 ? 100 shift >fixnum 1 = ] final-literals ] unit-test
[ V{ t } ] [ [ >fixnum 1 + >fixnum most-positive-fixnum <= ] final-literals ] unit-test
[ V{ t } ] [ [ >fixnum 1 + >fixnum most-negative-fixnum >= ] final-literals ] unit-test
[ V{ f } ] [ [ >fixnum 1 + >fixnum most-negative-fixnum > ] final-literals ] unit-test
! Mutable tuples with circularity should not cause problems
TUPLE: circle me ;

40
basis/compiler/tree/propagation/recursive/recursive-tests.factor
View File

@ -1,19 +1,51 @@
IN: compiler.tree.propagation.recursive.tests
USING: tools.test compiler.tree.propagation.recursive
math.intervals kernel ;
math.intervals kernel math literals layouts ;
[ T{ interval f { 0 t } { 1/0. t } } ] [
T{ interval f { 1 t } { 1 t } }
T{ interval f { 0 t } { 0 t } } generalize-counter-interval
T{ interval f { 0 t } { 0 t } }
integer generalize-counter-interval
] unit-test
[ T{ interval f { 0 t } { $[ most-positive-fixnum ] t } } ] [
T{ interval f { 1 t } { 1 t } }
T{ interval f { 0 t } { 0 t } }
fixnum generalize-counter-interval
] unit-test
[ T{ interval f { -1/0. t } { 10 t } } ] [
T{ interval f { -1 t } { -1 t } }
T{ interval f { 10 t } { 10 t } } generalize-counter-interval
T{ interval f { 10 t } { 10 t } }
integer generalize-counter-interval
] unit-test
[ T{ interval f { $[ most-negative-fixnum ] t } { 10 t } } ] [
T{ interval f { -1 t } { -1 t } }
T{ interval f { 10 t } { 10 t } }
fixnum generalize-counter-interval
] unit-test
[ t ] [
T{ interval f { 1 t } { 268435455 t } }
T{ interval f { -268435456 t } { 268435455 t } } tuck
generalize-counter-interval =
integer generalize-counter-interval =
] unit-test
[ t ] [
T{ interval f { 1 t } { 268435455 t } }
T{ interval f { -268435456 t } { 268435455 t } } tuck
fixnum generalize-counter-interval =
] unit-test
[ full-interval ] [
T{ interval f { -5 t } { 3 t } }
T{ interval f { 2 t } { 11 t } }
integer generalize-counter-interval
] unit-test
[ $[ fixnum-interval ] ] [
T{ interval f { -5 t } { 3 t } }
T{ interval f { 2 t } { 11 t } }
fixnum generalize-counter-interval
] unit-test

28
basis/compiler/tree/propagation/recursive/recursive.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences accessors arrays fry math.intervals
combinators namespaces
USING: kernel sequences accessors arrays fry math math.intervals
layouts combinators namespaces locals
stack-checker.inlining
compiler.tree
compiler.tree.combinators
@ -24,20 +24,26 @@ IN: compiler.tree.propagation.recursive
[ label>> calls>> [ node>> node-input-infos ] map flip ]
[ latest-input-infos ] bi ;
: generalize-counter-interval ( interval initial-interval -- interval' )
:: generalize-counter-interval ( interval initial-interval class -- interval' )
{
{ [ 2dup interval-subset? ] [ empty-interval ] }
{ [ over empty-interval eq? ] [ empty-interval ] }
{ [ 2dup interval>= t eq? ] [ 1/0. [a,a] ] }
{ [ 2dup interval<= t eq? ] [ -1/0. [a,a] ] }
[ [-inf,inf] ]
} cond interval-union nip ;
{ [ interval initial-interval interval-subset? ] [ initial-interval ] }
{ [ interval empty-interval eq? ] [ initial-interval ] }
{
[ interval initial-interval interval>= t eq? ]
[ class max-value [a,a] initial-interval interval-union ]
}
{
[ interval initial-interval interval<= t eq? ]
[ class min-value [a,a] initial-interval interval-union ]
}
[ class class-interval ]
} cond ;
: generalize-counter ( info' initial -- info )
2dup [ not ] either? [ drop ] [
2dup [ class>> null-class? ] either? [ drop ] [
[ clone ] dip
[ [ drop ] [ [ interval>> ] bi@ generalize-counter-interval ] 2bi >>interval ]
[ [ drop ] [ [ [ interval>> ] bi@ ] [ drop class>> ] 2bi generalize-counter-interval ] 2bi >>interval ]
[ [ drop ] [ [ slots>> ] bi@ [ generalize-counter ] 2map ] 2bi >>slots ]
[ [ drop ] [ [ length>> ] bi@ generalize-counter ] 2bi >>length ]
tri

19
basis/math/intervals/intervals.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
! Based on Slate's src/unfinished/interval.slate by Brian Rice.
USING: accessors kernel sequences arrays math math.order
combinators generic layouts ;
combinators generic layouts memoize ;
IN: math.intervals
SYMBOL: empty-interval
@ -48,7 +48,10 @@ TUPLE: interval { from read-only } { to read-only } ;
: (a,inf] ( a -- interval ) 1/0. (a,b] ; inline
: [0,inf] ( -- interval ) 0 [a,inf] ; foldable
MEMO: [0,inf] ( -- interval ) 0 [a,inf] ; foldable
MEMO: fixnum-interval ( -- interval )
most-negative-fixnum most-positive-fixnum [a,b] ; inline
: [-inf,inf] ( -- interval ) full-interval ; inline
@ -331,12 +334,22 @@ SYMBOL: incomparable
} cond
swap 0 [a,a] interval>= t eq? [ [0,inf] interval-intersect ] when ;
: (rem-range) ( i -- i' ) interval-abs to>> first 0 swap [a,b) ;
: interval-rem ( i1 i2 -- i3 )
{
{ [ over empty-interval eq? ] [ drop ] }
{ [ dup empty-interval eq? ] [ nip ] }
{ [ dup full-interval eq? ] [ nip ] }
[ nip interval-abs to>> first 0 swap [a,b) ]
[ (rem-range) 2dup interval-subset? [ drop ] [ nip ] if ]
} cond ;
: interval->fixnum ( i1 -- i2 )
{
{ [ dup empty-interval eq? ] [ ] }
{ [ dup full-interval eq? ] [ drop fixnum-interval ] }
{ [ dup fixnum-interval interval-subset? not ] [ drop fixnum-interval ] }
[ ]
} cond ;
: interval-bitand-pos ( i1 i2 -- ? )