steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

started type propogation

cvs
Slava Pestov 2004-12-26 07:16:38 +00:00
parent c908e1920a
commit b1953d4e0b
3 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
library/assoc.factor
View File

@ -80,6 +80,15 @@ USE: kernel
: 2cons ( car1 car2 cdr1 cdr2 -- cons1 cons2 ) : 2cons ( car1 car2 cdr1 cdr2 -- cons1 cons2 )
rot swons >r cons r> ; 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 ) : unzip ( assoc -- keys values )
#! Split an association list into two lists of keys and #! Split an association list into two lists of keys and
#! values. #! values.

10
library/inference/branches.factor
View File

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

9
library/lists.factor
View File

@ -200,12 +200,3 @@ M: cons hashcode ( cons -- hash ) 4 cons-hashcode ;
: intersection ( list list -- list ) : intersection ( list list -- list )
#! Make a list of elements that occur in both lists. #! Make a list of elements that occur in both lists.
[ over contains? ] subset nip ; [ 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 ;