steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

combine unbalanced-branches-error and invalid-quotation-input into one error

db4
Joe Groff 2010-03-07 22:23:24 -08:00
parent e5c2344ce4
commit 8159a19187
5 changed files with 29 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/stack-checker/branches/branches.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 combinators quotations namespaces grouping locals stack-checker.state
stack-checker.backend stack-checker.errors stack-checker.visitor stack-checker.backend stack-checker.errors stack-checker.visitor
stack-checker.values stack-checker.recursive-state ; stack-checker.values stack-checker.recursive-state ;
@ -45,11 +45,17 @@ SYMBOLS: +bottom+ +top+ ;
SYMBOL: quotations 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 ) : unify-branches ( ins stacks -- in phi-in phi-out )
zip [ 0 { } { } ] [ zip [ 0 { } { } ] [
[ keys supremum ] [ ] [ balanced? ] tri [ keys supremum ] [ ] [ balanced? ] tri
[ dupd phi-inputs dup phi-outputs ] [ dupd phi-inputs dup phi-outputs ]
[ quotations get unbalanced-branches-error ] [ quotations get simple-unbalanced-branches-error ]
if if
] if-empty ; ] if-empty ;

4
basis/stack-checker/errors/errors.factor
View File

@ -10,8 +10,6 @@ ERROR: bad-macro-input < inference-error macro ;
ERROR: unknown-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 ;
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: 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 ;

15
basis/stack-checker/errors/prettyprint/prettyprint.factor
View File

@ -10,17 +10,6 @@ M: unknown-macro-input summary
M: bad-macro-input summary M: bad-macro-input summary
macro>> name>> "Cannot apply “" "” to a run-time computed value" surround ; 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 M: too-many->r summary
drop "Quotation pushes elements on retain stack without popping them" ; drop "Quotation pushes elements on retain stack without popping them" ;
@ -65,11 +54,11 @@ M: transform-expansion-error error.
M: do-not-compile summary M: do-not-compile summary
word>> name>> "Cannot compile call to " prepend ; word>> name>> "Cannot compile call to " prepend ;
M: invalid-quotation-input summary M: unbalanced-branches-error summary
word>> name>> word>> name>>
"The input quotations to " " don't match their expected effects" surround ; "The input quotations to " " don't match their expected effects" surround ;
M: invalid-quotation-input error. M: unbalanced-branches-error error.
dup summary print dup summary print
[ quots>> ] [ declareds>> ] [ actuals>> ] tri 3array flip [ quots>> ] [ declareds>> ] [ actuals>> ] tri 3array flip
{ "Input" "Expected" "Got" } prefix simple-table. ; { "Input" "Expected" "Got" } prefix simple-table. ;

6
basis/stack-checker/row-polymorphism/row-polymorphism.factor
View File

@ -56,16 +56,16 @@ IN: stack-checker.row-polymorphism
] when ] when
] if ; ] if ;
: invalid-quotation-input* ( known -- * ) : complex-unbalanced-branches-error ( known -- * )
[ word>> ] [ [ word>> ] [
branches>> <reversed> branches>> <reversed>
[ [ known>callable ] { } map-as ] [ [ known>callable ] { } map-as ]
[ [ effect>> ] { } map-as ] [ [ effect>> ] { } map-as ]
[ [ actual>> ] { } map-as ] tri [ [ actual>> ] { } map-as ] tri
] bi invalid-quotation-input ; ] bi unbalanced-branches-error ;
: check-declared-effect ( known effect -- ) : check-declared-effect ( known effect -- )
[ >>actual ] keep [ >>actual ] keep
2dup [ [ variables>> ] [ effect>> ] bi ] dip check-variables 2dup [ [ variables>> ] [ effect>> ] bi ] dip check-variables
[ 2drop ] [ drop invalid-quotation-input* ] if ; [ 2drop ] [ drop complex-unbalanced-branches-error ] if ;

28
basis/stack-checker/stack-checker-tests.factor
View File

@ -234,10 +234,12 @@ DEFER: blah4
! Test some curry stuff ! Test some curry stuff
{ 1 1 } [ 3 [ ] curry 4 [ ] curry if ] must-infer-as { 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 { 2 1 } [ [ ] curry 4 [ ] curry if ] must-infer-as
[ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] [ unbalanced-branches-error? ] must-fail-with [ [ 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 { 1 3 } [ [ 2drop f ] assoc-find ] must-infer-as
@ -431,22 +433,22 @@ DEFER: eee'
FROM: splitting.private => split, ; FROM: splitting.private => split, ;
{ 2 0 } [ [ member? ] curry split, ] must-infer-as { 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 [ [ [ ] each ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ dup ] map ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ dup ] map ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ drop ] map ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ drop ] map ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ 1 + ] map-index ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ 1 + ] map-index ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ dup ] [ ] if ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ dup ] [ ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ 2dup ] [ over ] if ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ 2dup ] [ over ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ drop ] [ ] if ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ drop ] [ ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ ] [ ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ ] [ ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ dup ] [ ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ dup ] [ ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ drop ] [ drop ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ drop ] [ drop ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ ] [ drop ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ ] [ drop ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
[ [ [ ] [ 2dup ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with [ [ [ ] [ 2dup ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
! M\ declared-effect infer-call* didn't properly unify branches ! M\ declared-effect infer-call* didn't properly unify branches
{ 1 0 } [ [ 1 [ drop ] [ drop ] if ] each ] must-infer-as { 1 0 } [ [ 1 [ drop ] [ drop ] if ] each ] must-infer-as