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

assocs: Add of and ?of. Change all the things at once! Fixes #701.

db4
Doug Coleman 2013-03-23 14:35:01 -07:00
parent ccb46e62d4
commit 8c19602ae9
48 changed files with 145 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/classes/struct/struct-tests.factor
View File

@ -65,13 +65,13 @@ STRUCT: struct-test-bar
make-mirror >alist make-mirror >alist
] unit-test ] unit-test
[ 55 t ] [ S{ struct-test-foo { x 55 } } make-mirror { "x" "char" } 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" } swap at* ] 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" } swap at* ] 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" } swap at* ] unit-test [ f t ] [ S{ struct-test-foo { z f } } make-mirror { "z" "bool" } ?of ] unit-test
[ f f ] [ S{ struct-test-foo } make-mirror { "nonexist" "bool" } swap at* ] unit-test [ { "nonexist" "bool" } f ] [ S{ struct-test-foo } make-mirror { "nonexist" "bool" } ?of ] unit-test
[ f f ] [ S{ struct-test-foo } make-mirror "nonexist" swap at* ] 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" swap at* ] 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 3 } { y 2 } { z f } } ] [
S{ struct-test-foo { x 1 } { y 2 } { z f } } S{ struct-test-foo { x 1 } { y 2 } { z f } }

2
basis/compiler/tree/propagation/branches/branches.factor
View File

@ -95,7 +95,7 @@ M: #phi propagate-before ( #phi -- )
new [| key value | key old [ value union ] change-at ] assoc-each ; new [| key value | key old [ value union ] change-at ] assoc-each ;
: include-child-constraints ( i -- ) : 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 ; constraints get last update-constraints ;
: branch-phi-constraints ( output values booleans -- ) : branch-phi-constraints ( output values booleans -- )

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

