]> gitweb.factorcode.org Git - factor.git/commitdiff
started type propogation
authorSlava Pestov <slava@factorcode.org>
Sun, 26 Dec 2004 07:16:38 +0000 (07:16 +0000)
committerSlava Pestov <slava@factorcode.org>
Sun, 26 Dec 2004 07:16:38 +0000 (07:16 +0000)
library/assoc.factor
library/inference/branches.factor
library/lists.factor

index d3d9982507fe6ec48cc92ea211d49b36753fdec9..cc6c66982c716fe64fedb16845b77ea90ec8bd3b 100644 (file)
@@ -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.
index bdfbb1bf831b7421b549d00d65b3800a5c1a0c56..36a9dc55609714a3ddba4b63a62c00cd5054fd30 100644 (file)
@@ -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 ;
index 98c802427d72987d244b95cae1344b4c343457e5..3463e8f4aceba0beb3e5ba89892fe6730f669462 100644 (file)
@@ -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 ;