new -> new-sequence

construct-empty -> new
construct-boa -> boa
diff -> assoc-diff
union -> assoc-union
intersect -> assoc-intersect
db4
Doug Coleman 2008-04-13 22:58:07 -05:00
parent 72080fda4a
commit 2edd0fefc9
26 changed files with 43 additions and 43 deletions

View File

@ -69,10 +69,10 @@ ARTICLE: "assocs-lookup" "Lookup and querying of assocs"
ARTICLE: "assocs-sets" "Set-theoretic operations on assocs"
"It is often useful to use the keys of an associative mapping as a set, exploiting the constant or logarithmic lookup time of most implementations (" { $link "alists" } " being a notable exception)."
{ $subsection subassoc? }
{ $subsection intersect }
{ $subsection assoc-intersect }
{ $subsection update }
{ $subsection union }
{ $subsection diff }
{ $subsection assoc-union }
{ $subsection assoc-diff }
{ $subsection remove-all }
{ $subsection substitute }
{ $subsection substitute-here }
@ -260,7 +260,7 @@ HELP: values
{ keys values } related-words
HELP: intersect
HELP: assoc-intersect
{ $values { "assoc1" assoc } { "assoc2" assoc } { "intersection" "a new assoc" } }
{ $description "Outputs an assoc consisting of all entries from " { $snippet "assoc2" } " such that the key is also present in " { $snippet "assoc1" } "." }
{ $notes "The values of the keys in " { $snippet "assoc1" } " are disregarded, so this word is usually used for set-theoretic calculations where the assoc in question either has dummy sentinels as values, or the values equal the keys." } ;
@ -270,11 +270,11 @@ HELP: update
{ $description "Adds all entries from " { $snippet "assoc2" } " to " { $snippet "assoc1" } "." }
{ $side-effects "assoc1" } ;
HELP: union
HELP: assoc-union
{ $values { "assoc1" assoc } { "assoc2" assoc } { "union" "a new assoc" } }
{ $description "Outputs a assoc consisting of all entries from " { $snippet "assoc1" } " and " { $snippet "assoc2" } ", with entries from " { $snippet "assoc2" } " taking precedence in case the corresponding values are not equal." } ;
HELP: diff
HELP: assoc-diff
{ $values { "assoc1" assoc } { "assoc2" assoc } { "diff" "a new assoc" } }
{ $description "Outputs an assoc consisting of all entries from " { $snippet "assoc2" } " whose key is not contained in " { $snippet "assoc1" } "." }
;

View File

@ -58,24 +58,24 @@ H{ } clone "cache-test" set
] [
H{ { "factor" "rocks" } { "dup" "sq" } { 3 4 } }
H{ { "factor" "rocks" } { 1 2 } { 2 3 } { 3 4 } }
intersect
assoc-intersect
] unit-test
[
H{ { 1 2 } { 2 3 } { 6 5 } }
] [
H{ { 2 4 } { 6 5 } } H{ { 1 2 } { 2 3 } }
union
assoc-union
] unit-test
[ H{ { 1 2 } { 2 3 } } t ] [
f H{ { 1 2 } { 2 3 } } [ union ] 2keep swap union dupd =
f H{ { 1 2 } { 2 3 } } [ assoc-union ] 2keep swap assoc-union dupd =
] unit-test
[
H{ { 1 f } }
] [
H{ { 1 f } } H{ { 1 f } } intersect
H{ { 1 f } } H{ { 1 f } } assoc-intersect
] unit-test
[ { 1 3 } ] [ H{ { 2 2 } } { 1 2 3 } remove-all ] unit-test

View File

@ -109,17 +109,17 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
>r over r> hashcode* 2/ >r dupd hashcode* r> bitxor
] { } assoc>map hashcode* ;
: intersect ( assoc1 assoc2 -- intersection )
: assoc-intersect ( assoc1 assoc2 -- intersection )
swap [ nip key? ] curry assoc-subset ;
: update ( assoc1 assoc2 -- )
swap [ swapd set-at ] curry assoc-each ;
: union ( assoc1 assoc2 -- union )
: assoc-union ( assoc1 assoc2 -- union )
2dup [ assoc-size ] bi@ + pick new-assoc
[ rot update ] keep [ swap update ] keep ;
: diff ( assoc1 assoc2 -- diff )
: assoc-diff ( assoc1 assoc2 -- diff )
swap [ nip key? not ] curry assoc-subset ;
: remove-all ( assoc seq -- subseq )

View File

@ -36,4 +36,4 @@ tag-numbers get H{
{ word 17 }
{ byte-array 18 }
{ tuple-layout 19 }
} union type-numbers set
} assoc-union type-numbers set

