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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/cfg/liveness/liveness.factor
View File

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

2
basis/compiler/cfg/representations/selection/selection.factor
View File

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

2
basis/compiler/cfg/stacks/local/local.factor
View File

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

2
basis/compiler/crossref/crossref.factor
View File

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

2
basis/core-foundation/fsevents/fsevents.factor
View File

@ -170,7 +170,7 @@ SYMBOL: 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
: add-event-source-callback ( quot -- id )

2
basis/furnace/auth/providers/couchdb/couchdb.factor
View File

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

2
basis/hints/hints.factor
View File

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

2
basis/html/templates/chloe/compiler/compiler.factor
View File

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

2
basis/html/templates/chloe/components/components.factor
View File

@ -21,7 +21,7 @@ M: singleton-class component-tag ( tag class -- )
bi* ;
: 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 ]
[ [ boa ] [code-with] ]
bi ;

2
basis/math/floats/env/env.factor vendored
View File

@ -55,7 +55,7 @@ HOOK: (fp-env-registers) cpu ( -- registers )
: fp-env-register ( -- register ) (fp-env-registers) first ;
:: 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 )
over empty?
[ 2drop 0 ]

2
basis/prettyprint/backend/backend.factor
View File

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

2
basis/regexp/disambiguate/disambiguate.factor
View File

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

2
basis/soundex/soundex.factor
View File

@ -11,7 +11,7 @@ TR: soundex-tr
: remove-duplicates ( seq -- seq' )
#! Remove _consecutive_ duplicates (unlike prune which removes
#! 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 ;
: trim-first ( seq -- seq' ) dup first [ = ] curry trim-head ;

2
basis/tools/coverage/coverage.factor
View File

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

6
basis/tools/deploy/shaker/shaker.factor
View File

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

2
basis/tools/profiler/sampling/sampling.factor
View File

@ -154,7 +154,7 @@ PRIVATE>
[ total-time>> ] same? ;
: 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>

2
basis/ui/tools/listener/listener-docs.factor
View File

@ -53,7 +53,7 @@ ui.gadgets.editors ui.gestures ui.tools.listener ;
] change-commands drop multiline-editor update-gestures
"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"""
}
$nl

2
basis/unicode/data/data.factor
View File

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

2
basis/vocabs/cache/cache.factor vendored
View File

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

2
core/alien/alien.factor
View File

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

2
core/generic/single/single.factor
View File

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

2
core/vocabs/parser/parser.factor
View File

@ -205,7 +205,7 @@ PRIVATE>
GENERIC: update ( search-path-elt -- 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 ;
M: from update trim-forgotten ;

2
extra/assocs/extras/extras.factor
View File

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

2
extra/koszul/koszul.factor
View File

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

2
extra/managed-server/managed-server.factor
View File

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

2
extra/multi-methods/multi-methods.factor
View File

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

2
extra/tools/gc-decode/gc-decode-tests.factor
View File

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