stack-checker: tighten some screws in error reporting

basis/compiler/compiler.factor

@@ -63,17 +63,23 @@ M: method-body no-compile? "method-generic" word-prop no-compile? ;
 M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
 
 M: word no-compile?
-    {
-        [ macro? ]
-        [ inline? ]
-        [ "special" word-prop ]
-        [ "no-compile" word-prop ]
-    } 1|| ;
+    { [ macro? ] [ "special" word-prop ] [ "no-compile" word-prop ] } 1|| ;
+
+GENERIC: combinator? ( word -- ? )
+
+M: method-body combinator? "method-generic" word-prop combinator? ;
+
+M: predicate-engine-word combinator? "owner-generic" word-prop combinator? ;
+
+M: word combinator? inline? ;
 
 : ignore-error? ( word error -- ? )
     #! Ignore some errors on inline combinators, macros, and special
     #! words such as 'call'.
-    [ no-compile? ] [ { [ do-not-compile? ] [ literal-expected? ] } 1|| ] bi* and ;
+    {
+        [ drop no-compile? ]
+        [ [ combinator? ] [ unknown-macro-input? ] bi* and ]
+    } 2|| ;
 
 : finish ( word -- )
     #! Recompile callers if the word's stack effect changed, then

basis/compiler/tree/builder/builder.factor

@@ -39,7 +39,7 @@ M: word (build-tree)
     [
         <recursive-state> recursive-state set
         V{ } clone stack-visitor set
-        [ [ >vector \ meta-d set ] [ length d-in set ] bi ]
+        [ [ >vector \ meta-d set ] [ length input-count set ] bi ]
         [ (build-tree) ]
         bi*
     ] with-infer nip ;

basis/debugger/debugger.factor

@@ -26,6 +26,9 @@ M: object error. short. ;
 
 M: string error. print ;
 
+: traceback-link. ( continuation -- )
+    "[" write [ "Traceback" ] dip write-object "]" print ;
+
 : :s ( -- )
     error-continuation get data>> stack. ;
 

basis/stack-checker/backend/backend-tests.factor

@@ -1,17 +1,21 @@
 USING: stack-checker.backend tools.test kernel namespaces
-stack-checker.state sequences ;
+stack-checker.state stack-checker.values sequences assocs ;
 IN: stack-checker.backend.tests
 
 [ ] [
     V{ } clone \ meta-d set
     V{ } clone \ meta-r set
     V{ } clone \ literals set
-    0 d-in set
+    H{ } clone known-values set
+    0 input-count set
 ] unit-test
 
 [ 0 ] [ 0 ensure-d length ] unit-test
 
 [ 2 ] [ 2 ensure-d length ] unit-test
+
+[ t ] [ meta-d [ known-values get at input-parameter? ] all? ] unit-test
+
 [ 2 ] [ meta-d length ] unit-test
 
 [ 3 ] [ 3 ensure-d length ] unit-test

basis/stack-checker/backend/backend.factor

@@ -10,10 +10,14 @@ IN: stack-checker.backend
 
 : push-d ( obj -- ) meta-d push ;
 
