compiler.tree.propagation: remove method inlining heuristic

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -41,13 +41,13 @@ IN: compiler.tree.cleanup.tests
 
 GENERIC: mynot ( x -- y )
 
-M: f mynot drop t ;
+M: f mynot drop t ; inline
 
-M: object mynot drop f ;
+M: object mynot drop f ; inline
 
 GENERIC: detect-f ( x -- y )
 
-M: f detect-f ;
+M: f detect-f ; inline
 
 [ t ] [
     [ dup [ mynot ] [ ] if detect-f ] \ detect-f inlined?
@@ -55,9 +55,9 @@ M: f detect-f ;
 
 GENERIC: xyz ( n -- n )
 
-M: integer xyz ;
+M: integer xyz ; inline
 
-M: object xyz ;
+M: object xyz ; inline
 
 [ t ] [
     [ { integer } declare xyz ] \ xyz inlined?

basis/compiler/tree/propagation/call-effect/call-effect.factor

@@ -153,7 +153,7 @@ ERROR: uninferable ;
 
 : (value>quot) ( value-info -- quot )
     dup class>> {
-        { \ quotation [ literal>> dup remember-inlining '[ drop @ ] ] }
+        { \ quotation [ literal>> dup add-to-history '[ drop @ ] ] }
         { \ curry [
             slots>> third (value>quot)
             '[ [ obj>> ] [ quot>> @ ] bi ]

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -3,8 +3,8 @@
 USING: accessors kernel arrays sequences math math.order
 math.partial-dispatch generic generic.standard generic.single generic.math
 classes.algebra classes.union sets quotations assocs combinators
-words namespaces continuations classes fry combinators.smart hints
-locals
+combinators.short-circuit words namespaces continuations classes
+fry hints locals
 compiler.tree
 compiler.tree.builder
 compiler.tree.recursive
@@ -14,19 +14,6 @@ compiler.tree.propagation.info
 compiler.tree.propagation.nodes ;
 IN: compiler.tree.propagation.inlining
 
-! We count nodes up-front; if there are relatively few nodes,
-! we are more eager to inline
-SYMBOL: node-count
-
-: count-nodes ( nodes -- n )
-    0 swap [ drop 1 + ] each-node ;
-
-: compute-node-count ( nodes -- ) count-nodes node-count set ;
-
-! We try not to inline the same word too many times, to avoid
-! combinatorial explosion
-SYMBOL: inlining-count
-
 ! Splicing nodes
 : splicing-call ( #call word -- nodes )
     [ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ;
@@ -101,99 +88,28 @@ M: callable splicing-nodes splicing-body ;
     dupd inlining-math-partial eliminate-dispatch ;
 
 ! Method body inlining
-SYMBOL: recursive-calls
-DEFER: (flat-length)
-
-: word-flat-length ( word -- n )
-    {
-        ! special-case
-        { [ dup { dip 2dip 3dip } memq? ] [ drop 1 ] }
-        ! not inline
-        { [ dup inline? not ] [ drop 1 ] }
-        ! recursive and inline
-        { [ dup recursive-calls get key? ] [ drop 10 ] }
-        ! inline
-        [ [ recursive-calls get conjoin ] [ def>> (flat-length) ] bi ]
-    } cond ;
-
-: (flat-length) ( seq -- n )
-    [
-        {
-            { [ dup quotation? ] [ (flat-length) 2 + ] }
-            { [ dup array? ] [ (flat-length) ] }
-            { [ dup word? ] [ word-flat-length ] }
-            [ drop 0 ]
-        } cond
-    ] sigma ;
-
-: flat-length ( word -- n )
-    H{ } clone recursive-calls [
-        [ recursive-calls get conjoin ]
-        [ def>> (flat-length) 5 /i ]
-        bi
-    ] with-variable ;
-
-: classes-known? ( #call -- ? )
-    in-d>> [
-        value-info class>>
-        [ class-types length 1 = ]
-        [ union-class? not ]
-        bi and
-    ] any? ;
-
-: node-count-bias ( -- n )
-    45 node-count get [-] 8 /i ;
-
-: body-length-bias ( word -- n )
-    [ flat-length ] [ inlining-count get at 0 or ] bi
-    over 2 <= [ drop ] [ 2/ 1 + * ] if 24 swap [-] 4 /i ;
-
-: inlining-rank ( #call word -- n )
-    [
-        [ classes-known? 2 0 ? ]
-        [
-            [ body-length-bias ]
-            [ "specializer" word-prop 1 0 ? ]
-            [ method-body? 1 0 ? ]
-            tri
-            node-count-bias
-            loop-nesting get 0 or 2 *
-        ] bi*
-    ] sum-outputs ;
-
-: should-inline? ( #call word -- ? )
-    dup inline? [ 2drop t ] [ inlining-rank 5 >= ] if ;
-
 SYMBOL: history
 
 : already-inlined? ( obj -- ? ) history get memq? ;
 
 : add-to-history ( obj -- ) history [ swap suffix ] change ;
 
-: remember-inlining ( word -- )
-    [ inlining-count get inc-at ]
-    [ add-to-history ]
-    bi ;
-
 :: inline-word ( #call word -- ? )
     word already-inlined? [ f ] [
         #call word splicing-body [
             [
-                word remember-inlining
-                [ ] [ count-nodes ] [ (propagate) ] tri
+                word add-to-history
+                dup (propagate)
             ] with-scope
-            [ #call (>>body) ] [ node-count +@ ] bi* t
+            #call (>>body) t
         ] [ f ] if*
     ] if ;
 
-: inline-method-body ( #call word -- ? )
-    2dup should-inline? [ inline-word ] [ 2drop f ] if ;
-
 : always-inline-word? ( word -- ? )
     { curry compose } memq? ;
 
 : never-inline-word? ( word -- ? )
-    [ deferred? ] [ "default" word-prop ] [ \ call eq? ] tri or or ;
+    { [ deferred? ] [ "default" word-prop ] [ \ call eq? ] } 1|| ;
 
 : custom-inlining? ( word -- ? )
     "custom-inlining" word-prop ;
@@ -217,7 +133,7 @@ SYMBOL: history
         { [ dup always-inline-word? ] [ inline-word ] }
         { [ dup standard-generic? ] [ inline-standard-method ] }
         { [ dup math-generic? ] [ inline-math-method ] }
-        { [ dup method-body? ] [ inline-method-body ] }
+        { [ dup inline? ] [ inline-word ] }
         [ 2drop f ]
     } cond ;
 

basis/compiler/tree/propagation/propagation-tests.factor

@@ -56,9 +56,9 @@ IN: compiler.tree.propagation.tests
 
 [ float ] [ [ { float real } declare + ] final-math-class ] unit-test
 
-[ rational ] [ [ { ratio ratio } declare + ] final-math-class ] unit-test
+! [ rational ] [ [ { ratio ratio } declare + ] final-math-class ] unit-test
 
-[ rational ] [ [ { rational ratio } declare + ] final-math-class ] unit-test
+! [ rational ] [ [ { rational ratio } declare + ] final-math-class ] unit-test
 
 [ number ] [ [ { complex complex } declare + ] final-math-class ] unit-test
 
@@ -444,6 +444,13 @@ TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ;
     ] final-classes
 ] unit-test
 
+[ V{ f { } } ] [
+    [
+        T{ mixed-mutable-immutable f 3 { } }
+        [ x>> ] [ y>> ] bi
+    ] final-literals
+] unit-test
+
 ! Recursive propagation
 : recursive-test-1 ( a -- b ) recursive-test-1 ; inline recursive
 
@@ -502,8 +509,8 @@ TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ;
 ] unit-test
 
 GENERIC: iterate ( obj -- next-obj ? )
-M: fixnum iterate f ;
-M: array iterate first t ;
+M: fixnum iterate f ; inline
+M: array iterate first t ; inline
 
 : dead-loop ( obj -- final-obj )
     iterate [ dead-loop ] when ; inline recursive
@@ -567,7 +574,7 @@ M: array iterate first t ;
 ] unit-test
 
 GENERIC: bad-generic ( a -- b )
-M: fixnum bad-generic 1 fixnum+fast ;
+M: fixnum bad-generic 1 fixnum+fast ; inline
 : bad-behavior ( -- b ) 4 bad-generic ; inline recursive
 
 [ V{ fixnum } ] [ [ bad-behavior ] final-classes ] unit-test
@@ -740,7 +747,7 @@ TUPLE: foo bar ;
 [ t ] [ [ foo new ] { new } inlined? ] unit-test
 
 GENERIC: whatever ( x -- y )
-M: number whatever drop foo ;
+M: number whatever drop foo ; inline
 
 [ t ] [ [ 1 whatever new ] { new } inlined? ] unit-test
 
@@ -749,8 +756,8 @@ M: number whatever drop foo ;
 [ f ] [ [ that-thing new ] { new } inlined? ] unit-test
 
 GENERIC: whatever2 ( x -- y )
-M: number whatever2 drop H{ { 1 1 } { 2 2 } { 3 3 } { 4 4 } { 5 6 } } ;
-M: f whatever2 ;
+M: number whatever2 drop H{ { 1 1 } { 2 2 } { 3 3 } { 4 4 } { 5 6 } } ; inline
+M: f whatever2 ; inline
 
 [ t ] [ [ 1 whatever2 at ] { at* hashcode* } inlined? ] unit-test
 [ f ] [ [ whatever2 at ] { at* hashcode* } inlined? ] unit-test

basis/compiler/tree/propagation/propagation.factor

@@ -19,6 +19,4 @@ IN: compiler.tree.propagation
     H{ } clone copies set
     H{ } clone 1array value-infos set
     H{ } clone 1array constraints set
-    H{ } clone inlining-count set
-    dup compute-node-count
     dup (propagate) ;