some recursive value inferencer fixes

README.txt

@@ -69,8 +69,8 @@ The Factor source distribution ships with four boot image files:
 
   boot.image.le32 - for x86
   boot.image.be32 - for PowerPC, SPARC
-  boot.image.le64 - for x86-64
-  boot.image.be64 - for Alpha, PowerPC/64, UltraSparc
+  boot.image.le64 - for x86-64, Alpha
+  boot.image.be64 - for PowerPC/64, UltraSparc
 
 Once you have compiled the Factor runtime, you must bootstrap the Factor
 system using the image that corresponds to your CPU architecture.

examples/factorbot.factor

@@ -1,7 +1,7 @@
 ! Simple IRC bot written in Factor.
 
-USING: generic hashtables http io kernel math namespaces
-prettyprint sequences strings words ;
+USING: errors generic hashtables http io kernel math namespaces
+parser prettyprint sequences strings unparser words ;
 IN: factorbot
 
 SYMBOL: irc-stream

library/bootstrap/boot-stage1.factor

@@ -84,7 +84,6 @@ parser prettyprint sequences io vectors words ;
         "/library/tools/memory.factor"
 
         "/library/inference/dataflow.factor"
-        "/library/inference/values.factor"
         "/library/inference/inference.factor"
         "/library/inference/branches.factor"
         "/library/inference/words.factor"

library/bootstrap/image.factor

@@ -290,7 +290,7 @@ M: hashtable ' ( hashtable -- pointer )
 
 : with-minimal-image ( quot -- image )
     [
-        300000 <vector> image set
+        800000 <vector> image set
         <namespace> "objects" set
         call
         image get

library/inference/inference.factor

@@ -19,6 +19,51 @@ M: inference-error error. ( error -- )
     "! Recursive state:" print
     inference-error-rstate [.] ;
 
+TUPLE: value recursion safe? ;
+
+C: value ( rstate -- value )
+    t over set-value-safe?
+    recursive-state get over set-value-recursion ;
+
+M: value = eq? ;
+
+TUPLE: computed ;
+
+C: computed ( -- value ) <value> over set-delegate ;
+
+TUPLE: literal value ;
+
+C: literal ( obj -- value )
+    <value> over set-delegate
+    [ set-literal-value ] keep ;
+
+M: value literal-value ( value -- )
+    {
+        "A literal value was expected where a computed value was found.\n"
+        "This means that an attempt was made to compile a word that\n"
+        "applies 'call' or 'execute' to a value that is not known\n"
+        "at compile time. The value might become known if the word\n"
+        "is marked 'inline'. See the handbook for details."
+    } concat inference-error ;
+
+TUPLE: meet values ;
+
+C: meet ( values -- value )
+    <value> over set-delegate [ set-meet-values ] keep ;
+
+PREDICATE: tuple safe-literal ( obj -- ? )
+    dup literal? [ value-safe? ] [ drop f ] ifte ;
+
+: subst-values ( new old node -- )
+    [
+        dup .
+        3dup [ node-in-d subst ] keep set-node-in-d
+        3dup [ node-in-r subst ] keep set-node-in-r
+        3dup [ node-out-d subst ] keep set-node-out-d
+        3dup [ node-out-r subst ] keep set-node-out-r
+        drop
+    ] each-node 2drop ;
+
 ! Word properties that affect inference:
 ! - infer-effect -- must be set. controls number of inputs
 ! expected, and number of outputs produced.

library/inference/optimizer.factor

@@ -230,17 +230,6 @@ M: #values can-kill* ( literal node -- ? )
         drop t
     ] ifte ;
 
-: subst-values ( new old node -- )
-    dup [
-        3dup [ node-in-d subst ] keep set-node-in-d
-        3dup [ node-in-r subst ] keep set-node-in-r
-        3dup [ node-out-d subst ] keep set-node-out-d
-        3dup [ node-out-r subst ] keep set-node-out-r
-        node-successor subst-values
-    ] [
-        3drop
-    ] ifte ;
-
 : values/merge ( #values #merge -- new old )
     >r >r node-in-d r> node-in-d 2vector unify-lengths 2unseq r> ;
 

library/inference/recursive-values.factor

@@ -22,10 +22,10 @@ M: node solve-recursion* ( node -- ) drop ;
 M: #label solve-recursion* ( node -- )
     dup node-param over collect-recursion >r
     node-children first dup node-in-d r> swap add
-    unify-stacks swap [ node-in-d ] keep
-    node-successor subst-values ;
+    unify-stacks swap [ node-in-d ] keep 
+    node-successor dup . subst-values ;
 
 : solve-recursion ( node -- )
     #! Figure out which values survive inner recursions in
     #! #labels, and those that don't should be fudged.
-    ( [ solve-recursion* ] each-node ) drop ;
+    [ solve-recursion* ] each-node ;

library/inference/values.factor

@@ -1,39 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: inference
-USING: generic kernel lists namespaces sequences unparser words ;
-
-TUPLE: value recursion safe? ;
-
-C: value ( rstate -- value )
-    t over set-value-safe?
-    recursive-state get over set-value-recursion ;
-
-M: value = eq? ;
-
-TUPLE: computed ;
-
-C: computed ( -- value ) <value> over set-delegate ;
-
-TUPLE: literal value ;
-
-C: literal ( obj -- value )
-    <value> over set-delegate
-    [ set-literal-value ] keep ;
-
-M: value literal-value ( value -- )
-    {
-        "A literal value was expected where a computed value was found.\n"
-        "This means that an attempt was made to compile a word that\n"
-        "applies 'call' or 'execute' to a value that is not known\n"
-        "at compile time. The value might become known if the word\n"
-        "is marked 'inline'. See the handbook for details."
-    } concat inference-error ;
-
-TUPLE: meet values ;
-
-C: meet ( values -- value )
-    <value> over set-delegate [ set-meet-values ] keep ;
-
-PREDICATE: tuple safe-literal ( obj -- ? )
-    dup literal? [ value-safe? ] [ drop f ] ifte ;