Make some errors better in the stack checker

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<=

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 ;

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
+M: literal-expected error.
-    drop "Literal value expected" ;
+    "Got a computed value where a " write what>> write " was expected" print ;
 
 M: unbalanced-branches-error error.
     "Unbalanced branches:" print

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 ;