values are now objects in inferencer

factor/ExternalFactor.java

@@ -184,9 +184,11 @@ public class ExternalFactor extends DefaultVocabularyLookup
 	 */
 	public synchronized FactorWord makeWord(Cons info)
 	{
-		FactorWord w = new FactorWord(
-			(String)info.car,
-			(String)info.next().car);
+		String vocabulary = (String)info.car;
+		String name = (String)info.next().car;
+		FactorWord w = super.searchVocabulary(new Cons(vocabulary,null),name);
+		if(w == null)
+			w = new FactorWord(vocabulary,name);
 		w.stackEffect = (String)info.next().next().car;
 		return w;
 	} //}}}

library/compiler/optimizer.factor

@@ -55,23 +55,23 @@ USE: prettyprint
     #! Collect all literals from all branches.
     [ node-param get ] bind [ [ scan-literal ] each ] each ;
 
-: mentions-literal? ( literal list -- )
+: mentions-literal? ( literal list -- ? )
     #! Does the given list of result objects refer to this
     #! literal?
-    [ dup cons? [ car over = ] [ drop f ] ifte ] some? ;
+    [ dupd value= ] some? nip ;
 
 : consumes-literal? ( literal node -- ? )
     #! Does the dataflow node consume the literal?
     [
-        node-consume-d get mentions-literal? swap
-        node-consume-r get mentions-literal? nip or
+        dup node-consume-d get mentions-literal? swap
+        dup node-consume-r get mentions-literal? nip or
     ] bind ;
 
 : produces-literal? ( literal node -- ? )
     #! Does the dataflow node produce the literal?
     [
-        node-produce-d get mentions-literal? swap
-        node-produce-r get mentions-literal? nip or
+        dup node-produce-d get mentions-literal? swap
+        dup node-produce-r get mentions-literal? nip or
     ] bind ;
 
 : (can-kill?) ( literal node -- ? )
@@ -187,16 +187,16 @@ USE: prettyprint
 #swap [ 2drop t ] "can-kill" set-word-property
 #swap [ kill-node ] "kill-node" set-word-property
 
-: kill-mask ( literals node -- mask )
-    [ node-consume-d get ] bind [
-        dup cons? [ car over contains? ] [ drop f ] ifte
-    ] map nip ;
+: kill-mask ( killing inputs -- mask )
+    [ over [ over value= ] some? >boolean nip ] map nip ;
 
 : reduce-stack-op ( literals node map -- )
     #! If certain values passing through a stack op are being
     #! killed, the stack op can be reduced, in extreme cases
     #! to a no-op.
-    -rot [ kill-mask swap assoc ] keep
+    -rot [
+        [ node-consume-d get ] bind kill-mask swap assoc
+    ] keep
     over [ [ node-op set ] extend , ] [ 2drop ] ifte ;
 
 #over [ 2drop t ] "can-kill" set-word-property

library/inference/branches.factor

@@ -51,7 +51,7 @@ USE: hashtables
 : unify-result ( obj obj -- obj )
     #! Replace values with unknown result if they differ,
     #! otherwise retain them.
-    2dup = [ drop ] [ 2drop gensym ] ifte ;
+    2dup = [ drop ] [ 2drop <computed-value> ] ifte ;
 
 : unify-stacks ( list -- stack )
     #! Replace differing literals in stacks with unknown
@@ -85,13 +85,13 @@ USE: hashtables
         "Unbalanced branches" throw
     ] ifte ;
 
-: infer-branch ( rstate quot save-effect -- namespace )
+: infer-branch ( value save-effect -- namespace )
     <namespace> [
         save-effect set
-        swap recursive-state set
+        dup value-recursion recursive-state set
         copy-interpreter
         dataflow-graph off
-        infer-quot
+        literal infer-quot
         #values values-node
     ] extend ;
 
@@ -99,9 +99,9 @@ USE: hashtables
     #! This is a hack. undefined-method has a stack effect that
     #! probably does not match any other branch of the generic,
     #! so we handle it specially.
-    \ undefined-method swap tree-contains? ;
+    literal \ undefined-method swap tree-contains? ;
 
