core: append2, append_reverse, reverse, reverse!: Create less garbage.

* src/mes.c (append_reverse): New function.
  (reverse_x_): New function.
  (append2): Use them to create less garbage.
* module/mes/scm.mes (reverse): Create less garbage.
* module/srfi/srfi-1.mes (reverse!): Rewrite, use core:reverse!.
  (append-reverse): Remove.

build-aux/mes-snarf.scm

@@ -59,6 +59,7 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
                     (regexp-replace "_" "-")
                     (regexp-replace "_to_" "->")
                     (regexp-replace "_x$" "!")
+                    (regexp-replace "_x_$" "!-")
                     (regexp-replace "_p$" "?")
                     (regexp-replace "___" "***")
                     (regexp-replace "___" "***"))

module/mes/scm.mes

@@ -167,8 +167,9 @@
       (append2 (iota (- n 1)) (list (- n 1)))))
 
 (define (reverse lst)
-  (if (null? lst) '()
+  (let loop ((lst lst) (r '()))
-      (append (reverse (cdr lst)) (cons (car lst) '()))))
+    (if (null? lst) r
+        (loop (cdr lst) (cons (car lst) r)))))
 
 (define (filter pred lst)
   (let loop ((lst lst))

module/srfi/srfi-1.mes

@@ -64,17 +64,9 @@
 
 (define (remove pred lst) (filter (lambda (x) (not (pred x))) lst))
 
-(define (append-reverse rev-head tail)
+(define (reverse! lst . term)
-  (let loop ((rev-head rev-head) (tail tail))
+  (if (null? term) (core:reverse! lst term)
-    (if (null? rev-head) tail
+      (core:reverse! lst (car term))))
-	(loop (cdr rev-head) (cons (car rev-head) tail)))))
-
-(define (reverse! lst)
-  (let loop ((lst lst) (result '()))
-    (if (null? lst) result
-        (let ((tail (cdr lst)))
-          (set-cdr! lst result)
-          (loop tail lst)))))
 
 (define (srfi-1:member x lst eq)
   (if (null? lst) #f

src/mes.c

@@ -612,7 +612,44 @@ append2 (SCM x, SCM y)
     return y;
   if (TYPE (x) != TPAIR)
     error (cell_symbol_not_a_pair, cons (x, cell_append2));
-  return cons (car (x), append2 (cdr (x), y));
+  SCM r = cell_nil;
+  while (x != cell_nil)
+    {
+      r = cons (CAR (x), r);
+      x = CDR (x);
+    }
+  return reverse_x_ (r, y);
+}
+
+SCM
+append_reverse (SCM x, SCM y)
+{
+  if (x == cell_nil)
+    return y;
+  if (TYPE (x) != TPAIR)
+    error (cell_symbol_not_a_pair, cons (x, cell_append_reverse));
+  while (x != cell_nil)
+    {
+      y = cons (CAR (x), y);
+      x = CDR (x);
+    }
+  return y;
+}
+
+SCM
+reverse_x_ (SCM x, SCM t)
+{
+  if (TYPE (x) != TPAIR)
+    error (cell_symbol_not_a_pair, cons (x, cell_reverse_x_));
+  SCM r = t;
+  while (x != cell_nil)
+    {
+      t = CDR (x);
+      CDR (x) = r;
+      r = x;
+      x = t;
+    }
+  return r;
 }
 
 SCM

tests/scm.test

@@ -124,7 +124,18 @@ exit $?
 (pass-if-equal "iota -1"
                '() (iota -1))
 
-(pass-if "reverse" (sequal? (reverse '(1 2 3)) '(3 2 1)))
+(pass-if-equal "reverse" '(3 2 1)
+               (reverse '(1 2 3)))
+
+(pass-if-equal "reverse fresh" '(1 2 3)
+               (let ((list '(1 2 3)))
+                 (reverse list)
+                 list))
+
+(pass-if-equal "reverse!" '(1)
+               (let ((list '(1 2 3)))
+                 (reverse! list)
+                 list))
 
 (pass-if "cond-expand" (sequal? (cond-expand (foobar #f) (mes (display ": pass: *YAY*") 'mes) (guile (display ": pass: *GUILE*") 'mes)) 'mes))