diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index 3c298bdfed..0596f3d0bd 100755 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -44,11 +44,11 @@ IN: stack-checker.backend : pop-r ( -- obj ) meta-r dup empty? - [ too-many-r> inference-error ] [ pop ] if ; + [ too-many-r> ] [ pop ] if ; : consume-r ( n -- seq ) meta-r 2dup length > - [ too-many-r> inference-error ] when + [ too-many-r> ] when [ swap tail* ] [ shorten-by ] 2bi ; : output-r ( seq -- ) meta-r push-all ; @@ -81,7 +81,7 @@ M: object apply-object push-literal ; terminated? on meta-d clone meta-r clone #terminate, ; : check->r ( -- ) - meta-r empty? [ \ too-many->r inference-error ] unless ; + meta-r empty? [ too-many->r ] unless ; : infer-quot-here ( quot -- ) meta-r [ @@ -104,7 +104,7 @@ M: object apply-object push-literal ; : infer-literal-quot ( literal -- ) dup recursive-quotation? [ - value>> recursive-quotation-error inference-error + value>> recursive-quotation-error ] [ dup value>> callable? [ [ value>> ] @@ -139,7 +139,7 @@ M: object apply-object push-literal ; meta-d clone #return, ; : required-stack-effect ( word -- effect ) - dup stack-effect [ ] [ missing-effect inference-error ] ?if ; + dup stack-effect [ ] [ missing-effect ] ?if ; : check-effect ( word effect -- ) over required-stack-effect 2dup effect<= diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index 58944e7bc4..6a9a7cb8af 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -5,6 +5,9 @@ assocs accessors namespaces compiler.errors stack-checker.values stack-checker.recursive-state ; IN: stack-checker.errors +: pretty-word ( word -- word' ) + dup method-body? [ "method-generic" word-prop ] when ; + TUPLE: inference-error error type word ; M: inference-error compiler-error-type type>> ; @@ -20,9 +23,11 @@ M: inference-error compiler-error-type type>> ; : inference-warning ( ... class -- * ) +warning+ (inference-error) ; inline -TUPLE: literal-expected ; +TUPLE: literal-expected what ; -M: object (literal) \ literal-expected inference-warning ; +: literal-expected ( what -- * ) \ literal-expected inference-warning ; + +M: object (literal) "literal value" literal-expected ; TUPLE: unbalanced-branches-error branches quots ; @@ -31,10 +36,17 @@ TUPLE: unbalanced-branches-error branches quots ; TUPLE: too-many->r ; +: too-many->r ( -- * ) \ too-many->r inference-error ; + TUPLE: too-many-r> ; +: too-many-r> ( -- * ) \ too-many-r> inference-error ; + TUPLE: missing-effect word ; +: missing-effect ( word -- * ) + pretty-word \ missing-effect inference-error ; + TUPLE: effect-error word inferred declared ; : effect-error ( word inferred declared -- * ) @@ -42,12 +54,30 @@ TUPLE: effect-error word inferred declared ; TUPLE: recursive-quotation-error quot ; +: recursive-quotation-error ( word -- * ) + \ recursive-quotation-error inference-error ; + TUPLE: undeclared-recursion-error word ; +: undeclared-recursion-error ( word -- * ) + \ undeclared-recursion-error inference-error ; + TUPLE: diverging-recursion-error word ; +: diverging-recursion-error ( word -- * ) + \ diverging-recursion-error inference-error ; + TUPLE: unbalanced-recursion-error word height ; +: unbalanced-recursion-error ( word height -- * ) + \ unbalanced-recursion-error inference-error ; + TUPLE: inconsistent-recursive-call-error word ; +: inconsistent-recursive-call-error ( word -- * ) + \ inconsistent-recursive-call-error inference-error ; + TUPLE: unknown-primitive-error ; + +: unknown-primitive-error ( -- * ) + \ unknown-primitive-error inference-error ; diff --git a/basis/stack-checker/errors/prettyprint/prettyprint.factor b/basis/stack-checker/errors/prettyprint/prettyprint.factor index 21c6d64402..9dc82339b5 100644 --- a/basis/stack-checker/errors/prettyprint/prettyprint.factor +++ b/basis/stack-checker/errors/prettyprint/prettyprint.factor @@ -9,8 +9,8 @@ M: inference-error error-help error>> error-help ; M: inference-error error. [ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ; -M: literal-expected summary - drop "Literal value expected" ; +M: literal-expected error. + "Got a computed value where a " write what>> write " was expected" print ; M: unbalanced-branches-error error. "Unbalanced branches:" print diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 4ac9d802ed..0c20c41d99 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -87,7 +87,7 @@ M: composed infer-call* terminated? get [ 1 infer-r> infer-call ] unless ; M: object infer-call* - \ literal-expected inference-warning ; + "literal quotation" literal-expected ; : infer-nslip ( n -- ) [ infer->r infer-call ] [ infer-r> ] bi ;