From: Owen Rodley <Strigoides@gmail.com>
Date: Sat, 4 May 2013 06:14:08 +0000 (+1200)
Subject: COPY-ALIST
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=inline;h=5b544cfd2f52eaa127e6bedeff173f265113a5d2;p=jscl.git

COPY-ALIST
---

diff --git a/src/list.lisp b/src/list.lisp
index b353700..32d0398 100644
--- 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
--- 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
--- 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