graphs: move to core and simplify.

1. remove add-vertex* and remove-vertex* that contradicted the documentation.
2. graphs use hash-sets of edges instead of hashtables of {edge,edge} pairs.
3. make graphs:closure work like classes:closure, use in classes.

basis/compiler/crossref/crossref.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs combinators fry graphs grouping kernel namespaces
+USING: assocs combinators fry grouping kernel namespaces
 sequences sets stack-checker.dependencies words ;
 IN: compiler.crossref
 
@@ -58,9 +58,17 @@ generic-call-site-crossref [ H{ } clone ] initialize
     "effect-dependencies" "conditional-dependencies" "definition-dependencies"
     [ (store-dependencies) ] tri-curry@ tri-curry* tri ;
 
+: add-xref ( word dependencies crossref -- )
+    rot '[
+        swap _ [ drop H{ } clone ] cache _ swap set-at
+    ] assoc-each ;
+
+: remove-xref ( word dependencies crossref -- )
+    [ keys ] dip '[ _ at delete-at ] with each ;
+
 : (compiled-xref) ( word dependencies generic-dependencies -- )
     compiled-crossref generic-call-site-crossref
-    [ get add-vertex* ] bi-curry@ bi-curry* bi ;
+    [ get add-xref ] bi-curry@ bi-curry* bi ;
 
 : compiled-xref ( word dependencies generic-dependencies -- )
     [ only-xref ] bi@
@@ -86,7 +94,7 @@ generic-call-site-crossref [ H{ } clone ] initialize
     join-dependencies ;
 
 : (compiled-unxref) ( word dependencies variable -- )
-    get remove-vertex* ;
+    get remove-xref ;
 
 : generic-call-sites ( word -- alist )
     "generic-call-sites" word-prop 2 group ;

basis/graphs/graphs-tests.factor

@@ -1,50 +0,0 @@
-USING: graphs tools.test namespaces kernel sorting assocs ;
-
-H{ } "g" set
-{ 1 2 3 } "v" set
-
-{ } [ "v" dup get "g" get add-vertex ] unit-test
-
-{ { "v" } } [ 1 "g" get at keys ] unit-test
-
-H{
-    { 1 H{ { 1 1 } { 2 2 } } }
-    { 2 H{ { 3 3 } { 4 4 } } }
-    { 4 H{ { 4 4 } { 5 5 } } }
-} "g" set
-
-{ { 2 3 4 5 } } [
-    2 [ "g" get at ] closure keys natural-sort
-] unit-test
-
-H{ } "g" set
-
-{ } [
-    "mary"
-    H{ { "billy" "one" } { "joey" "two" } }
-    "g" get add-vertex*
-] unit-test
-
-{ H{ { "mary" "one" } } } [
-    "billy" "g" get at
-] unit-test
-
-{ } [
-    "liz"
-    H{ { "billy" "four" } { "fred" "three" } }
-    "g" get add-vertex*
-] unit-test
-
-{ H{ { "mary" "one" } { "liz" "four" } } } [
-    "billy" "g" get at
-] unit-test
-
-{ } [
-    "mary"
-    H{ { "billy" "one" } { "joey" "two" } }
-    "g" get remove-vertex*
-] unit-test
-
-{ H{ { "liz" "four" } } } [
-    "billy" "g" get at
-] unit-test

basis/graphs/graphs.factor

@@ -1,45 +0,0 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: assocs kernel sequences sets ;
-IN: graphs
-
-<PRIVATE
-
-: if-graph ( vertex edges graph quot -- )
-    dupd [ 3drop ] if ; inline
-
-: nest ( key graph -- hash )
-    [ drop H{ } clone ] cache ; inline
-
-PRIVATE>
-
-: add-vertex ( vertex edges graph -- )
-    [ [ nest conjoin ] curry with each ] if-graph ; inline
-
-: add-vertex* ( vertex edges graph -- )
-    [
-        swapd [ [ rot ] dip nest set-at ] 2curry assoc-each
-    ] if-graph ; inline
-
-: remove-vertex ( vertex edges graph -- )
-    [ [ at delete-at ] curry with each ] if-graph ; inline
-
-: remove-vertex* ( vertex edges graph -- )
-    [
-        swapd [ [ rot ] dip at delete-at drop ] 2curry assoc-each
-    ] if-graph ; inline
-
-<PRIVATE
-
-: (closure) ( vertex assoc quot: ( vertex -- assoc ) -- )
-    2over key? [
-        3drop
-    ] [
-        2over conjoin [ dip ] keep
-        [ [ drop ] 3dip (closure) ] 2curry assoc-each
-    ] if ; inline recursive
-
-PRIVATE>
-
-: closure ( vertex quot: ( vertex -- assoc ) -- assoc )
-    H{ } clone [ swap (closure) ] keep ; inline

core/classes/classes.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators definitions kernel
+USING: accessors assocs combinators definitions graphs kernel
 make namespaces quotations sequences sets words words.symbol ;
 IN: classes
 
@@ -135,18 +135,6 @@ GENERIC: implementors ( class/classes -- seq )
 : class-usage ( class -- seq )
     update-map get at members ;
 
-<PRIVATE
-
-: (closure) ( obj set quot: ( elt -- seq ) -- )
-    2over ?adjoin [
-        [ dip ] keep [ (closure) ] 2curry each
-    ] [ 3drop ] if ; inline recursive
-
-: closure ( obj quot -- set )
-    HS{ } clone [ swap (closure) ] keep ; inline
-
-PRIVATE>
-
 : class-usages ( class -- seq )
     [ class-usage ] closure members ;
 
