Skip to content
Snippets Groups Projects
Commit 572bae88 authored by toy's avatar toy
Browse files

Reinstate the special case handling when PLACE is a symbol (and not a

macro or symbol-macro).  This allows use of push/pushnew in
kernel.core again.  Solution suggested by Christophe Rhodes.
parent 44a31dcc
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.76 2002/10/28 19:36:59 toy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.77 2002/10/29 16:42:22 toy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -886,42 +886,52 @@ ...@@ -886,42 +886,52 @@
(defmacro push (obj place &environment env) (defmacro push (obj place &environment env)
"Takes an object and a location holding a list. Conses the object onto "Takes an object and a location holding a list. Conses the object onto
the list, returning the modified list. OBJ is evaluated before PLACE." the list, returning the modified list. OBJ is evaluated before PLACE."
(multiple-value-bind (dummies vals newval setter getter) (if (and (symbolp place)
(get-setf-method place env) (eq place (macroexpand place env)))
(let ((g (gensym))) `(setq ,place (cons ,obj ,place))
`(let* ((,g ,obj) (multiple-value-bind (dummies vals newval setter getter)
,@(mapcar #'list dummies vals) (get-setf-expansion place env)
(,(car newval) (cons ,g ,getter))) (let ((g (gensym)))
,setter)))) `(let* ((,g ,obj)
,@(mapcar #'list dummies vals)
(,(car newval) (cons ,g ,getter)))
,setter)))))
(defmacro pushnew (obj place &rest keys &environment env) (defmacro pushnew (obj place &rest keys &environment env)
"Takes an object and a location holding a list. If the object is already "Takes an object and a location holding a list. If the object is already
in the list, does nothing. Else, conses the object onto the list. Returns in the list, does nothing. Else, conses the object onto the list. Returns
NIL. If there is a :TEST keyword, this is used for the comparison." NIL. If there is a :TEST keyword, this is used for the comparison."
(multiple-value-bind (vars vals stores setter getter) (if (and (symbolp place)
(get-setf-method place env) (eq place (macroexpand place env)))
(let ((tem (gensym))) `(setq ,place (adjoin ,obj ,place ,@keys))
`(let* ((,tem ,obj) (multiple-value-bind (vars vals stores setter getter)
,@(mapcar #'list vars vals) (get-setf-method place env)
(,(car stores) (adjoin ,tem ,getter ,@keys))) (let ((tem (gensym)))
,setter)))) `(let* ((,tem ,obj)
,@(mapcar #'list vars vals)
(,(car stores) (adjoin ,tem ,getter ,@keys)))
,setter)))))
(defmacro pop (place &environment env) (defmacro pop (place &environment env)
"The argument is a location holding a list. Pops one item off the front "The argument is a location holding a list. Pops one item off the front
of the list and returns it." of the list and returns it."
(multiple-value-bind (dummies vals newval setter getter) (if (and (symbolp place)
(get-setf-method place env) (eq place (macroexpand place env)))
(do* ((d dummies (cdr d)) `(prog1 (car ,place)
(v vals (cdr v)) (setq ,place (cdr ,place)))
(let-list nil)) (multiple-value-bind (dummies vals newval setter getter)
((null d) (get-setf-method place env)
(push (list (car newval) getter) let-list) (do* ((d dummies (cdr d))
`(let* ,(nreverse let-list) (v vals (cdr v))
(prog1 (car ,(car newval)) (let-list nil))
(setq ,(car newval) (cdr ,(car newval))) ((null d)
,setter))) (push (list (car newval) getter) let-list)
(push (list (car d) (car v)) let-list)))) `(let* ,(nreverse let-list)
(prog1 (car ,(car newval))
(setq ,(car newval) (cdr ,(car newval)))
,setter)))
(push (list (car d) (car v)) let-list)))))
(define-modify-macro incf (&optional (delta 1)) + (define-modify-macro incf (&optional (delta 1)) +
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment