From 72efe349509e1d30c5ca130b32264316debecbc6 Mon Sep 17 00:00:00 2001 From: slava Date: Fri, 18 Aug 2006 07:10:08 +0000 Subject: [PATCH] Inference cleanup and documentation for errors --- TODO.FACTOR.txt | 4 +- doc/handbook/words.facts | 1 - library/bootstrap/boot-stage1.factor | 5 +++ library/compiler/inference/branches.factor | 18 +++------ library/compiler/inference/branches.facts | 22 ++++++++++ library/compiler/inference/dataflow.factor | 16 +------- library/compiler/inference/dataflow.facts | 16 ++++++++ library/compiler/inference/inference.factor | 34 ++++------------ library/compiler/inference/inference.facts | 45 +++++++++++++++++---- library/compiler/inference/shuffle.factor | 5 +-- library/compiler/inference/shuffle.facts | 10 +++++ library/compiler/inference/stack.facts | 7 ++++ library/compiler/inference/words.factor | 42 +++++-------------- library/compiler/inference/words.facts | 31 ++++++++++++++ library/syntax/parse-stream.facts | 10 ++++- library/test/inference.factor | 2 + library/tools/errors.factor | 39 ++++++++++++++++-- 17 files changed, 202 insertions(+), 105 deletions(-) create mode 100644 library/compiler/inference/branches.facts create mode 100644 library/compiler/inference/dataflow.facts create mode 100644 library/compiler/inference/shuffle.facts create mode 100644 library/compiler/inference/stack.facts create mode 100644 library/compiler/inference/words.facts diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 1777c57e08..2d8b4f3c5f 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,7 +1,5 @@ + 0.84: -- document: parse-hook no-parse-hook -- document inference errors - update docs for declared effects - better doc for accumulate, link from tree - RT_WORD should refer to XTs not word objects. @@ -97,6 +95,8 @@ + compiler/ffi: +- [ r> ] infer should throw an inference error +- better way of dealing with compiler errors - compiler tests are not as reliable now because of try-compile usage - we can just do [ t ] [ \ foo compiled? ] unit-test - [ [ dup call ] dup call ] infer hangs diff --git a/doc/handbook/words.facts b/doc/handbook/words.facts index 021f29e825..702fdea11a 100644 --- a/doc/handbook/words.facts +++ b/doc/handbook/words.facts @@ -78,7 +78,6 @@ $terpri "The first declaration specifies the time when a word runs. It affects both interpreted and compiled definitions." { $subsection POSTPONE: parsing } "The remaining declarations only affect compiled definitions. They do not change evaluation semantics of a word, but instead declare that the word follows a certain contract, and thus may be compiled differently." -$terpri { $warning "If a generic word is declared " { $link POSTPONE: foldable } ", all methods must satisfy the contract, otherwise unpredicable behavior will occur." } { $subsection POSTPONE: inline } { $subsection POSTPONE: foldable } ; diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index c3cd434667..b628a629e6 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -253,7 +253,12 @@ sequences vectors words ; "/library/compiler/alien/malloc.facts" "/library/compiler/alien/structs.facts" "/library/compiler/alien/syntax.facts" + "/library/compiler/inference/branches.facts" + "/library/compiler/inference/dataflow.facts" "/library/compiler/inference/inference.facts" + "/library/compiler/inference/shuffle.facts" + "/library/compiler/inference/stack.facts" + "/library/compiler/inference/words.facts" "/library/compiler/compiler.facts" "/library/generic/early-generic.facts" "/library/generic/classes.facts" diff --git a/library/compiler/inference/branches.factor b/library/compiler/inference/branches.factor index 528257c234..020741b493 100644 --- a/library/compiler/inference/branches.factor +++ b/library/compiler/inference/branches.factor @@ -4,15 +4,11 @@ IN: inference USING: arrays errors generic hashtables interpreter kernel math namespaces parser prettyprint sequences strings vectors words ; -: unify-lengths ( seq -- seq ) - #! Pad all vectors to the same length. If one vector is - #! shorter, pad it with unknown results at the bottom. +: unify-lengths ( seq -- newseq ) dup [ length ] map supremum swap [ add-inputs nip ] map-with ; : unify-values ( seq -- value ) - #! If all values in list are equal, return the value. - #! Otherwise, unify. dup all-eq? [ first ] [ drop ] if ; : unify-stacks ( seq -- stack ) flip [ unify-values ] map ; @@ -21,9 +17,10 @@ namespaces parser prettyprint sequences strings vectors words ; [ dup [ length - ] [ 2drop f ] if ] 2map [ ] subset all-equal? ; -: unbalanced-branches ( in out -- ) - [ swap unparse " " rot length unparse append3 ] 2map - "Unbalanced branches:" add* "\n" join inference-error ; +TUPLE: unbalanced-branches-error in out ; + +: unbalanced-branches-error ( in out -- * ) + inference-error ; : unify-inputs ( max-d-in d-in meta-d -- meta-d ) dup [ @@ -32,7 +29,7 @@ namespaces parser prettyprint sequences strings vectors words ; 2nip ] if ; -: unify-effect ( in out -- in out ) +: unify-effect ( in out -- newin newout ) #! in is a sequence of integers, out is a sequence of #! stacks. 2dup balanced? [ @@ -84,8 +81,5 @@ namespaces parser prettyprint sequences strings vectors words ; [ infer-branch ] map dup unify-effects unify-dataflow ; : infer-branches ( branches node -- ) - #! Recursive stack effect inference is done here. If one of - #! the branches has an undecidable stack effect, we set the - #! base case to this stack effect and try again. [ >r (infer-branches) r> set-node-children ] keep node, #merge node, ; diff --git a/library/compiler/inference/branches.facts b/library/compiler/inference/branches.facts new file mode 100644 index 0000000000..212798a91b --- /dev/null +++ b/library/compiler/inference/branches.facts @@ -0,0 +1,22 @@ +IN: inference +USING: help interpreter kernel kernel-internals ; + +HELP: unify-lengths +{ $values { "seq" "a sequence" } { "newseq" "a new sequence" } } +{ $description "Pads sequences in " { $snippet "seq" } " with computed value placeholders to ensure they are all the same length." } ; + +HELP: unify-values +{ $values { "seq" "a sequence" } { "value" "an object" } } +{ $description "If all values in the sequence are equal, outputs the value, otherwise outputs a computed value placeholder." } ; + +HELP: unbalanced-branches-error +{ $values { "in" "a sequence of integers" } { "out" "a sequence of integers" } } +{ $description "Throws an " { $link unbalanced-branches-error } "." } +{ $error-description "Thrown when inference encounters an " { $link if } ", " { $link dispatch } " or " { $link cond } " where the branches do not all exit with the same stack height." } +{ $notes "Conditionals with variable stack effects are considered to be bad style and should be avoided since they do not compile." +$terpri +"If this error comes up when inferring the stack effect of a recursive word, check the word's stack effect declaration; it might be wrong." } ; + +HELP: unify-effect +{ $values { "in" "a sequence of integers" } { "out" "a sequence of stacks" } { "newin" "a sequence of integers" } { "newout" "a sequence of stacks" } } +{ $description "Unifies the stack effects of a number of branches, and outputs new values for " { $link d-in } " and " { $link meta-d } "." } ; diff --git a/library/compiler/inference/dataflow.factor b/library/compiler/inference/dataflow.factor index 2b0678bc07..0d5e55dc29 100644 --- a/library/compiler/inference/dataflow.factor +++ b/library/compiler/inference/dataflow.factor @@ -4,10 +4,6 @@ IN: inference USING: arrays generic hashtables interpreter kernel math namespaces parser sequences words ; -! The dataflow IR is the first of the two intermediate -! representations used by Factor. It annotates concatenative -! code with stack flow information and types. - TUPLE: node param shuffle classes literals history successor children ; @@ -33,10 +29,10 @@ M: node equal? eq? ; : out-node >r f { } r> { } { } ; : meta-d-node meta-d get clone in-node ; -: d-tail ( n -- list ) +: d-tail ( n -- seq ) dup zero? [ drop f ] [ meta-d get swap tail* ] if ; -: r-tail ( n -- list ) +: r-tail ( n -- seq ) dup zero? [ drop f ] [ meta-r get swap tail* ] if ; : node-child node-children first ; @@ -74,8 +70,6 @@ C: #values make-node ; TUPLE: #return ; C: #return make-node ; : #return ( label -- node ) - #! The parameter is the label we are returning from, or if - #! f, this is a top-level return. meta-d-node <#return> [ set-node-param ] keep ; TUPLE: #if ; @@ -108,16 +102,13 @@ C: #declare make-node ; >r r-tail r> set-node-out-r >r d-tail r> set-node-out-d ; -! Variable holding dataflow graph being built. SYMBOL: dataflow-graph -! The most recently added node. SYMBOL: current-node : node, ( node -- ) dataflow-graph get [ dup current-node [ set-node-successor ] change ] [ - ! first node dup dataflow-graph set current-node set ] if ; @@ -177,8 +168,6 @@ SYMBOL: current-node swap [ with rot ] all-nodes? 2nip ; inline : remember-node ( word node -- ) - #! Annotate each node with the fact it was inlined from - #! 'word'. [ dup #call? [ [ node-history ?push ] keep set-node-history ] @@ -265,7 +254,6 @@ DEFER: (map-nodes) ] each-node 2drop ; : subst-values ( new old node -- ) - #! Mutates nodes. node-stack get 1 head-slice* swap add [ >r 2dup r> node-successor (subst-values) ] each 2drop ; diff --git a/library/compiler/inference/dataflow.facts b/library/compiler/inference/dataflow.facts new file mode 100644 index 0000000000..016195a456 --- /dev/null +++ b/library/compiler/inference/dataflow.facts @@ -0,0 +1,16 @@ +IN: inference +USING: help ; + +HELP: #return +{ $values { "label" "a word or " { $link f } } } +{ $description "Creates a node which returns from a nested label, or if " { $snippet "label" } " is " { $link f } ", the top-level word being compiled." } ; + +HELP: dataflow-graph +{ $var-description "In the dynamic extent of " { $link infer } " and " { $link dataflow } ", holds the first node of the dataflow graph being constructed." } ; + +HELP: current-node +{ $var-description "In the dynamic extent of " { $link infer } " and " { $link dataflow } ", holds the most recently added node of the dataflow graph being constructed." } ; + +HELP: remember-node +{ $values { "word" "a word" } { "node" "a dataflow node" } } +{ $description "Annotates all nodes starting from " { $snippet "node" } " with the fact that they were inlined from " { $snippet "word" } ". This prevents infinite loops when the optimizer inlines words." } ; diff --git a/library/compiler/inference/inference.factor b/library/compiler/inference/inference.factor index 09bd12e75f..3844300258 100644 --- a/library/compiler/inference/inference.factor +++ b/library/compiler/inference/inference.factor @@ -5,23 +5,16 @@ USING: arrays errors generic inspector interpreter io kernel math namespaces parser prettyprint sequences strings vectors words ; -TUPLE: inference-error message rstate data-stack call-stack ; +TUPLE: inference-error message rstate ; : inference-error ( msg -- * ) - recursive-state get meta-d get meta-r get - throw ; + recursive-state get throw ; + +TUPLE: literal-expected ; M: object value-literal - "A literal value was expected where a computed value was found" inference-error ; + inference-error ; -! Word properties that affect inference: -! - infer-effect -- must be set. controls number of inputs -! expected, and number of outputs produced. -! - infer - quotation with custom inference behavior; 'if' uses -! this. Word is passed on the stack. - -! Number of values we had to add to the datastack. Ie, the -! inputs. SYMBOL: d-in : pop-literal ( -- rstate obj ) @@ -41,8 +34,6 @@ SYMBOL: d-in : short-effect ( -- pair ) d-in get meta-d get length 2array ; -! Does this control flow path throw an exception, therefore its -! stack height is irrelevant and the branch will always unify? SYMBOL: terminated? : current-effect ( -- effect ) @@ -63,8 +54,6 @@ SYMBOL: recorded GENERIC: apply-object : apply-literal ( obj -- ) - #! Literals are annotated with the current recursive - #! state. push-d #push node, ; M: object apply-object apply-literal ; @@ -72,7 +61,6 @@ M: object apply-object apply-literal ; M: wrapper apply-object wrapped apply-literal ; : terminate ( -- ) - #! Ignore this branch's stack effect. terminated? on #terminate node, ; GENERIC: infer-quot ( quot -- ) @@ -80,20 +68,17 @@ GENERIC: infer-quot ( quot -- ) M: f infer-quot drop ; M: quotation infer-quot - #! Recursive calls to this word are made for nested - #! quotations. [ apply-object terminated? get not ] all? drop ; : infer-quot-value ( rstate quot -- ) recursive-state get >r swap recursive-state set infer-quot r> recursive-state set ; +TUPLE: check-return ; + : check-return ( -- ) - #! Raise an error if word leaves values on return stack. meta-r get empty? [ - "Word leaves " meta-r get length number>string - " element(s) on retain stack. Check >r/r> usage." append3 - inference-error + inference-error ] unless ; : undo-infer ( -- ) @@ -116,16 +101,13 @@ M: quotation infer-quot ] with-scope ; : infer ( quot -- effect ) - #! Stack effect of a quotation. [ infer-quot short-effect ] with-infer ; : (dataflow) ( quot -- dataflow ) infer-quot f #return node, dataflow-graph get ; : dataflow ( quot -- dataflow ) - #! Data flow of a quotation. [ (dataflow) ] with-infer ; : dataflow-with ( quot stack -- effect ) - #! Infer starting from a stack of values. [ meta-d set (dataflow) ] with-infer ; diff --git a/library/compiler/inference/inference.facts b/library/compiler/inference/inference.facts index 0c5da8f7ce..1d75f7c4f5 100644 --- a/library/compiler/inference/inference.facts +++ b/library/compiler/inference/inference.facts @@ -1,20 +1,49 @@ IN: inference -USING: help kernel ; +USING: compiler help kernel sequences ; HELP: inference-error { $values { "msg" "an object" } } { $description "Throws an " { $link inference-error } "." } { $error-description - "Thrown by " { $link infer } " when the stack effect of a quotation cannot be inferred. There are several possible reasons that this can occur:" + "Thrown by " { $link infer } ", " { $link dataflow } " and " { $link compile } " when the stack effect of a quotation cannot be inferred." + $terpri + "This error always delegates to one of the following classes of errors, which indicate the specific issue preventing a stack effect from being inferred:" { $list - { "The quotation applies " { $link call } " or " { $link if } " to quotation values which are not literals; thus the potential stack effect is arbitrary" } - "The quotation involves conditionals where the branches have incompatible stack effects" - "The quotation calls a recursive word with no base case" + { $link no-effect } + { $link literal-expected } + { $link check-return } + { $link unbalanced-branches-error } + { $link effect-error } + { $link recursive-declare-error } } - "Words without a static stack effect cannot be compiled, but will still run in the interpreter." } ; +HELP: literal-expected +{ $error-description "Thrown when inference encounters a " { $link call } " or " { $link if } " being applied to a value which is not known to be a literal. Such a form can have an arbitrary stack effect, and does not compile." } +{ $notes "This error will be thrown when compiling any combinator, such as " { $link each } ". However, words calling combinators can compile of the combinator is declared " { $link inline } " and the quotation being passed in is a literal." } ; + +HELP: d-in +{ $var-description "During inference, holds the number of inputs which the quotation has been inferred to require so far." } ; + +HELP: terminated? +{ $var-description "During inference, a flag set to " { $link t } " if the current control flow path unconditionally throws an error." } ; + +HELP: check-return +{ $error-description "Thrown if inference notices a quotation leaving behind elements on the retain stack." } +{ $notes "Usually this error indicates a coding mistake; check that usages of " { $link >r } " and " { $link r> } " are balanced in this case. Writing code which intentionally does this is considered bad style." } ; + HELP: infer { $values { "quot" "a quotation" } { "effect" "a pair of integers" } } -{ $description "Attempts to infer the quotation's stack effect, outputting a pair holding the correct of data stack inputs and outputs for the quotation." } -{ $errors "Throws an error if stack effect inference fails." } ; +{ $description "Attempts to infer the quotation's stack effect, and outputs a pair holding the correct of data stack inputs and outputs for the quotation." } +{ $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ; + +HELP: dataflow +{ $values { "quot" "a quotation" } { "dataflow" "a dataflow node" } } +{ $description "Attempts to construct a dataflow graph showing stack flow in the quotation." } +{ $notes "This is the first stage of the compiler." } +{ $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ; + +HELP: dataflow-with +{ $values { "quot" "a quotation" } { "stack" "a vector" } { "dataflow" "a dataflow node" } } +{ $description "Attempts to construct a dataflow graph showing stack flow in the quotation, starting with an initial data stack of values." } +{ $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ; diff --git a/library/compiler/inference/shuffle.factor b/library/compiler/inference/shuffle.factor index 3665c6db62..84f043d870 100644 --- a/library/compiler/inference/shuffle.factor +++ b/library/compiler/inference/shuffle.factor @@ -3,7 +3,6 @@ IN: inference USING: hashtables kernel math namespaces sequences ; -! Recursive state. An alist, mapping words to labels. SYMBOL: recursive-state : \ counter ; @@ -46,9 +45,7 @@ TUPLE: shuffle in-d in-r out-d out-r ; : join-shuffle ( d' r' d r -- d r ) swapd append >r append r> ; -: shuffle ( d r shuffle -- d r ) - #! d and r lengths must be at least the required length for - #! the shuffle. +: shuffle ( d r shuffle -- newd newr ) [ split-shuffle ] keep shuffle* join-shuffle ; M: shuffle clone diff --git a/library/compiler/inference/shuffle.facts b/library/compiler/inference/shuffle.facts new file mode 100644 index 0000000000..ab56ab58df --- /dev/null +++ b/library/compiler/inference/shuffle.facts @@ -0,0 +1,10 @@ +IN: inference +USING: help ; + +HELP: recursive-state +{ $var-description "During inference, holds an association list mapping words to labels." } ; + +HELP: shuffle +{ $values { "d" "a sequence" } { "r" "a sequence" } { "shuffle" "an instance of " { $link shuffle } } { "newd" "a new sequence" } { "newr" "a new sequence" } } +{ $description "Applies a stack shuffle pattern to a pair of stacks." } +{ $errors "Throws an error if the input stacks contain insufficient elements." } ; diff --git a/library/compiler/inference/stack.facts b/library/compiler/inference/stack.facts new file mode 100644 index 0000000000..400c8a0f37 --- /dev/null +++ b/library/compiler/inference/stack.facts @@ -0,0 +1,7 @@ +IN: inference +USING: help ; + +HELP: shuffle-stacks +{ $values { "shuffle" "an instance of " { $link shuffle } } } +{ $description "Applies a stack shuffle pattern to the inference stacks." } +{ $errors "Throws an error if the stacks contain insufficient elements." } ; diff --git a/library/compiler/inference/words.factor b/library/compiler/inference/words.factor index bbe318d49c..208c83b15b 100644 --- a/library/compiler/inference/words.factor +++ b/library/compiler/inference/words.factor @@ -24,8 +24,6 @@ IN: inference if ; : consume/produce ( word effect -- ) - #! Add a node to the dataflow graph that consumes and - #! produces a number of values. meta-d get clone >r swap make-call-node over effect-in length over consume-values @@ -33,10 +31,10 @@ IN: inference r> over #call-label? [ over set-node-in-d ] [ drop ] if node, effect-terminated? [ terminate ] when ; +TUPLE: no-effect word ; + : no-effect ( word -- * ) - "Stack effect inference of the word " swap word-name - " was already attempted, and failed" append3 - inference-error ; + inference-error ; : nest-node ( -- ) #entry node, ; @@ -67,32 +65,20 @@ M: #call-label collect-recursion* tuck node-param eq? [ node-in-d , ] [ drop ] if ; : collect-recursion ( #label -- seq ) - #! Collect the input stacks of all #call-label nodes that - #! call given label. dup node-param swap [ [ collect-recursion* ] each-node-with ] { } make ; : join-values ( node -- ) - #! We have to infer recursive labels twice to determine - #! which literals survive the recursion (eg, quotations) - #! and which don't (loop indices, etc). The latter cannot - #! be folded. collect-recursion meta-d get add unify-lengths unify-stacks meta-d [ length tail* >vector ] change ; : splice-node ( node -- ) - #! Labels which do not call themselves are just spliced into - #! the IR, and no #label node is added. dup node-successor [ dup node, penultimate-node f over set-node-successor dup current-node set ] when drop ; : inline-closure ( word -- ) - #! This is not a closure in the lexical scope sense, but a - #! closure under recursive value substitution. - #! If the block does not call itself, there is no point in - #! having the block node in the IR. Just add its contents. dup inline-block over recursive-label? [ meta-d get >r drop join-values inline-block apply-infer @@ -109,13 +95,12 @@ M: #call-label collect-recursion* GENERIC: apply-word -M: object apply-word - #! A primitive with an unknown stack effect. - no-effect ; +M: object apply-word no-effect ; TUPLE: effect-error word effect ; -: effect-error ( word effect -- * ) throw ; +: effect-error ( word effect -- * ) + inference-error ; : check-effect ( word effect -- ) over "infer" word-prop [ @@ -128,7 +113,6 @@ TUPLE: effect-error word effect ; ] if ; M: compound apply-word - #! Infer a compound word's stack effect. [ dup infer-compound check-effect ] [ @@ -154,21 +138,13 @@ M: word apply-object apply-default ; M: symbol apply-object apply-literal ; -: declared-effect ( word -- effect ) - dup "declared-effect" word-prop [ ] [ - "The recursive word " swap word-name - " does not declare a stack effect" append3 - inference-error - ] ?if ; +TUPLE: recursive-declare-error word ; : recursive-effect ( word -- effect ) - #! Handle a recursive call, by either applying a previously - #! inferred base case, or raising an error. If the recursive - #! call is to a local block, emit a label call node. - dup "infer-effect" word-prop [ ] [ declared-effect ] ?if ; + stack-effect + [ ] [ inference-error ] ?if ; M: compound apply-object - #! Apply the word's stack effect to the inferencer state. dup "inline" word-prop [ dup recursive-state get peek first eq? [ dup recursive-effect consume/produce diff --git a/library/compiler/inference/words.facts b/library/compiler/inference/words.facts new file mode 100644 index 0000000000..ce6eae9ed0 --- /dev/null +++ b/library/compiler/inference/words.facts @@ -0,0 +1,31 @@ +IN: inference +USING: help words ; + +HELP: consume/produce +{ $values { "word" "a word" } { "effect" "an instance of " { $link effect } } } +{ $description "Adds a node to the dataflow graph that calls " { $snippet "word" } " with a stack effect of " { $snippet "effect" } "." } ; + +HELP: no-effect +{ $values { "word" "a word" } } +{ $description "Throws a " { $link no-effect } " error." } +{ $error-description "Thrown when inference encounters a call to a word which is already known not to have a static stack effect, due to a prior inference attempt failing." } ; + +HELP: collect-recursion +{ $values { "#label" "a " { $link #label } " node" } { "seq" "a new sequence" } } +{ $description "Collect the input stacks of all child " { $link #call-label } " nodes that call the given label." } ; + +HELP: inline-closure +{ $values { "word" "a word" } } +{ $description "Called during inference to infer stack effects of inline words." +$terpri +"If the inline word is recursive, a new " { $link #label } " node is added to the dataflow graph, and the word has to be inferred twice, to determine which literals survive the recursion (eg, quotations) and which don't (loop indices, etc)." +$terpri +"If the inline word is not recursive, the resulting nodes are spliced into the dataflow graph, and no " { $link #label } " node is created." } ; + +HELP: effect-error +{ $values { "word" "a word" } { "effect" "an instance of " { $link effect } } } +{ $description "Throws an " { $link effect-error } "." } +{ $error-description "Thrown when a word's inferred stack effect does not match its declared stack effect." } ; + +HELP: recursive-declare-error +{ $error-description "Thrown when inference encounters a recursive call to a word lacking a stack effect declaration. Recursive words must declare a stack effect in order to compile. Due to implementation detail, generic words are recursive, and thus the same restriction applies." } ; diff --git a/library/syntax/parse-stream.facts b/library/syntax/parse-stream.facts index 45000cb918..6e692e1144 100644 --- a/library/syntax/parse-stream.facts +++ b/library/syntax/parse-stream.facts @@ -1,4 +1,4 @@ -USING: help io jedit parser ; +USING: compiler help io jedit parser ; HELP: file-vocabs { $description "Installs the initial the vocabulary search path for parsing a file." } ; @@ -22,6 +22,14 @@ HELP: eval { $description "Parses Factor source code from a string, and calls the resulting quotation. The current vocabulary search path is used." } { $errors "Throws an error if the input is malformed, or if the quotation throws an error." } ; +HELP: parse-hook +{ $var-description "A quotation called by " { $link parse-stream } " after parsing the input stream. The default value calls " { $link recompile } " to recompile any changed definitions." } +{ $see-also no-parse-hook } ; + +HELP: no-parse-hook +{ $values { "quot" "a quotation" } } +{ $description "Runs the quotation in a new dynamic scope where " { $link parse-hook } " is set to " { $link f } ". This disables the default behavior of recompiling changed definitions after a source file is loaded." } ; + HELP: parse-stream { $values { "stream" "an input stream" } { "name" "a file name for error reporting" } { "quot" "a new quotation" } } { $description "Parses Factor source code read from the stream. The initial vocabulary search path is used." } diff --git a/library/test/inference.factor b/library/test/inference.factor index e32145e36d..9391b7eee4 100644 --- a/library/test/inference.factor +++ b/library/test/inference.factor @@ -309,6 +309,8 @@ DEFER: bar : bad-bin ( a b -- ) 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] if ; [ [ bad-bin ] infer ] unit-test-fails +[ t ] [ [ [ r> ] infer ] catch inference-error? ] unit-test + ! Test some random library words [ { 1 1 } ] [ [ unit ] infer ] unit-test diff --git a/library/tools/errors.factor b/library/tools/errors.factor index 5e5386384f..a66ad95d02 100644 --- a/library/tools/errors.factor +++ b/library/tools/errors.factor @@ -168,7 +168,38 @@ M: alien-invoke-error summary M: assert summary drop "Assertion failed" ; M: inference-error error. - "Inference error:" print - dup inference-error-message print - "Recursive state:" print - inference-error-rstate describe ; + dup inference-error-message error. + "Nesting: " write + inference-error-rstate [ first ] map . ; + +M: inference-error error-help drop f ; + +M: unbalanced-branches error. + "Unbalanced branches:" print + dup unbalanced-branches-out + swap unbalanced-branches-in + [ pprint bl pprint ] 2map ; + +M: literal-expected summary + drop "Literal value expected" ; + +M: retain-leave-error summary + drop + "Quotation leaves elements behind on retain stack" ; + +M: no-effect error. + "The word " write + no-effect-word pprint + " does not have a stack effect" print ; + +M: recursive-declare-error error. + "The recursive word " write + recursive-declare-error-word pprint + " must declare a stack effect" print ; + +M: effect-error error. + "Stack effects of the word " write + dup effect-error-word pprint + " do not match." print + "Declared: " write dup effect-error-word stack-effect . + "Inferred: " write effect-error-effect . ;