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

diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor
index 61730d06ecc5cf647924895382bb0e5c8c6e10ff..6f8d503c0512d514c048a9723a229b06be999f2d 100644 (file)
--- 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" <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 ;
 

diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor
index cfc96e621e504cbf8e327e80a121c94d9e61c05d..58ce20035c3440d180cf1d9f49cc55da95fcc61f 100644 (file)
--- 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 d3330341e3b21adb4a022f8edf0c3961ebf388cd..90d12c62355663c3b3495ada8243c7c897dace93 100644 (file)
--- 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" <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. ;

diff --git a/basis/stack-checker/row-polymorphism/row-polymorphism.factor b/basis/stack-checker/row-polymorphism/row-polymorphism.factor
index debe014e33f75312d9eabdd1cc85f500635829ac..89bbbb79f0d04e5210d9aa46038e5e8994697d65 100644 (file)
--- 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>> <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 ;
 

diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index b8dacdadcc9860952456308c3314075f6355b42d..8aa2c0c8a26931810a7be106fd4b65074c73b507 100644 (file)
--- 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