inference cleanups; recursive value inference work in progress

CHANGES.html

@@ -36,6 +36,7 @@
 <li>Object slots are now clickable in the inspector</li>
 <li>The matrices library has been greatly simplified. Matrices are now represented as vectors of vectors, and matrix words have been moved to the <code>math</code> vocabulary.</li>
 <li>More descriptive "out of bounds" errors.</li>
+<li>Erlang/Termite-style concurrency library in <code>contrib/concurrency</code> (Chris Double).</li>
 </ul>
 
 </li>

library/bootstrap/boot-stage1.factor

@@ -83,13 +83,13 @@ parser prettyprint sequences io vectors words ;
         "/library/tools/debugger.factor"
         "/library/tools/memory.factor"
 
-        "/library/inference/conditions.factor"
         "/library/inference/dataflow.factor"
         "/library/inference/values.factor"
         "/library/inference/inference.factor"
         "/library/inference/branches.factor"
         "/library/inference/words.factor"
         "/library/inference/stack.factor"
+        "/library/inference/recursive-values.factor"
         "/library/inference/class-infer.factor"
         "/library/inference/optimizer.factor"
         "/library/inference/inline-methods.factor"

library/generic/generic.factor

@@ -131,6 +131,9 @@ DEFER: delegate
     ] unless
     [ "methods" word-prop set-hash ] keep make-generic ;
 
+: forget-method ( class generic -- )
+    [ "methods" word-prop remove-hash ] keep make-generic ;
+
 : init-methods ( word -- )
      dup "methods" word-prop [
          drop

library/inference/branches.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: inference
 USING: errors generic hashtables interpreter kernel lists math
-namespaces prettyprint sequences strings vectors words ;
+namespaces prettyprint sequences strings unparser vectors words ;
 
 : unify-lengths ( seq -- seq )
     #! Pad all vectors to the same length. If one vector is
@@ -37,7 +37,11 @@ namespaces prettyprint sequences strings vectors words ;
 : unify-effect ( in out -- in out )
     2dup balanced?
     [ unify-stacks >r unify-stacks r> ]
-    [ "Unbalanced branches" inference-error ] ifte ;
+    [
+        { "Unbalanced branches:" } -rot [
+            swap length unparse " " rot length unparse append3
+        ] 2map append "\n" join inference-error
+    ] ifte ;
 
 : datastack-effect ( seq -- )
     dup [ d-in swap hash ] map

library/inference/conditions.factor

@@ -1,38 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: inference
-USING: errors interpreter kernel lists namespaces prettyprint
-sequences io ;
-
-DEFER: recursive-state
-
-: inference-condition ( msg symbol -- )
-    [
-        , , recursive-state get , meta-d get , meta-r get ,
-    ] make-list ;
-
-: inference-condition. ( cond msg -- )
-    "! " write write
-    cdr unswons error.
-    "! Recursive state:" print
-    car [ "! " write . ] each ;
-
-: inference-error ( msg -- )
-    #! Signalled if your code is malformed in some
-    #! statically-provable way.
-    \ inference-error inference-condition throw ;
-
-PREDICATE: cons inference-error car \ inference-error = ;
-M: inference-error error. ( error -- )
-    "Inference error: " inference-condition. ;
-
-: inference-warning ( msg -- )
-    "inference-warnings" get [
-        \ inference-warning inference-condition error.
-    ] [
-        drop
-    ] ifte ;
-
-PREDICATE: cons inference-warning car \ inference-warning = ;
-M: inference-warning error. ( error -- )
-    "Inference warning: " inference-condition. ;

library/inference/dataflow.factor

@@ -35,10 +35,6 @@ TUPLE: #entry ;
 C: #entry make-node ;
 : #entry ( -- node ) meta-d get clone in-d-node <#entry> ;
 
-TUPLE: #split ;
-C: #split make-node ;
-: #split ( stack -- node ) in-d-node <#split> ;
-
 TUPLE: #call ;
 C: #call make-node ;
 : #call ( word -- node ) param-node <#call> ;

library/inference/inference.factor

@@ -1,12 +1,24 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: inference
-USING: errors generic interpreter kernel lists math namespaces
+USING: errors generic interpreter io kernel lists math
-prettyprint sequences strings unparser vectors words ;
+namespaces prettyprint sequences strings unparser vectors words ;
 
 ! This variable takes a boolean value.
 SYMBOL: inferring-base-case
 
+TUPLE: inference-error message rstate data-stack call-stack ;
+
+: inference-error ( msg -- )
+    recursive-state get meta-d get meta-r get
+    <inference-error> throw ;
+
+M: inference-error error. ( error -- )
+    "! Inference error:" print
+    dup inference-error-message print
+    "! Recursive state:" print
+    inference-error-rstate [.] ;
+
 ! Word properties that affect inference:
 ! - infer-effect -- must be set. controls number of inputs
 ! expected, and number of outputs produced.
@@ -18,7 +30,7 @@ SYMBOL: inferring-base-case
 SYMBOL: d-in
 
 : pop-literal ( -- rstate obj )
-    1 #drop node, pop-d >literal< ;
+    1 #drop node, pop-d dup value-recursion swap literal-value ;
 
 : computed-value-vector ( n -- vector )
     empty-vector dup [ drop <computed> ] nmap ;
@@ -88,13 +100,12 @@ M: wrapper apply-object wrapped apply-literal ;
     dup infer-quot handle-terminator
     r> recursive-state set ;
 
-: check-active ( -- )
-    active? [ "Provable runtime error" inference-error ] unless ;
-
 : check-return ( -- )
     #! Raise an error if word leaves values on return stack.
     meta-r get empty? [
-        "Word leaves elements on return stack" inference-error
+        "Word leaves " meta-r get length unparse
+        " element(s) on return stack. Check >r/r> usage." append3
+        inference-error
     ] unless ;
 
 : with-infer ( quot -- )
@@ -102,7 +113,6 @@ M: wrapper apply-object wrapped apply-literal ;
         inferring-base-case off
         f init-inference
         call
-        check-active
         check-return
     ] with-scope ;
 
