Inference cleanup and documentation for errors

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

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 } ;

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"

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 )
+: unify-lengths ( seq -- newseq )
-    #! Pad all vectors to the same length. If one vector is
-    #! shorter, pad it with unknown results at the bottom.
     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 <computed> ] 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 -- )
+TUPLE: unbalanced-branches-error in out ;
-    [ swap unparse " " rot length unparse append3 ] 2map
+
-    "Unbalanced branches:" add* "\n" join inference-error ;
+: unbalanced-branches-error ( in out -- * )
+    <unbalanced-branches-error> 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, ;

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 } "." } ;

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 ;
 

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." } ;

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
+    recursive-state get <inference-error> throw ;
-    <inference-error> throw ;
+
+TUPLE: literal-expected ;
 
 M: object value-literal
-    "A literal value was expected where a computed value was found" inference-error ;
+    <literal-expected> 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.
     <value> 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
+        <check-return> inference-error
-        " element(s) on retain stack. Check >r/r> usage." append3
-        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 ;

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" }
+        { $link no-effect }
-        "The quotation involves conditionals where the branches have incompatible stack effects"
+        { $link literal-expected }
-        "The quotation calls a recursive word with no base case"
+        { $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." }
+{ $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 error if stack effect inference fails." } ;
+{ $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." } ;

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
 
 : <computed> \ <computed> 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 )
+: shuffle ( d r shuffle -- newd newr )
-    #! d and r lengths must be at least the required length for
-    #! the shuffle.
     [ split-shuffle ] keep shuffle* join-shuffle ;
 
 M: shuffle clone

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." } ;

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." } ;

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
+    <no-effect> inference-error ;
-    " was already attempted, and failed" append3
-    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
+M: object apply-word no-effect ;
-    #! A primitive with an unknown stack effect.
-    no-effect ;
 
 TUPLE: effect-error word effect ;
 
-: effect-error ( word effect -- * ) <effect-error> throw ;
+: effect-error ( word effect -- * )
+    <effect-error> 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 )
+TUPLE: recursive-declare-error word ;
-    dup "declared-effect" word-prop [ ] [
-        "The recursive word " swap word-name
-        " does not declare a stack effect" append3
-        inference-error
-    ] ?if ;
 
 : recursive-effect ( word -- effect )
-    #! Handle a recursive call, by either applying a previously
+    stack-effect
-    #! inferred base case, or raising an error. If the recursive
+    [ ] [ <recursive-declare-error> inference-error ] ?if ;
-    #! call is to a local block, emit a label call node.
-    dup "infer-effect" word-prop [ ] [ declared-effect ] ?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

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." } ;

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." }

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

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 error.
-    dup inference-error-message print
+    "Nesting: " write
-    "Recursive state:" print
+    inference-error-rstate [ first ] map . ;
-    inference-error-rstate describe ;
+
+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 . ;