steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Revert "graphs: change closure to use a set and operate on sequences." 

This reverts commit 2cc201a38a.
db4
John Benediktsson 2013-03-08 18:08:09 -08:00
parent 67e3cfae22
commit 4da798920e
5 changed files with 16 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
core/classes/classes.factor
View File

@ -130,11 +130,9 @@ GENERIC: implementors ( class/classes -- seq )
tri tri
] { } make ; ] { } make ;
: class-usage ( class -- seq ) : class-usage ( class -- seq ) update-map get at ;
update-map get at keys ;
: class-usages ( class -- seq ) : class-usages ( class -- seq ) [ class-usage ] closure keys ;
[ class-usage ] closure sets:members ;
M: class implementors implementors-map get at sets:members ; M: class implementors implementors-map get at sets:members ;
@ -172,7 +170,7 @@ GENERIC: metaclass-changed ( use class -- )
: check-metaclass ( class metaclass -- usages/f ) : check-metaclass ( class metaclass -- usages/f )
over class? [ over class? [
over "metaclass" word-prop eq? over "metaclass" word-prop eq?
[ drop f ] [ class-usage ] if [ drop f ] [ class-usage keys ] if
] [ 2drop f ] if ; ] [ 2drop f ] if ;
: ?define-symbol ( word -- ) : ?define-symbol ( word -- )

2
core/classes/tuple/tuple.factor
View File

@ -298,7 +298,7 @@ PRIVATE>
GENERIC: make-final ( class -- ) GENERIC: make-final ( class -- )
M: tuple-class make-final M: tuple-class make-final
[ dup class-usage ?metaclass-changed ] [ dup class-usage keys ?metaclass-changed ]
[ t "final" set-word-prop ] [ t "final" set-word-prop ]
bi ; bi ;

5
core/graphs/graphs-docs.factor
View File

@ -1,5 +1,4 @@
USING: assocs hashtables help.markup help.syntax kernel USING: assocs hashtables help.markup help.syntax kernel sequences ;
sequences sets ;
IN: graphs IN: graphs
ARTICLE: "graphs" "Directed graph utilities" ARTICLE: "graphs" "Directed graph utilities"
@ -29,5 +28,5 @@ HELP: remove-vertex
{ $side-effects "graph" } ; { $side-effects "graph" } ;
HELP: closure HELP: closure
{ $values { "obj" object } { "quot" { $quotation "( obj -- assoc )" } } { "set" set } } { $values { "obj" object } { "quot" { $quotation "( obj -- 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" } "." } ; { $description "Outputs a set of all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. The set always includes " { $snippet "vertex" } "." } ;

3
core/graphs/graphs-tests.factor
View File

@ -1,5 +1,4 @@
USING: graphs tools.test namespaces kernel sorting assocs ; USING: graphs tools.test namespaces kernel sorting assocs ;
FROM: sets => members ;
H{ } "g" set H{ } "g" set
{ 1 2 3 } "v" set { 1 2 3 } "v" set
@ -15,7 +14,7 @@ H{
} "g" set } "g" set
[ { 2 3 4 5 } ] [ [ { 2 3 4 5 } ] [
2 [ "g" get at keys ] closure members natural-sort 2 [ "g" get at ] closure keys natural-sort
] unit-test ] unit-test
H{ } "g" set H{ } "g" set

15
core/graphs/graphs.factor
View File

@ -31,12 +31,15 @@ PRIVATE>
<PRIVATE <PRIVATE
: (closure) ( obj set quot: ( elt -- seq ) -- ) : (closure) ( obj assoc quot: ( elt -- assoc ) -- )
2over ?adjoin [ 2over key? [
[ dip ] keep [ (closure) ] 2curry each 3drop
] [ 3drop ] if ; inline recursive ] [
2over conjoin [ dip ] keep
[ [ drop ] 3dip (closure) ] 2curry assoc-each
] if ; inline recursive
PRIVATE> PRIVATE>
: closure ( obj quot -- set ) : closure ( obj quot -- assoc )
HS{ } clone [ swap (closure) ] keep ; inline H{ } clone [ swap (closure) ] keep ; inline