diff --git a/CHANGES.html b/CHANGES.html index 97cf1bab0b..921a0daa6f 100644 --- a/CHANGES.html +++ b/CHANGES.html @@ -36,6 +36,7 @@
  • Object slots are now clickable in the inspector
  • The matrices library has been greatly simplified. Matrices are now represented as vectors of vectors, and matrix words have been moved to the math vocabulary.
  • More descriptive "out of bounds" errors.
  • +
  • Erlang/Termite-style concurrency library in contrib/concurrency (Chris Double).
  • diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 65e8270298..e9c3dfd27d 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/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" diff --git a/library/generic/generic.factor b/library/generic/generic.factor index e1a0bc33b0..ae3d270113 100644 --- a/library/generic/generic.factor +++ b/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 diff --git a/library/inference/branches.factor b/library/inference/branches.factor index 1c585a6034..fc16268090 100644 --- a/library/inference/branches.factor +++ b/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 diff --git a/library/inference/conditions.factor b/library/inference/conditions.factor deleted file mode 100644 index dad8880c33..0000000000 --- a/library/inference/conditions.factor +++ /dev/null @@ -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. ; diff --git a/library/inference/dataflow.factor b/library/inference/dataflow.factor index efc18a35b2..a07b9cbd76 100644 --- a/library/inference/dataflow.factor +++ b/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> ; diff --git a/library/inference/inference.factor b/library/inference/inference.factor index 8bec93d72d..9fe87e91f9 100644 --- a/library/inference/inference.factor +++ b/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 -prettyprint sequences strings unparser vectors words ; +USING: errors generic interpreter io kernel lists math +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 + 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 ] 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 ; diff --git a/library/inference/optimizer.factor b/library/inference/optimizer.factor index 0ac27fc697..bd6025b028 100644 --- a/library/inference/optimizer.factor +++ b/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 ; diff --git a/library/inference/print-dataflow.factor b/library/inference/print-dataflow.factor index 3859a68333..8045702e87 100644 --- a/library/inference/print-dataflow.factor +++ b/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) diff --git a/library/inference/recursive-values.factor b/library/inference/recursive-values.factor index 1d27c2d888..fe2e34a048 100644 --- a/library/inference/recursive-values.factor +++ b/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 -- ) - [ node-children first over set-node-successor 1vector ] keep - set-node-children ; +GENERIC: solve-recursion* -M: #label optimize-node* ( node -- node/t ) - 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: node solve-recursion* ( node -- ) drop ; -M: #split optimize-node* ( node -- node/t ) - node-successor ; +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 ; + +: 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 ; diff --git a/library/inference/values.factor b/library/inference/values.factor index e5f9addeb4..178b524445 100644 --- a/library/inference/values.factor +++ b/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 over set-delegate ; -M: computed value= ( literal value -- ? ) - 2drop f ; - TUPLE: literal value ; C: literal ( obj rstate -- value ) [ >r 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 ; diff --git a/library/inference/words.factor b/library/inference/words.factor index 23d5a2e0c9..bc084e2670 100644 --- a/library/inference/words.factor +++ b/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 ( -- ) diff --git a/library/test/compiler/optimizer.factor b/library/test/compiler/optimizer.factor index 5bb2b9ca1d..31b9f6c848 100644 --- a/library/test/compiler/optimizer.factor +++ b/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