values are now objects in inferencer

diff --git a/factor/ExternalFactor.java b/factor/ExternalFactor.java
index 3c94bfffacaa70e69b0a608b1c094a87c91e4406..65717fb3d115271f05f634448df3930c4114fcdb 100644 (file)
--- a/factor/ExternalFactor.java
+++ b/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;
        } //}}}

diff --git a/library/compiler/optimizer.factor b/library/compiler/optimizer.factor
index 3f480256f4aa8d6c9d0f113cd9243aa7109d8f9a..549b81f85167bc77b0fd8bda822dfaf3bacf781b 100644 (file)
--- a/library/compiler/optimizer.factor
+++ b/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

diff --git a/library/inference/branches.factor b/library/inference/branches.factor
index 249533ef9fb19f25f571dff6b5cd3b1c621f8ced..8d833c0cebee83cc558790a3647e8705bef6413b 100644 (file)
--- a/library/inference/branches.factor
+++ b/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.

diff --git a/library/inference/inference.factor b/library/inference/inference.factor
index 6e0584ba0828c1d492e32f562640e069c7c625cc..ace10181e8de9748d6bd3d97fdd1d368110a0eaa 100644 (file)
--- a/library/inference/inference.factor
+++ b/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 -- )

diff --git a/library/inference/words.factor b/library/inference/words.factor
index d067da19d9ccc2f12183c97a7c316f44f7205a18..da0db56d1d8bf71a8ef8d267dff2c6586aa50199 100644 (file)
--- a/library/inference/words.factor
+++ b/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

diff --git a/library/test/compiler/optimizer.factor b/library/test/compiler/optimizer.factor
index 15ab4a204c8d01476467a5e087f5ce07def64dae..6bf3a094c41bfab15671b30a02317ad854cae839 100644 (file)
--- a/library/test/compiler/optimizer.factor
+++ b/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

diff --git a/library/test/inference.factor b/library/test/inference.factor
index aa037e2efb28446fce222bfdecbeb252659f437a..57f5b0fee386f046943b9610b343d4d2376ff8e5 100644 (file)
--- a/library/test/inference.factor
+++ b/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
 

diff --git a/library/test/strings.factor b/library/test/strings.factor
index 1e06d37e336e845545cbdc84431bab907970a305..177bd87fbea1ebb373f1a9e3a5d12638f963654e 100644 (file)
--- a/library/test/strings.factor
+++ b/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