declare effect on inputs to infer-if in non-literal case, so we get a better error than "unbalanced drop call/nip call"

basis/stack-checker/backend/backend.factor

@@ -3,7 +3,7 @@
 USING: fry arrays generic io io.streams.string kernel math namespaces
 parser sequences strings vectors words quotations effects classes
 continuations assocs combinators compiler.errors accessors math.order
-definitions sets hints macros stack-checker.state
+definitions locals sets hints macros stack-checker.state
 stack-checker.visitor stack-checker.errors stack-checker.values
 stack-checker.recursive-state stack-checker.dependencies summary ;
 FROM: sequences.private => from-end ;
@@ -170,3 +170,27 @@ M: bad-call summary
 
 : (infer) ( quot -- effect )
     [ infer-quot-here ] with-infer drop ;
+
+: ?quotation-effect ( in -- effect/f )
+    dup pair? [ second dup effect? [ drop f ] unless ] [ drop f ] if ;
+
+:: declare-effect-d ( word effect variables branches n -- )
+    meta-d length :> d-length
+    n d-length < [
+        d-length 1 - n - :> n'
+        n' meta-d nth :> value
+        value known :> known
+        known word effect variables branches <declared-effect> :> known'
+        known' value set-known
+        known' branches push
+    ] [ word unknown-macro-input ] if ;
+
+:: declare-input-effects ( word -- )
+    H{ } clone :> variables
+    V{ } clone :> branches
+    word stack-effect in>> <reversed> [| in n |
+        in ?quotation-effect [| effect |
+            word effect variables branches n declare-effect-d
+        ] when*
+    ] each-index ;
+

basis/stack-checker/branches/branches.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry vectors sequences assocs math math.order accessors kernel
-combinators quotations namespaces grouping stack-checker.state
+combinators quotations namespaces grouping locals stack-checker.state
 stack-checker.backend stack-checker.errors stack-checker.visitor
 stack-checker.values stack-checker.recursive-state ;
 IN: stack-checker.branches
@@ -119,11 +119,19 @@ M: curried curried/composed? drop t ;
 M: composed curried/composed? drop t ;
 M: declared-effect curried/composed? known>> curried/composed? ;
 
+:: declare-if-effects ( -- )
+    H{ } clone :> variables
+    V{ } clone :> branches
+    \ if (( ..a -- ..b )) variables branches 0 declare-effect-d
+    \ if (( ..a -- ..b )) variables branches 1 declare-effect-d ;
+
 : infer-if ( -- )
     2 literals-available? [
         (infer-if)
     ] [
-        drop 2 consume-d
+        drop 2 ensure-d
+        declare-if-effects
+        2 shorten-d
         dup [ known curried/composed? ] any? [
             output-d
             [ rot [ drop call ] [ nip call ] if ]

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

@@ -10,29 +10,6 @@ stack-checker.values
 stack-checker.visitor ;
 IN: stack-checker.row-polymorphism
 
-: ?quotation-effect ( in -- effect/f )
-    dup pair? [ second dup effect? [ drop f ] unless ] [ drop f ] if ;
-
-:: declare-effect-d ( word effect variables branches n -- )
-    meta-d length :> d-length
-    n d-length < [
-        d-length 1 - n - :> n'
-        n' meta-d nth :> value
-        value known :> known
-        known word effect variables branches <declared-effect> :> known'
-        known' value set-known
-        known' branches push
-    ] [ word unknown-macro-input ] if ;
-
-:: declare-input-effects ( word -- )
-    H{ } clone :> variables
-    V{ } clone :> branches
-    word stack-effect in>> <reversed> [| in n |
-        in ?quotation-effect [| effect |
-            word effect variables branches n declare-effect-d
-        ] when*
-    ] each-index ;
-
 :: with-effect-here ( quot -- effect )
     inner-d-index get :> old-inner-d-index
     input-count get :> old-input-count

basis/stack-checker/stack-checker-tests.factor

@@ -448,6 +448,6 @@ FROM: splitting.private => split, ;
 [ [ [      ] [ drop  ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with
 [ [ [      ] [ 2dup  ] if* ] infer ] [ invalid-quotation-input? ] must-fail-with
 
-! edge cases in polymorphic checking
+! M\ declared-effect infer-call* didn't properly unify branches
 { 1 0 } [ [ 1 [ drop ] [ drop ] if ] each ] must-infer-as