core: Add string-append.

* src/strings.c (string_append): New function.
* mes/module/mes/boot-0.scm.in (string-append): Remove.
* mes/module/mes/boot-03.scm (string-append): Remove.
* scaffold/boot/50-make-string.scm (string-append): Remove.
* scaffold/boot/50-string-append.scm (string-append): Remove.
* scaffold/boot/50-string-join.scm (string-append): Remove.
* scaffold/boot/51-module.scm (string-append): Remove.
* scaffold/boot/52-define-module.scm (string-append): Remove.
* tests/macro.test (string-append): Remove.
* scaffold/boot/17-string-append.scm: Move from 50-string-append.scm.

build-aux/check-boot.sh

@@ -50,6 +50,7 @@ tests="
 17-memq-keyword.scm
 17-string-equal.scm
 17-equal2.scm
+17-string-append.scm
 17-open-input-string.scm
 
 20-define.scm

mes/module/mes/boot-0.scm.in

@@ -148,9 +148,6 @@
 (include (list->string
           (append2 (string->list %moduledir) (string->list "mes/type-0.mes"))))
 
-(define (string-append . rest)
-  (apply string (apply append (map1 string->list rest))))
-
 (if (and (getenv "MES_DEBUG")
           (not (equal2? (getenv "MES_DEBUG") "0"))
           (not (equal2? (getenv "MES_DEBUG") "1")))

mes/module/mes/boot-03.scm

@@ -148,9 +148,6 @@
 (include (list->string
           (append2 (string->list %moduledir) (string->list "mes/type-0.mes"))))
 
-(define (string-append . rest)
-  (apply string (apply append (map1 string->list rest))))
-
 (if (and (getenv "MES_DEBUG")
           (not (equal2? (getenv "MES_DEBUG") "0"))
           (not (equal2? (getenv "MES_DEBUG") "1")))

scaffold/boot/17-string-append.scm

@@ -16,34 +16,6 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-(cond-expand
- (guile)
- (mes
-  (define (cons* . rest)
-    (if (null? (cdr rest)) (car rest)
-        (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
-
-  (define (apply f h . t)
-    (if (null? t) (core:apply f h (current-module))
-        (apply f (apply cons* (cons h t)))))
-
-  (define (append . rest)
-    (if (null? rest) '()
-        (if (null? (cdr rest)) (car rest)
-            (append2 (car rest) (apply append (cdr rest))))))
-
-  (define (string . lst)
-    (list->string lst))
-
-  (define (map1 f lst)
-    (if (null? lst) (list)
-        (cons (f (car lst)) (map1 f (cdr lst)))))
-
-  (define map map1)
-
-  (define (string-append . rest)
-    (apply string (apply append (map string->list rest))))))
-
 (if (string=? (string-append "foo" "/" "bar") "foo/bar")
     (exit 0))
 (exit 1)

scaffold/boot/50-make-string.scm

@@ -33,16 +33,7 @@
             (append2 (car rest) (apply append (cdr rest))))))
 
   (define (string . lst)
-    (list->string lst))
-
-  (define (map1 f lst)
-    (if (null? lst) (list)
-        (cons (f (car lst)) (map1 f (cdr lst)))))
-
-  (define map map1)
-
-  (define (string-append . rest)
-    (apply string (apply append (map string->list rest))))))
+    (list->string lst))))
 
 (define (make-list n . fill)
   fill)

scaffold/boot/50-string-join.scm

@@ -39,14 +39,11 @@
     (if (null? lst) (list)
         (cons (f (car lst)) (map1 f (cdr lst)))))
 
-  (define map map1)
+  (define map map1)))
 
-  (define (string-append . rest)
-    (apply string (apply append (map string->list rest))))))
-
-  (define (string-join lst infix)
-    (if (null? (cdr lst)) (car lst)
-        (string-append (car lst) infix (string-join (cdr lst) infix))))
+(define (string-join lst infix)
+  (if (null? (cdr lst)) (car lst)
+      (string-append (car lst) infix (string-join (cdr lst) infix))))
 
 (if (string=? (string-join '("foo" "bar") "/") "foo/bar")
     (exit 0))

scaffold/boot/51-module.scm

@@ -45,9 +45,6 @@
   (define (string . lst)
     (list->string lst))
 
-  (define (string-append . rest)
-    (apply string (apply append (map string->list rest))))
-
   (define %prefix (getenv "MES_PREFIX"))
 
   (define (not x) (if x #f #t))

scaffold/boot/52-define-module.scm

@@ -49,9 +49,6 @@
 
   (define map map1)
 
-  (define (string-append . rest)
-    (apply string (apply append (map string->list rest))))
-
 ;;;;;;;;;;;;;;;;;;
   (define (string-join lst infix)
     (if (null? (cdr lst)) (car lst)

src/strings.c

@@ -240,3 +240,23 @@ read_string (SCM port) ///((arity . n))
   g_stdin = fd;
   return make_string (buf, i);
 }
+
+SCM
+string_append (SCM x) ///((arity . n))
+{
+  static char buf[MAX_STRING];
+  char const *p = buf;
+  buf[0] = 0;
+  size_t size = 0;
+  while (x != cell_nil)
+    {
+      SCM string = CAR (x);
+      assert (TYPE (string) == TSTRING);
+      memcpy (p, CSTRING (string), LENGTH (string) + 1);
+      p += LENGTH (string);
+      size += LENGTH (string);
+      assert (size < MAX_STRING);
+      x = CDR (x);
+    }
+  return make_string (buf, size);
+}

tests/macro.test

@@ -59,10 +59,6 @@ exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests macr
 (define (string . lst)
   (list->string lst))
 
-;; boot-0.scm
-(define (string-append . rest)
-  (apply string (apply append (map1 string->list rest))))
-
 ;; scm.mes
 (define (symbol-append . rest)
   (string->symbol (apply string-append (map symbol->string rest))))