From 169f160f33fc72e2e6ee4442d8cb544304fb0f79 Mon Sep 17 00:00:00 2001 From: David Vazquez Date: Mon, 18 Feb 2013 22:49:52 +0000 Subject: [PATCH] Remove old PUSH --- ecmalisp.lisp | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/ecmalisp.lisp b/ecmalisp.lisp index 8fe11a9..dc694a6 100644 --- a/ecmalisp.lisp +++ b/ecmalisp.lisp @@ -163,7 +163,14 @@ `(setq ,x (- ,x ,delta))) (defmacro push (x place) - `(setq ,place (cons ,x ,place))) + (multiple-value-bind (dummies vals newval setter getter) + (get-setf-expansion place) + (let ((g (gensym))) + `(let* ((,g ,x) + ,@(mapcar #'list dummies vals) + (,(car newval) (cons ,g ,getter)) + ,@(cdr newval)) + ,setter)))) (defmacro dolist (iter &body body) (let ((var (first iter)) @@ -466,6 +473,7 @@ ((funcall func (car list)) (remove-if func (cdr list))) (t + ;; (cons (car list) (remove-if func (cdr list)))))) (defun remove-if-not (func list) @@ -641,16 +649,6 @@ `(progn (rplacd ,cons ,new-value) ,new-value) `(car ,cons)))) - (defmacro push (x place) - (multiple-value-bind (dummies vals newval setter getter) - (get-setf-expansion place) - (let ((g (gensym))) - `(let* ((,g ,x) - ,@(mapcar #'list dummies vals) - (,(car newval) (cons ,g ,getter)) - ,@(cdr newval)) - ,setter)))) - ;; Incorrect typecase, but used in NCONC. (defmacro typecase (x &rest clausules) (let ((value (gensym))) -- 1.7.10.4