diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index 3ca9cab7d9..cfc96e621e 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -34,5 +34,5 @@ ERROR: transform-expansion-error < inference-error error continuation word ; ERROR: bad-declaration-error < inference-error declaration ; -ERROR: invalid-quotation-input < inference-error word quots branches ; +ERROR: invalid-quotation-input < inference-error word quots declareds actuals ; diff --git a/basis/stack-checker/errors/prettyprint/prettyprint.factor b/basis/stack-checker/errors/prettyprint/prettyprint.factor index 589bd0a056..d3330341e3 100644 --- a/basis/stack-checker/errors/prettyprint/prettyprint.factor +++ b/basis/stack-checker/errors/prettyprint/prettyprint.factor @@ -71,5 +71,6 @@ M: invalid-quotation-input summary M: invalid-quotation-input error. dup summary print - [ quots>> ] [ branches>> ] bi quots-and-branches. ; + [ quots>> ] [ declareds>> ] [ actuals>> ] tri 3array flip + { "Input" "Expected" "Got" } prefix simple-table. ; diff --git a/basis/stack-checker/row-polymorphism/row-polymorphism.factor b/basis/stack-checker/row-polymorphism/row-polymorphism.factor index cabb69d47c..4fb54506c5 100644 --- a/basis/stack-checker/row-polymorphism/row-polymorphism.factor +++ b/basis/stack-checker/row-polymorphism/row-polymorphism.factor @@ -83,10 +83,12 @@ IN: stack-checker.row-polymorphism [ word>> ] [ branches>> [ [ known>callable ] { } map-as ] - [ [ effect>> ] { } map-as ] bi + [ [ effect>> ] { } map-as ] + [ [ actual>> ] { } map-as ] tri ] bi invalid-quotation-input ; : check-declared-effect ( known effect -- ) + [ >>actual ] keep 2dup [ [ variables>> ] [ effect>> ] bi ] dip check-variables [ 2drop ] [ drop invalid-quotation-input* ] if ; diff --git a/basis/stack-checker/values/values.factor b/basis/stack-checker/values/values.factor index 714634bdc3..e2c1ec4707 100644 --- a/basis/stack-checker/values/values.factor +++ b/basis/stack-checker/values/values.factor @@ -100,9 +100,12 @@ M: input-parameter (literal) current-word get unknown-macro-input ; ! Argument corresponding to polymorphic declared input of inline combinator -TUPLE: declared-effect known word effect variables branches ; +TUPLE: declared-effect known word effect variables branches actual ; -C: declared-effect +C: (declared-effect) declared-effect + +: ( known word effect variables branches -- declared-effect ) + f (declared-effect) ; inline M: declared-effect (input-value?) known>> (input-value?) ;