use assoc-reject instead of [ ... not ] assoc-filter.

db4
John Benediktsson 2015-05-12 19:08:42 -07:00
parent 55122d9141
commit 296968580a
27 changed files with 29 additions and 29 deletions

View File

@ -31,7 +31,7 @@ GENERIC: visit-insn ( live-set insn -- )
! This would be much better if live-set was a real set ! This would be much better if live-set was a real set
: kill-defs ( live-set insn -- ) : kill-defs ( live-set insn -- )
defs-vregs [ ?leader ] map defs-vregs [ ?leader ] map
'[ drop ?leader _ in? not ] assoc-filter! drop ; inline '[ drop ?leader _ in? ] assoc-reject! drop ; inline
: gen-uses ( live-set insn -- ) : gen-uses ( live-set insn -- )
uses-vregs [ swap conjoin ] with each ; inline uses-vregs [ swap conjoin ] with each ; inline

View File

@ -139,7 +139,7 @@ M: vreg-insn compute-insn-costs
! For every vreg, compute preferred representation, that minimizes costs. ! For every vreg, compute preferred representation, that minimizes costs.
: minimize-costs ( costs -- representations ) : minimize-costs ( costs -- representations )
[ nip assoc-empty? not ] assoc-filter [ nip assoc-empty? ] assoc-reject
[ >alist alist-min first ] assoc-map ; [ >alist alist-min first ] assoc-map ;
: compute-representations ( cfg -- ) : compute-representations ( cfg -- )

View File

@ -80,7 +80,7 @@ SYMBOLS: local-peek-set replaces ;
H{ } clone replaces set ; H{ } clone replaces set ;
: remove-redundant-replaces ( replaces -- replaces' ) : remove-redundant-replaces ( replaces -- replaces' )
[ [ loc>vreg ] dip = not ] assoc-filter ; [ [ loc>vreg ] dip = ] assoc-reject ;
: end-local-analysis ( basic-block -- ) : end-local-analysis ( basic-block -- )
[ [

View File

@ -34,7 +34,7 @@ generic-call-site-crossref [ H{ } clone ] initialize
: outdated-conditional-usages ( set -- assocs ) : outdated-conditional-usages ( set -- assocs )
members H{ } clone '[ members H{ } clone '[
conditional-dependencies-of conditional-dependencies-of
[ drop _ dependencies-satisfied? not ] assoc-filter [ drop _ dependencies-satisfied? ] assoc-reject
] map ; ] map ;
: generic-call-sites-of ( word -- assoc ) : generic-call-sites-of ( word -- assoc )

View File

@ -170,7 +170,7 @@ SYMBOL: event-stream-callbacks
[ [
event-stream-callbacks event-stream-callbacks
[ [ drop expired? not ] assoc-filter H{ } assoc-like ] change-global [ [ drop expired? ] assoc-reject H{ } assoc-like ] change-global
] "core-foundation" add-startup-hook ] "core-foundation" add-startup-hook
: add-event-source-callback ( quot -- id ) : add-event-source-callback ( quot -- id )

View File

@ -119,7 +119,7 @@ TUPLE: couchdb-auth-provider
((get-user)) ; ((get-user)) ;
: strip-hash ( hash1 -- hash2 ) : strip-hash ( hash1 -- hash2 )
[ drop first CHAR: _ = not ] assoc-filter ; [ drop first CHAR: _ = ] assoc-reject ;
: at-or-k ( key hash -- newkey ) : at-or-k ( key hash -- newkey )
dupd at [ nip ] when* ; dupd at [ nip ] when* ;

View File

@ -26,7 +26,7 @@ M: object specializer-declaration class-of ;
: make-specializer ( specs -- quot ) : make-specializer ( specs -- quot )
dup length iota <reversed> dup length iota <reversed>
[ (picker) 2array ] 2map [ (picker) 2array ] 2map
[ drop object eq? not ] assoc-filter [ drop object eq? ] assoc-reject
[ [ t ] ] [ [ [ t ] ] [
[ swap specializer-predicate append ] { } assoc>map [ swap specializer-predicate append ] { } assoc>map
[ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce [ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce

View File

@ -10,7 +10,7 @@ IN: html.templates.chloe.compiler
[ drop chloe-name? ] assoc-filter ; [ drop chloe-name? ] assoc-filter ;
: non-chloe-attrs-only ( assoc -- assoc' ) : non-chloe-attrs-only ( assoc -- assoc' )
[ drop chloe-name? not ] assoc-filter ; [ drop chloe-name? ] assoc-reject ;
: chloe-tag? ( tag -- ? ) : chloe-tag? ( tag -- ? )
dup xml? [ body>> ] when dup xml? [ body>> ] when

View File

@ -21,7 +21,7 @@ M: singleton-class component-tag ( tag class -- )
bi* ; bi* ;
: compile-component-attrs ( tag class -- ) : compile-component-attrs ( tag class -- )
[ attrs>> [ drop main>> "name" = not ] assoc-filter ] dip [ attrs>> [ drop main>> "name" = ] assoc-reject ] dip
[ all-slots swap '[ name>> _ at compile-attr ] each ] [ all-slots swap '[ name>> _ at compile-attr ] each ]
[ [ boa ] [code-with] ] [ [ boa ] [code-with] ]
bi ; bi ;

View File

@ -55,7 +55,7 @@ HOOK: (fp-env-registers) cpu ( -- registers )
: fp-env-register ( -- register ) (fp-env-registers) first ; : fp-env-register ( -- register ) (fp-env-registers) first ;
:: mask> ( bits assoc -- symbols ) :: mask> ( bits assoc -- symbols )
assoc [| k v | bits v mask zero? not ] assoc-filter keys ; assoc [| k v | bits v mask zero? ] assoc-reject keys ;
: >mask ( symbols assoc -- bits ) : >mask ( symbols assoc -- bits )
over empty? over empty?
[ 2drop 0 ] [ 2drop 0 ]

View File

@ -160,7 +160,7 @@ M: pathname pprint*
] if ; inline ] if ; inline
: filter-tuple-assoc ( slot,value -- name,value ) : filter-tuple-assoc ( slot,value -- name,value )
[ [ initial>> ] dip = not ] assoc-filter [ [ initial>> ] dip = ] assoc-reject
[ [ name>> ] dip ] assoc-map ; [ [ name>> ] dip ] assoc-map ;
: tuple>assoc ( tuple -- assoc ) : tuple>assoc ( tuple -- assoc )

View File

@ -66,7 +66,7 @@ TUPLE: parts in out ;
dup new-transitions '[ dup new-transitions '[
[ [
_ swap '[ _ get-transitions ] assoc-map _ swap '[ _ get-transitions ] assoc-map
[ nip empty? not ] assoc-filter [ nip empty? ] assoc-reject
] preserving-epsilon ] preserving-epsilon
] assoc-map ] assoc-map
] change-transitions ; ] change-transitions ;