View File

@ -89,7 +89,7 @@ M: word reset-class drop ;
dup reset-class
dup deferred? [ dup define-symbol ] when
dup word-props
r> union over set-word-props
r> assoc-union over set-word-props
dup predicate-word
[ 1quotation "predicate" set-word-prop ]
[ swap "predicating" set-word-prop ]

View File

@ -202,7 +202,7 @@ M: #dispatch generate-node
: define-if>boolean-intrinsics ( word intrinsics -- )
[
>r [ if>boolean-intrinsic ] curry r>
{ { f "if-scratch" } } +scratch+ associate union
{ { f "if-scratch" } } +scratch+ associate assoc-union
] assoc-map "intrinsics" set-word-prop ;
: define-if-intrinsics ( word intrinsics -- )

View File

@ -45,7 +45,7 @@ C: <ignore-close-stream> ignore-close-stream
TUPLE: style-stream < filter-writer style ;
: do-nested-style ( style style-stream -- style stream )
[ style>> swap union ] [ stream>> ] bi ; inline
[ style>> swap assoc-union ] [ stream>> ] bi ; inline
C: <style-stream> style-stream

View File

@ -17,7 +17,7 @@ SYMBOL: optimizer-changed
GENERIC: optimize-node* ( node -- node/t changed? )
: ?union ( assoc/f assoc -- hash )
over [ union ] [ nip ] if ;
over [ assoc-union ] [ nip ] if ;
: add-node-literals ( assoc node -- )
over assoc-empty? [
@ -82,7 +82,7 @@ M: node optimize-node* drop t f ;
2dup at* [ swap follow nip ] [ 2drop ] if ;
: union* ( assoc1 assoc2 -- assoc )
union [ keys ] keep
assoc-union [ keys ] keep
[ dupd follow ] curry
H{ } map>assoc ;

View File

@ -501,14 +501,14 @@ SYMBOL: interactive-vocabs
] if ;
: filter-moved ( assoc1 assoc2 -- seq )
diff [
assoc-diff [
drop where dup [ first ] when
file get source-file-path =
] assoc-subset keys ;
: removed-definitions ( -- assoc1 assoc2 )
new-definitions old-definitions
[ get first2 union ] bi@ ;
[ get first2 assoc-union ] bi@ ;
: removed-classes ( -- assoc1 assoc2 )
new-definitions old-definitions

View File

@ -19,6 +19,6 @@ IN: sbufs.tests
[ SBUF" x" ] [ 1 <sbuf> CHAR: x >bignum over push ] unit-test
[ fixnum ] [ 1 >bignum SBUF" " new length class ] unit-test
[ fixnum ] [ 1 >bignum SBUF" " new-sequence length class ] unit-test
[ fixnum ] [ 1 >bignum [ ] SBUF" " map-as length class ] unit-test

View File

@ -240,7 +240,7 @@ unit-test
[ ?{ f t } ] [ 0 2 ?{ f t f } subseq ] unit-test
[ V{ f f f } ] [ 3 V{ } new ] unit-test
[ V{ f f f } ] [ 3 V{ } new-sequence ] unit-test
[ SBUF" \0\0\0" ] [ 3 SBUF" " new ] unit-test
[ 0 ] [ f length ] unit-test

View File

@ -69,7 +69,7 @@ M: pathname forget*
pathname-string forget-source ;
: rollback-source-file ( file -- )
dup source-file-definitions new-definitions get [ union ] 2map
dup source-file-definitions new-definitions get [ assoc-union ] 2map
swap set-source-file-definitions ;
SYMBOL: file

View File

@ -94,6 +94,6 @@ IN: vectors.tests
100 >array dup >vector <reversed> >array >r reverse r> =
] unit-test
[ fixnum ] [ 1 >bignum V{ } new length class ] unit-test
[ fixnum ] [ 1 >bignum V{ } new-sequence length class ] unit-test
[ fixnum ] [ 1 >bignum [ ] V{ } map-as length class ] unit-test

View File

@ -139,7 +139,7 @@ H{
{ "NSRect" "{_NSRect=ffff}" }
{ "NSSize" "{_NSSize=ff}" }
{ "NSRange" "{_NSRange=II}" }
} union alien>objc-types set-global
} assoc-union alien>objc-types set-global
: objc-struct-type ( i string -- ctype )
2dup CHAR: = -rot index* swap subseq

View File

@ -5,7 +5,7 @@ io definitions kernel continuations ;
IN: delegate.protocols
PROTOCOL: sequence-protocol
clone clone-like like new new-resizable nth nth-unsafe
clone clone-like like new-sequence new-resizable nth nth-unsafe
set-nth set-nth-unsafe length set-length lengthen ;
PROTOCOL: assoc-protocol

