From 1117690bf46342f1ab704334d818d07ea0640b9f Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Sat, 26 Jul 2008 19:48:40 +0200
Subject: Add APPEND and REVERSE.

---
 util.lisp | 75 +++++++++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 49 insertions(+), 26 deletions(-)

(limited to 'util.lisp')

diff --git a/util.lisp b/util.lisp
index ca1b25a..13877b2 100644
--- a/util.lisp
+++ b/util.lisp
@@ -107,33 +107,32 @@
                          expr-sym
                          (cons 'or (cdr expressions))))))))
 
-(%defun* %member (item list)
-  (and list
-       (or (and (eq item (car list)) list)
-           (%member item (cdr list)))))
+(%defun* %reverse-helper (list stack)
+  (if (null list)
+      stack
+      (%reverse-helper (cdr list) (cons (car list) stack))))
 
-(%defmacro* case (object . clauses)
-  (let ((this-clause (car clauses))
-        (rest (cdr clauses))
-        (object-sym (gensym)))
-    (if (null clauses)
-        nil
-        (if (and (null rest)
-                 (or (eq (car this-clause) t)
-                     (eq (car this-clause) 'otherwise)))
-            (cons 'progn (cdr this-clause))
-            (list 'let
-                  (list (list object-sym object))
-                  (list 'if
-                        (if (listp (car this-clause))
-                            (list '%member
-                                  object-sym
-                                  (list 'quote (car this-clause)))
-                            (list 'eq
-                                  object-sym
-                                  (list 'quote (car this-clause))))
-                        (cons 'progn (cdr this-clause))
-                        (list* 'case object-sym rest)))))))
+(%defun* reverse (list)
+  (%reverse-helper list nil))
+
+(%defun* %append-helper (reversed-list1 list2)
+  (if (null reversed-list1)
+      list2
+      (%append-helper (cdr reversed-list1) (cons (car reversed-list1) list2))))
+
+(%defun* %append-two-lists (list1 list2)
+  (%append-helper (reverse list1) list2))
+
+(%defun* %append (lists)
+  (if (null (cdr lists))
+      (car lists)
+      (let ((first-list (car lists))
+            (second-list (car (cdr lists)))
+            (rest (cdr (cdr lists))))
+        (%append (list* (%append-two-lists first-list second-list) rest)))))
+
+(%defun append lists
+  (%append lists))
 
 (%defmacro* sys::quasiquote (object)
   (if (not (consp object))
@@ -149,6 +148,30 @@
                      (list 'sys::quasiquote (car object))
                      (list 'sys::quasiquote (cdr object)))))))
 
+(%defun* %member (item list)
+  (and list
+       (or (and (eq item (car list)) list)
+           (%member item (cdr list)))))
+
+(%defmacro* case (object . clauses)
+  (let ((this-clause (car clauses))
+        (rest (cdr clauses))
+        (object-sym (gensym)))
+    (if (null clauses)
+        nil
+        (if (and (null rest)
+                 (or (eq (car this-clause) t)
+                     (eq (car this-clause) 'otherwise)))
+            `(progn ,@(cdr this-clause))
+            `(let ((,object-sym ,object))
+               (if ,(if (listp (car this-clause))
+                        `(%member ,object-sym
+                                  (quote ,(car this-clause)))
+                        `(eq ,object-sym
+                             (quote ,(car this-clause))))
+                   (progn ,(cdr this-clause))
+                   (case ,object-sym ,@rest)))))))
+
 (%defun* list-eqp (list1 list2)
   "Not really EQUALP (only works on trees of symbols)."
   (if (and (consp list1) (consp list2))
-- 
cgit v1.2.3