View File

@ -11,7 +11,7 @@ TR: soundex-tr
: remove-duplicates ( seq -- seq' ) : remove-duplicates ( seq -- seq' )
#! Remove _consecutive_ duplicates (unlike prune which removes #! Remove _consecutive_ duplicates (unlike prune which removes
#! all duplicates). #! all duplicates).
[ 2 <clumps> [ = not ] assoc-filter values ] [ first ] bi prefix ; [ 2 <clumps> [ = ] assoc-reject values ] [ first ] bi prefix ;
: first>upper ( seq -- seq' ) 1 head >upper ; : first>upper ( seq -- seq' ) 1 head >upper ;
: trim-first ( seq -- seq' ) dup first [ = ] curry trim-head ; : trim-first ( seq -- seq' ) dup first [ = ] curry trim-head ;

View File

@ -81,7 +81,7 @@ M: string coverage
M: word coverage ( word -- seq ) M: word coverage ( word -- seq )
"coverage" word-prop >alist "coverage" word-prop >alist
[ drop executed?>> not ] assoc-filter values ; [ drop executed?>> ] assoc-reject values ;
GENERIC: coverage. ( object -- ) GENERIC: coverage. ( object -- )

View File

@ -132,7 +132,7 @@ IN: tools.deploy.shaker
"Stripping word properties" show "Stripping word properties" show
swap '[ swap '[
[ [
[ drop _ member? not ] assoc-filter sift-values [ drop _ member? ] assoc-reject sift-values
>alist f like >alist f like
] change-props drop ] change-props drop
] each ; ] each ;
@ -255,7 +255,7 @@ IN: tools.deploy.shaker
dup array? [ dup array? [
[ [
2 group 2 group
[ drop _ key? not ] assoc-filter [ drop _ key? ] assoc-reject
concat concat
] map ] map
] when ] when
@ -432,7 +432,7 @@ IN: tools.deploy.shaker
stripped-globals :> to-strip stripped-globals :> to-strip
cleared-globals :> to-clear cleared-globals :> to-clear
global boxes>> global boxes>>
[ drop to-strip strip-global? not ] assoc-filter! [ drop to-strip strip-global? ] assoc-reject!
[ [
[ [
swap to-clear clear-global? swap to-clear clear-global?

View File

@ -154,7 +154,7 @@ PRIVATE>
[ total-time>> ] same? ; [ total-time>> ] same? ;
: trim-flat ( root-node -- root-node' ) : trim-flat ( root-node -- root-node' )
dup '[ [ nip _ redundant-flat-node? not ] assoc-filter ] change-children ; dup '[ [ nip _ redundant-flat-node? ] assoc-reject ] change-children ;
PRIVATE> PRIVATE>

View File

@ -53,7 +53,7 @@ ui.gadgets.editors ui.gestures ui.tools.listener ;
] change-commands drop multiline-editor update-gestures ] change-commands drop multiline-editor update-gestures
"interactor" interactor get-command-at [ "interactor" interactor get-command-at [
[ drop T{ key-down f { C+ } "k" } = not ] assoc-filter [ drop T{ key-down f { C+ } "k" } = ] assoc-reject
] change-commands drop interactor update-gestures""" ] change-commands drop interactor update-gestures"""
} }
$nl $nl

View File

@ -135,7 +135,7 @@ PRIVATE>
: process-combining ( data -- hash ) : process-combining ( data -- hash )
3 swap (process-data) 3 swap (process-data)
[ string>number ] assoc-map [ string>number ] assoc-map
[ nip zero? not ] assoc-filter [ nip zero? ] assoc-reject
>hashtable ; >hashtable ;
! the maximum unicode char in the first 3 planes ! the maximum unicode char in the first 3 planes

View File

@ -10,7 +10,7 @@ IN: vocabs.cache
[ root-cache get delete-at ] [ root-cache get delete-at ]
[ [
\ vocab-file-contents "memoize" word-prop swap \ vocab-file-contents "memoize" word-prop swap
'[ drop first vocab-name _ = not ] assoc-filter! drop '[ drop first vocab-name _ = ] assoc-reject! drop
] bi ] bi
\ all-vocabs-recursive reset-memoized \ all-vocabs-recursive reset-memoized
\ all-authors reset-memoized \ all-authors reset-memoized

View File

@ -120,7 +120,7 @@ TUPLE: expiry-check object alien ;
[ alien>> expired? ] [ t ] if* ; [ alien>> expired? ] [ t ] if* ;
: delete-values ( value assoc -- ) : delete-values ( value assoc -- )
[ rot drop = not ] with assoc-filter! drop ; [ rot drop = ] with assoc-reject! drop ;
PRIVATE> PRIVATE>

View File

@ -82,7 +82,7 @@ C: <predicate-engine> predicate-engine
! 2. Convert methods ! 2. Convert methods
: split-methods ( assoc class -- first second ) : split-methods ( assoc class -- first second )
[ [ nip class<= not ] curry assoc-filter ] [ [ nip class<= ] curry assoc-reject ]
[ [ nip class<= ] curry assoc-filter ] 2bi ; [ [ nip class<= ] curry assoc-filter ] 2bi ;
: convert-methods ( assoc class word -- assoc' ) : convert-methods ( assoc class word -- assoc' )

View File

@ -205,7 +205,7 @@ PRIVATE>
GENERIC: update ( search-path-elt -- valid? ) GENERIC: update ( search-path-elt -- valid? )
: trim-forgotten ( qualified-vocab -- valid? ) : trim-forgotten ( qualified-vocab -- valid? )
[ [ nip "forgotten" word-prop not ] assoc-filter ] change-words [ [ nip "forgotten" word-prop ] assoc-reject ] change-words
words>> assoc-empty? not ; words>> assoc-empty? not ;
M: from update trim-forgotten ; M: from update trim-forgotten ;

View File

@ -9,7 +9,7 @@ IN: assocs.extras
[ nip ] assoc-filter ; inline [ nip ] assoc-filter ; inline
: assoc-harvest ( assoc -- assoc' ) : assoc-harvest ( assoc -- assoc' )
[ nip empty? not ] assoc-filter ; inline [ nip empty? ] assoc-reject ; inline
: deep-at ( assoc seq -- value/f ) : deep-at ( assoc seq -- value/f )
[ of ] each ; inline [ of ] each ; inline

View File

@ -20,7 +20,7 @@ IN: koszul
} cond ; } cond ;
: canonicalize ( assoc -- assoc' ) : canonicalize ( assoc -- assoc' )
[ nip zero? not ] assoc-filter ; [ nip zero? ] assoc-reject ;
SYMBOL: terms SYMBOL: terms

