graphs: add closure-as, base closure on that

Motivation: `V{ } closure-as` returns elements in reverse post-order.

diff --git a/core/graphs/graphs-tests.factor b/core/graphs/graphs-tests.factor
index 8b559648fe485feaad3795804359206c0c13b8a1..4a69a371c9a7771a0c2a36b3560fafec8bf075aa 100644 (file)
--- a/core/graphs/graphs-tests.factor
+++ b/core/graphs/graphs-tests.factor
@@ -1,4 +1,5 @@
-USING: assocs graphs kernel namespaces sorting tools.test ;
+USING: assocs graphs hash-sets kernel math namespaces sequences sorting
+tools.test vectors ;
 QUALIFIED: sets
 
 H{ } "g" set
@@ -17,3 +18,11 @@ H{
 { { 2 3 4 5 } } [
     2 [ "g" get at sets:members ] closure sets:members natural-sort
 ] unit-test
+
+{ t } [ 2 [ "g" get at sets:members ] HS{ } closure-as hash-set? ] unit-test
+{ t } [ 2 [ "g" get at sets:members ] closure hash-set? ] unit-test
+{ t } [ 2 [ "g" get at sets:members ] V{ } closure-as vector? ] unit-test
+
+{ V{ 5 4 3 2 1 0 } } [
+    5 [ [ f ] [ <iota> <reversed> ] if-zero ] V{ } closure-as
+] unit-test

diff --git a/core/graphs/graphs.factor b/core/graphs/graphs.factor
index 098a7047693394f62b475f2d7d4f09127ceb2461..de64c6b6063cf7e207d63ae8bc8d6f1c08b2f27c 100644 (file)
--- a/core/graphs/graphs.factor
+++ b/core/graphs/graphs.factor
@@ -23,7 +23,13 @@ PRIVATE>
          [ dip ] keep [ (closure) ] 2curry each
      ] [ 3drop ] if ; inline recursive
 
+ : new-empty-set-like ( exemplar -- set )
+     f swap set-like clone ; inline
+
 PRIVATE>
 
+: closure-as ( vertex quot: ( vertex -- edges ) exemplar -- set )
+    new-empty-set-like [ swap (closure) ] keep ; inline
+
 : closure ( vertex quot: ( vertex -- edges ) -- set )
-    HS{ } clone [ swap (closure) ] keep ; inline
+    HS{ } closure-as ; inline