diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index 61730d06ec..6f8d503c05 100644 --- a/basis/stack-checker/branches/branches.factor +++ b/basis/stack-checker/branches/branches.factor @@ -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" ] bi@ ] { } 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 ; diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index cfc96e621e..58ce20035c 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -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 ; diff --git a/basis/stack-checker/errors/prettyprint/prettyprint.factor b/basis/stack-checker/errors/prettyprint/prettyprint.factor index d3330341e3..90d12c6235 100644 --- a/basis/stack-checker/errors/prettyprint/prettyprint.factor +++ b/basis/stack-checker/errors/prettyprint/prettyprint.factor @@ -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" ] bi@ ] { } 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. ; diff --git a/basis/stack-checker/row-polymorphism/row-polymorphism.factor b/basis/stack-checker/row-polymorphism/row-polymorphism.factor index debe014e33..89bbbb79f0 100644 --- a/basis/stack-checker/row-polymorphism/row-polymorphism.factor +++ b/basis/stack-checker/row-polymorphism/row-polymorphism.factor @@ -56,16 +56,16 @@ IN: stack-checker.row-polymorphism ] when ] if ; -: invalid-quotation-input* ( known -- * ) +: complex-unbalanced-branches-error ( known -- * ) [ word>> ] [ branches>> [ [ 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 ; diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index b8dacdadcc..8aa2c0c8a2 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -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