From b82ea14af0d0dd95d167157bd828ead751111c47 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Tue, 30 Aug 2016 02:34:37 +0200
Subject: [PATCH] sets,compiler.cfg.stacks.global: putting the refine word in
 sets

---
 basis/compiler/cfg/stacks/global/global.factor | 4 ----
 core/sets/sets-docs.factor                     | 4 ++++
 core/sets/sets-tests.factor                    | 6 ++++++
 core/sets/sets.factor                          | 3 +++
 4 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/basis/compiler/cfg/stacks/global/global.factor b/basis/compiler/cfg/stacks/global/global.factor
index 31db43f49e..a6d8184959 100644
--- a/basis/compiler/cfg/stacks/global/global.factor
+++ b/basis/compiler/cfg/stacks/global/global.factor
@@ -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 ;
 
diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor
index 955a56b9da..beed7fd8a4 100644
--- a/core/sets/sets-docs.factor
+++ b/core/sets/sets-docs.factor
@@ -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." } ;
diff --git a/core/sets/sets-tests.factor b/core/sets/sets-tests.factor
index 1a109c1da6..0ffd8aff08 100644
--- a/core/sets/sets-tests.factor
+++ b/core/sets/sets-tests.factor
@@ -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
 
diff --git a/core/sets/sets.factor b/core/sets/sets.factor
index ab98c578ee..4a78d39865 100644
--- a/core/sets/sets.factor
+++ b/core/sets/sets.factor
@@ -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