diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor index 3997289df6..ea0ea61a85 100644 --- a/library/collections/namespaces.factor +++ b/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 ; diff --git a/library/collections/sequence-combinators.factor b/library/collections/sequence-combinators.factor index 0c118867e8..97cb463b1f 100644 --- a/library/collections/sequence-combinators.factor +++ b/library/collections/sequence-combinators.factor @@ -30,10 +30,12 @@ vectors ; t f 0 pick set-nth-unsafe ] if ; -: (subset) ( quot accum elt -- quot accum ) - -rot [ - >r over >r call [ r> r> push ] [ r> r> 2drop ] if - ] 2keep ; inline +: select ( seq quot quot -- seq ) + pick >r >r V{ } clone rot [ + -rot [ + >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 ; - inline + [ each ] select ; inline : subset-with ( obj seq quot -- seq | quot: obj elt -- ? ) swap [ with rot ] subset 2nip ; inline diff --git a/library/collections/tree-each.factor b/library/collections/tree-each.factor index 9d9c200aff..7f12916f81 100644 --- a/library/collections/tree-each.factor +++ b/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 diff --git a/library/words.factor b/library/words.factor index 47c06b66d8..e1c2967bcb 100644 --- a/library/words.factor +++ b/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 ) - [ - word-def - [ dup word? [ dup dup set ] when drop ] tree-each - ] make-hash hash-keys ; +: uses ( word -- uses ) word-def [ word? ] tree-subset prune ; SYMBOL: crossref