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.
! 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
"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@
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 ;
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: assocs hashtables help.markup help.syntax kernel sequences ;
-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."
-$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 }
-"To remove vertices from the graph:"
-{ $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:"
-{ $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" } }
-{ $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" } }
-{ $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." }
-{ $side-effects "graph" } ;
-
-HELP: closure
-{ $values { "vertex" object } { "quot" { $quotation ( vertex -- assoc ) } } { "assoc" "a new assoc" } }
-{ $description "Outputs a set of all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. The set always includes " { $snippet "vertex" } "." } ;
+++ /dev/null
-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
+++ /dev/null
-! 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
+++ /dev/null
-Directed graphs
+++ /dev/null
-collections
! 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
: 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 ;
<PRIVATE
: update-map+ ( class -- )
- dup class-uses update-map get
- [ adjoin-at ] curry with each ;
+ dup class-uses update-map get add-vertex ;
: update-map- ( class -- )
- dup class-uses update-map get
- [ at delete ] curry with each ;
+ dup class-uses update-map get remove-vertex ;
: implementors-map+ ( class -- )
[ HS{ } clone ] dip implementors-map get set-at ;
--- /dev/null
+Slava Pestov
--- /dev/null
+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 " { $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 }
+"To remove vertices from the graph:"
+{ $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 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 " { $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 " { $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 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 -- edges ) } } { "set" hash-set } }
+{ $description "Outputs all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. The set always includes " { $snippet "vertex" } "." } ;
--- /dev/null
+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
--- /dev/null
+! 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
--- /dev/null
+Directed graphs
--- /dev/null
+collections
projects / factor.git / commitdiff