Propagation pass: add inlined node counts to total node count, so that the more we inline the less we are eager to inline more

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

@@ -17,8 +17,10 @@ IN: compiler.tree.propagation.inlining
 ! we are more eager to inline
 SYMBOL: node-count
 
-: count-nodes ( nodes -- )
+: count-nodes ( nodes -- n )
-    0 swap [ drop 1+ ] each-node node-count set ;
+    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
@@ -33,9 +35,6 @@ M: word splicing-nodes
 M: callable splicing-nodes
     build-sub-tree analyze-recursive normalize ;
 
-: propagate-body ( #call -- )
-    body>> (propagate) ;
-
 ! Dispatch elimination
 : eliminate-dispatch ( #call class/f word/quot/f -- ? )
     dup [
@@ -44,7 +43,7 @@ M: callable splicing-nodes
             2dup splicing-nodes
             [ >>method ] [ >>body ] bi*
         ] if
-        propagate-body t
+        body>> (propagate) t
     ] [ 2drop f >>method f >>body f >>class drop f ] if ;
 
 : inlining-standard-method ( #call word -- class/f method/f )
@@ -161,10 +160,10 @@ SYMBOL: history
 : inline-word-def ( #call word quot -- ? )
     over history get memq? [ 3drop f ] [
         [
-            swap remember-inlining
+            [ remember-inlining ] dip
-            dupd splicing-nodes >>body
+            [ drop ] [ splicing-nodes ] 2bi
-            propagate-body
+            [ >>body drop ] [ count-nodes ] [ (propagate) ] tri
-        ] with-scope
+        ] with-scope node-count +@
         t
     ] if ;
 

basis/compiler/tree/propagation/propagation.factor

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