tri
] { } make ;
-: class-usage ( class -- seq ) update-map get at ;
+: class-usage ( class -- seq )
+ update-map get at keys ;
-: class-usages ( class -- seq ) [ class-usage ] closure keys ;
+: class-usages ( class -- seq )
+ [ class-usage ] closure sets:members ;
M: class implementors implementors-map get at sets:members ;
: check-metaclass ( class metaclass -- usages/f )
over class? [
over "metaclass" word-prop eq?
- [ drop f ] [ class-usage keys ] if
+ [ drop f ] [ class-usage ] if
] [ 2drop f ] if ;
: ?define-symbol ( word -- )
GENERIC: make-final ( class -- )
M: tuple-class make-final
- [ dup class-usage keys ?metaclass-changed ]
+ [ dup class-usage ?metaclass-changed ]
[ t "final" set-word-prop ]
bi ;
-USING: assocs hashtables help.markup help.syntax kernel sequences ;
+USING: assocs hashtables help.markup help.syntax kernel
+sequences sets ;
IN: graphs
ARTICLE: "graphs" "Directed graph utilities"
{ $side-effects "graph" } ;
HELP: closure
-{ $values { "obj" object } { "quot" { $quotation "( obj -- assoc )" } } { "assoc" "a new assoc" } }
+{ $values { "obj" object } { "quot" { $quotation "( obj -- assoc )" } } { "set" set } }
{ $description "Outputs a set of all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. The set always includes " { $snippet "vertex" } "." } ;
USING: graphs tools.test namespaces kernel sorting assocs ;
+FROM: sets => members ;
H{ } "g" set
{ 1 2 3 } "v" set
} "g" set
[ { 2 3 4 5 } ] [
- 2 [ "g" get at ] closure keys natural-sort
+ 2 [ "g" get at keys ] closure members natural-sort
] unit-test
H{ } "g" set
<PRIVATE
-: (closure) ( obj assoc quot: ( elt -- assoc ) -- )
- 2over key? [
- 3drop
- ] [
- 2over conjoin [ dip ] keep
- [ [ drop ] 3dip (closure) ] 2curry assoc-each
- ] if ; inline recursive
+: (closure) ( obj set quot: ( elt -- seq ) -- )
+ 2over ?adjoin [
+ [ dip ] keep [ (closure) ] 2curry each
+ ] [ 3drop ] if ; inline recursive
PRIVATE>
-: closure ( obj quot -- assoc )
- H{ } clone [ swap (closure) ] keep ; inline
+: closure ( obj quot -- set )
+ HS{ } clone [ swap (closure) ] keep ; inline