View File

@ -79,7 +79,7 @@ M: f print-element drop ;
[ strong-style get print-element* ] ($heading) ;
: ($code-style) ( presentation -- hash )
presented associate code-style get union ;
presented associate code-style get assoc-union ;
: ($code) ( presentation quot -- )
[

View File

@ -40,7 +40,7 @@ TUPLE: action init display submit get-params post-params ;
M: action call-responder ( path action -- response )
'[
, ,
[ +append-path associate request-params union params set ]
[ +append-path associate request-params assoc-union params set ]
[ action set ] bi*
request get method>> {
{ "GET" [ handle-get ] }

View File

@ -84,7 +84,7 @@ TUPLE: url-sessions ;
[ drop ] [ get-session ] 2bi ;
: add-session-id ( query -- query' )
session-id get [ session-id-key associate union ] when* ;
session-id get [ session-id-key associate assoc-union ] when* ;
: session-form-field ( -- )
<input

View File

@ -85,8 +85,8 @@ M: process hashcode* process-handle hashcode* ;
: get-environment ( process -- env )
dup environment>>
swap environment-mode>> {
{ +prepend-environment+ [ os-envs union ] }
{ +append-environment+ [ os-envs swap union ] }
{ +prepend-environment+ [ os-envs assoc-union ] }
{ +append-environment+ [ os-envs swap assoc-union ] }
{ +replace-environment+ [ ] }
} case ;

View File

@ -65,7 +65,7 @@ SYMBOL: deploy-image
{ deploy-c-types? f }
! default value for deploy.macosx
{ "stop-after-last-window?" t }
} union ;
} assoc-union ;
: deploy-config-path ( vocab -- string )
vocab-dir "deploy.factor" append-path ;
@ -73,7 +73,7 @@ SYMBOL: deploy-image
: deploy-config ( vocab -- assoc )
dup default-config swap
dup deploy-config-path vocab-file-contents
parse-fresh dup empty? [ drop ] [ first union ] if ;
parse-fresh dup empty? [ drop ] [ first assoc-union ] if ;
: set-deploy-config ( assoc vocab -- )
>r unparse-use string-lines r>

View File

@ -9,14 +9,14 @@ global [
[ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global
! Only keeps those methods that we actually call
sent-messages get super-sent-messages get union
objc-methods [ intersect ] change
sent-messages get super-sent-messages get assoc-union
objc-methods [ assoc-intersect ] change
sent-messages get
super-sent-messages get
[ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@
super-message-senders [ intersect ] change
message-senders [ intersect ] change
super-message-senders [ assoc-intersect ] change
message-senders [ assoc-intersect ] change
sent-messages off
super-sent-messages off

View File

@ -11,7 +11,7 @@ TUPLE: tuple-array example ;
swap tuple>array length over length - ;
: <tuple-array> ( length example -- tuple-array )
prepare-example [ rot * { } new ] keep
prepare-example [ rot * { } new-sequence ] keep
<sliced-groups> tuple-array construct-delegate
[ set-tuple-array-example ] keep ;

View File

@ -66,7 +66,7 @@ M: word command-description ( word -- str )
H{ { +nullary+ f } { +listener+ f } { +description+ f } } ;
: define-command ( word hash -- )
default-flags swap union >r word-props r> update ;
default-flags swap assoc-union >r word-props r> update ;
: command-quot ( target command -- quot )
dup 1quotation swap +nullary+ word-prop

View File

@ -54,7 +54,7 @@ SYMBOL: operations
H{ { +keyboard+ f } { +primary+ f } { +secondary+ f } } ;
: define-operation ( pred command flags -- )
default-flags swap union
default-flags swap assoc-union
dupd define-command <operation>
operations get push ;

View File

@ -135,7 +135,7 @@ load-data
dup process-names \ name-map set-value
13 over process-data \ simple-lower set-value
12 over process-data tuck \ simple-upper set-value
14 over process-data swapd union \ simple-title set-value
14 over process-data swapd assoc-union \ simple-title set-value
dup process-combining \ class-map set-value
dup process-canonical \ canonical-map set-value
\ combine-map set-value

View File

@ -62,7 +62,7 @@ M: attrs set-at
] if* ;
M: attrs assoc-size attrs-alist length ;
M: attrs new-assoc drop V{ } new <attrs> ;
M: attrs new-assoc drop V{ } new-sequence <attrs> ;
M: attrs >alist attrs-alist ;
: >attrs ( assoc -- attrs )