From: Owen Rodley <Strigoides@gmail.com>
Date: Fri, 26 Apr 2013 20:26:11 +0000 (+1200)
Subject: Add POP macro
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c79c3adff52293988ece14b5cdb01f9bb7027645;p=jscl.git

Add POP macro
---

diff --git a/src/list.lisp b/src/list.lisp
index f1d5afb..ddaeb56 100644
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -54,3 +54,9 @@
      (cons (subst new old (car tree) :key key :test test)
            (subst new old (cdr tree) :key key :test test))) 
     (t tree)))
+
+(defmacro pop (place)
+  (let ((car-symbol (gensym)))
+    `(let ((,car-symbol (car ,place)))
+       (setf ,place (cdr ,place))
+       ,car-symbol)))
diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 0c418f7..a0b0cdc 100644
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -67,7 +67,7 @@
           make-symbol mapcar member minusp mod multiple-value-bind
           multiple-value-call multiple-value-list multiple-value-prog1
           nconc nil not nreconc nth nthcdr null numberp or
-          package-name package-use-list packagep parse-integer plusp
+          package-name package-use-list packagep parse-integer plusp pop
           prin1-to-string print proclaim prog1 prog2 progn psetq push
           quote read-from-string remove remove-if remove-if-not return
           return-from revappend reverse rplaca rplacd second set setf
diff --git a/tests/list.lisp b/tests/list.lisp
index aba417a..0365b5f 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -1,4 +1,7 @@
-; Tests for list functions
+;; Tests for list functions
+
+;; TODO: EQUAL doesn't compare lists correctly at the moment.
+;; Once it does the lists can be compared directly in many of these tests
 
 ; COPY-TREE
 (test (let* ((foo '((1 2) (3 4)))
@@ -6,10 +9,14 @@
         ;; (SETF (CAR (CAR FOO)) 0) doesn't work in the test for some reason,
         ;; despite working fine in the REPL
         (rplaca (car foo) 0)
-        ;; TODO: EQUAL doesn't compare lists correctly at the moment.
-        ;; Once it does the lists can be compared directly
         (not (= (car (car foo))
                 (car (car bar))))))
 
 ; SUBST
 ; Can't really test this until EQUAL works properly on lists
+
+; POP
+(test (let* ((foo '(1 2 3))
+             (bar (pop foo)))
+        (and (= bar 1)
+             (= (car foo) 2))))