From 7fbff9384e07846cf1ab7c6162531093995e792f Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 18 Nov 2013 01:26:03 +0900
Subject: [PATCH] add missing string functions

---
 README.md           |  2 +-
 piclib/built-in.scm | 62 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 63 insertions(+), 1 deletion(-)

diff --git a/README.md b/README.md
index b62d0fbe..1c35dade 100644
--- a/README.md
+++ b/README.md
@@ -69,7 +69,7 @@
 | 6.4 Pairs and lists | yes | |
 | 6.5 Symbols | yes | |
 | 6.6 Characters | yes | |
-| 6.7 Strings | incomplete | TODO: almost all functions in the section :-( |
+| 6.7 Strings | yes | `substring` is not provided |
 | 6.8 Vectors | incomplete | string->vector, vector->string, ...etc |
 | 6.9 Bytevectors | incomplete | TODO: string<->utf8 conversion, etc |
 | 6.10  Control features | incomplete | TODO: `string-map`, `vector-map`, ...etc |
diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index ae6d6bca..d92edf88 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -379,6 +379,68 @@
 (define-char-transitive-predicate char<=? <=)
 (define-char-transitive-predicate char>=? >=)
 
+;;; 6.7 String
+
+(define (string . objs)
+  (let ((len (length objs)))
+    (let ((v (make-string len)))
+      (do ((i 0 (+ i 1))
+	   (l objs (cdr l)))
+	  ((< i len)
+	   v)
+	(string-set! v i (car l))))))
+
+(define (string->list string . opts)
+  (let ((start (if (pair? opts) (car opts) 0))
+	(end (if (>= (length opts) 2)
+		 (cadr opts)
+		 (string-length string))))
+    (do ((i start (+ i 1))
+	 (res '()))
+	((< i end)
+	 (reverse res))
+      (set! res (cons (string-ref string i) res)))))
+
+(define (list->string list)
+  (apply string list))
+
+(define (string-copy! to at from . opts)
+  (let ((start (if (pair? opts) (car opts) 0))
+	(end (if (>= (length opts) 2)
+		 (cadr opts)
+		 (string-length from))))
+    (do ((i at (+ i 1))
+	 (j start (+ j 1)))
+	((< j end))
+      (string-set! to i (string-ref from j)))))
+
+(define (string-copy v . opts)
+  (let ((start (if (pair? opts) (car opts) 0))
+	(end (if (>= (length opts) 2)
+		 (cadr opts)
+		 (string-length v))))
+    (let ((res (make-string (string-length v))))
+      (string-copy! res 0 v start end)
+      res)))
+
+(define (string-append . vs)
+  (define (string-append-2-inv w v)
+    (let ((res (make-string (+ (string-length v) (string-length w)))))
+      (string-copy! res 0 v)
+      (string-copy! res (string-length v) w)
+      res))
+  (fold string-append-2-inv #() vs))
+
+(define (string-fill! v fill . opts)
+  (let ((start (if (pair? opts) (car opts) 0))
+	(end (if (>= (length opts) 2)
+		 (cadr opts)
+		 (string-length v))))
+    (do ((i start (+ i 1)))
+	((< i end)
+	 #f)
+      (string-set! v i fill))))
+
 ;;; 6.8. Vector
 
 (define (vector . objs)