From 4b6d11e9900dac78910fb7eabf42c3c3f34dedc9 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Fri, 20 Apr 2018 14:38:24 +0200
Subject: [PATCH] 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 |  1 +
 module/mes/scm.mes      |  5 +++--
 module/srfi/srfi-1.mes  | 14 +++-----------
 src/mes.c               | 39 ++++++++++++++++++++++++++++++++++++++-
 tests/scm.test          | 13 ++++++++++++-
 5 files changed, 57 insertions(+), 15 deletions(-)

diff --git a/build-aux/mes-snarf.scm b/build-aux/mes-snarf.scm
index 28c779f9..63aba942 100755
--- a/build-aux/mes-snarf.scm
+++ b/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 "___" "***"))
diff --git a/module/mes/scm.mes b/module/mes/scm.mes
index 7e5ea618..23d4bf53 100644
--- a/module/mes/scm.mes
+++ b/module/mes/scm.mes
@@ -167,8 +167,9 @@
       (append2 (iota (- n 1)) (list (- n 1)))))
 
 (define (reverse lst)
-  (if (null? lst) '()
-      (append (reverse (cdr lst)) (cons (car lst) '()))))
+  (let loop ((lst lst) (r '()))
+    (if (null? lst) r
+        (loop (cdr lst) (cons (car lst) r)))))
 
 (define (filter pred lst)
   (let loop ((lst lst))
diff --git a/module/srfi/srfi-1.mes b/module/srfi/srfi-1.mes
index 5a413126..321a47f5 100644
--- a/module/srfi/srfi-1.mes
+++ b/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)
-  (let loop ((rev-head rev-head) (tail tail))
-    (if (null? rev-head) tail
-	(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 (reverse! lst . term)
+  (if (null? term) (core:reverse! lst term)
+      (core:reverse! lst (car term))))
 
 (define (srfi-1:member x lst eq)
   (if (null? lst) #f
diff --git a/src/mes.c b/src/mes.c
index 08734a1c..277b6154 100644
--- a/src/mes.c
+++ b/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
diff --git a/tests/scm.test b/tests/scm.test
index 7e86e33f..0e1927ff 100755
--- a/tests/scm.test
+++ b/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))