basis: swap 3append -> glue
parent
f6a205cc3a
commit
db30415dcb
|
@ -29,7 +29,7 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
|
||||||
writer>> swap "writing" set-word-prop ;
|
writer>> swap "writing" set-word-prop ;
|
||||||
|
|
||||||
: reader-word ( class name vocab -- word )
|
: reader-word ( class name vocab -- word )
|
||||||
[ "-" swap 3append ] dip create ;
|
[ "-" glue ] dip create ;
|
||||||
|
|
||||||
: writer-word ( class name vocab -- word )
|
: writer-word ( class name vocab -- word )
|
||||||
[ [ swap "set-" % % "-" % % ] "" make ] dip create ;
|
[ [ swap "set-" % % "-" % % ] "" make ] dip create ;
|
||||||
|
|
|
@ -162,22 +162,19 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
|
||||||
where-clause
|
where-clause
|
||||||
] query-make ;
|
] query-make ;
|
||||||
|
|
||||||
: splice ( string1 string2 string3 -- string )
|
|
||||||
swap 3append ;
|
|
||||||
|
|
||||||
: do-group ( tuple groups -- )
|
: do-group ( tuple groups -- )
|
||||||
dup string? [ 1array ] when
|
dup string? [ 1array ] when
|
||||||
[ ", " join " group by " splice ] curry change-sql drop ;
|
[ ", " join " group by " glue ] curry change-sql drop ;
|
||||||
|
|
||||||
: do-order ( tuple order -- )
|
: do-order ( tuple order -- )
|
||||||
dup string? [ 1array ] when
|
dup string? [ 1array ] when
|
||||||
[ ", " join " order by " splice ] curry change-sql drop ;
|
[ ", " join " order by " glue ] curry change-sql drop ;
|
||||||
|
|
||||||
: do-offset ( tuple n -- )
|
: do-offset ( tuple n -- )
|
||||||
[ number>string " offset " splice ] curry change-sql drop ;
|
[ number>string " offset " glue ] curry change-sql drop ;
|
||||||
|
|
||||||
: do-limit ( tuple n -- )
|
: do-limit ( tuple n -- )
|
||||||
[ number>string " limit " splice ] curry change-sql drop ;
|
[ number>string " limit " glue ] curry change-sql drop ;
|
||||||
|
|
||||||
: make-query* ( tuple query -- tuple' )
|
: make-query* ( tuple query -- tuple' )
|
||||||
dupd
|
dupd
|
||||||
|
|
|
@ -158,12 +158,6 @@ ERROR: no-sql-type type ;
|
||||||
modifiers>> [ lookup-modifier ] map " " join
|
modifiers>> [ lookup-modifier ] map " " join
|
||||||
[ "" ] [ " " prepend ] if-empty ;
|
[ "" ] [ " " prepend ] if-empty ;
|
||||||
|
|
||||||
: join-space ( string1 string2 -- new-string )
|
|
||||||
" " swap 3append ;
|
|
||||||
|
|
||||||
: paren ( string -- new-string )
|
|
||||||
"(" swap ")" 3append ;
|
|
||||||
|
|
||||||
HOOK: bind% db ( spec -- )
|
HOOK: bind% db ( spec -- )
|
||||||
HOOK: bind# db ( spec obj -- )
|
HOOK: bind# db ( spec obj -- )
|
||||||
|
|
||||||
|
@ -171,7 +165,7 @@ ERROR: no-column column ;
|
||||||
|
|
||||||
: >reference-string ( string pair -- string )
|
: >reference-string ( string pair -- string )
|
||||||
first2
|
first2
|
||||||
[ [ unparse join-space ] [ db-columns ] bi ] dip
|
[ [ unparse " " glue ] [ db-columns ] bi ] dip
|
||||||
swap [ column-name>> = ] with find nip
|
swap [ column-name>> = ] with find nip
|
||||||
[ no-column ] unless*
|
[ no-column ] unless*
|
||||||
column-name>> paren append ;
|
column-name>> "(" ")" surround append ;
|
||||||
|
|
|
@ -18,7 +18,7 @@ HOOK: (set-os-envs) os ( seq -- )
|
||||||
(os-envs) [ "=" split1 ] H{ } map>assoc ;
|
(os-envs) [ "=" split1 ] H{ } map>assoc ;
|
||||||
|
|
||||||
: set-os-envs ( assoc -- )
|
: set-os-envs ( assoc -- )
|
||||||
[ "=" swap 3append ] { } assoc>map (set-os-envs) ;
|
[ "=" glue ] { } assoc>map (set-os-envs) ;
|
||||||
|
|
||||||
{
|
{
|
||||||
{ [ os unix? ] [ "environment.unix" require ] }
|
{ [ os unix? ] [ "environment.unix" require ] }
|
||||||
|
|
|
@ -7,7 +7,7 @@ http.server.redirection http.server.remapping ;
|
||||||
IN: furnace.utilities
|
IN: furnace.utilities
|
||||||
|
|
||||||
: word>string ( word -- string )
|
: word>string ( word -- string )
|
||||||
[ vocabulary>> ] [ name>> ] bi ":" swap 3append ;
|
[ vocabulary>> ] [ name>> ] bi ":" glue ;
|
||||||
|
|
||||||
: words>strings ( seq -- seq' )
|
: words>strings ( seq -- seq' )
|
||||||
[ word>string ] map ;
|
[ word>string ] map ;
|
||||||
|
|
|
@ -29,7 +29,7 @@ PRIVATE>
|
||||||
: make-unique-file ( prefix suffix -- path )
|
: make-unique-file ( prefix suffix -- path )
|
||||||
temporary-path -rot
|
temporary-path -rot
|
||||||
[
|
[
|
||||||
unique-length get random-name swap 3append append-path
|
unique-length get random-name glue append-path
|
||||||
dup (make-unique-file)
|
dup (make-unique-file)
|
||||||
] 3curry unique-retries get retry ;
|
] 3curry unique-retries get retry ;
|
||||||
|
|
||||||
|
|
|
@ -79,7 +79,7 @@ M: threaded-server handle-client* handler>> call ;
|
||||||
\ handle-client ERROR add-error-logging
|
\ handle-client ERROR add-error-logging
|
||||||
|
|
||||||
: thread-name ( server-name addrspec -- string )
|
: thread-name ( server-name addrspec -- string )
|
||||||
unparse-short " connection from " swap 3append ;
|
unparse-short " connection from " glue ;
|
||||||
|
|
||||||
: accept-connection ( threaded-server -- )
|
: accept-connection ( threaded-server -- )
|
||||||
[ accept ] [ addr>> ] bi
|
[ accept ] [ addr>> ] bi
|
||||||
|
|
|
@ -115,7 +115,7 @@ M: invalid-inet6 summary drop "Invalid IPv6 address" ;
|
||||||
: pad-inet6 ( string1 string2 -- seq )
|
: pad-inet6 ( string1 string2 -- seq )
|
||||||
2dup [ length ] bi@ + 8 swap -
|
2dup [ length ] bi@ + 8 swap -
|
||||||
dup 0 < [ "More than 8 components" throw ] when
|
dup 0 < [ "More than 8 components" throw ] when
|
||||||
<byte-array> swap 3append ;
|
<byte-array> glue ;
|
||||||
|
|
||||||
: inet6-bytes ( seq -- bytes )
|
: inet6-bytes ( seq -- bytes )
|
||||||
[ 2 >be ] { } map-as concat >byte-array ;
|
[ 2 >be ] { } map-as concat >byte-array ;
|
||||||
|
|
|
@ -16,7 +16,7 @@ USE: unix
|
||||||
command>> dup string? [ tokenize-command ] when ;
|
command>> dup string? [ tokenize-command ] when ;
|
||||||
|
|
||||||
: assoc>env ( assoc -- env )
|
: assoc>env ( assoc -- env )
|
||||||
[ "=" swap 3append ] { } assoc>map ;
|
[ "=" glue ] { } assoc>map ;
|
||||||
|
|
||||||
: setup-priority ( process -- process )
|
: setup-priority ( process -- process )
|
||||||
dup priority>> [
|
dup priority>> [
|
||||||
|
|
|
@ -129,7 +129,7 @@ SYMBOL: ->
|
||||||
: remove-breakpoints ( quot pos -- quot' )
|
: remove-breakpoints ( quot pos -- quot' )
|
||||||
over quotation? [
|
over quotation? [
|
||||||
1+ cut [ (remove-breakpoints) ] bi@
|
1+ cut [ (remove-breakpoints) ] bi@
|
||||||
[ -> ] swap 3append
|
[ -> ] glue
|
||||||
] [
|
] [
|
||||||
drop
|
drop
|
||||||
] if ;
|
] if ;
|
||||||
|
|
|
@ -10,7 +10,7 @@ IN: tools.memory
|
||||||
|
|
||||||
: write-size ( n -- )
|
: write-size ( n -- )
|
||||||
number>string
|
number>string
|
||||||
dup length 4 > [ 3 cut* "," swap 3append ] when
|
dup length 4 > [ 3 cut* "," glue ] when
|
||||||
" KB" append write-cell ;
|
" KB" append write-cell ;
|
||||||
|
|
||||||
: write-total/used/free ( free total str -- )
|
: write-total/used/free ( free total str -- )
|
||||||
|
|
|
@ -238,7 +238,7 @@ M: vocab-link summary vocab-summary ;
|
||||||
vocab-dir append-path dup exists?
|
vocab-dir append-path dup exists?
|
||||||
[ subdirs ] [ drop { } ] if
|
[ subdirs ] [ drop { } ] if
|
||||||
] keep [
|
] keep [
|
||||||
swap [ "." swap 3append ] with map
|
swap [ "." glue ] with map
|
||||||
] unless-empty ;
|
] unless-empty ;
|
||||||
|
|
||||||
: vocabs-in-dir ( root name -- )
|
: vocabs-in-dir ( root name -- )
|
||||||
|
|
|
@ -126,7 +126,7 @@ SYMBOL: +stopped+
|
||||||
[
|
[
|
||||||
2dup length = [ nip [ break ] append ] [
|
2dup length = [ nip [ break ] append ] [
|
||||||
2dup nth \ break = [ nip ] [
|
2dup nth \ break = [ nip ] [
|
||||||
swap 1+ cut [ break ] swap 3append
|
swap 1+ cut [ break ] glue
|
||||||
] if
|
] if
|
||||||
] if
|
] if
|
||||||
] change-frame ;
|
] change-frame ;
|
||||||
|
|
|
@ -91,6 +91,6 @@ PRIVATE>
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
[ url-encode ] dip
|
[ url-encode ] dip
|
||||||
[ url-encode "=" swap 3append , ] with each
|
[ url-encode "=" glue , ] with each
|
||||||
] assoc-each
|
] assoc-each
|
||||||
] { } make "&" join ;
|
] { } make "&" join ;
|
||||||
|
|
Loading…
Reference in New Issue