Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / compiler / tree / propagation / known-words / known-words.factor

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index aec61608f1cb9ca83e7fe63b6840c0f2072ab4b6..7c684f5b7f6892daa3eba9aa90d3be27523498a4 100644 (file)
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -14,17 +14,10 @@ compiler.tree.propagation.nodes
 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
 
@@ -52,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@
@@ -65,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? [
@@ -172,7 +165,8 @@ generic-comparison-ops [
     [ 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= } [
     [
@@ -217,49 +211,9 @@ 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
 
-: 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
 
@@ -286,14 +240,14 @@ generic-comparison-ops [
     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
 
@@ -314,15 +268,6 @@ generic-comparison-ops [
     "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
@@ -346,29 +291,3 @@ generic-comparison-ops [
         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