COPY-ALIST

diff --git a/src/list.lisp b/src/list.lisp
index b353700..32d0398 100644 (file)
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -194,6 +194,13 @@
     (setq data (cdr data)))
   alist)
 
+(defun copy-alist (alist)
+  (let ((new-alist ()))
+    (while alist
+      (push (cons (caar alist) (cdar alist)) new-alist)
+      (setq alist (cdr alist)))
+    (reverse new-alist)))
+
 
 (define-setf-expander car (x)
   (let ((cons (gensym))

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index b238135..f56e92e 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -55,9 +55,9 @@
           cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr caar cadddr caddr
           cadr car car case catch cdar cdddr cddr cdr cdr char
           char-code char= code-char cond cons consp constantly
-          copy-list copy-tree decf declaim declare defconstant define-setf-expander
-          define-symbol-macro defmacro defparameter defun defvar
-          digit-char digit-char-p disassemble do do* documentation
+          copy-alist copy-list copy-tree decf declaim declare defconstant
+          define-setf-expander define-symbol-macro defmacro defparameter defun
+          defvar digit-char digit-char-p disassemble do do* documentation
           dolist dotimes ecase eighth eq eql equal error eval every export expt
           fdefinition fifth find-package find-symbol first flet format fourth
           fset funcall function functionp gensym get-internal-real-time

diff --git a/tests/list.lisp b/tests/list.lisp
index 4be2453..be6faff 100644 (file)
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -49,6 +49,13 @@
 (test (equal '((1 . 2) (a . b))
              (pairlis '(1) '(2) '((a . b)))))
 
+; COPY-ALIST
+(let* ((alist '((1 . 2) (3 . 4)))
+       (copy (copy-alist alist)))
+  (test (not (eql alist copy)))
+  (test (not (eql (car alist) (car copy))))
+  (test (equal alist copy)))
+
 ; SUBST
 ; Can't really test this until EQUAL works properly on lists