compiler.tree.propagation.slots
compiler.tree.propagation.simple
compiler.tree.propagation.constraints
-compiler.tree.propagation.call-effect ;
+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
{ 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@
[ [ 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? [
[ object-info ] [ f <literal-info> ] if ;
: info-intervals-intersect? ( info1 info2 -- ? )
- [ interval>> ] bi@ intervals-intersect? ;
+ 2dup [ class>> real class<= ] both?
+ [ [ interval>> ] bi@ intervals-intersect? ] [ 2drop t ] if ;
{ number= bignum= float= } [
[
{ >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
-: rem-custom-inlining ( #call -- quot/f )
- second value-info literal>> dup integer?
- [ power-of-2? [ 1- bitand ] f ? ] [ drop f ] if ;
-
-{
- mod-integer-integer
- mod-integer-fixnum
- mod-fixnum-integer
- fixnum-mod
-} [
- [
- in-d>> dup first value-info interval>> [0,inf] interval-subset?
- [ rem-custom-inlining ] [ drop f ] if
- ] "custom-inlining" set-word-prop
-] each
-
-\ rem [
- in-d>> rem-custom-inlining
-] "custom-inlining" set-word-prop
-
-{
- bitand-integer-integer
- bitand-integer-fixnum
- bitand-fixnum-integer
-} [
- [
- in-d>> second value-info >literal< [
- 0 most-positive-fixnum between?
- [ [ >fixnum ] bi@ fixnum-bitand ] f ?
- ] when
- ] "custom-inlining" set-word-prop
-] each
-
{ numerator denominator }
[ [ drop integer <class-info> ] "outputs" set-word-prop ] each
dup name>> {
{
[ "alien-signed-" ?head ]
- [ string>number 8 * 1- 2^ dup neg swap 1- [a,b] ]
+ [ string>number 8 * 1 - 2^ dup neg swap 1 - [a,b] ]
}
{
[ "alien-unsigned-" ?head ]
- [ string>number 8 * 2^ 1- 0 swap [a,b] ]
+ [ 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
"outputs" set-word-prop
] each
-! Generate more efficient code for common idiom
-\ clone [
- in-d>> first value-info literal>> {
- { V{ } [ [ drop { } 0 vector boa ] ] }
- { H{ } [ [ drop 0 <hashtable> ] ] }
- [ drop f ]
- } case
-] "custom-inlining" set-word-prop
-
\ slot [
dup literal?>>
[ literal>> swap value-info-slot ] [ 2drop object-info ] if
bi
] [ 2drop object-info ] if
] "outputs" set-word-prop
-
-\ instance? [
- in-d>> second value-info literal>> dup class?
- [ "predicate" word-prop '[ drop @ ] ] [ drop f ] if
-] "custom-inlining" set-word-prop
-
-\ equal? [
- ! If first input has a known type and second input is an
- ! object, we convert this to [ swap equal? ].
- in-d>> first2 value-info class>> object class= [
- value-info class>> \ equal? specific-method
- [ swap equal? ] f ?
- ] [ drop f ] if
-] "custom-inlining" set-word-prop
-
-: inline-new ( class -- quot/f )
- dup tuple-class? [
- dup inlined-dependency depends-on
- [ all-slots [ initial>> literalize ] map ]
- [ tuple-layout '[ _ <tuple-boa> ] ]
- bi append [ drop ] prepend >quotation
- ] [ drop f ] if ;
-
-\ new [
- in-d>> first value-info literal>> inline-new
-] "custom-inlining" set-word-prop