From 8c19602ae9085ad7ea24cfd90a5bde0703855177 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 23 Mar 2013 14:35:01 -0700 Subject: [PATCH] assocs: Add of and ?of. Change all the things at once! Fixes #701. --- basis/classes/struct/struct-tests.factor | 14 +++++----- .../tree/propagation/branches/branches.factor | 2 +- .../auth/providers/couchdb/couchdb.factor | 26 +++++++++---------- .../hashtables/identity/identity-tests.factor | 2 +- .../sequences/sequences-tests.factor | 2 +- basis/html/streams/streams.factor | 10 +++---- basis/http/http.factor | 2 +- .../io/launcher/windows/windows-tests.factor | 6 ++--- .../linked-assocs/linked-assocs-tests.factor | 2 +- basis/math/statistics/statistics-tests.factor | 2 +- basis/mime/multipart/multipart-tests.factor | 2 +- basis/mime/multipart/multipart.factor | 2 +- basis/peg/ebnf/ebnf.factor | 4 +-- basis/stack-checker/branches/branches.factor | 2 +- basis/tools/walker/debug/debug.factor | 2 +- basis/tools/walker/walker.factor | 4 +-- basis/ui/gadgets/panes/panes.factor | 10 +++---- basis/unicode/collation/collation.factor | 2 +- basis/unicode/data/data.factor | 2 +- basis/xml/elements/elements.factor | 6 ++--- basis/xml/syntax/syntax.factor | 2 +- basis/xmode/marker/marker.factor | 2 +- core/assocs/assocs-docs.factor | 10 ++++++- core/assocs/assocs.factor | 6 +++++ core/classes/classes.factor | 2 +- core/hashtables/hashtables-tests.factor | 2 +- extra/asn1/asn1.factor | 6 ++--- extra/assocs/extras/extras.factor | 4 +-- extra/bit/ly/ly.factor | 4 +-- extra/bitcoin/client/client.factor | 2 +- extra/bson/constants/constants.factor | 2 +- extra/couchdb/couchdb-tests.factor | 10 +++---- extra/couchdb/couchdb.factor | 16 ++++++------ extra/fuel/xref/xref.factor | 2 +- extra/google/translate/translate.factor | 4 +-- extra/hacker-news/hacker-news.factor | 2 +- extra/io/streams/256color/256color.factor | 6 ++--- .../client/internals/internals-tests.factor | 2 +- extra/mongodb/connection/connection.factor | 6 ++--- extra/mongodb/driver/driver.factor | 2 +- extra/oauth/oauth-tests.factor | 2 +- extra/pdf/canvas/canvas.factor | 14 +++++----- extra/quadtrees/quadtrees-tests.factor | 6 ++--- extra/reddit/reddit.factor | 10 +++---- extra/trees/avl/avl-tests.factor | 24 ++++++++--------- extra/trees/splay/splay-tests.factor | 4 +-- extra/trees/trees-tests.factor | 22 ++++++++-------- extra/twitter/twitter.factor | 2 +- 48 files changed, 145 insertions(+), 135 deletions(-) diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index dba07661ad..4ee47adea4 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -65,13 +65,13 @@ STRUCT: struct-test-bar make-mirror >alist ] unit-test -[ 55 t ] [ S{ struct-test-foo { x 55 } } make-mirror { "x" "char" } swap at* ] unit-test -[ 55 t ] [ S{ struct-test-foo { y 55 } } make-mirror { "y" "int" } swap at* ] unit-test -[ t t ] [ S{ struct-test-foo { z t } } make-mirror { "z" "bool" } swap at* ] unit-test -[ f t ] [ S{ struct-test-foo { z f } } make-mirror { "z" "bool" } swap at* ] unit-test -[ f f ] [ S{ struct-test-foo } make-mirror { "nonexist" "bool" } swap at* ] unit-test -[ f f ] [ S{ struct-test-foo } make-mirror "nonexist" swap at* ] unit-test -[ f t ] [ f struct-test-foo memory>struct make-mirror "underlying" swap at* ] unit-test +[ 55 t ] [ S{ struct-test-foo { x 55 } } make-mirror { "x" "char" } ?of ] unit-test +[ 55 t ] [ S{ struct-test-foo { y 55 } } make-mirror { "y" "int" } ?of ] unit-test +[ t t ] [ S{ struct-test-foo { z t } } make-mirror { "z" "bool" } ?of ] unit-test +[ f t ] [ S{ struct-test-foo { z f } } make-mirror { "z" "bool" } ?of ] unit-test +[ { "nonexist" "bool" } f ] [ S{ struct-test-foo } make-mirror { "nonexist" "bool" } ?of ] unit-test +[ "nonexist" f ] [ S{ struct-test-foo } make-mirror "nonexist" ?of ] unit-test +[ f t ] [ f struct-test-foo memory>struct make-mirror "underlying" ?of ] unit-test [ S{ struct-test-foo { x 3 } { y 2 } { z f } } ] [ S{ struct-test-foo { x 1 } { y 2 } { z f } } diff --git a/basis/compiler/tree/propagation/branches/branches.factor b/basis/compiler/tree/propagation/branches/branches.factor index 26e2e05a94..aae41f9c2d 100644 --- a/basis/compiler/tree/propagation/branches/branches.factor +++ b/basis/compiler/tree/propagation/branches/branches.factor @@ -95,7 +95,7 @@ M: #phi propagate-before ( #phi -- ) new [| key value | key old [ value union ] change-at ] assoc-each ; : include-child-constraints ( i -- ) - infer-children-data get nth constraints swap at last + infer-children-data get nth constraints of last constraints get last update-constraints ; : branch-phi-constraints ( output values booleans -- ) diff --git a/basis/furnace/auth/providers/couchdb/couchdb.factor b/basis/furnace/auth/providers/couchdb/couchdb.factor index 8df62df9b2..1a58c5e434 100644 --- a/basis/furnace/auth/providers/couchdb/couchdb.factor +++ b/basis/furnace/auth/providers/couchdb/couchdb.factor @@ -45,9 +45,9 @@ TUPLE: couchdb-auth-provider make-mirror H{ } assoc-like ; : is-couchdb-conflict-error? ( error -- ? ) - { [ couchdb-error? ] [ data>> "error" swap at "conflict" = ] } 1&& ; + { [ couchdb-error? ] [ data>> "error" of "conflict" = ] } 1&& ; : is-couchdb-not-found-error? ( error -- ? ) - { [ couchdb-error? ] [ data>> "error" swap at "not_found" = ] } 1&& ; + { [ couchdb-error? ] [ data>> "error" of "not_found" = ] } 1&& ; : get-url ( url -- url' ) couchdb-auth-provider get @@ -73,15 +73,15 @@ TUPLE: couchdb-auth-provider over [ (reserve) ] [ 2drop t ] if ; : unreserve ( couch-rval -- ) - [ "id" swap at get-url ] - [ "rev" swap at "rev" set-query-param ] + [ "id" of get-url ] + [ "rev" of "rev" set-query-param ] bi couch-delete drop ; : unreserve-from-id ( id -- ) [ get-url dup couch-get - "_rev" swap at "rev" set-query-param + "_rev" of "rev" set-query-param couch-delete drop ] [ dup is-couchdb-not-found-error? [ 2drop ] [ rethrow ] if @@ -110,7 +110,7 @@ TUPLE: couchdb-auth-provider ! Should be given a view URL. : ((get-user)) ( couchdb-url -- user/f ) couch-get - "rows" swap at dup empty? [ drop f ] [ first "value" swap at ] if ; + "rows" of dup empty? [ drop f ] [ first "value" of ] if ; : (get-user) ( username -- user/f ) couchdb-auth-provider get @@ -171,8 +171,8 @@ TUPLE: couchdb-auth-provider : unify-users ( old new -- new ) swap - [ "_rev" swap at "_rev" rot set-at ] - [ "_id" swap at "_id" rot set-at ] + [ "_rev" of "_rev" rot set-at ] + [ "_id" of "_id" rot set-at ] [ swap assoc-union ] 2tri ; @@ -182,15 +182,15 @@ TUPLE: couchdb-auth-provider ! (This word is called by the 'update-user' method.) : check-update ( old new -- ? ) [ - 2dup [ "email" swap at ] same? not [ - [ "email" swap at ] bi@ + 2dup [ "email" of ] same? not [ + [ "email" of ] bi@ [ drop "email" reservation-id unreserve-from-id ] [ nip "email" reserve ] 2bi ] [ 2drop t ] if ] [ - 2dup [ "username" swap at ] same? not [ - [ "username" swap at ] bi@ + 2dup [ "username" of ] same? not [ + [ "username" of ] bi@ [ drop "username" reservation-id unreserve-from-id ] [ nip "username" reserve ] 2bi @@ -217,7 +217,7 @@ M: couchdb-auth-provider new-user ( user provider -- user/f ) M: couchdb-auth-provider update-user ( user provider -- ) couchdb-auth-provider [ [ username>> (get-user)/throw-on-no-user dup ] - [ drop "_id" swap at get-url ] + [ drop "_id" of get-url ] [ user>user-hash swapd 2dup check-update drop unify-users >json swap couch-put drop diff --git a/basis/hashtables/identity/identity-tests.factor b/basis/hashtables/identity/identity-tests.factor index 36640388ea..e333d1f7ba 100644 --- a/basis/hashtables/identity/identity-tests.factor +++ b/basis/hashtables/identity/identity-tests.factor @@ -11,7 +11,7 @@ CONSTANT: will } : please-stand-up ( assoc key -- value ) - swap at ; + of ; [ t ] [ will the-real-slim-shady please-stand-up ] unit-test [ t ] [ will clone the-real-slim-shady please-stand-up ] unit-test diff --git a/basis/hashtables/sequences/sequences-tests.factor b/basis/hashtables/sequences/sequences-tests.factor index 7fe68ccf02..4ccea2fda6 100644 --- a/basis/hashtables/sequences/sequences-tests.factor +++ b/basis/hashtables/sequences/sequences-tests.factor @@ -15,7 +15,7 @@ IN: hashtables.identity.tests [ 1001 ] [ SH{ } clone 1001 0 4 "asdf" pick set-at - "asdf" swap at + "asdf" of ] unit-test [ { { "asdf" 1000 } } ] [ SH{ { "asdf" 1000 } } >alist ] unit-test diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor index 1b1e3c2dea..37ad24daec 100644 --- a/basis/html/streams/streams.factor +++ b/basis/html/streams/streams.factor @@ -29,10 +29,10 @@ TUPLE: html-sub-stream < html-writer style parent ; [ data>> ] [ style>> ] [ parent>> ] tri ; : object-link-tag ( xml style -- xml ) - presented swap at [ url-of [ simple-link ] when* ] when* ; + presented of [ url-of [ simple-link ] when* ] when* ; : href-link-tag ( xml style -- xml ) - href swap at [ simple-link ] when* ; + href of [ simple-link ] when* ; : hex-color, ( color -- ) [ red>> ] [ green>> ] [ blue>> ] tri @@ -58,7 +58,7 @@ TUPLE: html-sub-stream < html-writer style parent ; "font-family: " % % "; " % ; MACRO: make-css ( pairs -- str ) - [ '[ _ swap at [ _ execute ] when* ] ] { } assoc>map + [ '[ _ of [ _ execute ] when* ] ] { } assoc>map '[ [ _ cleave ] "" make ] ; : span-css-style ( style -- str ) @@ -81,7 +81,7 @@ MACRO: make-css ( pairs -- str ) "vocab:definitions/icons/" ?head [ "/icons/" prepend ] when ; : img-tag ( xml style -- xml ) - image swap at [ nip image-path simple-image ] when* ; + image of [ nip image-path simple-image ] when* ; : format-html-span ( string style stream -- ) [ @@ -113,7 +113,7 @@ CONSTANT: pre-css "white-space: pre; font-family: monospace;" { border-color border-css, } { inset padding-css, } } make-css - ] [ wrap-margin swap at [ pre-css append ] unless ] bi + ] [ wrap-margin of [ pre-css append ] unless ] bi " display: inline-block;" append ; : div-tag ( xml style -- xml' ) diff --git a/basis/http/http.factor b/basis/http/http.factor index 07d2b4eba5..8fdf9f0e58 100644 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -222,5 +222,5 @@ TUPLE: post-data data params content-type content-encoding ; : parse-content-type ( content-type -- type encoding ) ";" split1 - parse-content-type-attributes "charset" swap at + parse-content-type-attributes "charset" of [ dup mime-type-encoding encoding>name ] unless* ; diff --git a/basis/io/launcher/windows/windows-tests.factor b/basis/io/launcher/windows/windows-tests.factor index 754c3db871..5dba709844 100644 --- a/basis/io/launcher/windows/windows-tests.factor +++ b/basis/io/launcher/windows/windows-tests.factor @@ -173,7 +173,7 @@ IN: io.launcher.windows.tests ascii stream-contents ] with-directory eval( -- alist ) - "A" swap at + "A" of ] unit-test [ f ] [ @@ -185,7 +185,7 @@ IN: io.launcher.windows.tests ascii stream-contents ] with-directory eval( -- alist ) - "USERPROFILE" swap at "XXX" = + "USERPROFILE" of "XXX" = ] unit-test 2 [ @@ -240,4 +240,4 @@ IN: io.launcher.windows.tests [ process>> command>> "asdfdontexistplzplz" = ] [ process>> status>> f = ] } 1&& -] must-fail-with \ No newline at end of file +] must-fail-with diff --git a/basis/linked-assocs/linked-assocs-tests.factor b/basis/linked-assocs/linked-assocs-tests.factor index 603b04e895..a7a8512669 100644 --- a/basis/linked-assocs/linked-assocs-tests.factor +++ b/basis/linked-assocs/linked-assocs-tests.factor @@ -14,7 +14,7 @@ IN: linked-assocs.test 1 "b" pick set-at 2 "c" pick set-at 3 "a" pick set-at - "c" swap at* + "c" ?of ] unit-test { { 2 3 4 } { "c" "a" "d" } 3 } [ diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor index 04154fec0e..7e22222225 100644 --- a/basis/math/statistics/statistics-tests.factor +++ b/basis/math/statistics/statistics-tests.factor @@ -103,7 +103,7 @@ IN: math.statistics.tests V{ 2 5 8 } } [ 10 iota [ 3 mod ] collect-by - [ 0 swap at ] [ 1 swap at ] [ 2 swap at ] tri + [ 0 of ] [ 1 of ] [ 2 of ] tri ] unit-test [ 0 ] [ { 1 } { 1 } sample-cov ] unit-test diff --git a/basis/mime/multipart/multipart-tests.factor b/basis/mime/multipart/multipart-tests.factor index bfeb1335ee..3ded3da21a 100644 --- a/basis/mime/multipart/multipart-tests.factor +++ b/basis/mime/multipart/multipart-tests.factor @@ -32,7 +32,7 @@ IN: mime.multipart.tests [ t ] [ mime-test-stream [ upload-separator parse-multipart ] with-input-stream - "file1" swap at filename>> "up.txt" = + "file1" of filename>> "up.txt" = ] unit-test SYMBOL: mime-test-server diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor index c464e5d674..6e73b9b846 100644 --- a/basis/mime/multipart/multipart.factor +++ b/basis/mime/multipart/multipart.factor @@ -81,7 +81,7 @@ ERROR: end-of-stream multipart ; drop ] [ [ [ header>> ] [ filename>> ] [ temp-file>> ] tri mime-file boa ] - [ content-disposition>> "name" swap at unquote ] + [ content-disposition>> "name" of unquote ] [ mime-parts>> set-at ] tri ] if ; diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index ca9ab69e6c..4ad57278a1 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -555,14 +555,14 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) 'ebnf' (parse) check-parse-result ast>> transform ; : ebnf>quot ( string -- hashtable quot ) - parse-ebnf dup dup parser [ main swap at compile ] with-variable + parse-ebnf dup dup parser [ main of compile ] with-variable [ compiled-parse ] curry [ with-scope ast>> ] curry ; PRIVATE> SYNTAX: " - reset-tokenizer parse-multiline-string parse-ebnf main swap at + reset-tokenizer parse-multiline-string parse-ebnf main of suffix! reset-tokenizer ; SYNTAX: [EBNF diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index 2ab73b9a13..d569a34a6b 100644 --- a/basis/stack-checker/branches/branches.factor +++ b/basis/stack-checker/branches/branches.factor @@ -78,7 +78,7 @@ SYMBOLS: combinator quotations ; terminated? branch-variable ; : terminate-branches ( seq -- ) - [ terminated? swap at ] all? [ terminate ] when ; + [ terminated? of ] all? [ terminate ] when ; : compute-phi-function ( seq -- ) [ quotation active-variable sift quotations set ] diff --git a/basis/tools/walker/debug/debug.factor b/basis/tools/walker/debug/debug.factor index 2ab74bf735..b776a2c574 100644 --- a/basis/tools/walker/debug/debug.factor +++ b/basis/tools/walker/debug/debug.factor @@ -26,5 +26,5 @@ IN: tools.walker.debug send-synchronous drop p ?promise - variables>> walker-continuation swap at + variables>> walker-continuation of value>> data>> ; diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor index 3c287cbf24..f2516e18d8 100644 --- a/basis/tools/walker/walker.factor +++ b/basis/tools/walker/walker.factor @@ -23,8 +23,8 @@ DEFER: start-walker-thread : get-walker-thread ( -- status continuation thread ) walker-thread tget [ - [ variables>> walker-status swap at ] - [ variables>> walker-continuation swap at ] + [ variables>> walker-status of ] + [ variables>> walker-continuation of ] [ ] tri ] [ f diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 35447d71c5..bc9461ef87 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -199,9 +199,9 @@ MEMO: specified-font ( assoc -- font ) #! We memoize here to avoid creating lots of duplicate font objects. [ monospace-font ] dip { - [ font-name swap at >>name ] + [ font-name of >>name ] [ - font-style swap at { + font-style of { { f [ ] } { plain [ ] } { bold [ t >>bold? ] } @@ -209,9 +209,9 @@ MEMO: specified-font ( assoc -- font ) { bold-italic [ t >>bold? t >>italic? ] } } case ] - [ font-size swap at >>size ] - [ foreground swap at >>foreground ] - [ background swap at >>background ] + [ font-size of >>size ] + [ foreground of >>foreground ] + [ background of >>background ] } cleave derive-font ; diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index b66c9be792..38b5e9c9bf 100644 --- a/basis/unicode/collation/collation.factor +++ b/basis/unicode/collation/collation.factor @@ -31,7 +31,7 @@ TUPLE: weight primary secondary tertiary ignorable? ; : help-one ( assoc key -- ) ! Need to be more general? Not for DUCET, apparently 2 head 2dup swap key? [ 2drop ] [ - [ [ 1string swap at ] with { } map-as concat ] + [ [ 1string of ] with { } map-as concat ] [ swap set-at ] 2bi ] if ; diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index b328b075ff..94c4e12075 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -92,7 +92,7 @@ PRIVATE> : (chain-decomposed) ( hash value -- newvalue ) [ - 2dup swap at + 2dup of [ (chain-decomposed) ] [ 1array nip ] ?if ] with map concat ; diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor index 4de4fc3679..eb84b110e8 100644 --- a/basis/xml/elements/elements.factor +++ b/basis/xml/elements/elements.factor @@ -63,12 +63,12 @@ IN: xml.elements dup { "1.0" "1.1" } member? [ bad-version ] unless ; : prolog-version ( alist -- version ) - T{ name { space "" } { main "version" } } swap at + T{ name { space "" } { main "version" } } of [ good-version ] [ versionless-prolog ] if* dup set-version ; : prolog-encoding ( alist -- encoding ) - T{ name { space "" } { main "encoding" } } swap at + T{ name { space "" } { main "encoding" } } of "UTF-8" or ; : yes/no>bool ( string -- t/f ) @@ -79,7 +79,7 @@ IN: xml.elements } case ; : prolog-standalone ( alist -- version ) - T{ name { space "" } { main "standalone" } } swap at + T{ name { space "" } { main "standalone" } } of [ yes/no>bool ] [ f ] if* ; : prolog-attrs ( alist -- prolog ) diff --git a/basis/xml/syntax/syntax.factor b/basis/xml/syntax/syntax.factor index 5d1e9a5947..8113ed7f74 100644 --- a/basis/xml/syntax/syntax.factor +++ b/basis/xml/syntax/syntax.factor @@ -72,7 +72,7 @@ SYNTAX: XML-NS: DEFER: interpolate-sequence : get-interpolated ( interpolated -- quot ) - var>> '[ [ _ swap at ] keep ] ; + var>> '[ [ _ of ] keep ] ; : ?present ( object -- string ) dup [ present ] when ; diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor index f4245e0e65..91d1ffaac4 100644 --- a/basis/xmode/marker/marker.factor +++ b/basis/xmode/marker/marker.factor @@ -311,7 +311,7 @@ M: mark-previous-rule handle-rule-start : tokenize-line ( line-context line rules -- line-context' seq ) [ - "MAIN" swap at -rot + "MAIN" of -rot init-token-marker mark-token-loop mark-remaining diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index 9212d6a363..c13efdcab2 100644 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -236,7 +236,7 @@ HELP: key? { $values { "key" object } { "assoc" assoc } { "?" boolean } } { $description "Tests if an assoc contains a key." } ; -{ at at* key? ?at } related-words +{ at at* key? ?at of ?of } related-words HELP: at { $values { "key" object } { "assoc" assoc } { "value/f" "the value associated to the key, or " { $link f } " if the key is not present in the assoc" } } @@ -246,6 +246,14 @@ HELP: ?at { $values { "key" object } { "assoc" assoc } { "value/key" "the value associated to the key, or the key if the key is not present in the assoc" } { "?" "a " { $link boolean } " indicating if the key was present" } } { $description "Looks up the value associated with a key. If the key was not present, an error can be thrown without extra stack shuffling. This word handles assocs that store " { $link f } "." } ; +HELP: of +{ $values { "assoc" assoc } { "key" object } { "value/f" "the value associated to the key, or " { $link f } " if the key is not present in the assoc" } } +{ $description "Looks up the value associated with a key. This word makes no distinction between a missing value and a value set to " { $link f } "; if the difference is important, use " { $link ?of } "." } ; + +HELP: ?of +{ $values { "assoc" assoc } { "key" object } { "value/key" "the value associated to the key, or the key if the key is not present in the assoc" } { "?" "a " { $link boolean } " indicating if the key was present" } } +{ $description "Looks up the value associated with a key. If the key was not present, an error can be thrown without extra stack shuffling. This word handles assocs that store " { $link f } "." } ; + HELP: assoc-each { $values { "assoc" assoc } { "quot" { $quotation "( ... key value -- ... )" } } } { $description "Applies a quotation to each entry in the assoc." } diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 6f296ab5b3..afd722b797 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -97,6 +97,12 @@ PRIVATE> : at ( key assoc -- value/f ) at* drop ; inline +: ?of ( assoc key -- value/key ? ) + swap ?at ; inline + +: of ( assoc key -- value/f ) + swap at ; inline + M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) [ dup assoc-size ] dip new-assoc [ [ set-at ] with-assoc assoc-each ] keep ; inline diff --git a/core/classes/classes.factor b/core/classes/classes.factor index eb5270864f..5aa0d97c24 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -198,7 +198,7 @@ GENERIC: metaclass-changed ( use class -- ) : (define-class) ( word props -- ) reset-caches - 2dup "metaclass" swap at check-metaclass + 2dup "metaclass" of check-metaclass { [ 2drop update-map- ] [ 2drop dup class? [ reset-class ] [ implementors-map+ ] if ] diff --git a/core/hashtables/hashtables-tests.factor b/core/hashtables/hashtables-tests.factor index 40ccfc4e9a..f9d5f7c174 100644 --- a/core/hashtables/hashtables-tests.factor +++ b/core/hashtables/hashtables-tests.factor @@ -177,4 +177,4 @@ H{ } "x" set [ 1 ] [ 2 "h" get at ] unit-test ! Random test case -[ "A" ] [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 swap at ] unit-test +[ "A" ] [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 of ] unit-test diff --git a/extra/asn1/asn1.factor b/extra/asn1/asn1.factor index ac43c94d0a..047f0133ff 100644 --- a/extra/asn1/asn1.factor +++ b/extra/asn1/asn1.factor @@ -100,10 +100,10 @@ TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ; : set-objtype ( syntax -- ) builtin-syntax 2array [ - elements get tagclass>> swap at - elements get encoding>> swap at + elements get tagclass>> of + elements get encoding>> of elements get tag>> - swap at [ + of [ elements get objtype<< ] when* ] each ; diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor index 8c8c97438c..21d0044c51 100644 --- a/extra/assocs/extras/extras.factor +++ b/extra/assocs/extras/extras.factor @@ -5,13 +5,11 @@ USING: arrays assocs assocs.private kernel math sequences ; IN: assocs.extras -: of ( assoc key -- value ) swap at ; inline - : assoc-harvest ( assoc -- assoc' ) [ nip empty? not ] assoc-filter ; inline : deep-at ( assoc seq -- value/f ) - [ swap at ] each ; inline + [ of ] each ; inline : zip-as ( keys values exemplar -- assoc ) dup sequence? [ diff --git a/extra/bit/ly/ly.factor b/extra/bit/ly/ly.factor index ff7395e8d0..f69eff34b0 100644 --- a/extra/bit/ly/ly.factor +++ b/extra/bit/ly/ly.factor @@ -8,8 +8,6 @@ SYMBOLS: bitly-api-user bitly-api-key ; ( path -- url ) "http://api.bitly.com/v3/" prepend >url bitly-api-user get "login" set-query-param @@ -25,7 +23,7 @@ ERROR: bad-response json status ; ] unless ; : json-data ( url -- json ) - http-get nip json> check-status "data" swap at ; + http-get nip json> check-status "data" of ; : get-short-url ( short-url path -- data ) swap "shortUrl" set-query-param json-data ; diff --git a/extra/bitcoin/client/client.factor b/extra/bitcoin/client/client.factor index b3413d6b3e..88926b0912 100644 --- a/extra/bitcoin/client/client.factor +++ b/extra/bitcoin/client/client.factor @@ -64,7 +64,7 @@ IN: bitcoin.client payload bitcoin-url basic-auth "Authorization" set-header dup post-data>> data>> length "Content-Length" set-header - http-request nip >string json> "result" swap at ; + http-request nip >string json> "result" of ; PRIVATE> diff --git a/extra/bson/constants/constants.factor b/extra/bson/constants/constants.factor index 359a393516..bd930beac1 100644 --- a/extra/bson/constants/constants.factor +++ b/extra/bson/constants/constants.factor @@ -42,7 +42,7 @@ CONSTRUCTOR: dbref ( ref id -- dbref ) ; } 2cleave ; inline : assoc>dbref ( assoc -- dbref ) - [ "$ref" swap at ] [ "$id" swap at ] [ "$db" swap at ] tri + [ "$ref" of ] [ "$id" of ] [ "$db" of ] tri dbref boa ; inline : dbref-assoc? ( assoc -- ? ) diff --git a/extra/couchdb/couchdb-tests.factor b/extra/couchdb/couchdb-tests.factor index d7161a14cd..9573710334 100644 --- a/extra/couchdb/couchdb-tests.factor +++ b/extra/couchdb/couchdb-tests.factor @@ -14,7 +14,7 @@ IN: couchdb.tests [ couch get delete-db ] must-fail [ ] [ couch get ensure-db ] unit-test [ ] [ couch get ensure-db ] unit-test - [ 0 ] [ couch get db-info "doc_count" swap at ] unit-test + [ 0 ] [ couch get db-info "doc_count" of ] unit-test [ ] [ couch get compact-db ] unit-test [ t ] [ couch get server>> next-uuid string? ] unit-test [ ] [ H{ @@ -25,13 +25,13 @@ IN: couchdb.tests { "Author" "Rusty" } { "PostedDate" "2006-08-15T17:30:12Z-04:00" } } save-doc ] unit-test - [ t ] [ couch get all-docs "rows" swap at first "id" swap at dup "id" set string? ] unit-test + [ t ] [ couch get all-docs "rows" of first "id" of dup "id" set string? ] unit-test [ t ] [ "id" get dup load-doc id> = ] unit-test [ ] [ "id" get load-doc save-doc ] unit-test - [ "Rusty" ] [ "id" get load-doc "Author" swap at ] unit-test + [ "Rusty" ] [ "id" get load-doc "Author" of ] unit-test [ ] [ "id" get load-doc "Alex" "Author" pick set-at save-doc ] unit-test - [ "Alex" ] [ "id" get load-doc "Author" swap at ] unit-test - [ 1 ] [ "function(doc) { emit(null, doc) }" temp-view-map "total_rows" swap at ] unit-test + [ "Alex" ] [ "id" get load-doc "Author" of ] unit-test + [ 1 ] [ "function(doc) { emit(null, doc) }" temp-view-map "total_rows" of ] unit-test [ ] [ H{ { "_id" "_design/posts" } { "language" "javascript" } diff --git a/extra/couchdb/couchdb.factor b/extra/couchdb/couchdb.factor index 5665246246..ca1f8306c2 100644 --- a/extra/couchdb/couchdb.factor +++ b/extra/couchdb/couchdb.factor @@ -21,10 +21,10 @@ C: couchdb-error M: couchdb-error error. ( error -- ) "CouchDB Error: " write data>> "error" over at [ print ] when* - "reason" swap at [ print ] when* ; + "reason" of [ print ] when* ; PREDICATE: file-exists-error < couchdb-error - data>> "error" swap at "file_exists" = ; + data>> "error" of "file_exists" = ; ! http tools : couch-http-request ( request -- data ) @@ -83,7 +83,7 @@ CONSTANT: default-uuids-to-cache 100 [ dup server-url % "_uuids?count=" % uuids-to-cache>> number>string % ] "" make ; : uuids-get ( server -- uuids ) - uuids-url couch-get "uuids" swap at >vector ; + uuids-url couch-get "uuids" of >vector ; : get-uuids ( server -- server ) dup uuids-get [ nip ] curry change-uuids ; @@ -129,11 +129,11 @@ C: db >json utf8 encode "application/json" swap >>data ; ! documents -: id> ( assoc -- id ) "_id" swap at ; +: id> ( assoc -- id ) "_id" of ; : >id ( assoc id -- assoc ) "_id" pick set-at ; -: rev> ( assoc -- rev ) "_rev" swap at ; +: rev> ( assoc -- rev ) "_rev" of ; : >rev ( assoc rev -- assoc ) "_rev" pick set-at ; -: attachments> ( assoc -- attachments ) "_attachments" swap at ; +: attachments> ( assoc -- attachments ) "_attachments" of ; : >attachments ( assoc attachments -- assoc ) "_attachments" pick set-at ; :: copy-key ( to from to-key from-key -- ) @@ -174,8 +174,8 @@ C: db : delete-doc ( assoc -- deletion-revision ) [ [ doc-url % ] - [ "?rev=" % "_rev" swap at % ] bi - ] "" make couch-delete response-ok "rev" swap at ; + [ "?rev=" % "_rev" of % ] bi + ] "" make couch-delete response-ok "rev" of ; : remove-keys ( assoc keys -- ) swap [ delete-at ] curry each ; diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor index eeec3b260c..a88fd23067 100644 --- a/extra/fuel/xref/xref.factor +++ b/extra/fuel/xref/xref.factor @@ -60,7 +60,7 @@ PRIVATE> : vocab-usage-xref ( vocab -- seq ) vocab-usage [ vocab>xref ] map ; -: doc-location ( word -- loc ) props>> "help-loc" swap at get-loc ; +: doc-location ( word -- loc ) props>> "help-loc" of get-loc ; : article-location ( name -- loc ) lookup-article loc>> get-loc ; diff --git a/extra/google/translate/translate.factor b/extra/google/translate/translate.factor index c5354804f1..ed559d0c94 100644 --- a/extra/google/translate/translate.factor +++ b/extra/google/translate/translate.factor @@ -31,8 +31,8 @@ ERROR: response-error response error ; : query-response>text ( response -- text ) json> check-response - "responseData" swap at - "translatedText" swap at ; + "responseData" of + "translatedText" of ; : (translate) ( text from to -- text' ) parameters>assoc diff --git a/extra/hacker-news/hacker-news.factor b/extra/hacker-news/hacker-news.factor index 9472fab23f..e7faaccf38 100644 --- a/extra/hacker-news/hacker-news.factor +++ b/extra/hacker-news/hacker-news.factor @@ -26,7 +26,7 @@ TUPLE: post title postedBy points id url commentCount postedAgo ; : hacker-news-items ( -- seq ) "http://api.ihackernews.com/page" http-get nip - json> "items" swap at items> ; + json> "items" of items> ; : write-title ( title url -- ) '[ diff --git a/extra/io/streams/256color/256color.factor b/extra/io/streams/256color/256color.factor index d157dee2d1..0d7b13a41a 100644 --- a/extra/io/streams/256color/256color.factor +++ b/extra/io/streams/256color/256color.factor @@ -84,9 +84,9 @@ M: 256color stream-nl stream>> stream-nl ; M: 256color stream-format [ - [ foreground swap at [ color>foreground ] [ "" ] if* ] - [ background swap at [ color>background ] [ "" ] if* ] - [ font-style swap at [ font-styles ] [ "" ] if* ] + [ foreground of [ color>foreground ] [ "" ] if* ] + [ background of [ color>background ] [ "" ] if* ] + [ font-style of [ font-styles ] [ "" ] if* ] tri 3append [ "\e[0m" surround ] unless-empty ] dip stream>> stream-write ; diff --git a/extra/irc/client/internals/internals-tests.factor b/extra/irc/client/internals/internals-tests.factor index be1e94cd70..43c9a6ad76 100644 --- a/extra/irc/client/internals/internals-tests.factor +++ b/extra/irc/client/internals/internals-tests.factor @@ -223,7 +223,7 @@ M: mb-writer dispose drop ; "#factortest" [ %add-named-chat ] keep "ircuser" over join-participant ":ircserver.net MODE #factortest +o ircuser" %push-line - participants>> "ircuser" swap at + participants>> "ircuser" of ] unit-test ] spawning-irc diff --git a/extra/mongodb/connection/connection.factor b/extra/mongodb/connection/connection.factor index d2b8f0b611..4cc72f1e50 100644 --- a/extra/mongodb/connection/connection.factor +++ b/extra/mongodb/connection/connection.factor @@ -32,10 +32,10 @@ CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ; mdb-db new swap >>nodes swap >>name H{ } clone >>collections ; : master-node ( mdb -- node ) - nodes>> t swap at ; + nodes>> t of ; : slave-node ( mdb -- node ) - nodes>> f swap at ; + nodes>> f of ; : with-connection ( connection quot -- * ) [ mdb-connection ] dip with-variable ; inline @@ -74,7 +74,7 @@ CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ; : get-nonce ( -- nonce ) getnonce-cmd make-cmd send-cmd - [ "nonce" swap at ] [ f ] if* ; + [ "nonce" of ] [ f ] if* ; : auth? ( mdb -- ? ) [ username>> ] [ pwd-digest>> ] bi and ; diff --git a/extra/mongodb/driver/driver.factor b/extra/mongodb/driver/driver.factor index 8f425414b8..e5460760ff 100644 --- a/extra/mongodb/driver/driver.factor +++ b/extra/mongodb/driver/driver.factor @@ -105,7 +105,7 @@ SYNTAX: r/ [ mdb-pool get ] dip with-mdb-pool ; inline : >id-selector ( assoc -- selector ) - [ MDB_OID_FIELD swap at ] keep + [ MDB_OID_FIELD of ] keep H{ } clone [ set-at ] keep ; : ( db host port -- mdb ) diff --git a/extra/oauth/oauth-tests.factor b/extra/oauth/oauth-tests.factor index 4f4907e439..9e3d349623 100644 --- a/extra/oauth/oauth-tests.factor +++ b/extra/oauth/oauth-tests.factor @@ -21,6 +21,6 @@ IN: oauth.tests 54321 >>nonce post-data>> - "oauth_signature" swap at + "oauth_signature" of >string ] unit-test diff --git a/extra/pdf/canvas/canvas.factor b/extra/pdf/canvas/canvas.factor index c3d9d9a88c..61afb3be56 100644 --- a/extra/pdf/canvas/canvas.factor +++ b/extra/pdf/canvas/canvas.factor @@ -31,7 +31,7 @@ foreground background page-color inset line-height metrics ; : set-style ( canvas style -- canvas ) { [ - font-name swap at "sans-serif" or { + font-name of "sans-serif" or { { "sans-serif" [ "Helvetica" ] } { "serif" [ "Times" ] } { "monospace" [ "Courier" ] } @@ -39,21 +39,21 @@ foreground background page-color inset line-height metrics ; } case [ dup font>> ] dip >>name drop ] [ - font-size swap at 12 or + font-size of 12 or [ dup font>> ] dip >>size drop ] [ - font-style swap at [ dup font>> ] dip { + font-style of [ dup font>> ] dip { { bold [ t f ] } { italic [ f t ] } { bold-italic [ t t ] } [ drop f f ] } case [ >>bold? ] [ >>italic? ] bi* drop ] - [ foreground swap at COLOR: black or >>foreground ] - [ background swap at f or >>background ] - [ page-color swap at f or >>page-color ] - [ inset swap at { 0 0 } or >>inset ] + [ foreground of COLOR: black or >>foreground ] + [ background of f or >>background ] + [ page-color of f or >>page-color ] + [ inset of { 0 0 } or >>inset ] } cleave dup font>> font-metrics [ >>metrics ] [ height>> '[ _ max ] change-line-height ] bi ; diff --git a/extra/quadtrees/quadtrees-tests.factor b/extra/quadtrees/quadtrees-tests.factor index 993389a4b4..f44a7b9df4 100644 --- a/extra/quadtrees/quadtrees-tests.factor +++ b/extra/quadtrees/quadtrees-tests.factor @@ -61,17 +61,17 @@ IN: quadtrees.tests "c" { -0.5 -0.75 } value>>key "d" { 0.75 0.25 } value>>key - { 0.25 0.25 } swap at* + { 0.25 0.25 } ?of ] unit-test -[ f f ] [ +[ { 1.0 1.0 } f ] [ unit-bounds "a" { 0.0 -0.25 } value>>key "b" { 0.25 0.25 } value>>key "c" { -0.5 -0.75 } value>>key "d" { 0.75 0.25 } value>>key - { 1.0 1.0 } swap at* + { 1.0 1.0 } ?of ] unit-test [ { "a" "c" } ] [ diff --git a/extra/reddit/reddit.factor b/extra/reddit/reddit.factor index 0955a23de1..ec712719a5 100644 --- a/extra/reddit/reddit.factor +++ b/extra/reddit/reddit.factor @@ -30,7 +30,7 @@ display_name id header_img header_size header_title name over18 public_description subscribers title url ; : parse-data ( assoc -- obj ) - [ "data" swap at ] [ "kind" swap at ] bi { + [ "data" of ] [ "kind" of ] bi { { "t1" [ comment ] } { "t2" [ user ] } { "t3" [ story ] } @@ -41,10 +41,10 @@ public_description subscribers title url ; TUPLE: page url data before after ; : json-page ( url -- page ) - >url dup http-get nip json> "data" swap at { - [ "children" swap at [ parse-data ] map ] - [ "before" swap at [ f ] when-json-null ] - [ "after" swap at [ f ] when-json-null ] + >url dup http-get nip json> "data" of { + [ "children" of [ parse-data ] map ] + [ "before" of [ f ] when-json-null ] + [ "after" of [ f ] when-json-null ] } cleave \ page boa ; : get-user ( username -- page ) diff --git a/extra/trees/avl/avl-tests.factor b/extra/trees/avl/avl-tests.factor index 41a6310a64..5ba25b9568 100644 --- a/extra/trees/avl/avl-tests.factor +++ b/extra/trees/avl/avl-tests.factor @@ -88,7 +88,7 @@ IN: trees.avl.tests [ "another eight" ] [ ! ERROR! "seven" 7 pick set-at - "another eight" 8 pick set-at 8 swap at + "another eight" 8 pick set-at 8 of ] unit-test : test-tree ( -- tree ) @@ -102,16 +102,16 @@ IN: trees.avl.tests ! test set-at, at, at* [ t ] [ test-tree avl? ] unit-test -[ "seven" ] [ "seven" 7 pick set-at 7 swap at ] unit-test -[ "seven" t ] [ "seven" 7 pick set-at 7 swap at* ] unit-test -[ f f ] [ "seven" 7 pick set-at 8 swap at* ] unit-test -[ "seven" ] [ "seven" 7 pick set-at 7 swap at ] unit-test -[ "replacement" ] [ "seven" 7 pick set-at "replacement" 7 pick set-at 7 swap at ] unit-test -[ "nine" ] [ test-tree 9 swap at ] unit-test -[ "replaced four" ] [ test-tree 4 swap at ] unit-test -[ "replaced seven" ] [ test-tree 7 swap at ] unit-test +[ "seven" ] [ "seven" 7 pick set-at 7 of ] unit-test +[ "seven" t ] [ "seven" 7 pick set-at 7 ?of ] unit-test +[ 8 f ] [ "seven" 7 pick set-at 8 ?of ] unit-test +[ "seven" ] [ "seven" 7 pick set-at 7 of ] unit-test +[ "replacement" ] [ "seven" 7 pick set-at "replacement" 7 pick set-at 7 of ] unit-test +[ "nine" ] [ test-tree 9 of ] unit-test +[ "replaced four" ] [ test-tree 4 of ] unit-test +[ "replaced seven" ] [ test-tree 7 of ] unit-test ! test delete-at--all errors! -[ f ] [ test-tree 9 over delete-at 9 swap at ] unit-test -[ "replaced seven" ] [ test-tree 9 over delete-at 7 swap at ] unit-test -[ "nine" ] [ test-tree 7 over delete-at 4 over delete-at 9 swap at ] unit-test +[ f ] [ test-tree 9 over delete-at 9 of ] unit-test +[ "replaced seven" ] [ test-tree 9 over delete-at 7 of ] unit-test +[ "nine" ] [ test-tree 7 over delete-at 4 over delete-at 9 of ] unit-test diff --git a/extra/trees/splay/splay-tests.factor b/extra/trees/splay/splay-tests.factor index 957b8738ea..deabe23973 100644 --- a/extra/trees/splay/splay-tests.factor +++ b/extra/trees/splay/splay-tests.factor @@ -5,7 +5,7 @@ sequences random sets make grouping ; IN: trees.splay.tests : randomize-numeric-splay-tree ( splay-tree -- ) - 100 iota [ drop 100 random swap at drop ] with each ; + 100 iota [ drop 100 random of drop ] with each ; : make-numeric-splay-tree ( n -- splay-tree ) iota [ [ conjoin ] curry each ] keep ; @@ -18,7 +18,7 @@ IN: trees.splay.tests [ 10 ] [ 10 make-numeric-splay-tree keys length ] unit-test [ 10 ] [ 10 make-numeric-splay-tree values length ] unit-test -[ f ] [ f 4 pick set-at 4 swap at ] unit-test +[ f ] [ f 4 pick set-at 4 of ] unit-test ! Ensure that f can be a value [ t ] [ f 4 pick set-at 4 swap key? ] unit-test diff --git a/extra/trees/trees-tests.factor b/extra/trees/trees-tests.factor index 99d3734b3e..d5211ce77e 100644 --- a/extra/trees/trees-tests.factor +++ b/extra/trees/trees-tests.factor @@ -11,17 +11,17 @@ IN: trees.tests } clone ; ! test set-at, at, at* -[ "seven" ] [ "seven" 7 pick set-at 7 swap at ] unit-test -[ "seven" t ] [ "seven" 7 pick set-at 7 swap at* ] unit-test -[ f f ] [ "seven" 7 pick set-at 8 swap at* ] unit-test -[ "seven" ] [ "seven" 7 pick set-at 7 swap at ] unit-test -[ "replacement" ] [ "seven" 7 pick set-at "replacement" 7 pick set-at 7 swap at ] unit-test -[ "replaced four" ] [ test-tree 4 swap at ] unit-test -[ "nine" ] [ test-tree 9 swap at ] unit-test +[ "seven" ] [ "seven" 7 pick set-at 7 of ] unit-test +[ "seven" t ] [ "seven" 7 pick set-at 7 ?of ] unit-test +[ 8 f ] [ "seven" 7 pick set-at 8 ?of ] unit-test +[ "seven" ] [ "seven" 7 pick set-at 7 of ] unit-test +[ "replacement" ] [ "seven" 7 pick set-at "replacement" 7 pick set-at 7 of ] unit-test +[ "replaced four" ] [ test-tree 4 of ] unit-test +[ "nine" ] [ test-tree 9 of ] unit-test ! test delete-at -[ f ] [ test-tree 9 over delete-at 9 swap at ] unit-test -[ "replaced seven" ] [ test-tree 9 over delete-at 7 swap at ] unit-test -[ "replaced four" ] [ test-tree 9 over delete-at 4 swap at ] unit-test +[ f ] [ test-tree 9 over delete-at 9 of ] unit-test +[ "replaced seven" ] [ test-tree 9 over delete-at 7 of ] unit-test +[ "replaced four" ] [ test-tree 9 over delete-at 4 of ] unit-test [ "nine" "replaced four" ] [ test-tree 7 over delete-at 9 over at 4 rot at ] unit-test -[ "nine" ] [ test-tree 7 over delete-at 4 over delete-at 9 swap at ] unit-test +[ "nine" ] [ test-tree 7 over delete-at 4 over delete-at 9 of ] unit-test diff --git a/extra/twitter/twitter.factor b/extra/twitter/twitter.factor index 658aae32c6..92c5e37d77 100644 --- a/extra/twitter/twitter.factor +++ b/extra/twitter/twitter.factor @@ -50,7 +50,7 @@ PRIVATE> ! Utilities MACRO: keys-boa ( keys class -- ) - [ [ '[ _ swap at ] ] map ] dip '[ _ cleave _ boa ] ; + [ [ '[ _ of ] ] map ] dip '[ _ cleave _ boa ] ; ! Twitter requests : status-url ( string -- url )