sets,compiler.cfg.stacks.global: putting the refine word in sets

char-rename
Björn Lindqvist 2016-08-30 02:34:37 +02:00
parent 6c88577ee7
commit b82ea14af0
4 changed files with 13 additions and 4 deletions

View File

@ -3,10 +3,6 @@
USING: accessors compiler.cfg.dataflow-analysis kernel sequences sets ;
IN: compiler.cfg.stacks.global
! Should exists somewhere else
: refine ( sets -- set )
[ f ] [ [ ] [ intersect ] map-reduce ] if-empty ;
: transfer-peeked-locs ( set bb -- set' )
[ replaces>> diff ] [ peeks>> union ] bi ;

View File

@ -224,3 +224,7 @@ HELP: cardinality
HELP: combine
{ $values { "sets" { $sequence set } } { "set/f" { $maybe set } } }
{ $description "Outputs the union of a sequence of sets, or " { $link f } " if the sequence is empty." } ;
HELP: refine
{ $values { "sets" { $sequence set } } { "set/f" { $maybe set } } }
{ $description "Outputs the intersection of a sequence of sets, or " { $link f } " if the sequence is empty." } ;

View File

@ -100,9 +100,15 @@ IN: sets.tests
{ { 1 } } [ { 1 2 3 } { 2 3 4 } without ] unit-test
{ { 1 1 } } [ { 1 1 2 3 3 } { 2 3 4 4 } without ] unit-test
! combine
{ { 1 2 3 } } [ { { 1 } { 2 } { 1 3 } } combine ] unit-test
{ f } [ { } combine ] unit-test
! refine
{ { 2 } } [
{ { 2 3 } { 2 4 } { 9 8 4 2 } } refine
] unit-test
{ { 1 4 9 16 25 36 } }
[ { { 1 2 3 } { 4 5 6 } } [ [ sq ] map ] gather ] unit-test

View File

@ -149,6 +149,9 @@ M: sequence clear-set
: intersection ( sets -- set/f )
[ f ] [ [ ] [ intersect ] map-reduce ] if-empty ;
: refine ( sets -- set/f )
[ f ] [ [ ] [ intersect ] map-reduce ] if-empty ;
: gather ( ... seq quot: ( ... elt -- ... elt' ) -- ... newseq )
map concat members ; inline