@@ -110,10 +120,6 @@ M: wrapper apply-object wrapped apply-literal ;
     #! Stack effect of a quotation.
     [ infer-quot effect ] with-infer ;
 
-: infer-from ( quot stack -- effect )
-    #! Infer starting from a stack of values.
-    [ meta-d set infer-quot effect ] with-infer ;
-
 : (dataflow) ( quot -- dataflow )
     infer-quot #return node, dataflow-graph get ;
 

library/inference/optimizer.factor

@@ -70,6 +70,7 @@ M: node optimize-children ( node -- )
     #! is destructively modified.
     [
         recursive-state off
+        dup solve-recursion
         dup kill-set over kill-node
         dup infer-classes
         optimize-node
@@ -213,7 +214,7 @@ M: #ifte can-kill* ( literal node -- ? )
 
 M: #ifte optimize-node* ( node -- node )
     dup static-branch?
-    [ f swap value= 1 0 ? static-branch ] [ 2drop t ] ifte ;
+    [ literal-value 0 1 ? static-branch ] [ 2drop t ] ifte ;
 
 ! #dispatch
 M: #dispatch can-kill* ( literal node -- ? )
@@ -255,3 +256,6 @@ M: #values optimize-node* ( node -- node ? )
 
 ! #merge
 M: #merge can-kill* ( literal node -- ? ) 2drop t ;
+
+! #entry
+M: #entry can-kill* ( literal node -- ? ) 2drop t ;

library/inference/print-dataflow.factor

@@ -71,8 +71,6 @@ M: #merge node>quot ( ? node -- ) "#merge" comment, ;
 
 M: #entry node>quot ( ? node -- ) "#entry" comment, ;
 
-M: #split node>quot ( ? node -- ) "#split" comment, ;
-
 : (dataflow>quot) ( ? node -- )
     dup [
         2dup node>quot node-successor (dataflow>quot)

library/inference/recursive-values.factor

@@ -3,9 +3,6 @@
 IN: inference
 USING: kernel namespaces prettyprint sequences vectors ;
 
-! Technical detail: need to figure out which values survive
-! inner recursions in #labels.
-
 GENERIC: collect-recursion* ( label node -- )
 
 M: node collect-recursion* ( label node -- ) 2drop ;
@@ -18,14 +15,17 @@ M: #call-label collect-recursion* ( label node -- )
     #! call given label.
     [ [ collect-recursion* ] each-node-with ] make-vector ;
 
-: first-child ( child node -- )
+GENERIC: solve-recursion*
-    [ node-children first over set-node-successor 1vector ] keep
-    set-node-children ;
 
-M: #label optimize-node* ( node -- node/t )
+M: node solve-recursion* ( node -- ) drop ;
-    dup dup node-param over collect-recursion >r
-    node-children first node-in-d r> swap add
-    unify-stacks #split swap first-child t ;
 
-M: #split optimize-node* ( node -- node/t )
+M: #label solve-recursion* ( node -- )
-    node-successor ;
+    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 ;
+
+: 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 ;

library/inference/values.factor

@@ -3,8 +3,6 @@
 IN: inference
 USING: generic kernel lists namespaces sequences unparser words ;
 
-GENERIC: value= ( literal value -- ? )
-
 TUPLE: value recursion safe? ;
 
 C: value ( recursion -- value )
@@ -18,24 +16,20 @@ TUPLE: computed ;
 C: computed ( -- value )
     recursive-state get <value> over set-delegate ;
 
-M: computed value= ( literal value -- ? )
-    2drop f ;
-
 TUPLE: literal value ;
 
 C: literal ( obj rstate -- value )
     [ >r <value> r> set-delegate ] keep
     [ set-literal-value ] keep ;
 
-M: literal value= ( literal value -- ? )
-    literal-value = ;
-
-: >literal< ( literal -- rstate obj )
-    dup value-recursion swap literal-value ;
-
 M: value literal-value ( value -- )
-    "A literal value was expected where a computed value was found"
+    {
-    inference-error ;
+        "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 ;
 

library/inference/words.factor

@@ -21,7 +21,8 @@ hashtables parser prettyprint ;
     ] keep node, ;
 
 : no-effect ( word -- )
-    "Unknown stack effect: " swap word-name append
+    "Stack effect inference of the word " swap word-name
+    " was already attempted, and failed" append3
     inference-error ;
 
 : inhibit-parital ( -- )

library/test/compiler/optimizer.factor

@@ -27,11 +27,6 @@ USE: sequences
     [ [ literal-value 2 <= ] subset ] keep in-d-node <#drop> kill-mask
 ] unit-test
 
-[ t ] [
-    3 [ 3 over [ ] [ ] ifte drop ] dataflow
-    kill-set [ value= ] contains-with?
-] unit-test
-
 : literal-kill-test-1 4 compiled-offset cell 2 * - ; compiled
 
 [ 4 ] [ literal-kill-test-1 drop ] unit-test