started type propogation

library/assoc.factor

@@ -80,6 +80,15 @@ USE: kernel
 : 2cons ( car1 car2 cdr1 cdr2 -- cons1 cons2 )
     rot swons >r cons r> ;
 
+: zip ( list list -- list )
+    #! Make a new list containing pairs of corresponding
+    #! elements from the two given lists.
+    dup [
+        2uncons zip >r cons r> cons
+    ] [
+        2drop [ ]
+    ] ifte ;
+
 : unzip ( assoc -- keys values )
     #! Split an association list into two lists of keys and
     #! values.

library/inference/branches.factor

@@ -149,7 +149,7 @@ SYMBOL: dual-recursive-state
     #! Either the word is not recursive, or it is recursive
     #! and the base case throws an error.
     [
-        [ terminator-quot? not ] subset dup length 1 > [
+        unzip drop [ terminator-quot? not ] subset dup length 1 > [
             infer-base-cases unify-effects
             effect dual-recursive-state get set-base
         ] [
@@ -158,7 +158,7 @@ SYMBOL: dual-recursive-state
     ] with-scope ;
 
 : (infer-branches) ( branchlist -- list )
-    dup infer-base-case [
+    dup infer-base-case unzip drop [
         dup t infer-branch swap terminator-quot? [
             [ meta-d off meta-r off d-in off ] extend
         ] when
@@ -181,7 +181,10 @@ SYMBOL: dual-recursive-state
     dataflow-drop, pop-d
     dataflow-drop, pop-d swap 2list
     >r 1 meta-d get vector-tail* #ifte r>
-    pop-d drop ( condition )
+    pop-d [
+        dup \ t cons ,
+        \ f cons ,
+    ] make-list zip ( condition )
     infer-branches ;
 
 \ ifte [ infer-ifte ] "infer" set-word-property
@@ -194,6 +197,7 @@ SYMBOL: dual-recursive-state
     #! Infer effects for all branches, unify.
     [ object vector ] ensure-d
     dataflow-drop, pop-d vtable>list
+    [ f cons ] map
     >r 1 meta-d get vector-tail* #dispatch r>
     pop-d drop ( n )
     infer-branches ;

library/lists.factor

@@ -200,12 +200,3 @@ M: cons hashcode ( cons -- hash ) 4 cons-hashcode ;
 : intersection ( list list -- list )
     #! Make a list of elements that occur in both lists.
     [ over contains? ] subset nip ;
-
-: zip ( list list -- list )
-    #! Make a new list containing pairs of corresponding
-    #! elements from the two given lists.
-    dup [
-        2uncons zip >r cons r> cons
-    ] [
-        2drop [ ]
-    ] ifte ;