From 180dc087777e43f5bd7441b8d210292f083b537d Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Fri, 18 Apr 2008 14:00:41 +0000
Subject: [PATCH] added add-between and string-join, no lists-join

svn: r9361
---
 collects/scheme/list.ss           | 25 +++++++++++++++++++++++++
 collects/scheme/string.ss         | 11 +++++++++++
 collects/tests/mzscheme/list.ss   |  7 +++++++
 collects/tests/mzscheme/string.ss |  8 ++++++++
 4 files changed, 51 insertions(+)

diff --git a/collects/scheme/list.ss b/collects/scheme/list.ss
index c095b2b299..52690333e6 100644
--- a/collects/scheme/list.ss
+++ b/collects/scheme/list.ss
@@ -13,6 +13,7 @@
          take
 
          append*
+         add-between
          flatten)
 
 (define (first x)
@@ -77,6 +78,30 @@
   (case-lambda [(ls) (apply append ls)] ; optimize common case
                [(l . lss) (apply append (apply list* l lss))]))
 
+;; General note: many non-tail recursive, which are just as fast in mzscheme
+
+(define (add-between l x)
+  (cond [(not (list? l)) (raise-type-error 'add-between "list" l)]
+        [(null? l) null]
+        [(null? (cdr l)) l]
+        [else (cons (car l)
+                    (let loop ([l (cdr l)])
+                      (if (null? l)
+                        null
+                        (list* x (car l) (loop (cdr l))))))]))
+
+;; This is nice for symmetry, but confusing to use, and we can get it using
+;; something like (append* (add-between l ls)), or even `flatten' for an
+;; arbitrary nesting.
+;; (define (lists-join ls l)
+;;   (cond [(null? ls) ls]
+;;         [(null? l) ls] ; empty separator
+;;         [else (append (car ls)
+;;                       (let loop ([ls (cdr ls)])
+;;                         (if (null? ls)
+;;                           ls
+;;                           (append l (car ls) (loop (cdr ls))))))]))
+
 (define (flatten orig-sexp)
   (let loop ([sexp orig-sexp] [acc null])
     (cond [(null? sexp) acc]
diff --git a/collects/scheme/string.ss b/collects/scheme/string.ss
index c63e5c448f..ea3a810712 100644
--- a/collects/scheme/string.ss
+++ b/collects/scheme/string.ss
@@ -5,3 +5,14 @@
 (define string-append*
   (case-lambda [(strs) (apply string-append strs)] ; optimize common case
                [(str . strss) (apply string-append (apply list* str strss))]))
+
+(require (only-in scheme/list add-between))
+
+(define (string-join strs sep)
+  (cond [(not (and (list? strs) (andmap string? strs)))
+         (raise-type-error 'string-join "list-of-strings" strs)]
+        [(not (string? sep))
+         (raise-type-error 'string-join "string" sep)]
+        [(null? strs) ""]
+        [(null? (cdr strs)) (car strs)]
+        [else (apply string-append (add-between strs sep))]))
diff --git a/collects/tests/mzscheme/list.ss b/collects/tests/mzscheme/list.ss
index cdd03f91c5..ebcc8faaf3 100644
--- a/collects/tests/mzscheme/list.ss
+++ b/collects/tests/mzscheme/list.ss
@@ -183,6 +183,13 @@
   (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))))
 
+;; ---------- add-between ----------
+(let ()
+  (test '()          add-between '() 1)
+  (test '(9)         add-between '(9) 1)
+  (test '(9 1 8 1 7) add-between '(9 8 7) 1)
+  (test '(9 (1) 8)   add-between '(9 8) '(1)))
+
 ;; ---------- flatten ----------
 (let ()
   (define (all-sexps n)
diff --git a/collects/tests/mzscheme/string.ss b/collects/tests/mzscheme/string.ss
index ddfc8b4a89..49e1439513 100644
--- a/collects/tests/mzscheme/string.ss
+++ b/collects/tests/mzscheme/string.ss
@@ -144,4 +144,12 @@
   (test "0123456789" string-append* "0123456789" '("" ""))
   (test "0123456789" string-append* "01234567" '("8" "9")))
 
+;; ---------- string-join ----------
+(let ()
+  (test ""    string-join '() " ")
+  (test ""    string-join '("") " ")
+  (test " "   string-join '("" "") " ")
+  (test "x y" string-join '("x" "y") " ")
+  (test "x"   string-join '("x") " "))
+
 (report-errs)