diff --git a/collects/scheme/main.ss b/collects/scheme/main.ss index c0e8ae0779..07ef68bddf 100644 --- a/collects/scheme/main.ss +++ b/collects/scheme/main.ss @@ -10,6 +10,7 @@ scheme/tcp scheme/udp scheme/list + scheme/string scheme/function scheme/path scheme/file @@ -32,6 +33,7 @@ scheme/tcp scheme/udp scheme/list + scheme/string scheme/function scheme/path scheme/file diff --git a/collects/scheme/string.ss b/collects/scheme/string.ss new file mode 100644 index 0000000000..c63e5c448f --- /dev/null +++ b/collects/scheme/string.ss @@ -0,0 +1,7 @@ +#lang scheme/base + +(provide string-append*) + +(define string-append* + (case-lambda [(strs) (apply string-append strs)] ; optimize common case + [(str . strss) (apply string-append (apply list* str strss))])) diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl index 03afbc4abc..80a48a04a8 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/collects/scribblings/reference/pairs.scrbl @@ -529,6 +529,7 @@ must merely start with a chain of at least @scheme[pos] pairs. @defproc*[([(append* [lst list?] ... [lsts (listof list?)]) list?] [(append* [lst list?] ... [lsts list?]) any/c])]{ +@; Note: this is exactly the same description as the one for string-append* Like @scheme[append], but the last argument is used as a list of arguments for @scheme[append], so @scheme[(append* x ... xs)] is the diff --git a/collects/scribblings/reference/strings.scrbl b/collects/scribblings/reference/strings.scrbl index 780bc10aa5..3ab50905a9 100644 --- a/collects/scribblings/reference/strings.scrbl +++ b/collects/scribblings/reference/strings.scrbl @@ -359,3 +359,24 @@ allocated string).} @scheme[string-downcase], but using locale-specific case-conversion rules based the value of @scheme[current-locale]. } + +@; ---------------------------------------- +@section{Additional String Functions} + +@note-lib[scheme/string] +@(define string-eval (make-base-eval)) +@interaction-eval[#:eval string-eval (require scheme/string)] + +@defproc[(string-append* [str string?] ... [strs (listof string?)]) string?]{ +@; Note: this is exactly the same description as the one for append* + +Like @scheme[string-append], but the last argument is used as a list of +arguments for @scheme[string-append], so @scheme[(string-append* x ... xs)] is the +same as @scheme[(apply string-append x ... xs)]. In other words, the +relationship between @scheme[string-append] and @scheme[string-append*] is similar +to the one between @scheme[list] and @scheme[list*]. + +@examples[#:eval string-eval + (string-append* (cdr (append* (map (lambda (x) (list ", " x)) + '("Alpha" "Beta" "Gamma"))))) +]} diff --git a/collects/tests/mzscheme/list.ss b/collects/tests/mzscheme/list.ss index de131bd0ca..cdd03f91c5 100644 --- a/collects/tests/mzscheme/list.ss +++ b/collects/tests/mzscheme/list.ss @@ -172,6 +172,14 @@ ;; ---------- append* ---------- (let () + (test '() append* '()) + (test '() append* '(())) + (test '() append* '(() ())) + (test '(0 1 2 3) append* '((0 1 2 3))) + (test '(0 1 2 3) append* '(0 1 2 3) '()) + (test '(0 1 2 3) append* '(0 1 2 3) '(())) + (test '(0 1 2 3) append* '(0 1 2 3) '(() ())) + (test '(0 1 2 3) append* '(0 1) '((2) (3))) (test '(0 1 0 2 0 3) append* (map (lambda (x) (list 0 x)) '(1 2 3))) (test '(1 2 3 4 5 6 7 8 9) append* '(1 2 3) '(4 5) '((6 7 8) (9)))) diff --git a/collects/tests/mzscheme/string.ss b/collects/tests/mzscheme/string.ss index 065ea72573..ddfc8b4a89 100644 --- a/collects/tests/mzscheme/string.ss +++ b/collects/tests/mzscheme/string.ss @@ -3,8 +3,9 @@ (Section 'string) -;; to add when this library is there: (require scheme/string) +(require scheme/string) +;; ---------- real->decimal-string ---------- (test "0." real->decimal-string 0 0) (test "0." real->decimal-string 0.0 0) (test "1." real->decimal-string 0.6 0) @@ -19,8 +20,10 @@ (test "-1.20" real->decimal-string -1.2) (test "1.00" real->decimal-string 0.99999999999) (test "-1.00" real->decimal-string -0.99999999999) -(test "1999999999999999859514578049071102439861518336.00" real->decimal-string 2e45) +(test "1999999999999999859514578049071102439861518336.00" + real->decimal-string 2e45) +;; ---------- regexp-quote ---------- (let ([s (list->string (let loop ([i 0]) (if (= i 256) @@ -31,6 +34,7 @@ regexp-replace (regexp-quote s) s (regexp-replace-quote (string-append "!" s "!")))) +;; ---------- regexp-match* ---------- (test '("a" "b" "c") regexp-match* "[abc]" "here's a buck") (test '("b" "c") regexp-match* "[abc]" "here's a buck" 8) (test '("a") regexp-match* "[abc]" "here's a buck" 0 8) @@ -56,6 +60,7 @@ (test '(#"a" #"b" #"c") regexp-match* "[abc]" s 0 #f) (test eof read-char s)) +;; ---------- regexp-match-positions* ---------- (test '((7 . 8) (9 . 10) (11 . 12)) regexp-match-positions* "[abc]" "here's a buck") (test '((9 . 10) (11 . 12)) @@ -76,6 +81,7 @@ (test '((7 . 8) (9 . 10) (11 . 12)) regexp-match-positions* "[abc]" s 0 #f) (test eof read-char s)) +;; ---------- regexp-match-peek-positions* ---------- (let ([s (open-input-string "here's a buck")]) (test '((7 . 8) (9 . 10) (11 . 12)) regexp-match-peek-positions* @@ -90,6 +96,7 @@ (test "here's a buck" read-string 50 s)) +;; ---------- regexp-split ---------- (test '("here's " " " "u" "k") regexp-split "[abc]" "here's a buck") (test '(" " "u" "k") regexp-split "[abc]" "here's a buck" 8) (test '("" "u" "k") regexp-split "[abc]" "here's a buck" 9) @@ -126,4 +133,15 @@ ;; this doesn't work (like in Emacs) because ^ matches the start pos ;; (test '("" "foo bar") regexp-split #rx"^" "foo bar") +;; ---------- string-append* ---------- +(let () + (test "" string-append* '()) + (test "" string-append* '("")) + (test "" string-append* '("" "")) + (test "0123456789" string-append* '("0123456789")) + (test "0123456789" string-append* "0123456789" '()) + (test "0123456789" string-append* "0123456789" '("")) + (test "0123456789" string-append* "0123456789" '("" "")) + (test "0123456789" string-append* "01234567" '("8" "9"))) + (report-errs)