swap ... 3append -> surround in basis

db4
Doug Coleman 2008-12-06 18:58:45 -06:00
parent c75777b7a2
commit 14fb58f448
9 changed files with 14 additions and 12 deletions

View File

@ -23,7 +23,7 @@ IN: bootstrap.image
os name>> cpu name>> arch ; os name>> cpu name>> arch ;
: boot-image-name ( arch -- string ) : boot-image-name ( arch -- string )
"boot." swap ".image" 3append ; "boot." ".image" surround ;
: my-boot-image-name ( -- string ) : my-boot-image-name ( -- string )
my-arch boot-image-name ; my-arch boot-image-name ;

View File

@ -164,7 +164,7 @@ M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
M: sqlite-db bind# ( spec obj -- ) M: sqlite-db bind# ( spec obj -- )
[ [
[ column-name>> ":" swap next-sql-counter 3append dup 0% ] [ column-name>> ":" next-sql-counter surround dup 0% ]
[ type>> ] bi [ type>> ] bi
] dip <literal-bind> 1, ; ] dip <literal-bind> 1, ;

View File

@ -26,7 +26,7 @@ SYMBOL: html
#! dynamically creating words. #! dynamically creating words.
[ elements-vocab create ] 2dip define-declared ; [ elements-vocab create ] 2dip define-declared ;
: <foo> ( str -- <str> ) "<" swap ">" 3append ; : <foo> ( str -- <str> ) "<" ">" surround ;
: def-for-html-word-<foo> ( name -- ) : def-for-html-word-<foo> ( name -- )
#! Return the name and code for the <foo> patterned #! Return the name and code for the <foo> patterned
@ -49,14 +49,14 @@ SYMBOL: html
#! word. #! word.
foo> [ ">" write-html ] (( -- )) html-word ; foo> [ ">" write-html ] (( -- )) html-word ;
: </foo> ( str -- </str> ) "</" swap ">" 3append ; : </foo> ( str -- </str> ) "</" ">" surround ;
: def-for-html-word-</foo> ( name -- ) : def-for-html-word-</foo> ( name -- )
#! Return the name and code for the </foo> patterned #! Return the name and code for the </foo> patterned
#! word. #! word.
</foo> dup '[ _ write-html ] (( -- )) html-word ; </foo> dup '[ _ write-html ] (( -- )) html-word ;
: <foo/> ( str -- <str/> ) "<" swap "/>" 3append ; : <foo/> ( str -- <str/> ) "<" "/>" surround ;
: def-for-html-word-<foo/> ( name -- ) : def-for-html-word-<foo/> ( name -- )
#! Return the name and code for the <foo/> patterned #! Return the name and code for the <foo/> patterned

View File

@ -56,7 +56,7 @@ TUPLE: CreateProcess-args
: escape-argument ( str -- newstr ) : escape-argument ( str -- newstr )
CHAR: \s over member? [ CHAR: \s over member? [
"\"" swap fix-trailing-backslashes "\"" 3append fix-trailing-backslashes "\"" dup surround
] when ; ] when ;
: join-arguments ( args -- cmd-line ) : join-arguments ( args -- cmd-line )

View File

@ -10,7 +10,7 @@ IN: prettyprint.backend
GENERIC: pprint* ( obj -- ) GENERIC: pprint* ( obj -- )
M: effect pprint* effect>string "(" swap ")" 3append text ; M: effect pprint* effect>string "(" ")" surround text ;
: ?effect-height ( word -- n ) : ?effect-height ( word -- n )
stack-effect [ effect-height ] [ 0 ] if* ; stack-effect [ effect-height ] [ 0 ] if* ;

View File

@ -72,10 +72,12 @@ ERROR: bad-email-address email ;
[ bad-email-address ] unless ; [ bad-email-address ] unless ;
: mail-from ( fromaddr -- ) : mail-from ( fromaddr -- )
"MAIL FROM:<" swap validate-address ">" 3append command ; validate-address
"MAIL FROM:<" ">" surround command ;
: rcpt-to ( to -- ) : rcpt-to ( to -- )
"RCPT TO:<" swap validate-address ">" 3append command ; validate-address
"RCPT TO:<" ">" surround command ;
: data ( -- ) : data ( -- )
"DATA" command ; "DATA" command ;

View File

@ -289,7 +289,7 @@ M: vocab-spec article-parent drop "vocab-index" ;
M: vocab-tag >link ; M: vocab-tag >link ;
M: vocab-tag article-title M: vocab-tag article-title
name>> "Vocabularies tagged ``" swap "''" 3append ; name>> "Vocabularies tagged ``" "''" surround ;
M: vocab-tag article-name name>> ; M: vocab-tag article-name name>> ;

View File

@ -61,7 +61,7 @@ M: freetype-renderer free-fonts ( world -- )
} at ; } at ;
: ttf-path ( name -- string ) : ttf-path ( name -- string )
"resource:fonts/" swap ".ttf" 3append ; "resource:fonts/" ".ttf" surround ;
: (open-face) ( path length -- face ) : (open-face) ( path length -- face )
#! We use FT_New_Memory_Face, not FT_New_Face, since #! We use FT_New_Memory_Face, not FT_New_Face, since

View File

@ -119,5 +119,5 @@ deploy-gadget "toolbar" f {
: deploy-tool ( vocab -- ) : deploy-tool ( vocab -- )
vocab-name vocab-name
[ <deploy-gadget> 10 <border> ] [ <deploy-gadget> 10 <border> ]
[ "Deploying \"" swap "\"" 3append ] bi [ "Deploying \"" "\"" surround ] bi
open-window ; open-window ;