/[cmucl]/src/code/macros.lisp
ViewVC logotype

Diff of /src/code/macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.77 by toy, Tue Oct 29 16:42:22 2002 UTC revision 1.78 by toy, Wed Oct 30 18:08:32 2002 UTC
# Line 886  Line 886 
886  (defmacro push (obj place &environment env)  (defmacro push (obj place &environment env)
887    "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
888    the list, returning the modified list.  OBJ is evaluated before PLACE."    the list, returning the modified list.  OBJ is evaluated before PLACE."
889    
890      ;; This special case for place being a symbol isn't strictly needed.
891      ;; It's so we can do push (and pushnew) with a kernel.core.
892    (if (and (symbolp place)    (if (and (symbolp place)
893             (eq place (macroexpand place env)))             (eq place (macroexpand place env)))
894        `(setq ,place (cons ,obj ,place))        `(setq ,place (cons ,obj ,place))
895        (multiple-value-bind (dummies vals newval setter getter)        (multiple-value-bind (dummies vals newval setter getter)
896            (get-setf-expansion place env)            (get-setf-expansion place env)
897          (let ((g (gensym)))          ;; Handle multiple values
898            `(let* ((,g ,obj)          `(let* (,@(mapcar #'list dummies vals))
899                    ,@(mapcar #'list dummies vals)             (multiple-value-bind ,newval
900                    (,(car newval) (cons ,g ,getter)))                 ,(if (cdr newval)
901              ,setter)))))                      `(values ,@(rest (mapcar #'(lambda (a b)
902                                                     (list 'cons a b))
903                                                 obj getter)))
904                        `(cons ,obj ,getter))
905                 ,setter)))))
906    
907  (defmacro pushnew (obj place &rest keys &environment env)  (defmacro pushnew (obj place &rest keys &environment env)
908    "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
# Line 905  Line 912 
912             (eq place (macroexpand place env)))             (eq place (macroexpand place env)))
913        `(setq ,place (adjoin ,obj ,place ,@keys))        `(setq ,place (adjoin ,obj ,place ,@keys))
914        (multiple-value-bind (vars vals stores setter getter)        (multiple-value-bind (vars vals stores setter getter)
915            (get-setf-method place env)            (get-setf-expansion place env)
916          (let ((tem (gensym)))          `(let* (,@(mapcar #'list vars vals))
917            `(let* ((,tem ,obj)             (multiple-value-bind ,stores
918                    ,@(mapcar #'list vars vals)                 ,(if (cdr stores)
919                    (,(car stores) (adjoin ,tem ,getter ,@keys)))                      `(values ,@(rest (mapcar #'(lambda (a b)
920              ,setter)))))                                                   `(adjoin ,a ,b ,@keys))
921                                                 obj getter)))
922                        `(adjoin ,obj ,getter ,@keys))
923                 ,setter)))))
924    
925    
926  (defmacro pop (place &environment env)  (defmacro pop (place &environment env)

Legend:
Removed from v.1.77  
changed lines
  Added in v.1.78

  ViewVC Help
Powered by ViewVC 1.1.5