stack inference fixes, do not linearize #values

TODO.FACTOR.txt

@@ -12,11 +12,11 @@
 - handle recursion with when, when* etc
 - optimizer rewrite stack ops
 - alien-call need special nodes
-- mutual recursion is borked with certain branch order
 
 + linearizer/generator:
 
 - peephole optimizer
+- tail call optimization
 - getenv/setenv: if literal arg, compile as a load/store
 - compiler: drop literal peephole optimization
 

library/compiler/compiler.factor

@@ -52,6 +52,9 @@ USE: words
 
 : (compile) ( word -- )
     #! Should be called inside the with-compiler scope.
+    "verbose-compile" get [
+        "Compiling " write dup . flush
+    ] when
     begin-compiling dataflow ( optimize ) linearize generate ;
 
 : precompile ( word -- )

library/compiler/generator.factor

@@ -49,4 +49,3 @@ USE: words
     [ generate-node ] each ;
 
 #label [ save-xt ] "generator" set-word-property
-#values [ nop ] "generator" set-word-property

library/compiler/linearizer.factor

@@ -132,3 +132,5 @@ SYMBOL: #return-to ( push addr on C stack )
 #2generic [
     [ node-param get node-op get ] bind linearize-generic
 ] "linearizer" set-word-property
+
+#values [ drop ] "linearizer" set-word-property

library/inference/branches.factor

@@ -87,12 +87,14 @@ USE: hashtables
         "Unbalanced branches" throw
     ] ifte ;
 
-: infer-branch ( quot -- namespace )
+: infer-branch ( rstate quot save-effect -- namespace )
     <namespace> [
+        save-effect set
+        swap recursive-state set
         copy-interpreter
         dataflow-graph off
         infer-quot
-        ( #values values-node )
+        #values values-node
     ] extend ;
 
 : terminator? ( quot -- ? )
@@ -101,27 +103,33 @@ USE: hashtables
     #! so we handle it specially.
     \ no-method swap tree-contains? ;
 
-: recursive-branch ( quot -- )
+: recursive-branch ( rstate quot -- )
     #! Set base case if inference didn't fail.
     [
-        infer-branch [
+        f infer-branch [
             d-in get meta-d get vector-length cons
         ] bind recursive-state get set-base
     ] [
-        [ drop ] when
+        [ 2drop ] when
     ] catch ;
 
-: (infer-branches) ( branchlist -- list )
-    dup [
-        car dup terminator? [ drop ] [ recursive-branch ] ifte
-    ] each
+: infer-base-case ( branchlist -- )
     [
-        car dup terminator? [
-            infer-branch [
+        unswons dup terminator? [
+            2drop
+        ] [
+            recursive-branch
+        ] ifte
+    ] each ;
+
+: (infer-branches) ( branchlist -- list )
+    dup infer-base-case [
+        unswons dup terminator? [
+            t infer-branch [
                 meta-d off meta-r off d-in off
             ] extend
         ] [
-            infer-branch
+            t infer-branch
         ] ifte
     ] map ;
 

library/inference/inference.factor

@@ -59,6 +59,12 @@ SYMBOL: entry-effect
 ! makes a local jump to this label.
 SYMBOL: recursive-label
 
+! When inferring stack effects of mutually recursive words, we
+! don't want to save the fact that one word does not have a
+! stack effect before the base case of its mutual pair is
+! inferred.
+SYMBOL: save-effect
+
 : gensym-vector ( n --  vector )
     dup <vector> swap [ gensym over vector-push ] times ;
 
@@ -100,7 +106,8 @@ SYMBOL: recursive-label
     init-interpreter
     0 d-in set
     recursive-state set
-    dataflow-graph off ;
+    dataflow-graph off
+    save-effect on ;
 
 DEFER: apply-word
 

library/inference/words.factor

@@ -115,7 +115,11 @@ USE: prettyprint
         dup (infer-compound) consume/produce
     ] [
         [
-            swap t "no-effect" set-word-property rethrow
+            swap save-effect get [
+                t "no-effect" set-word-property
+            ] [
+                drop
+            ] ifte rethrow
         ] when*
     ] catch ;
 
@@ -187,7 +191,6 @@ USE: prettyprint
 
 \ call [ infer-call ] "infer" set-word-property
 
-\ + [ 2 | 1 ] "infer-effect" set-word-property
 \ - [ 2 | 1 ] "infer-effect" set-word-property
 \ * [ 2 | 1 ] "infer-effect" set-word-property
 \ / [ 2 | 1 ] "infer-effect" set-word-property