+: introduce-values ( values -- )
+    [ [ [ input-parameter ] dip set-known ] each ]
+    [ length input-count +@ ]
+    [ #introduce, ]
+    tri ;
+
 : pop-d  ( -- obj )
-    meta-d [
-        <value> dup 1array #introduce, d-in inc
-    ] [ pop ] if-empty ;
+    meta-d [ <value> dup 1array introduce-values ] [ pop ] if-empty ;
 
 : peek-d ( -- obj ) pop-d dup push-d ;
 
@@ -24,7 +28,7 @@ IN: stack-checker.backend
     meta-d 2dup length > [
         2dup
         [ nip >array ] [ length - make-values ] [ nip delete-all ] 2tri
-        [ length d-in +@ ] [ #introduce, ] [ meta-d push-all ] tri
+        [ introduce-values ] [ meta-d push-all ] bi
         meta-d push-all
     ] when swap tail* ;
 

basis/stack-checker/branches/branches.factor

@@ -11,7 +11,7 @@ IN: stack-checker.branches
 
 SYMBOLS: +bottom+ +top+ ;
 
-: unify-inputs ( max-d-in d-in meta-d -- new-meta-d )
+: unify-inputs ( max-input-count input-count meta-d -- new-meta-d )
     ! Introduced values can be anything, and don't unify with
     ! literals.
     dup [ [ - +top+ <repetition> ] dip append ] [ 3drop f ] if ;
@@ -24,7 +24,7 @@ SYMBOLS: +bottom+ +top+ ;
         '[ _ +bottom+ pad-head ] map
     ] unless ;
 
-: phi-inputs ( max-d-in pairs -- newseq )
+: phi-inputs ( max-input-count pairs -- newseq )
     dup empty? [ nip ] [
         swap '[ [ _ ] dip first2 unify-inputs ] map
         pad-with-bottom
@@ -61,9 +61,9 @@ SYMBOL: quotations
     branch-variable ;
 
 : datastack-phi ( seq -- phi-in phi-out )
-    [ d-in branch-variable ] [ \ meta-d active-variable ] bi
+    [ input-count branch-variable ] [ \ meta-d active-variable ] bi
     unify-branches
-    [ d-in set ] [ ] [ dup >vector \ meta-d set ] tri* ;
+    [ input-count set ] [ ] [ dup >vector \ meta-d set ] tri* ;
 
 : terminated-phi ( seq -- terminated )
     terminated? branch-variable ;
@@ -80,7 +80,7 @@ SYMBOL: quotations
 : copy-inference ( -- )
     \ meta-d [ clone ] change
     literals [ clone ] change
-    d-in [ ] change ;
+    input-count [ ] change ;
 
 GENERIC: infer-branch ( literal -- namespace )
 

basis/stack-checker/dependencies/dependencies-tests.factor

@@ -1,5 +1,5 @@
-IN: stack-checker.state.tests
-USING: tools.test stack-checker.state words kernel namespaces
+IN: stack-checker.dependencies.tests
+USING: tools.test stack-checker.dependencies words kernel namespaces
 definitions ;
 
 : computing-dependencies ( quot -- dependencies )
@@ -35,4 +35,3 @@ SYMBOL: b
 [ inlined-dependency ] [ called-dependency inlined-dependency strongest-dependency ] unit-test
 [ flushed-dependency ] [ called-dependency flushed-dependency strongest-dependency ] unit-test
 [ called-dependency ] [ called-dependency f strongest-dependency ] unit-test
-

basis/stack-checker/errors/errors-docs.factor

@@ -12,10 +12,10 @@ HELP: do-not-compile
     }
 } ;
 
