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

Use [ ] [ ] map-reduce instead of unclip [ ] reduce

db4
Slava Pestov 2009-04-06 17:50:54 -05:00
parent 2ef6043566
commit 37e278ed02
4 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/cfg/linear-scan/allocation/allocation.factor
View File

@ -99,7 +99,7 @@ SYMBOL: spill-counts
: interval-to-spill ( active-intervals current -- live-interval ) : interval-to-spill ( active-intervals current -- live-interval )
#! We spill the interval with the most distant use location. #! We spill the interval with the most distant use location.
start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
unclip-slice [ [ [ second ] bi@ > ] most ] reduce first ; [ ] [ [ [ second ] bi@ > ] most ] map-reduce first ;
: assign-spill ( before after -- before after ) : assign-spill ( before after -- before after )
#! If it has been spilled already, reuse spill location. #! If it has been spilled already, reuse spill location.

2
basis/compiler/tree/propagation/info/info.factor
View File

@ -238,7 +238,7 @@ DEFER: (value-info-union)
: value-infos-union ( infos -- info ) : value-infos-union ( infos -- info )
[ null-info ] [ null-info ]
[ unclip-slice [ value-info-union ] reduce ] if-empty ; [ [ ] [ value-info-union ] map-reduce ] if-empty ;
: literals<= ( info1 info2 -- ? ) : literals<= ( info1 info2 -- ? )
{ {

2
basis/hints/hints.factor
View File

@ -25,7 +25,7 @@ M: object specializer-declaration class ;
[ drop object eq? not ] assoc-filter [ drop object eq? not ] assoc-filter
[ [ t ] ] [ [ [ t ] ] [
[ swap specializer-predicate append ] { } assoc>map [ swap specializer-predicate append ] { } assoc>map
unclip [ swap [ f ] \ if 3array append [ ] like ] reduce [ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce
] if-empty ; ] if-empty ;
: specializer-cases ( quot word -- default alist ) : specializer-cases ( quot word -- default alist )

2
core/classes/builtin/builtin.factor
View File

@ -55,7 +55,7 @@ M: anonymous-intersection (flatten-class)
[ [
builtins get sift [ (flatten-class) ] each builtins get sift [ (flatten-class) ] each
] [ ] [
unclip [ assoc-intersect ] reduce [ swap set ] assoc-each [ ] [ assoc-intersect ] map-reduce [ swap set ] assoc-each
] if-empty ; ] if-empty ;
M: anonymous-complement (flatten-class) M: anonymous-complement (flatten-class)