@ -45,9 +45,9 @@ TUPLE: couchdb-auth-provider
make-mirror H{ } assoc-like ; make-mirror H{ } assoc-like ;
: is-couchdb-conflict-error? ( error -- ? ) : 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 -- ? ) : 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' ) : get-url ( url -- url' )
couchdb-auth-provider get couchdb-auth-provider get
@ -73,15 +73,15 @@ TUPLE: couchdb-auth-provider
over [ (reserve) ] [ 2drop t ] if ; over [ (reserve) ] [ 2drop t ] if ;
: unreserve ( couch-rval -- ) : unreserve ( couch-rval -- )
[ "id" swap at get-url ] [ "id" of get-url ]
[ "rev" swap at "rev" set-query-param ] [ "rev" of "rev" set-query-param ]
bi bi
couch-delete drop ; couch-delete drop ;
: unreserve-from-id ( id -- ) : unreserve-from-id ( id -- )
[ [
get-url dup couch-get get-url dup couch-get
"_rev" swap at "rev" set-query-param "_rev" of "rev" set-query-param
couch-delete drop couch-delete drop
] [ ] [
dup is-couchdb-not-found-error? [ 2drop ] [ rethrow ] if dup is-couchdb-not-found-error? [ 2drop ] [ rethrow ] if
@ -110,7 +110,7 @@ TUPLE: couchdb-auth-provider
! Should be given a view URL. ! Should be given a view URL.
: ((get-user)) ( couchdb-url -- user/f ) : ((get-user)) ( couchdb-url -- user/f )
couch-get 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 ) : (get-user) ( username -- user/f )
couchdb-auth-provider get couchdb-auth-provider get
@ -171,8 +171,8 @@ TUPLE: couchdb-auth-provider
: unify-users ( old new -- new ) : unify-users ( old new -- new )
swap swap
[ "_rev" swap at "_rev" rot set-at ] [ "_rev" of "_rev" rot set-at ]
[ "_id" swap at "_id" rot set-at ] [ "_id" of "_id" rot set-at ]
[ swap assoc-union ] [ swap assoc-union ]
2tri ; 2tri ;
@ -182,15 +182,15 @@ TUPLE: couchdb-auth-provider
! (This word is called by the 'update-user' method.) ! (This word is called by the 'update-user' method.)
: check-update ( old new -- ? ) : check-update ( old new -- ? )
[ [
2dup [ "email" swap at ] same? not [ 2dup [ "email" of ] same? not [
[ "email" swap at ] bi@ [ "email" of ] bi@
[ drop "email" reservation-id unreserve-from-id ] [ drop "email" reservation-id unreserve-from-id ]
[ nip "email" reserve ] [ nip "email" reserve ]
2bi 2bi
] [ 2drop t ] if ] [ 2drop t ] if
] [ ] [
2dup [ "username" swap at ] same? not [ 2dup [ "username" of ] same? not [
[ "username" swap at ] bi@ [ "username" of ] bi@
[ drop "username" reservation-id unreserve-from-id ] [ drop "username" reservation-id unreserve-from-id ]
[ nip "username" reserve ] [ nip "username" reserve ]
2bi 2bi
@ -217,7 +217,7 @@ M: couchdb-auth-provider new-user ( user provider -- user/f )
M: couchdb-auth-provider update-user ( user provider -- ) M: couchdb-auth-provider update-user ( user provider -- )
couchdb-auth-provider [ couchdb-auth-provider [
[ username>> (get-user)/throw-on-no-user dup ] [ username>> (get-user)/throw-on-no-user dup ]
[ drop "_id" swap at get-url ] [ drop "_id" of get-url ]
[ user>user-hash swapd [ user>user-hash swapd
2dup check-update drop 2dup check-update drop
unify-users >json swap couch-put drop unify-users >json swap couch-put drop

2
basis/hashtables/identity/identity-tests.factor
View File

@ -11,7 +11,7 @@ CONSTANT: will
} }
: please-stand-up ( assoc key -- value ) : please-stand-up ( assoc key -- value )
swap at ; of ;
[ t ] [ will the-real-slim-shady please-stand-up ] unit-test [ t ] [ will the-real-slim-shady please-stand-up ] unit-test
[ t ] [ will clone the-real-slim-shady please-stand-up ] unit-test [ t ] [ will clone the-real-slim-shady please-stand-up ] unit-test

2
basis/hashtables/sequences/sequences-tests.factor
View File

@ -15,7 +15,7 @@ IN: hashtables.identity.tests
[ 1001 ] [ [ 1001 ] [
SH{ } clone 1001 0 4 "asdf" <slice> pick set-at SH{ } clone 1001 0 4 "asdf" <slice> pick set-at
"asdf" swap at "asdf" of
] unit-test ] unit-test
[ { { "asdf" 1000 } } ] [ SH{ { "asdf" 1000 } } >alist ] unit-test [ { { "asdf" 1000 } } ] [ SH{ { "asdf" 1000 } } >alist ] unit-test

10
basis/html/streams/streams.factor
View File

@ -29,10 +29,10 @@ TUPLE: html-sub-stream < html-writer style parent ;
[ data>> ] [ style>> ] [ parent>> ] tri ; [ data>> ] [ style>> ] [ parent>> ] tri ;
: object-link-tag ( xml style -- xml ) : 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-link-tag ( xml style -- xml )
href swap at [ simple-link ] when* ; href of [ simple-link ] when* ;
: hex-color, ( color -- ) : hex-color, ( color -- )
[ red>> ] [ green>> ] [ blue>> ] tri [ red>> ] [ green>> ] [ blue>> ] tri
@ -58,7 +58,7 @@ TUPLE: html-sub-stream < html-writer style parent ;
"font-family: " % % "; " % ; "font-family: " % % "; " % ;
MACRO: make-css ( pairs -- str ) MACRO: make-css ( pairs -- str )
[ '[ _ swap at [ _ execute ] when* ] ] { } assoc>map [ '[ _ of [ _ execute ] when* ] ] { } assoc>map
'[ [ _ cleave ] "" make ] ; '[ [ _ cleave ] "" make ] ;
: span-css-style ( style -- str ) : span-css-style ( style -- str )
@ -81,7 +81,7 @@ MACRO: make-css ( pairs -- str )
"vocab:definitions/icons/" ?head [ "/icons/" prepend ] when ; "vocab:definitions/icons/" ?head [ "/icons/" prepend ] when ;
: img-tag ( xml style -- xml ) : 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 -- ) : format-html-span ( string style stream -- )
[ [
@ -113,7 +113,7 @@ CONSTANT: pre-css "white-space: pre; font-family: monospace;"
{ border-color border-css, } { border-color border-css, }
{ inset padding-css, } { inset padding-css, }
} make-css } make-css
] [ wrap-margin swap at [ pre-css append ] unless ] bi ] [ wrap-margin of [ pre-css append ] unless ] bi
" display: inline-block;" append ; " display: inline-block;" append ;
: div-tag ( xml style -- xml' ) : div-tag ( xml style -- xml' )

2
basis/http/http.factor
View File

@ -222,5 +222,5 @@ TUPLE: post-data data params content-type content-encoding ;
: parse-content-type ( content-type -- type encoding ) : parse-content-type ( content-type -- type encoding )
";" split1 ";" split1
parse-content-type-attributes "charset" swap at parse-content-type-attributes "charset" of
[ dup mime-type-encoding encoding>name ] unless* ; [ dup mime-type-encoding encoding>name ] unless* ;

4
basis/io/launcher/windows/windows-tests.factor
View File

@ -173,7 +173,7 @@ IN: io.launcher.windows.tests
ascii <process-reader> stream-contents ascii <process-reader> stream-contents
] with-directory eval( -- alist ) ] with-directory eval( -- alist )
"A" swap at "A" of
] unit-test ] unit-test
[ f ] [ [ f ] [
@ -185,7 +185,7 @@ IN: io.launcher.windows.tests
ascii <process-reader> stream-contents ascii <process-reader> stream-contents
] with-directory eval( -- alist ) ] with-directory eval( -- alist )
"USERPROFILE" swap at "XXX" = "USERPROFILE" of "XXX" =
] unit-test ] unit-test
2 [ 2 [

2
basis/linked-assocs/linked-assocs-tests.factor
View File

@ -14,7 +14,7 @@ IN: linked-assocs.test
<linked-hash> 1 "b" pick set-at <linked-hash> 1 "b" pick set-at
2 "c" pick set-at 2 "c" pick set-at
3 "a" pick set-at 3 "a" pick set-at
"c" swap at* "c" ?of
] unit-test ] unit-test
{ { 2 3 4 } { "c" "a" "d" } 3 } [ { { 2 3 4 } { "c" "a" "d" } 3 } [

2
basis/math/statistics/statistics-tests.factor
View File

@ -103,7 +103,7 @@ IN: math.statistics.tests
V{ 2 5 8 } V{ 2 5 8 }
} [ } [
10 iota [ 3 mod ] collect-by 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 ] unit-test
[ 0 ] [ { 1 } { 1 } sample-cov ] unit-test [ 0 ] [ { 1 } { 1 } sample-cov ] unit-test

2
basis/mime/multipart/multipart-tests.factor
View File

@ -32,7 +32,7 @@ IN: mime.multipart.tests
[ t ] [ [ t ] [
mime-test-stream [ upload-separator parse-multipart ] with-input-stream mime-test-stream [ upload-separator parse-multipart ] with-input-stream
"file1" swap at filename>> "up.txt" = "file1" of filename>> "up.txt" =
] unit-test ] unit-test
SYMBOL: mime-test-server SYMBOL: mime-test-server

2
basis/mime/multipart/multipart.factor
View File

@ -81,7 +81,7 @@ ERROR: end-of-stream multipart ;
drop drop
] [ ] [
[ [ header>> ] [ filename>> ] [ temp-file>> ] tri mime-file boa ] [ [ header>> ] [ filename>> ] [ temp-file>> ] tri mime-file boa ]
[ content-disposition>> "name" swap at unquote ] [ content-disposition>> "name" of unquote ]
[ mime-parts>> set-at ] tri [ mime-parts>> set-at ] tri
] if ; ] if ;

