combine unbalanced-branches-error and invalid-quotation-input into one error
Joe Groff
parent
e5c2344ce4
commit
8159a19187
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: fry vectors sequences assocs math math.order accessors kernel
|
||||
USING: arrays effects fry vectors sequences assocs math math.order accessors kernel
|
||||
combinators quotations namespaces grouping locals stack-checker.state
|
||||
stack-checker.backend stack-checker.errors stack-checker.visitor
|
||||
stack-checker.values stack-checker.recursive-state ;
|
||||
|
|
@ -45,11 +45,17 @@ SYMBOLS: +bottom+ +top+ ;
|
|||
|
||||
SYMBOL: quotations
|
||||
|
||||
: simple-unbalanced-branches-error ( branches quots -- * )
|
||||
[ \ if ] 2dip swap
|
||||
[ length [ (( ..a -- ..b )) ] replicate ]
|
||||
[ [ length [ "x" <array> ] bi@ <effect> ] { } assoc>map ] bi
|
||||
unbalanced-branches-error ;
|
||||
|
||||
: unify-branches ( ins stacks -- in phi-in phi-out )
|
||||
zip [ 0 { } { } ] [
|
||||
[ keys supremum ] [ ] [ balanced? ] tri
|
||||
[ dupd phi-inputs dup phi-outputs ]
|
||||
[ quotations get unbalanced-branches-error ]
|
||||
[ quotations get simple-unbalanced-branches-error ]
|
||||
if
|
||||
] if-empty ;
|
||||
|
||||
|
|
|
|||
|
|
@ -10,8 +10,6 @@ ERROR: bad-macro-input < inference-error macro ;
|
|||
|
||||
ERROR: unknown-macro-input < inference-error macro ;
|
||||
|
||||
ERROR: unbalanced-branches-error < inference-error branches quots ;
|
||||
|
||||
ERROR: too-many->r < inference-error ;
|
||||
|
||||
ERROR: too-many-r> < inference-error ;
|
||||
|
|
@ -34,5 +32,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 declareds actuals ;
|
||||
ERROR: unbalanced-branches-error < inference-error word quots declareds actuals ;
|
||||
|
||||
|
|
|
|||
|
|
@ -10,17 +10,6 @@ M: unknown-macro-input summary
|
|||
M: bad-macro-input summary
|
||||
macro>> name>> "Cannot apply “" "” to a run-time computed value" surround ;
|
||||
|
||||
M: unbalanced-branches-error summary
|
||||
drop "Unbalanced branches" ;
|
||||
|
||||
: quots-and-branches. ( quots branches -- )
|
||||
zip [ [ first pprint-short bl ] [ second effect>string print ] bi ] each ;
|
||||
|
||||
M: unbalanced-branches-error error.
|
||||
dup summary print
|
||||
[ quots>> ] [ branches>> [ length [ "x" <array> ] bi@ <effect> ] { } assoc>map ] bi
|
||||
quots-and-branches. ;
|
||||
|
||||
M: too-many->r summary
|
||||
drop "Quotation pushes elements on retain stack without popping them" ;
|
||||
|
||||
|
|
@ -65,11 +54,11 @@ M: transform-expansion-error error.
|
|||
M: do-not-compile summary
|
||||
word>> name>> "Cannot compile call to " prepend ;
|
||||
|
||||
M: invalid-quotation-input summary
|
||||
M: unbalanced-branches-error summary
|
||||
word>> name>>
|
||||
"The input quotations to " " don't match their expected effects" surround ;
|
||||
|
||||
M: invalid-quotation-input error.
|
||||
M: unbalanced-branches-error error.
|
||||
dup summary print
|
||||
[ quots>> ] [ declareds>> ] [ actuals>> ] tri 3array flip
|
||||
{ "Input" "Expected" "Got" } prefix simple-table. ;
|
||||
|
|
|
|||
|
|
@ -56,16 +56,16 @@ IN: stack-checker.row-polymorphism
|
|||
] when
|
||||
] if ;
|
||||
|
||||
: invalid-quotation-input* ( known -- * )
|
||||
: complex-unbalanced-branches-error ( known -- * )
|
||||
[ word>> ] [
|
||||
branches>> <reversed>
|
||||
[ [ known>callable ] { } map-as ]
|
||||
[ [ effect>> ] { } map-as ]
|
||||
[ [ actual>> ] { } map-as ] tri
|
||||
] bi invalid-quotation-input ;
|
||||
] bi unbalanced-branches-error ;
|
||||
|
||||
: check-declared-effect ( known effect -- )
|
||||
[ >>actual ] keep
|
||||
2dup [ [ variables>> ] [ effect>> ] bi ] dip check-variables
|
||||
[ 2drop ] [ drop invalid-quotation-input* ] if ;
|
||||
[ 2drop ] [ drop complex-unbalanced-branches-error ] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -234,10 +234,12 @@ DEFER: blah4
|
|||
|
||||
! Test some curry stuff
|
||||
{ 1 1 } [ 3 [ ] curry 4 [ ] curry if ] must-infer-as
|
||||
{ 3 1 } [ [ ] curry [ [ ] curry ] dip if ] must-infer-as
|
||||
|
||||
{ 2 1 } [ [ ] curry 4 [ ] curry if ] must-infer-as
|
||||
|
||||
[ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ ] curry [ [ ] 2curry ] dip if ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
|
||||
{ 1 3 } [ [ 2drop f ] assoc-find ] must-infer-as
|
||||
|
||||
|
|
@ -431,22 +433,22 @@ DEFER: eee'
|
|||
FROM: splitting.private => split, ;
|
||||
{ 2 0 } [ [ member? ] curry split, ] must-infer-as
|
||||
|
||||
[ [ [ write write ] each ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ write write ] each ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
|
||||
[ [ [ ] each ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ dup ] map ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ drop ] map ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ 1 + ] map-index ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ ] each ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ dup ] map ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ drop ] map ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ 1 + ] map-index ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
|
||||
[ [ [ dup ] [ ] if ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ 2dup ] [ over ] if ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ drop ] [ ] if ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ dup ] [ ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ 2dup ] [ over ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ drop ] [ ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
|
||||
[ [ [ ] [ ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ dup ] [ ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ drop ] [ drop ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ ] [ drop ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ ] [ 2dup ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with
|
||||
[ [ [ ] [ ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ dup ] [ ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ drop ] [ drop ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ ] [ drop ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
[ [ [ ] [ 2dup ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
|
||||
|
||||
! M\ declared-effect infer-call* didn't properly unify branches
|
||||
{ 1 0 } [ [ 1 [ drop ] [ drop ] if ] each ] must-infer-as
|
||||
|
|
|
|||
Loading…
Reference in New Issue