From: Doug Coleman Date: Wed, 12 Jan 2022 01:14:18 +0000 (-0600) Subject: sequences: Add 1surround which is dup surround X-Git-Tag: 0.99~1851 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=ffcefacba7dafdd493e0925be7449b6a751cfa37 sequences: Add 1surround which is dup surround add >string-list --- diff --git a/basis/escape-strings/escape-strings.factor b/basis/escape-strings/escape-strings.factor index 4c0f4b762e..89de4c8da3 100644 --- a/basis/escape-strings/escape-strings.factor +++ b/basis/escape-strings/escape-strings.factor @@ -49,7 +49,7 @@ IN: escape-strings [ nip ] [ drop length ] if ; : surround-by-brackets ( str delim -- str' ) - [ "[" dup surround ] [ "]" dup surround ] bi surround ; + [ "[" 1surround ] [ "]" 1surround ] bi surround ; : surround-by-equals-brackets ( str n -- str' ) CHAR: = surround-by-brackets ; diff --git a/basis/escape-strings/ui/ui.factor b/basis/escape-strings/ui/ui.factor index f24de3dc81..fb685d0da6 100644 --- a/basis/escape-strings/ui/ui.factor +++ b/basis/escape-strings/ui/ui.factor @@ -25,11 +25,8 @@ M: escape-string-editor model-changed [ quot>> call( str -- str' ) ] [ set-editor-string ] bi ] [ call-next-method ] if ; -: cake ( string delim -- string' ) - dup surround ; inline - : containerize ( string tag open-delim close-delim -- string' ) - overd [ cake ] 2bi@ surround ; + overd [ 1string ] 2bi@ surround ; : checksum-escape-string ( string checksum -- string' ) [ drop ] diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor index e39f4d4f48..04e019eefd 100644 --- a/basis/ftp/server/server.factor +++ b/basis/ftp/server/server.factor @@ -133,7 +133,7 @@ ERROR: type-error type ; : handle-PWD ( obj -- ) drop - display-directory "\"" dup surround 257 server-response ; + display-directory "\"" 1surround 257 server-response ; : handle-SYST ( obj -- ) drop diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor index 1ad2122d6b..7829ec5d8d 100644 --- a/basis/io/launcher/windows/windows.factor +++ b/basis/io/launcher/windows/windows.factor @@ -82,7 +82,7 @@ TUPLE: CreateProcess-args : escape-argument ( str -- newstr ) escape-double-quote CHAR: \s over member? [ - fix-trailing-backslashes "\"" dup surround + fix-trailing-backslashes "\"" 1surround ] when ; : join-arguments ( args -- cmd-line ) diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 56200756c0..c918655697 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -157,7 +157,7 @@ M: pathname pprint* : check-recursion ( obj quot: ( obj -- ) -- ) nesting-limit? [ drop - [ class-of name>> "~" dup surround ] keep present-text + [ class-of name>> "~" 1surround ] keep present-text ] [ over recursion-check get member-eq? [ drop "~circularity~" swap present-text diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index d6d2d3008c..7d20148de9 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -380,6 +380,10 @@ PRIVATE> : surround ( seq1 seq2 seq3 -- newseq ) over surround-as ; inline +: 1surround-as ( seq1 seq2 exemplar -- newseq ) dupd surround-as ; inline + +: 1surround ( seq1 seq2 -- newseq ) over 1surround-as ; inline + : glue-as ( seq1 seq2 seq3 exemplar -- newseq ) swapd 3append-as ; inline : glue ( seq1 seq2 seq3 -- newseq ) pick glue-as ; inline diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index 0fe17af627..9e70223671 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -124,7 +124,7 @@ DEFER: (parse-string) dup current-char forbid-tab { { CHAR: \s [ advance-char ] } { f [ drop ] } - [ "[space]" swap 1string "'" dup surround unexpected ] + [ "[space]" swap 1string "'" 1surround unexpected ] } case drop ] if ; diff --git a/extra/crypto/passwd-md5/passwd-md5.factor b/extra/crypto/passwd-md5/passwd-md5.factor index 0f17e8459c..d256311a0a 100644 --- a/extra/crypto/passwd-md5/passwd-md5.factor +++ b/extra/crypto/passwd-md5/passwd-md5.factor @@ -18,7 +18,7 @@ PRIVATE> :: passwd-md5 ( magic salt password -- bytes ) password magic salt 3append - salt password dup surround md5 checksum-bytes + salt password 1surround md5 checksum-bytes password length [ 16 / ceiling swap concat ] keep head-slice append @@ -42,7 +42,7 @@ PRIVATE> 11 final nth 2 to64 3append ; : parse-shadow-password ( string -- magic salt password ) - "$" split harvest first3 [ "$" dup surround ] 2dip ; + "$" split harvest first3 [ "$" 1surround ] 2dip ; : authenticate-password ( shadow password -- ? ) '[ parse-shadow-password drop _ passwd-md5 ] keep = ; diff --git a/extra/html/parser/utils/utils.factor b/extra/html/parser/utils/utils.factor index ddb7a062b3..982820e338 100644 --- a/extra/html/parser/utils/utils.factor +++ b/extra/html/parser/utils/utils.factor @@ -6,9 +6,9 @@ IN: html.parser.utils : trim1 ( seq ch -- newseq ) [ [ ?head-slice drop ] [ ?tail-slice drop ] bi ] keepd like ; -: single-quote ( str -- newstr ) "'" dup surround ; +: single-quote ( str -- newstr ) "'" 1surround ; -: double-quote ( str -- newstr ) "\"" dup surround ; +: double-quote ( str -- newstr ) "\"" 1surround ; : quote ( str -- newstr ) CHAR: ' over member? diff --git a/extra/images/testing/testing.factor b/extra/images/testing/testing.factor index 94a68a96e0..574533aa7a 100644 --- a/extra/images/testing/testing.factor +++ b/extra/images/testing/testing.factor @@ -27,7 +27,7 @@ PRIVATE> [ image. ] with-matching-files ; : ls ( dirpath extension -- ) - [ "\"" dup surround print ] with-matching-files ; + [ "\"" 1surround print ] with-matching-files ; : save-as-reference-image ( path -- ) [ load-image ] [ fig-name ] bi diff --git a/extra/managed-server/chat/chat.factor b/extra/managed-server/chat/chat.factor index c425890c40..74aa37f4b0 100644 --- a/extra/managed-server/chat/chat.factor +++ b/extra/managed-server/chat/chat.factor @@ -120,7 +120,7 @@ M: chat-server handle-client-join M: chat-server handle-client-disconnect [ line-beginning username " has quit " - client object>> dup [ "\"" dup surround ] when + client object>> dup [ "\"" 1surround ] when ] "" append-outputs-as send-everyone ; M: chat-server handle-already-logged-in diff --git a/extra/modern/html/html.factor b/extra/modern/html/html.factor index 483eaf64ff..cbae2fa824 100644 --- a/extra/modern/html/html.factor +++ b/extra/modern/html/html.factor @@ -180,8 +180,8 @@ GENERIC: write-html ( tag -- ) : >value ( obj -- string ) { - { [ dup squote? ] [ payload>> "'" dup surround ] } - { [ dup dquote? ] [ payload>> "\"" dup surround ] } + { [ dup squote? ] [ payload>> "'" 1surround ] } + { [ dup dquote? ] [ payload>> "\"" 1surround ] } [ ] } cond ; diff --git a/extra/rosetta-code/sierpinski-triangle/sierpinski-triangle.factor b/extra/rosetta-code/sierpinski-triangle/sierpinski-triangle.factor index c2ba8f4872..d372042988 100644 --- a/extra/rosetta-code/sierpinski-triangle/sierpinski-triangle.factor +++ b/extra/rosetta-code/sierpinski-triangle/sierpinski-triangle.factor @@ -27,7 +27,7 @@ IN: rosetta-code.sierpinski-triangle ! * * * * * * * * * * * * * * * * : iterate-triangle ( triange spaces -- triangle' ) - [ [ dup surround ] curry map ] + [ [ 1surround ] curry map ] [ drop [ dup " " glue ] map ] 2bi append ; : (sierpinski) ( triangle spaces n -- triangle' ) diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 9259b64a1d..2c9a2d7ce0 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -351,6 +351,9 @@ PRIVATE> : unsurround ( newseq seq2 seq3 -- seq1 ) [ ?head drop ] [ ?tail drop ] bi* ; +: >string-list ( seq -- seq' ) + [ "\"" 1surround ] map "," join ; + : one? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? ) [ find ] 2keep rot [ [ 1 + ] 2dip find-from drop not diff --git a/extra/tools/grep/grep.factor b/extra/tools/grep/grep.factor index e600e0a4e1..6c82a4b74e 100644 --- a/extra/tools/grep/grep.factor +++ b/extra/tools/grep/grep.factor @@ -21,7 +21,7 @@ IN: tools.grep command-line get [ grep-usage ] [ - unclip ".*" dup surround swap [ + unclip ".*" 1surround swap [ grep-lines ] [ [ grep-file ] with each