add stack variable unification to M\ declared-effect infer-call*

basis/stack-checker/errors/errors.factor

@@ -34,9 +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 branches quots ;
-
-ERROR: invalid-effect-variable < inference-error effect ;
-
-ERROR: effect-variable-can't-have-type < inference-error effect ;
+ERROR: invalid-quotation-input < inference-error word quot variables expected actual ;
 

basis/stack-checker/errors/prettyprint/prettyprint.factor

@@ -68,8 +68,3 @@ 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. ;
-

basis/stack-checker/row-polymorphism/row-polymorphism.factor

@@ -53,5 +53,36 @@ IN: stack-checker.row-polymorphism
 
     in "x" <array> out "x" <array> terminated? get <terminated-effect> ; inline
 
+:: check-variable ( actual-count declared-count variable vars -- difference )
+    actual-count declared-count -
+    variable [
+        variable vars at* nip
+        [ variable vars at -     ]
+        [ variable vars set-at 0 ] if
+    ] [ drop 0 ] if ;
+
+: adjust-variable ( diff var vars -- )
+    pick 0 >=
+    [ at+ ]
+    [ 3drop ] if ; inline
+
+:: check-variables ( vars declared actual -- ? )
+    actual terminated?>> [ t ] [
+        actual declared [ in>>  length ] bi@ declared in-var>>
+            [ vars check-variable ] keep :> ( in-diff in-var ) 
+        actual declared [ out>> length ] bi@ declared out-var>>
+            [ vars check-variable ] keep :> ( out-diff out-var )
+        { [ in-var not ] [ out-var not ] [ in-diff out-diff = ] } 0||
+        dup [
+            in-var  [ in-diff  swap vars adjust-variable ] when*
+            out-var [ out-diff swap vars adjust-variable ] when*
+        ] when
+    ] if ;
+
 : check-declared-effect ( known effect -- )
-    [ known>callable P. ] [ P. ] bi* ;
+    2dup [ [ variables>> ] [ effect>> ] bi ] dip check-variables
+    [ 2drop ] [
+        [ { [ word>> ] [ known>callable ] [ variables>> ] [ effect>> ] } cleave ]
+        dip invalid-quotation-input
+    ] if ;
+