@@ -157,12 +145,10 @@ M: sequence implementors [ implementors ] gather ;
 <PRIVATE
 
 : update-map+ ( class -- )
-    dup class-uses update-map get
+    dup class-uses update-map get add-vertex ;
-    [ adjoin-at ] curry with each ;
 
 : update-map- ( class -- )
-    dup class-uses update-map get
+    dup class-uses update-map get remove-vertex ;
-    [ at delete ] curry with each ;
 
 : implementors-map+ ( class -- )
     [ HS{ } clone ] dip implementors-map get set-at ;

core/graphs/graphs-docs.factor

@@ -1,8 +1,9 @@
-USING: assocs hashtables help.markup help.syntax kernel sequences ;
+USING: assocs hashtables hash-sets help.markup help.syntax
+kernel sequences sets ;
 IN: graphs
 
 ARTICLE: "graphs" "Directed graph utilities"
-"Words for treating associative mappings as directed graphs can be found in the " { $vocab-link "graphs" } " vocabulary. A directed graph is represented as an assoc mapping each vertex to a set of edges entering that vertex, where the set is itself an assoc, with equal keys and values."
+"Words for treating associative mappings as directed graphs can be found in the " { $vocab-link "graphs" } " vocabulary. A directed graph is represented as an assoc mapping each vertex to a " { $link hash-set } " of edges entering that vertex."
 $nl
 "To create a new graph, just create an assoc, for example by calling " { $link <hashtable> } ". To add vertices and edges to a graph:"
 { $subsections add-vertex }
@@ -10,23 +11,23 @@ $nl
 { $subsections remove-vertex }
 "Since graphs are represented as assocs, they can be cleared out by calling " { $link clear-assoc } "."
 $nl
-"You can perform queries on the graph:"
+"You can perform queries on a graph:"
 { $subsections closure }
 "Directed graphs are used to maintain cross-referencing information for " { $link "definitions" } "." ;
 
 ABOUT: "graphs"
 
 HELP: add-vertex
-{ $values { "vertex" object } { "edges" sequence } { "graph" "an assoc mapping vertices to sequences of edges" } }
+{ $values { "vertex" object } { "edges" sequence } { "graph" "an " { $link assoc } " mapping vertices to " { $link hash-set } " of edges" } }
 { $description "Adds a vertex to a directed graph, with " { $snippet "edges" } "  as the outward edges from the vertex." }
 { $side-effects "graph" } ;
 
 HELP: remove-vertex
-{ $values { "vertex" object } { "edges" sequence } { "graph" "an assoc mapping vertices to sequences of edges" } }
+{ $values { "vertex" object } { "edges" sequence } { "graph" "an " { $link assoc } " mapping vertices to " { $link unordered-set } "s of edges" } }
 { $description "Removes a vertex from a graph, using the given edges sequence." }
-{ $notes "The " { $snippet "edges" } " sequence must equal the value passed to " { $link add-vertex } ", otherwise some vertices of the graph may continue to refer to the removed vertex." }
+{ $notes "The " { $snippet "edges" } " sequence must have all the values passed to " { $link add-vertex } ", otherwise some vertices of the graph may continue to refer to the removed vertex." }
 { $side-effects "graph" } ;
 
 HELP: closure
-{ $values { "vertex" object } { "quot" { $quotation ( vertex -- assoc ) } } { "assoc" "a new assoc" } }
+{ $values { "vertex" object } { "quot" { $quotation ( vertex -- edges ) } } { "set" hash-set } }
-{ $description "Outputs a set of all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. The set always includes " { $snippet "vertex" } "." } ;
+{ $description "Outputs all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. The set always includes " { $snippet "vertex" } "." } ;

core/graphs/graphs-tests.factor

@@ -0,0 +1,18 @@
+USING: assocs graphs kernel namespaces sets sorting tools.test ;
+
+H{ } "g" set
+{ 1 2 3 } "v" set
+
+{ } [ "v" dup get "g" get add-vertex ] unit-test
+
+{ { "v" } } [ 1 "g" get at members ] unit-test
+
+H{
+    { 1 HS{ 1 2 } }
+    { 2 HS{ 3 4 } }
+    { 4 HS{ 4 5 } }
+} "g" set
+
+{ { 2 3 4 5 } } [
+    2 [ "g" get at members ] closure members natural-sort
+] unit-test

core/graphs/graphs.factor

@@ -0,0 +1,29 @@
+! Copyright (C) 2006, 2007 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs kernel sequences sets ;
+IN: graphs
+
+<PRIVATE
+
+: nest ( vertex graph -- edges )
+    [ drop HS{ } clone ] cache ; inline
+
+PRIVATE>
+
+: add-vertex ( vertex edges graph -- )
+    [ nest adjoin ] curry with each ; inline
+
+: remove-vertex ( vertex edges graph -- )
+    [ at delete ] curry with each ; inline
+
+<PRIVATE
+
+ : (closure) ( vertex set quot: ( vertex -- edges ) -- )
+     2over ?adjoin [
+         [ dip ] keep [ (closure) ] 2curry each
+     ] [ 3drop ] if ; inline recursive
+
+PRIVATE>
+
+: closure ( vertex quot: ( vertex -- edges ) -- set )
+    HS{ } clone [ swap (closure) ] keep ; inline