4
basis/peg/ebnf/ebnf.factor
View File

@ -555,14 +555,14 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
'ebnf' (parse) check-parse-result ast>> transform ; 'ebnf' (parse) check-parse-result ast>> transform ;
: ebnf>quot ( string -- hashtable quot ) : 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 ; [ compiled-parse ] curry [ with-scope ast>> ] curry ;
PRIVATE> PRIVATE>
SYNTAX: <EBNF SYNTAX: <EBNF
"EBNF>" "EBNF>"
reset-tokenizer parse-multiline-string parse-ebnf main swap at reset-tokenizer parse-multiline-string parse-ebnf main of
suffix! reset-tokenizer ; suffix! reset-tokenizer ;
SYNTAX: [EBNF SYNTAX: [EBNF

2
basis/stack-checker/branches/branches.factor
View File

@ -78,7 +78,7 @@ SYMBOLS: combinator quotations ;
terminated? branch-variable ; terminated? branch-variable ;
: terminate-branches ( seq -- ) : terminate-branches ( seq -- )
[ terminated? swap at ] all? [ terminate ] when ; [ terminated? of ] all? [ terminate ] when ;
: compute-phi-function ( seq -- ) : compute-phi-function ( seq -- )
[ quotation active-variable sift quotations set ] [ quotation active-variable sift quotations set ]

2
basis/tools/walker/debug/debug.factor
View File

@ -26,5 +26,5 @@ IN: tools.walker.debug
send-synchronous drop send-synchronous drop
p ?promise p ?promise
variables>> walker-continuation swap at variables>> walker-continuation of
value>> data>> ; value>> data>> ;

4
basis/tools/walker/walker.factor
View File

@ -23,8 +23,8 @@ DEFER: start-walker-thread
: get-walker-thread ( -- status continuation thread ) : get-walker-thread ( -- status continuation thread )
walker-thread tget [ walker-thread tget [
[ variables>> walker-status swap at ] [ variables>> walker-status of ]
[ variables>> walker-continuation swap at ] [ variables>> walker-continuation of ]
[ ] tri [ ] tri
] [ ] [
f <model> f <model>

10
basis/ui/gadgets/panes/panes.factor
View File

@ -199,9 +199,9 @@ MEMO: specified-font ( assoc -- font )
#! We memoize here to avoid creating lots of duplicate font objects. #! We memoize here to avoid creating lots of duplicate font objects.
[ monospace-font <font> ] dip [ monospace-font <font> ] dip
{ {
[ font-name swap at >>name ] [ font-name of >>name ]
[ [
font-style swap at { font-style of {
{ f [ ] } { f [ ] }
{ plain [ ] } { plain [ ] }
{ bold [ t >>bold? ] } { bold [ t >>bold? ] }
@ -209,9 +209,9 @@ MEMO: specified-font ( assoc -- font )
{ bold-italic [ t >>bold? t >>italic? ] } { bold-italic [ t >>bold? t >>italic? ] }
} case } case
] ]
[ font-size swap at >>size ] [ font-size of >>size ]
[ foreground swap at >>foreground ] [ foreground of >>foreground ]
[ background swap at >>background ] [ background of >>background ]
} cleave } cleave
derive-font ; derive-font ;

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

@ -31,7 +31,7 @@ TUPLE: weight primary secondary tertiary ignorable? ;
: help-one ( assoc key -- ) : help-one ( assoc key -- )
! Need to be more general? Not for DUCET, apparently ! Need to be more general? Not for DUCET, apparently
2 head 2dup swap key? [ 2drop ] [ 2 head 2dup swap key? [ 2drop ] [
[ [ 1string swap at ] with { } map-as concat ] [ [ 1string of ] with { } map-as concat ]
[ swap set-at ] 2bi [ swap set-at ] 2bi
] if ; ] if ;

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

@ -92,7 +92,7 @@ PRIVATE>
: (chain-decomposed) ( hash value -- newvalue ) : (chain-decomposed) ( hash value -- newvalue )
[ [
2dup swap at 2dup of
[ (chain-decomposed) ] [ 1array nip ] ?if [ (chain-decomposed) ] [ 1array nip ] ?if
] with map concat ; ] with map concat ;

6
basis/xml/elements/elements.factor
View File

@ -63,12 +63,12 @@ IN: xml.elements
dup { "1.0" "1.1" } member? [ bad-version ] unless ; dup { "1.0" "1.1" } member? [ bad-version ] unless ;
: prolog-version ( alist -- version ) : prolog-version ( alist -- version )
T{ name { space "" } { main "version" } } swap at T{ name { space "" } { main "version" } } of
[ good-version ] [ versionless-prolog ] if* [ good-version ] [ versionless-prolog ] if*
dup set-version ; dup set-version ;
: prolog-encoding ( alist -- encoding ) : prolog-encoding ( alist -- encoding )
T{ name { space "" } { main "encoding" } } swap at T{ name { space "" } { main "encoding" } } of
"UTF-8" or ; "UTF-8" or ;
: yes/no>bool ( string -- t/f ) : yes/no>bool ( string -- t/f )
@ -79,7 +79,7 @@ IN: xml.elements
} case ; } case ;
: prolog-standalone ( alist -- version ) : prolog-standalone ( alist -- version )
T{ name { space "" } { main "standalone" } } swap at T{ name { space "" } { main "standalone" } } of
[ yes/no>bool ] [ f ] if* ; [ yes/no>bool ] [ f ] if* ;
: prolog-attrs ( alist -- prolog ) : prolog-attrs ( alist -- prolog )

2
basis/xml/syntax/syntax.factor
View File

@ -72,7 +72,7 @@ SYNTAX: XML-NS:
DEFER: interpolate-sequence DEFER: interpolate-sequence
: get-interpolated ( interpolated -- quot ) : get-interpolated ( interpolated -- quot )
var>> '[ [ _ swap at ] keep ] ; var>> '[ [ _ of ] keep ] ;
: ?present ( object -- string ) : ?present ( object -- string )
dup [ present ] when ; dup [ present ] when ;

2
basis/xmode/marker/marker.factor
View File

@ -311,7 +311,7 @@ M: mark-previous-rule handle-rule-start
: tokenize-line ( line-context line rules -- line-context' seq ) : tokenize-line ( line-context line rules -- line-context' seq )
[ [
"MAIN" swap at -rot "MAIN" of -rot
init-token-marker init-token-marker
mark-token-loop mark-token-loop
mark-remaining mark-remaining

10
core/assocs/assocs-docs.factor
View File

@ -236,7 +236,7 @@ HELP: key?
{ $values { "key" object } { "assoc" assoc } { "?" boolean } } { $values { "key" object } { "assoc" assoc } { "?" boolean } }
{ $description "Tests if an assoc contains a key." } ; { $description "Tests if an assoc contains a key." } ;
{ at at* key? ?at } related-words { at at* key? ?at of ?of } related-words
HELP: at 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" } } { $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" } } { $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 } "." } ; { $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 HELP: assoc-each
{ $values { "assoc" assoc } { "quot" { $quotation "( ... key value -- ... )" } } } { $values { "assoc" assoc } { "quot" { $quotation "( ... key value -- ... )" } } }
{ $description "Applies a quotation to each entry in the assoc." } { $description "Applies a quotation to each entry in the assoc." }

6
core/assocs/assocs.factor
View File

@ -97,6 +97,12 @@ PRIVATE>
: at ( key assoc -- value/f ) : at ( key assoc -- value/f )
at* drop ; inline 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 ) M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
[ dup assoc-size ] dip new-assoc [ dup assoc-size ] dip new-assoc
[ [ set-at ] with-assoc assoc-each ] keep ; inline [ [ set-at ] with-assoc assoc-each ] keep ; inline

2
core/classes/classes.factor
View File

@ -198,7 +198,7 @@ GENERIC: metaclass-changed ( use class -- )
: (define-class) ( word props -- ) : (define-class) ( word props -- )
reset-caches reset-caches
2dup "metaclass" swap at check-metaclass 2dup "metaclass" of check-metaclass
{ {
[ 2drop update-map- ] [ 2drop update-map- ]
[ 2drop dup class? [ reset-class ] [ implementors-map+ ] if ] [ 2drop dup class? [ reset-class ] [ implementors-map+ ] if ]

2
core/hashtables/hashtables-tests.factor
View File

@ -177,4 +177,4 @@ H{ } "x" set
[ 1 ] [ 2 "h" get at ] unit-test [ 1 ] [ 2 "h" get at ] unit-test
! Random test case ! 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

6
extra/asn1/asn1.factor
View File

@ -100,10 +100,10 @@ TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ;
: set-objtype ( syntax -- ) : set-objtype ( syntax -- )
builtin-syntax 2array [ builtin-syntax 2array [
elements get tagclass>> swap at elements get tagclass>> of
elements get encoding>> swap at elements get encoding>> of
elements get tag>> elements get tag>>
swap at [ of [
elements get objtype<< elements get objtype<<
] when* ] when*
] each ; ] each ;

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

@ -5,13 +5,11 @@ USING: arrays assocs assocs.private kernel math sequences ;
IN: assocs.extras IN: assocs.extras
: of ( assoc key -- value ) swap at ; inline
: assoc-harvest ( assoc -- assoc' ) : assoc-harvest ( assoc -- assoc' )
[ nip empty? not ] assoc-filter ; inline [ nip empty? not ] assoc-filter ; inline
: deep-at ( assoc seq -- value/f ) : deep-at ( assoc seq -- value/f )
[ swap at ] each ; inline [ of ] each ; inline
: zip-as ( keys values exemplar -- assoc ) : zip-as ( keys values exemplar -- assoc )
dup sequence? [ dup sequence? [

4
extra/bit/ly/ly.factor
View File

@ -8,8 +8,6 @@ SYMBOLS: bitly-api-user bitly-api-key ;
<PRIVATE <PRIVATE
: of ( assoc key -- value ) swap at ;
: <bitly-url> ( path -- url ) : <bitly-url> ( path -- url )
"http://api.bitly.com/v3/" prepend >url "http://api.bitly.com/v3/" prepend >url
bitly-api-user get "login" set-query-param bitly-api-user get "login" set-query-param
@ -25,7 +23,7 @@ ERROR: bad-response json status ;
] unless ; ] unless ;
: json-data ( url -- json ) : 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 ) : get-short-url ( short-url path -- data )
<bitly-url> swap "shortUrl" set-query-param json-data ; <bitly-url> swap "shortUrl" set-query-param json-data ;

2
extra/bitcoin/client/client.factor
View File

@ -64,7 +64,7 @@ IN: bitcoin.client
payload bitcoin-url <post-request> payload bitcoin-url <post-request>
basic-auth "Authorization" set-header basic-auth "Authorization" set-header
dup post-data>> data>> length "Content-Length" 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> PRIVATE>

2
extra/bson/constants/constants.factor
View File

@ -42,7 +42,7 @@ CONSTRUCTOR: dbref ( ref id -- dbref ) ;
} 2cleave ; inline } 2cleave ; inline
: assoc>dbref ( assoc -- dbref ) : 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 boa ; inline
: dbref-assoc? ( assoc -- ? ) : dbref-assoc? ( assoc -- ? )

