diff --git a/library/assoc.factor b/library/assoc.factor index d3d9982507..cc6c66982c 100644 --- a/library/assoc.factor +++ b/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. diff --git a/library/inference/branches.factor b/library/inference/branches.factor index bdfbb1bf83..36a9dc5560 100644 --- a/library/inference/branches.factor +++ b/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 ; diff --git a/library/lists.factor b/library/lists.factor index 98c802427d..3463e8f4ac 100644 --- a/library/lists.factor +++ b/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 ;