new tree-subset combinator

library/collections/namespaces.factor

@@ -80,6 +80,11 @@ IN: lists
 : alist>quot ( default alist -- quot )
     [ [ first2 swap % , , \ if , ] [ ] make ] each ;
 
+IN: sequences
+
+: prune ( seq -- seq )
+    [ [ dup set ] each ] make-hash hash-keys ;
+
 IN: kernel-internals
 
 : init-namespaces ( -- ) global 1array >vector set-namestack ;

library/collections/sequence-combinators.factor

@@ -30,10 +30,12 @@ vectors ;
         t <array> f 0 pick set-nth-unsafe
     ] if ;
 
-: (subset) ( quot accum elt -- quot accum )
+: select ( seq quot quot -- seq )
-    -rot [
+    pick >r >r V{ } clone rot [
-        >r over >r call [ r> r> push ] [ r> r> 2drop ] if
+        -rot [
-    ] 2keep ; inline
+            >r over >r call [ r> r> push ] [ r> r> 2drop ] if
+        ] 2keep
+    ] r> call r> like nip ; inline
 
 IN: sequences
 
@@ -143,8 +145,7 @@ M: object find ( seq quot -- i elt )
     swap [ with rot ] all? 2nip ; inline
 
 : subset ( seq quot -- seq | quot: elt -- ? )
-    over >r V{ } clone rot [ (subset) ] each r> like nip ;
+    [ each ] select ; inline
-    inline
 
 : subset-with ( obj seq quot -- seq | quot: obj elt -- ? )
     swap [ with rot ] subset 2nip ; inline

library/collections/tree-each.factor

@@ -9,7 +9,7 @@ G: tree-each* ( obj quot -- | quot: elt -- )
 : tree-each ( obj quot -- | quot: elt -- )
     [ call ] 2keep tree-each* ; inline
 
-: tree-each-with ( obj vector quot -- )
+: tree-each-with ( obj obj quot -- )
     swap [ with ] tree-each 2drop ; inline
 
 M: object tree-each* 2drop ;
@@ -23,3 +23,9 @@ M: cons tree-each* ( cons quot -- )
 
 M: wrapper tree-each* ( wrapper quot -- )
     >r wrapped r> tree-each ;
+
+: tree-subset ( obj quot -- seq )
+    [ tree-each ] select ; inline
+
+: tree-subset-with ( obj seq quot -- seq | quot: obj elt -- ? )
+    swap [ with rot ] tree-subset 2nip ; inline

library/words.factor

@@ -38,11 +38,7 @@ M: word word-xt ( w -- xt ) 7 integer-slot ;
 GENERIC: set-word-xt
 M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
 
-: uses ( word -- uses )
+: uses ( word -- uses ) word-def [ word? ] tree-subset prune ;
-    [
-        word-def
-        [ dup word? [ dup dup set ] when drop ] tree-each
-    ] make-hash hash-keys ;
 
 SYMBOL: crossref