core: append2, append_reverse, reverse, reverse!: Create less garbage.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 20 Apr 2018 12:38:24 +0000 (14:38 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 20 Apr 2018 12:38:24 +0000 (14:38 +0200)
* 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
module/mes/scm.mes
module/srfi/srfi-1.mes
src/mes.c
tests/scm.test

index 28c779f971da4e8d9fde2599a090d309adc23160..63aba942185a9b1207ca7eac7d1a61e74bc47ca7 100755 (executable)
@@ -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 "___" "***"))
index 7e5ea6186122bb96f913dda48c14110613383d8d..23d4bf53ba6050c283b3db476efe252da03dad93 100644 (file)
       (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))
index 5a4131260ccfe01e202251fa5e6302ce83ae88f6..321a47f54f0edde3873620c0d7237ffb0868b697 100644 (file)
 
 (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
index 08734a1c3a5e9ae978a2d4242efe7744aa51948e..277b615414aeda9e9e78664ebc776bd4adb9c744 100644 (file)
--- 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
index 7e86e33f0fb91f5c4ebbb09805ff0740e54ab076..0e1927fff7f980e3ce6eda6238a99987b1a841e4 100755 (executable)
@@ -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))