-: recursive-branch ( rstate quot -- )
+: recursive-branch ( value -- )
     #! Set base case if inference didn't fail.
     [
         f infer-branch [
@@ -109,13 +109,13 @@ USE: hashtables
             recursive-state get set-base
         ] bind
     ] [
-        [ 2drop ] when
+        [ drop ] when
     ] catch ;
 
 : infer-base-case ( branchlist -- )
     [
-        unswons dup terminator? [
-            2drop
+        dup terminator? [
+            drop
         ] [
             recursive-branch
         ] ifte
@@ -123,7 +123,7 @@ USE: hashtables
 
 : (infer-branches) ( branchlist -- list )
     dup infer-base-case [
-        unswons dup terminator? [
+        dup terminator? [
             t infer-branch [
                 meta-d off meta-r off d-in off
             ] extend
@@ -153,8 +153,9 @@ USE: hashtables
 
 \ ifte [ infer-ifte ] "infer" set-word-property
 
-: vtable>list ( [ vtable | rstate ] -- list )
-    unswons vector>list [ over cons ] map nip ;
+: vtable>list ( value -- list )
+    dup value-recursion swap literal vector>list
+    [ over <literal-value> ] map nip ;
 
 : infer-dispatch ( -- )
     #! Infer effects for all branches, unify.

library/inference/inference.factor

@@ -36,6 +36,7 @@ USE: strings
 USE: vectors
 USE: words
 USE: hashtables
+USE: generic
 
 ! Word properties that affect inference:
 ! - infer-effect -- must be set. controls number of inputs
@@ -62,12 +63,42 @@ SYMBOL: recursive-label
 ! inferred.
 SYMBOL: save-effect
 
-: gensym-vector ( n --  vector )
-    dup <vector> swap [ gensym over vector-push ] times ;
+! A value has the following slots:
+
+! the literal object, if any.
+SYMBOL: value
+
+! value-type -- the type, if known.
+SYMBOL: value-type
+
+GENERIC: literal ( value -- obj )
+GENERIC: value= ( literal value -- ? )
+
+TRAITS: computed-value
+C: computed-value ( -- value )
+    [ gensym value set ] extend ;
+M: computed-value literal ( value -- obj )
+    "Cannot use a computed value literally." throw ;
+M: computed-value value= ( literal value -- ? )
+    2drop f ;
+
+TRAITS: literal-value
+C: literal-value ( obj rstate -- value )
+    [ recursive-state set value set ] extend ;
+M: literal-value literal ( value -- obj )
+    [ value get ] bind ;
+M: literal-value value= ( literal value -- ? )
+    literal = ;
+
+: value-recursion ( value -- rstate )
+    [ recursive-state get ] bind ;
+
+: computed-value-vector ( n --  vector )
+    [ drop <computed-value> ] vector-project ;
 
 : add-inputs ( count stack -- stack )
     #! Add this many inputs to the given stack.
-    >r gensym-vector dup r> vector-append ;
+    >r computed-value-vector dup r> vector-append ;
 
 : ensure ( count stack -- count stack )
     #! Ensure stack has this many elements. Return number of
@@ -88,7 +119,7 @@ SYMBOL: save-effect
 
 : produce-d ( count -- )
     #! Push count of unknown results.
-    [ gensym push-d ] times ;
+    [ <computed-value> push-d ] times ;
 
 : effect ( -- [ in | out ] )
     #! After inference is finished, collect information.
@@ -111,7 +142,7 @@ DEFER: apply-word
 : apply-literal ( obj -- )
     #! Literals are annotated with the current recursive
     #! state.
-    dup recursive-state get cons push-d
+    dup recursive-state get <literal-value> push-d
     #push dataflow, [ 1 0 node-outputs ] bind ;
 
 : apply-object ( obj -- )

library/inference/words.factor

@@ -178,11 +178,13 @@ USE: prettyprint
         ] ifte
     ] ifte ;
 
-: infer-call ( [ rstate | quot ] -- )
+: infer-call ( -- )
     1 ensure-d
     dataflow-drop,
     gensym dup [
-        drop pop-d uncons recursive-state set infer-quot
+        drop pop-d dup
+        value-recursion recursive-state set
+        literal infer-quot
     ] with-block ;
 
 \ call [ infer-call ] "infer" set-word-property

library/test/compiler/optimizer.factor

@@ -5,6 +5,7 @@ USE: inference
 USE: words
 USE: math
 USE: kernel
+USE: lists
 
 : foo 1 2 3 ;
 
@@ -15,3 +16,5 @@ USE: kernel
 [ [ [ 1 ] [ 2 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] dataflow kill-set ] unit-test
 
 [ [ [ 1 ] [ 2 ] ] ] [ [ t [ 1 ] [ 2 ] ifte ] dataflow kill-set ] unit-test
+
+[ [ t t f ] ] [ [ 1 2 ] [ 1 2 3 ] [ f <literal-value> ] map kill-mask ] unit-test

library/test/inference.factor

@@ -25,7 +25,7 @@ USE: math-internals
 !         dup [ 7 | 7 ] decompose compose [ 7 | 7 ] =
 !     ] all?
 ! ] unit-test
-[ 6 ] [ 6 gensym-vector vector-length ] unit-test
+[ 6 ] [ 6 computed-value-vector vector-length ] unit-test
 
 [ 3 ] [ [ { 1 2 } { 1 2 3 } ] longest-vector ] unit-test
 

library/test/strings.factor

@@ -6,9 +6,6 @@ USE: namespaces
 USE: strings
 USE: test
 
-[ f ] [ "a" "b" "c" =? ] unit-test
-[ "c" ] [ "a" "a" "c" =? ] unit-test
-
 [ f ] [ "A string." f-or-"" ] unit-test
 [ t ] [ "" f-or-"" ] unit-test
 [ t ] [ f f-or-"" ] unit-test