-HELP: literal-expected
-{ $error-description "Thrown when inference encounters a combinator or macro being applied to a value which is not known to be a literal, or constructed in a manner which can be analyzed statically. Such code needs changes before it can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
+HELP: unknown-macro-input
+{ $error-description "Thrown when inference encounters a combinator or macro being applied to an input parameter of a non-" { $link POSTPONE: inline } " word. The word needs to be declared " { $link POSTPONE: inline } " before its callers can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
 { $examples
-    "In this example, the words being defined cannot be called, because they fail to compile with a " { $link literal-expected } " error:"
+    "In this example, the words being defined cannot be called, because they fail to compile with a " { $link unknown-macro-input } " error:"
     { $code
         ": bad-example ( quot -- )"
         "    [ call ] [ call ] bi ;"
@@ -41,6 +41,27 @@ HELP: literal-expected
     }
 } ;
 
+HELP: bad-macro-input
+{ $error-description "Thrown when inference encounters a combinator or macro being applied to a value which is not known at compile time. Such code needs changes before it can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
+{ $examples
+    "In this example, the words being defined cannot be called, because they fail to compile with a " { $link bad-macro-input } " error:"
+    { $code
+        ": bad-example ( quot -- )"
+        "    [ . ] append call ; inline"
+        ""
+        ": usage ( -- )"
+        "    2 2 [ + ] bad-example ;"
+    }
+    "One fix is to use " { $link compose } " instead of " { $link append } ":"
+    { $code
+        ": good-example ( quot -- )"
+        "    [ . ] compose call ; inline"
+        ""
+        ": usage ( -- )"
+        "    2 2 [ + ] good-example ;"
+    }
+} ;
+
 HELP: unbalanced-branches-error
 { $values { "in" "a sequence of integers" } { "out" "a sequence of integers" } }
 { $description "Throws an " { $link unbalanced-branches-error } "." }
@@ -121,7 +142,8 @@ ARTICLE: "inference-errors" "Stack checker errors"
 "Errors thrown when insufficient information is available to calculate the stack effect of a call to a combinator or macro (see " { $link "inference-combinators" } "):"
 { $subsections
     do-not-compile
-    literal-expected
+    unknown-macro-input
+    bad-macro-input
 }
 "Error thrown when a word's stack effect declaration does not match the composition of the stack effects of its factors:"
 { $subsections effect-error }

basis/stack-checker/errors/errors.factor

@@ -1,13 +1,14 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel stack-checker.values ;
 IN: stack-checker.errors
 
 TUPLE: inference-error ;
 
 ERROR: do-not-compile < inference-error word ;
 
-ERROR: literal-expected < inference-error what ;
+ERROR: bad-macro-input < inference-error macro ;
+
+ERROR: unknown-macro-input < inference-error macro ;
 
 ERROR: unbalanced-branches-error < inference-error branches quots ;
 
@@ -31,8 +32,6 @@ ERROR: inconsistent-recursive-call-error < inference-error word ;
 
 ERROR: unknown-primitive-error < inference-error ;
 
-ERROR: transform-expansion-error < inference-error word error ;
+ERROR: transform-expansion-error < inference-error error continuation word ;
 
-ERROR: bad-declaration-error < inference-error declaration ;
-
-M: object (literal) "literal value" literal-expected ;
+ERROR: bad-declaration-error < inference-error declaration ;

basis/stack-checker/errors/prettyprint/prettyprint.factor

@@ -4,10 +4,11 @@ USING: accessors kernel prettyprint io debugger
 sequences assocs stack-checker.errors summary effects ;
 IN: stack-checker.errors.prettyprint
 
-M: literal-expected summary
-    what>> "Got a computed value where a " " was expected" surround ;
+M: unknown-macro-input summary
+    macro>> name>> "Cannot apply “" "” to an input parameter of a non-inline word" surround ;
 
-M: literal-expected error. summary print ;
+M: bad-macro-input summary
+    macro>> name>> "Cannot apply “" "” to a run-time computed value" surround ;
 
 M: unbalanced-branches-error summary
     drop "Unbalanced branches" ;
@@ -56,7 +57,10 @@ M: transform-expansion-error summary
     word>> name>> "Macro expansion of " " threw an error" surround ;
 
 M: transform-expansion-error error.
-    [ summary print ] [ error>> error. ] bi ;
+    [ summary print ]
+    [ nl "The error was:" print error>> error. nl ]
+    [ continuation>> traceback-link. ]
+    tri ;
 
 M: do-not-compile summary
     word>> name>> "Cannot compile call to " prepend ;

basis/stack-checker/inlining/inlining.factor

@@ -82,7 +82,7 @@ SYMBOL: enter-out
     bi ;
 
 : recursive-word-inputs ( label -- n )
-    entry-stack-height d-in get + ;
+    entry-stack-height input-count get + ;
 
 : (inline-recursive-word) ( word -- label in out visitor terminated? )
     dup prepare-stack

basis/stack-checker/known-words/known-words.factor

@@ -98,8 +98,8 @@ M: composed infer-call*
     1 infer->r infer-call
     terminated? get [ 1 infer-r> infer-call ] unless ;
 
-M: object infer-call*
-    "literal quotation" literal-expected ;
+M: input-parameter infer-call* \ call unknown-macro-input ;
+M: object infer-call* \ call bad-macro-input ;
 
 : infer-ndip ( word n -- )
     [ literals get ] 2dip
@@ -231,7 +231,7 @@ M: bad-executable summary
 \ alien-callback [ infer-alien-callback ] "special" set-word-prop
 
 : infer-special ( word -- )
-    "special" word-prop call( -- ) ;
+    [ current-word set ] [ "special" word-prop call( -- ) ] bi ;
 
 : infer-local-reader ( word -- )
     (( -- value )) apply-word/effect ;

basis/stack-checker/stack-checker-docs.factor

@@ -26,7 +26,7 @@ ARTICLE: "inference-combinators" "Combinator stack effects"
   { "The combinator must be called with a quotation that is either literal or built from literal quotations, " { $link curry } ", and " { $link compose } ". (Note that quotations that use " { $vocab-link "fry" } " or " { $vocab-link "locals" } " use " { $link curry } " and " { $link compose } " from the perspective of the stack checker.)" }
   { "If the word is declared " { $link POSTPONE: inline } ", the combinator may additionally be called on one of the word's input parameters or with quotations built from the word's input parameters, literal quotations, " { $link curry } ", and " { $link compose } ". When inline, a word is itself considered to be a combinator, and its callers must in turn satisfy these conditions." }
 }
-"If neither condition holds, the stack checker throws a " { $link literal-expected } " error. To make the code compile, a runtime checking combinator such as " { $link POSTPONE: call( } " must be used instead. See " { $link "inference-escape" } " for details. An inline combinator can be called with an unknown quotation by " { $link curry } "ing the quotation onto a literal quotation that uses " { $link POSTPONE: call( } "."
+"If neither condition holds, the stack checker throws a " { $link unknown-macro-input } " or " { $link bad-macro-input } " error. To make the code compile, a runtime checking combinator such as " { $link POSTPONE: call( } " must be used instead. See " { $link "inference-escape" } " for details. An inline combinator can be called with an unknown quotation by " { $link curry } "ing the quotation onto a literal quotation that uses " { $link POSTPONE: call( } "."
 { $heading "Examples" }
 { $subheading "Calling a combinator" }
 "The following usage of " { $link map } " passes the stack checker, because the quotation is the result of " { $link curry } ":"
@@ -51,7 +51,7 @@ ARTICLE: "inference-combinators" "Combinator stack effects"
 "However this fails to pass the stack checker since there is no guarantee the quotation has the right stack effect for " { $link map } ". It can be wrapped in a new quotation with a declaration:"
 { $code ": perform ( values action -- results )" "    quot>> [ call( value -- result ) ] curry map ;" }
 { $heading "Explanation" }
-"This restriction exists because without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the stack checker encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised."
+"This restriction exists because without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the stack checker encounters a " { $link call } " without further information, a " { $link unknown-macro-input } " or " { $link bad-macro-input } " error is raised."
 $nl
 "On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point."
 { $heading "Limitations" }

basis/stack-checker/stack-checker-tests.factor

@@ -16,14 +16,18 @@ IN: stack-checker.tests
 { 1 2 } [ dup ] must-infer-as
 
 { 1 2 } [ [ dup ] call ] must-infer-as
-[ [ call ] infer ] must-fail
+[ [ call ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
+[ [ curry call ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
+[ [ { } >quotation call ] infer ] [ T{ bad-macro-input f call } = ] must-fail-with
+[ [ append curry call ] infer ] [ T{ bad-macro-input f call } = ] must-fail-with
 
 { 2 4 } [ 2dup ] must-infer-as
 
 { 1 0 } [ [ ] [ ] if ] must-infer-as
-[ [ if ] infer ] must-fail
-[ [ [ ] if ] infer ] must-fail
-[ [ [ 2 ] [ ] if ] infer ] must-fail
+[ [ if ] infer ] [ T{ unknown-macro-input f if } = ] must-fail-with
+[ [ { } >quotation { } >quotation if ] infer ] [ T{ bad-macro-input f if } = ] must-fail-with
+[ [ [ ] if ] infer ] [ T{ unknown-macro-input f if } = ] must-fail-with
+[ [ [ 2 ] [ ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
 { 4 3 } [ [ rot ] [ -rot ] if ] must-infer-as
 
 { 4 3 } [
@@ -46,7 +50,7 @@ IN: stack-checker.tests
 
 [
     [ [ [ 2 2 fixnum+ ] ] [ [ 2 2 fixnum* ] ] if call ] infer
-] must-fail
+] [ T{ bad-macro-input f call } = ] must-fail-with
 
 ! Test inference of termination of control flow
 : termination-test-1 ( -- * ) "foo" throw ;
@@ -198,42 +202,42 @@ DEFER: blah4
 
 ! This used to hang
 [ [ [ dup call ] dup call ] infer ]
-[ inference-error? ] must-fail-with
+[ recursive-quotation-error? ] must-fail-with
 
 : m ( q -- ) dup call ; inline
 
-[ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with
+[ [ [ m ] m ] infer ] [ recursive-quotation-error? ] must-fail-with
 
 : m' ( quot -- ) dup curry call ; inline
 
-[ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with
+[ [ [ m' ] m' ] infer ] [ recursive-quotation-error? ] must-fail-with
 
 : m'' ( -- q ) [ dup curry ] ; inline
 
 : m''' ( -- ) m'' call call ; inline
 
-[ [ [ m''' ] m''' ] infer ] [ inference-error? ] must-fail-with
+[ [ [ m''' ] m''' ] infer ] [ recursive-quotation-error? ] must-fail-with
 
-: m-if ( a b c -- ) t over if ; inline
+: m-if ( a b c -- ) t over when ; inline
 
-[ [ [ m-if ] m-if ] infer ] [ inference-error? ] must-fail-with
+[ [ [ m-if ] m-if ] infer ] [ recursive-quotation-error? ] must-fail-with
 
 ! This doesn't hang but it's also an example of the
 ! undedicable case
 [ [ [ [ drop 3 ] swap call ] dup call ] infer ]
-[ inference-error? ] must-fail-with
+[ recursive-quotation-error? ] must-fail-with
 
-[ [ 1 drop-locals ] infer ] [ inference-error? ] must-fail-with
+[ [ 1 drop-locals ] infer ] [ too-many-r>? ] must-fail-with
 
 ! Regression
-[ [ cleave ] infer ] [ inference-error? ] must-fail-with
+[ [ cleave ] infer ] [ T{ unknown-macro-input f cleave } = ] must-fail-with
 
 ! Test some curry stuff
 { 1 1 } [ 3 [ ] curry 4 [ ] curry if ] must-infer-as
 
 { 2 1 } [ [ ] curry 4 [ ] curry if ] must-infer-as
 
-[ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] must-fail
+[ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] [ unbalanced-branches-error? ] must-fail-with
 
 { 1 3 } [ [ 2drop f ] assoc-find ] must-infer-as
 
@@ -304,7 +308,7 @@ ERROR: custom-error ;
 ] unit-test
 
 ! Regression
-[ [ 1 load-locals ] infer ] must-fail
+[ [ 1 load-locals ] infer ] [ too-many->r? ] must-fail-with
 
 ! Corner case
 [ [ [ f dup ] [ dup ] produce ] infer ] must-fail
@@ -329,6 +333,8 @@ FORGET: bad-recursion-3
     dup bad-recursion-6 call ; inline recursive
 [ [ [ drop f ] bad-recursion-6 ] infer ] must-fail
 
+[ ] [ [ \ bad-recursion-6 forget ] with-compilation-unit ] unit-test
+
 { 3 0 } [ [ 2drop "A" throw ] [ ] if 2drop ] must-infer-as
 { 2 0 } [ drop f f [ 2drop "A" throw ] [ ] if 2drop ] must-infer-as
 
@@ -346,6 +352,9 @@ DEFER: eee'
 
 [ [ eee' ] infer ] [ inference-error? ] must-fail-with
 
+[ ] [ [ \ ddd' forget ] with-compilation-unit ] unit-test
+[ ] [ [ \ eee' forget ] with-compilation-unit ] unit-test
+
 : bogus-error ( x -- )
     dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive
 
@@ -367,9 +376,9 @@ DEFER: eee'
 [ ] [ [ \ forget-test forget ] with-compilation-unit ] unit-test
 [ forget-test ] must-infer
 
-[ [ cond ] infer ] must-fail
-[ [ bi ] infer ] must-fail
-[ at ] must-infer
+[ [ cond ] infer ] [ T{ unknown-macro-input f cond } = ] must-fail-with
+[ [ bi ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
+[ [ each ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
 
 [ [ [ "OOPS" throw ] dip ] [ drop ] if ] must-infer
 
@@ -380,5 +389,5 @@ DEFER: eee'
 { 3 1 } [ call( a b -- c ) ] must-infer-as
 { 3 1 } [ execute( a b -- c ) ] must-infer-as
 
-[ [ call-effect ] infer ] must-fail
-[ [ execute-effect ] infer ] must-fail
+[ [ call-effect ] infer ] [ T{ unknown-macro-input f call-effect } = ] must-fail-with
+[ [ execute-effect ] infer ] [ T{ unknown-macro-input f execute-effect } = ] must-fail-with

basis/stack-checker/state/state.factor

@@ -2,14 +2,15 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs arrays namespaces sequences kernel definitions
 math effects accessors words fry classes.algebra
-compiler.units stack-checker.values stack-checker.visitor ;
+compiler.units stack-checker.values stack-checker.visitor
+stack-checker.errors ;
 IN: stack-checker.state
 
 ! Did the current control-flow path throw an error?
 SYMBOL: terminated?
 
 ! Number of inputs current word expects from the stack
-SYMBOL: d-in
+SYMBOL: input-count
 
 DEFER: commit-literals
 
@@ -34,13 +35,13 @@ SYMBOL: literals
         [ [ (push-literal) ] each ] [ delete-all ] bi
     ] unless-empty ;
 
-: current-stack-height ( -- n ) meta-d length d-in get - ;
+: current-stack-height ( -- n ) meta-d length input-count get - ;
 
 : current-effect ( -- effect )
-    d-in get meta-d length terminated? get effect boa ;
+    input-count get meta-d length terminated? get effect boa ;
 
 : init-inference ( -- )
     terminated? off
     V{ } clone \ meta-d set
     V{ } clone literals set
-    0 d-in set ;
+    0 input-count set ;

basis/stack-checker/transforms/transforms-tests.factor

@@ -1,15 +1,9 @@
 IN: stack-checker.transforms.tests
 USING: sequences stack-checker.transforms tools.test math kernel
-quotations stack-checker stack-checker.errors accessors combinators words arrays
-classes classes.tuple ;
+quotations stack-checker stack-checker.errors accessors
+combinators words arrays classes classes.tuple macros ;
 
-: compose-n ( quot n -- ) "OOPS" throw ;
-
-<<
-: compose-n-quot ( n word -- quot' ) <repetition> >quotation ;
-\ compose-n [ compose-n-quot ] 2 define-transform
-\ compose-n t "no-compile" set-word-prop
->>
+MACRO: compose-n ( n word -- quot' ) <repetition> >quotation ;
 
 : compose-n-test ( a b c -- x ) 2 \ + compose-n ;
 
@@ -64,14 +58,16 @@ DEFER: smart-combo ( quot -- )
 [ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer
 
 ! Caveat found by Doug
-DEFER: curry-folding-test ( quot -- )
-
-\ curry-folding-test [ length \ drop <repetition> >quotation ] 1 define-transform
+MACRO: curry-folding-test ( quot -- )
+    length \ drop <repetition> >quotation ;
 
 { 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as
 { 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as
 { 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
 
+[ [ curry curry-folding-test ] infer ]
+[ T{ unknown-macro-input f curry-folding-test } = ] must-fail-with
+
 : member?-test ( a -- ? ) { 1 2 3 10 7 58 } member? ;
 
 [ f ] [ 1.0 member?-test ] unit-test
@@ -82,4 +78,8 @@ DEFER: curry-folding-test ( quot -- )
 
 \ bad-macro [ "OOPS" throw ] 0 define-transform
 
-[ [ bad-macro ] infer ] [ inference-error? ] must-fail-with
+[ [ bad-macro ] infer ] [ f >>continuation T{ transform-expansion-error f "OOPS" f bad-macro } = ] must-fail-with
+
+MACRO: two-params ( a b -- c ) + 1quotation ;
+
+[ [ 3 two-params ] infer ] [ T{ unknown-macro-input f two-params } = ] must-fail-with

basis/stack-checker/transforms/transforms.factor

@@ -11,37 +11,45 @@ stack-checker.values stack-checker.recursive-state
 stack-checker.dependencies ;
 IN: stack-checker.transforms
 
-: call-transformer ( word stack quot -- newquot )
-    '[ _ _ with-datastack [ length 1 assert= ] [ first ] bi nip ]
-    [ transform-expansion-error ]
+: call-transformer ( stack quot -- newquot )
+    '[ _ _ with-datastack [ length 1 assert= ] [ first ] bi ]
+    [ error-continuation get current-word get transform-expansion-error ]
     recover ;
 
-:: ((apply-transform)) ( word quot values stack rstate -- )
-    rstate recursive-state
-    [ word stack quot call-transformer ] with-variable
-    [
-        values [ length meta-d shorten-by ] [ #drop, ] bi
-        rstate infer-quot
-    ] [ word infer-word ] if* ;
+:: ((apply-transform)) ( quot values stack rstate -- )
+    rstate recursive-state [ stack quot call-transformer ] with-variable
+    values [ length meta-d shorten-by ] [ #drop, ] bi
+    rstate infer-quot ;
 
-: literals? ( values -- ? ) [ literal-value? ] all? ;
+: literal-values? ( values -- ? ) [ literal-value? ] all? ;
 
-: (apply-transform) ( word quot n -- )
-    ensure-d dup literals? [
-        dup empty? [ dup recursive-state get ] [
-            [ ]
-            [ [ literal value>> ] map ]
-            [ first literal recursion>> ] tri
-        ] if
-        ((apply-transform))
-    ] [ 2drop infer-word ] if ;
+: input-values? ( values -- ? )
+    [ { [ literal-value? ] [ input-value? ] } 1|| ] all? ;
+
+: (apply-transform) ( quot n -- )
+    ensure-d {
+        { [ dup literal-values? ] [
+            dup empty? [ dup recursive-state get ] [
+                [ ]
+                [ [ literal value>> ] map ]
+                [ first literal recursion>> ] tri
+            ] if
+            ((apply-transform))
+        ] }
+        { [ dup input-values? ] [ drop current-word get unknown-macro-input ] }
+        [ drop current-word get bad-macro-input ]
+    } cond ;
 
 : apply-transform ( word -- )
-    [ ] [ "transform-quot" word-prop ] [ "transform-n" word-prop ] tri
+    [ current-word set ]
+    [ "transform-quot" word-prop ]
+    [ "transform-n" word-prop ] tri
     (apply-transform) ;
 
 : apply-macro ( word -- )
-    [ ] [ "macro" word-prop ] [ "declared-effect" word-prop in>> length ] tri
+    [ current-word set ]
+    [ "macro" word-prop ]
+    [ "declared-effect" word-prop in>> length ] tri
     (apply-transform) ;
 
 : define-transform ( word quot n -- )

basis/stack-checker/values/values.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors namespaces kernel assocs sequences
-stack-checker.recursive-state ;
+stack-checker.recursive-state stack-checker.errors ;
 IN: stack-checker.values
 
 ! Values
@@ -28,22 +28,26 @@ SYMBOL: known-values
 
 GENERIC: (literal-value?) ( value -- ? )
 
-M: object (literal-value?) drop f ;
+: literal-value? ( value -- ? ) known (literal-value?) ;
 
-GENERIC: (literal) ( value -- literal )
+GENERIC: (input-value?) ( value -- ? )
+
+: input-value? ( value -- ? ) known (input-value?) ;
+
+GENERIC: (literal) ( known -- literal )
 
 ! Literal value
 TUPLE: literal < identity-tuple value recursion hashcode ;
 
 : literal ( value -- literal ) known (literal) ;
 
-: literal-value? ( value -- ? ) known (literal-value?) ;
-
 M: literal hashcode* nip hashcode>> ;
 
 : <literal> ( obj -- value )
     recursive-state get over hashcode \ literal boa ;
 
+M: literal (input-value?) drop f ;
+
 M: literal (literal-value?) drop t ;
 
 M: literal (literal) ;
@@ -61,7 +65,10 @@ C: <curried> curried
 : >curried< ( curried -- obj quot )
     [ obj>> ] [ quot>> ] bi ; inline
 
+M: curried (input-value?) >curried< [ input-value? ] either? ;
+
 M: curried (literal-value?) >curried< [ literal-value? ] both? ;
+
 M: curried (literal) >curried< [ curry ] curried/composed-literal ;
 
 ! Result of compose
@@ -72,5 +79,27 @@ C: <composed> composed
 : >composed< ( composed -- quot1 quot2 )
     [ quot1>> ] [ quot2>> ] bi ; inline
 
+M: composed (input-value?)
+    [ quot1>> input-value? ] [ quot2>> input-value? ] bi or ;
+
 M: composed (literal-value?) >composed< [ literal-value? ] both? ;
-M: composed (literal) >composed< [ compose ] curried/composed-literal ;
+
+M: composed (literal) >composed< [ compose ] curried/composed-literal ;
+
+! Input parameters
+SINGLETON: input-parameter
+
+SYMBOL: current-word
+
+M: input-parameter (input-value?) drop t ;
+
+M: input-parameter (literal-value?) drop f ;
+
+M: input-parameter (literal) current-word get unknown-macro-input ;
+
+! Computed values
+M: f (input-value?) drop f ;
+
+M: f (literal-value?) drop f ;
+
+M: f (literal) current-word get bad-macro-input ;

basis/tools/test/test.factor

@@ -121,9 +121,6 @@ SYNTAX: TEST:
         vocab-tests [ run-test-file ] each
     ] [ drop ] if ;
 
-: traceback-button. ( failure -- )
-    "[" write [ "Traceback" ] dip continuation>> write-object "]" print ;
-
 PRIVATE>
 
 TEST: unit-test
@@ -137,7 +134,7 @@ M: test-failure error. ( error -- )
         [ error-location print nl ]
         [ asset>> [ experiment. nl ] when* ]
         [ error>> error. ]
-        [ traceback-button. ]
+        [ continuation>> traceback-link. ]
     } cleave ;
 
 : :test-failures ( -- ) test-failures get errors. ;