10
extra/couchdb/couchdb-tests.factor
View File

@ -14,7 +14,7 @@ IN: couchdb.tests
[ couch get delete-db ] must-fail [ couch get delete-db ] must-fail
[ ] [ couch get ensure-db ] unit-test [ ] [ couch get ensure-db ] unit-test
[ ] [ 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 [ ] [ couch get compact-db ] unit-test
[ t ] [ couch get server>> next-uuid string? ] unit-test [ t ] [ couch get server>> next-uuid string? ] unit-test
[ ] [ H{ [ ] [ H{
@ -25,13 +25,13 @@ IN: couchdb.tests
{ "Author" "Rusty" } { "Author" "Rusty" }
{ "PostedDate" "2006-08-15T17:30:12Z-04:00" } { "PostedDate" "2006-08-15T17:30:12Z-04:00" }
} save-doc ] unit-test } 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 [ t ] [ "id" get dup load-doc id> = ] unit-test
[ ] [ "id" get load-doc save-doc ] 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 [ ] [ "id" get load-doc "Alex" "Author" pick set-at save-doc ] unit-test
[ "Alex" ] [ "id" get load-doc "Author" swap at ] unit-test [ "Alex" ] [ "id" get load-doc "Author" of ] unit-test
[ 1 ] [ "function(doc) { emit(null, doc) }" temp-view-map "total_rows" swap at ] unit-test [ 1 ] [ "function(doc) { emit(null, doc) }" temp-view-map "total_rows" of ] unit-test
[ ] [ H{ [ ] [ H{
{ "_id" "_design/posts" } { "_id" "_design/posts" }
{ "language" "javascript" } { "language" "javascript" }

16
extra/couchdb/couchdb.factor
View File

@ -21,10 +21,10 @@ C: <couchdb-error> couchdb-error
M: couchdb-error error. ( error -- ) M: couchdb-error error. ( error -- )
"CouchDB Error: " write data>> "CouchDB Error: " write data>>
"error" over at [ print ] when* "error" over at [ print ] when*
"reason" swap at [ print ] when* ; "reason" of [ print ] when* ;
PREDICATE: file-exists-error < couchdb-error PREDICATE: file-exists-error < couchdb-error
data>> "error" swap at "file_exists" = ; data>> "error" of "file_exists" = ;
! http tools ! http tools
: couch-http-request ( request -- data ) : 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 ; [ dup server-url % "_uuids?count=" % uuids-to-cache>> number>string % ] "" make ;
: uuids-get ( server -- uuids ) : uuids-get ( server -- uuids )
uuids-url couch-get "uuids" swap at >vector ; uuids-url couch-get "uuids" of >vector ;
: get-uuids ( server -- server ) : get-uuids ( server -- server )
dup uuids-get [ nip ] curry change-uuids ; dup uuids-get [ nip ] curry change-uuids ;
@ -129,11 +129,11 @@ C: <db> db
>json utf8 encode "application/json" <post-data> swap >>data ; >json utf8 encode "application/json" <post-data> swap >>data ;
! documents ! documents
: id> ( assoc -- id ) "_id" swap at ; : id> ( assoc -- id ) "_id" of ;
: >id ( assoc id -- assoc ) "_id" pick set-at ; : >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 ; : >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 ; : >attachments ( assoc attachments -- assoc ) "_attachments" pick set-at ;
:: copy-key ( to from to-key from-key -- ) :: copy-key ( to from to-key from-key -- )
@ -174,8 +174,8 @@ C: <db> db
: delete-doc ( assoc -- deletion-revision ) : delete-doc ( assoc -- deletion-revision )
[ [
[ doc-url % ] [ doc-url % ]
[ "?rev=" % "_rev" swap at % ] bi [ "?rev=" % "_rev" of % ] bi
] "" make couch-delete response-ok "rev" swap at ; ] "" make couch-delete response-ok "rev" of ;
: remove-keys ( assoc keys -- ) : remove-keys ( assoc keys -- )
swap [ delete-at ] curry each ; swap [ delete-at ] curry each ;

2
extra/fuel/xref/xref.factor
View File

@ -60,7 +60,7 @@ PRIVATE>
: vocab-usage-xref ( vocab -- seq ) vocab-usage [ vocab>xref ] map ; : 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 ; : article-location ( name -- loc ) lookup-article loc>> get-loc ;

4
extra/google/translate/translate.factor
View File

@ -31,8 +31,8 @@ ERROR: response-error response error ;
: query-response>text ( response -- text ) : query-response>text ( response -- text )
json> check-response json> check-response
"responseData" swap at "responseData" of
"translatedText" swap at ; "translatedText" of ;
: (translate) ( text from to -- text' ) : (translate) ( text from to -- text' )
parameters>assoc parameters>assoc

2
extra/hacker-news/hacker-news.factor
View File

@ -26,7 +26,7 @@ TUPLE: post title postedBy points id url commentCount postedAgo ;
: hacker-news-items ( -- seq ) : hacker-news-items ( -- seq )
"http://api.ihackernews.com/page" http-get nip "http://api.ihackernews.com/page" http-get nip
json> "items" swap at items> ; json> "items" of items> ;
: write-title ( title url -- ) : write-title ( title url -- )
'[ '[

6
extra/io/streams/256color/256color.factor
View File

@ -84,9 +84,9 @@ M: 256color stream-nl stream>> stream-nl ;
M: 256color stream-format M: 256color stream-format
[ [
[ foreground swap at [ color>foreground ] [ "" ] if* ] [ foreground of [ color>foreground ] [ "" ] if* ]
[ background swap at [ color>background ] [ "" ] if* ] [ background of [ color>background ] [ "" ] if* ]
[ font-style swap at [ font-styles ] [ "" ] if* ] [ font-style of [ font-styles ] [ "" ] if* ]
tri 3append [ "\e[0m" surround ] unless-empty tri 3append [ "\e[0m" surround ] unless-empty
] dip stream>> stream-write ; ] dip stream>> stream-write ;

2
extra/irc/client/internals/internals-tests.factor
View File

@ -223,7 +223,7 @@ M: mb-writer dispose drop ;
"#factortest" <irc-channel-chat> [ %add-named-chat ] keep "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
"ircuser" over join-participant "ircuser" over join-participant
":ircserver.net MODE #factortest +o ircuser" %push-line ":ircserver.net MODE #factortest +o ircuser" %push-line
participants>> "ircuser" swap at participants>> "ircuser" of
] unit-test ] unit-test
] spawning-irc ] spawning-irc

6
extra/mongodb/connection/connection.factor
View File

@ -32,10 +32,10 @@ CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ;
mdb-db new swap >>nodes swap >>name H{ } clone >>collections ; mdb-db new swap >>nodes swap >>name H{ } clone >>collections ;
: master-node ( mdb -- node ) : master-node ( mdb -- node )
nodes>> t swap at ; nodes>> t of ;
: slave-node ( mdb -- node ) : slave-node ( mdb -- node )
nodes>> f swap at ; nodes>> f of ;
: with-connection ( connection quot -- * ) : with-connection ( connection quot -- * )
[ mdb-connection ] dip with-variable ; inline [ mdb-connection ] dip with-variable ; inline
@ -74,7 +74,7 @@ CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ;
: get-nonce ( -- nonce ) : get-nonce ( -- nonce )
getnonce-cmd make-cmd send-cmd getnonce-cmd make-cmd send-cmd
[ "nonce" swap at ] [ f ] if* ; [ "nonce" of ] [ f ] if* ;
: auth? ( mdb -- ? ) : auth? ( mdb -- ? )
[ username>> ] [ pwd-digest>> ] bi and ; [ username>> ] [ pwd-digest>> ] bi and ;

2
extra/mongodb/driver/driver.factor
View File

@ -105,7 +105,7 @@ SYNTAX: r/
[ mdb-pool get ] dip with-mdb-pool ; inline [ mdb-pool get ] dip with-mdb-pool ; inline
: >id-selector ( assoc -- selector ) : >id-selector ( assoc -- selector )
[ MDB_OID_FIELD swap at ] keep [ MDB_OID_FIELD of ] keep
H{ } clone [ set-at ] keep ; H{ } clone [ set-at ] keep ;
: <mdb> ( db host port -- mdb ) : <mdb> ( db host port -- mdb )

2
extra/oauth/oauth-tests.factor
View File

@ -21,6 +21,6 @@ IN: oauth.tests
54321 >>nonce 54321 >>nonce
<request-token-request> <request-token-request>
post-data>> post-data>>
"oauth_signature" swap at "oauth_signature" of
>string >string
] unit-test ] unit-test

14
extra/pdf/canvas/canvas.factor
View File

@ -31,7 +31,7 @@ foreground background page-color inset line-height metrics ;
: set-style ( canvas style -- canvas ) : set-style ( canvas style -- canvas )
{ {
[ [
font-name swap at "sans-serif" or { font-name of "sans-serif" or {
{ "sans-serif" [ "Helvetica" ] } { "sans-serif" [ "Helvetica" ] }
{ "serif" [ "Times" ] } { "serif" [ "Times" ] }
{ "monospace" [ "Courier" ] } { "monospace" [ "Courier" ] }
@ -39,21 +39,21 @@ foreground background page-color inset line-height metrics ;
} case [ dup font>> ] dip >>name drop } case [ dup font>> ] dip >>name drop
] ]
[ [
font-size swap at 12 or font-size of 12 or
[ dup font>> ] dip >>size drop [ dup font>> ] dip >>size drop
] ]
[ [
font-style swap at [ dup font>> ] dip { font-style of [ dup font>> ] dip {
{ bold [ t f ] } { bold [ t f ] }
{ italic [ f t ] } { italic [ f t ] }
{ bold-italic [ t t ] } { bold-italic [ t t ] }
[ drop f f ] [ drop f f ]
} case [ >>bold? ] [ >>italic? ] bi* drop } case [ >>bold? ] [ >>italic? ] bi* drop
] ]
[ foreground swap at COLOR: black or >>foreground ] [ foreground of COLOR: black or >>foreground ]
[ background swap at f or >>background ] [ background of f or >>background ]
[ page-color swap at f or >>page-color ] [ page-color of f or >>page-color ]
[ inset swap at { 0 0 } or >>inset ] [ inset of { 0 0 } or >>inset ]
} cleave } cleave
dup font>> font-metrics dup font>> font-metrics
[ >>metrics ] [ height>> '[ _ max ] change-line-height ] bi ; [ >>metrics ] [ height>> '[ _ max ] change-line-height ] bi ;

6
extra/quadtrees/quadtrees-tests.factor
View File

@ -61,17 +61,17 @@ IN: quadtrees.tests
"c" { -0.5 -0.75 } value>>key "c" { -0.5 -0.75 } value>>key
"d" { 0.75 0.25 } value>>key "d" { 0.75 0.25 } value>>key
{ 0.25 0.25 } swap at* { 0.25 0.25 } ?of
] unit-test ] unit-test
[ f f ] [ [ { 1.0 1.0 } f ] [
unit-bounds <quadtree> unit-bounds <quadtree>
"a" { 0.0 -0.25 } value>>key "a" { 0.0 -0.25 } value>>key
"b" { 0.25 0.25 } value>>key "b" { 0.25 0.25 } value>>key
"c" { -0.5 -0.75 } value>>key "c" { -0.5 -0.75 } value>>key
"d" { 0.75 0.25 } value>>key "d" { 0.75 0.25 } value>>key
{ 1.0 1.0 } swap at* { 1.0 1.0 } ?of
] unit-test ] unit-test
[ { "a" "c" } ] [ [ { "a" "c" } ] [

10
extra/reddit/reddit.factor
View File

@ -30,7 +30,7 @@ display_name id header_img header_size header_title name over18
public_description subscribers title url ; public_description subscribers title url ;
: parse-data ( assoc -- obj ) : parse-data ( assoc -- obj )
[ "data" swap at ] [ "kind" swap at ] bi { [ "data" of ] [ "kind" of ] bi {
{ "t1" [ comment ] } { "t1" [ comment ] }
{ "t2" [ user ] } { "t2" [ user ] }
{ "t3" [ story ] } { "t3" [ story ] }
@ -41,10 +41,10 @@ public_description subscribers title url ;
TUPLE: page url data before after ; TUPLE: page url data before after ;
: json-page ( url -- page ) : json-page ( url -- page )
>url dup http-get nip json> "data" swap at { >url dup http-get nip json> "data" of {
[ "children" swap at [ parse-data ] map ] [ "children" of [ parse-data ] map ]
[ "before" swap at [ f ] when-json-null ] [ "before" of [ f ] when-json-null ]
[ "after" swap at [ f ] when-json-null ] [ "after" of [ f ] when-json-null ]
} cleave \ page boa ; } cleave \ page boa ;
: get-user ( username -- page ) : get-user ( username -- page )

24
extra/trees/avl/avl-tests.factor
View File

@ -88,7 +88,7 @@ IN: trees.avl.tests
[ "another eight" ] [ ! ERROR! [ "another eight" ] [ ! ERROR!
<avl> "seven" 7 pick set-at <avl> "seven" 7 pick set-at
"another eight" 8 pick set-at 8 swap at "another eight" 8 pick set-at 8 of
] unit-test ] unit-test
: test-tree ( -- tree ) : test-tree ( -- tree )
@ -102,16 +102,16 @@ IN: trees.avl.tests
! test set-at, at, at* ! test set-at, at, at*
[ t ] [ test-tree avl? ] unit-test [ t ] [ test-tree avl? ] unit-test
[ "seven" ] [ <avl> "seven" 7 pick set-at 7 swap at ] unit-test [ "seven" ] [ <avl> "seven" 7 pick set-at 7 of ] unit-test
[ "seven" t ] [ <avl> "seven" 7 pick set-at 7 swap at* ] unit-test [ "seven" t ] [ <avl> "seven" 7 pick set-at 7 ?of ] unit-test
[ f f ] [ <avl> "seven" 7 pick set-at 8 swap at* ] unit-test [ 8 f ] [ <avl> "seven" 7 pick set-at 8 ?of ] unit-test
[ "seven" ] [ <avl> "seven" 7 pick set-at 7 swap at ] unit-test [ "seven" ] [ <avl> "seven" 7 pick set-at 7 of ] unit-test
[ "replacement" ] [ <avl> "seven" 7 pick set-at "replacement" 7 pick set-at 7 swap at ] unit-test [ "replacement" ] [ <avl> "seven" 7 pick set-at "replacement" 7 pick set-at 7 of ] unit-test
[ "nine" ] [ test-tree 9 swap at ] unit-test [ "nine" ] [ test-tree 9 of ] unit-test
[ "replaced four" ] [ test-tree 4 swap at ] unit-test [ "replaced four" ] [ test-tree 4 of ] unit-test
[ "replaced seven" ] [ test-tree 7 swap at ] unit-test [ "replaced seven" ] [ test-tree 7 of ] unit-test
! test delete-at--all errors! ! test delete-at--all errors!
[ f ] [ test-tree 9 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 swap at ] 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 swap at ] unit-test [ "nine" ] [ test-tree 7 over delete-at 4 over delete-at 9 of ] unit-test

4
extra/trees/splay/splay-tests.factor
View File

@ -5,7 +5,7 @@ sequences random sets make grouping ;
IN: trees.splay.tests IN: trees.splay.tests
: randomize-numeric-splay-tree ( splay-tree -- ) : 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 ) : make-numeric-splay-tree ( n -- splay-tree )
iota <splay> [ [ conjoin ] curry each ] keep ; iota <splay> [ [ 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 keys length ] unit-test
[ 10 ] [ 10 make-numeric-splay-tree values length ] unit-test [ 10 ] [ 10 make-numeric-splay-tree values length ] unit-test
[ f ] [ <splay> f 4 pick set-at 4 swap at ] unit-test [ f ] [ <splay> f 4 pick set-at 4 of ] unit-test
! Ensure that f can be a value ! Ensure that f can be a value
[ t ] [ <splay> f 4 pick set-at 4 swap key? ] unit-test [ t ] [ <splay> f 4 pick set-at 4 swap key? ] unit-test

22
extra/trees/trees-tests.factor
View File

@ -11,17 +11,17 @@ IN: trees.tests
} clone ; } clone ;
! test set-at, at, at* ! test set-at, at, at*
[ "seven" ] [ <tree> "seven" 7 pick set-at 7 swap at ] unit-test [ "seven" ] [ <tree> "seven" 7 pick set-at 7 of ] unit-test
[ "seven" t ] [ <tree> "seven" 7 pick set-at 7 swap at* ] unit-test [ "seven" t ] [ <tree> "seven" 7 pick set-at 7 ?of ] unit-test
[ f f ] [ <tree> "seven" 7 pick set-at 8 swap at* ] unit-test [ 8 f ] [ <tree> "seven" 7 pick set-at 8 ?of ] unit-test
[ "seven" ] [ <tree> "seven" 7 pick set-at 7 swap at ] unit-test [ "seven" ] [ <tree> "seven" 7 pick set-at 7 of ] unit-test
[ "replacement" ] [ <tree> "seven" 7 pick set-at "replacement" 7 pick set-at 7 swap at ] unit-test [ "replacement" ] [ <tree> "seven" 7 pick set-at "replacement" 7 pick set-at 7 of ] unit-test
[ "replaced four" ] [ test-tree 4 swap at ] unit-test [ "replaced four" ] [ test-tree 4 of ] unit-test
[ "nine" ] [ test-tree 9 swap at ] unit-test [ "nine" ] [ test-tree 9 of ] unit-test
! test delete-at ! test delete-at
[ f ] [ test-tree 9 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 swap at ] unit-test [ "replaced seven" ] [ test-tree 9 over delete-at 7 of ] unit-test
[ "replaced four" ] [ test-tree 9 over delete-at 4 swap at ] 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" "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

2
extra/twitter/twitter.factor
View File

@ -50,7 +50,7 @@ PRIVATE>
! Utilities ! Utilities
MACRO: keys-boa ( keys class -- ) MACRO: keys-boa ( keys class -- )
[ [ '[ _ swap at ] ] map ] dip '[ _ cleave _ boa ] ; [ [ '[ _ of ] ] map ] dip '[ _ cleave _ boa ] ;
! Twitter requests ! Twitter requests
: status-url ( string -- url ) : status-url ( string -- url )