View File

@ -32,7 +32,7 @@ M: managed-server handle-client-disconnect ;
: client-streams ( -- assoc ) clients values ; : client-streams ( -- assoc ) clients values ;
: username ( -- string ) client username>> ; : username ( -- string ) client username>> ;
: everyone-else ( -- assoc ) : everyone-else ( -- assoc )
clients [ drop username = not ] assoc-filter ; clients [ drop username = ] assoc-reject ;
: everyone-else-streams ( -- assoc ) everyone-else values ; : everyone-else-streams ( -- assoc ) everyone-else values ;
ERROR: no-such-client username ; ERROR: no-such-client username ;

View File

@ -114,7 +114,7 @@ SYMBOL: total
: multi-predicate ( classes -- quot ) : multi-predicate ( classes -- quot )
dup length iota <reversed> dup length iota <reversed>
[ picker 2array ] 2map [ picker 2array ] 2map
[ drop object eq? not ] assoc-filter [ drop object eq? ] assoc-reject
[ [ t ] ] [ [ [ t ] ] [
[ (multi-predicate) ] { } assoc>map [ (multi-predicate) ] { } assoc>map
unclip [ swap [ f ] \ if 3array append [ ] like ] reduce unclip [ swap [ f ] \ if 3array append [ ] like ] reduce

View File

@ -82,7 +82,7 @@ IN: tools.gc-decode.tests
: base-pointer-groups-decoded ( word -- seq ) : base-pointer-groups-decoded ( word -- seq )
word>gc-info base-pointer-groups [ word>gc-info base-pointer-groups [
[ swap 2array ] map-index [ nip -1 = not ] assoc-filter [ swap 2array ] map-index [ nip -1 = ] assoc-reject
] map ; ] map ;
! base-pointer-groups ! base-pointer-groups