improve error message for invalid quotation inputs by referencing each declared-effect to its other references
parent
011a39457e
commit
ea4545e366
|
@ -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 quot variables expected actual ;
|
||||
ERROR: invalid-quotation-input < inference-error word quots branches ;
|
||||
|
||||
|
|
|
@ -68,3 +68,8 @@ M: do-not-compile summary
|
|||
M: invalid-quotation-input summary
|
||||
word>> name>>
|
||||
"The input quotations to " " don't match their expected effects" surround ;
|
||||
|
||||
M: invalid-quotation-input error.
|
||||
dup summary print
|
||||
[ quots>> ] [ branches>> ] bi quots-and-branches. ;
|
||||
|
||||
|
|
|
@ -13,21 +13,23 @@ IN: stack-checker.row-polymorphism
|
|||
: ?quotation-effect ( in -- effect/f )
|
||||
dup pair? [ second dup effect? [ drop f ] unless ] [ drop f ] if ;
|
||||
|
||||
:: declare-effect-d ( word effect variables n -- )
|
||||
:: declare-effect-d ( word effect variables branches n -- )
|
||||
meta-d length :> d-length
|
||||
n d-length < [
|
||||
d-length 1 - n - :> n'
|
||||
n' meta-d nth :> value
|
||||
value known :> known
|
||||
known word effect variables <declared-effect> :> known'
|
||||
known word effect variables branches <declared-effect> :> known'
|
||||
known' value set-known
|
||||
known' branches push
|
||||
] [ word unknown-macro-input ] if ;
|
||||
|
||||
:: declare-input-effects ( word -- )
|
||||
H{ } clone :> variables
|
||||
V{ } clone :> branches
|
||||
word stack-effect in>> <reversed> [| in n |
|
||||
in ?quotation-effect [| effect |
|
||||
word effect variables n declare-effect-d
|
||||
word effect variables branches n declare-effect-d
|
||||
] when*
|
||||
] each-index ;
|
||||
|
||||
|
@ -77,10 +79,14 @@ IN: stack-checker.row-polymorphism
|
|||
] when
|
||||
] if ;
|
||||
|
||||
: invalid-quotation-input* ( known -- * )
|
||||
[ word>> ] [
|
||||
branches>> <reversed>
|
||||
[ [ known>callable ] { } map-as ]
|
||||
[ [ effect>> ] { } map-as ] bi
|
||||
] bi invalid-quotation-input ;
|
||||
|
||||
: check-declared-effect ( known effect -- )
|
||||
2dup [ [ variables>> ] [ effect>> ] bi ] dip check-variables
|
||||
[ 2drop ] [
|
||||
[ { [ word>> ] [ known>callable ] [ variables>> ] [ effect>> ] } cleave ]
|
||||
dip invalid-quotation-input
|
||||
] if ;
|
||||
[ 2drop ] [ drop invalid-quotation-input* ] if ;
|
||||
|
||||
|
|
|
@ -100,7 +100,7 @@ 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 ;
|
||||
TUPLE: declared-effect known word effect variables branches ;
|
||||
|
||||
C: <declared-effect> declared-effect
|
||||
|
||||
|
|
Loading…
Reference in New Issue