/[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.78 by toy, Wed Oct 30 18:08:32 2002 UTC revision 1.79 by toy, Fri Nov 1 17:41:53 2002 UTC
# Line 894  Line 894 
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          ;; Handle multiple values          (cond
898          `(let* (,@(mapcar #'list dummies vals))            ((cdr newval)
899             (multiple-value-bind ,newval             ;; Handle multiple values
900                 ,(if (cdr newval)             (let ((g (mapcar #'(lambda (x)
901                      `(values ,@(rest (mapcar #'(lambda (a b)                                  (declare (ignore x))
902                                                   (list 'cons a b))                                  (gensym))
903                                               obj getter)))                              (rest obj))))
904                      `(cons ,obj ,getter))               `(multiple-value-bind ,g
905               ,setter)))))                    ,obj
906                    (let* (,@(mapcar #'list dummies vals))
907                      (multiple-value-bind ,newval
908                          (values ,@(mapcar #'(lambda (a b)
909                                                 (list 'cons a b))
910                                             g (rest getter)))
911                        ,setter)))))
912              (t
913               ;; A single value
914               (let ((g (gensym)))
915                 `(let* ((,g ,obj)
916                         ,@(mapcar #'list dummies vals)
917                         (,@newval (cons ,g ,getter)))
918                   ,setter)))))))
919    
920  (defmacro pushnew (obj place &rest keys &environment env)  (defmacro pushnew (obj place &rest keys &environment env)
921    "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 913  Line 926 
926        `(setq ,place (adjoin ,obj ,place ,@keys))        `(setq ,place (adjoin ,obj ,place ,@keys))
927        (multiple-value-bind (vars vals stores setter getter)        (multiple-value-bind (vars vals stores setter getter)
928            (get-setf-expansion place env)            (get-setf-expansion place env)
929          `(let* (,@(mapcar #'list vars vals))          (cond
930             (multiple-value-bind ,stores            ((cdr stores)
931                 ,(if (cdr stores)             ;; Multiple values
932                      `(values ,@(rest (mapcar #'(lambda (a b)             (let ((g (mapcar #'(lambda (x)
933                                                   `(adjoin ,a ,b ,@keys))                                  (declare (ignore x))
934                                               obj getter)))                                  (gensym))
935                      `(adjoin ,obj ,getter ,@keys))                              (rest obj))))
936               ,setter)))))               `(multiple-value-bind ,g
937                      ,obj
938                    (let* (,@(mapcar #'list vars vals))
939                      (multiple-value-bind ,stores
940                          (values ,@(mapcar #'(lambda (a b)
941                                                `(adjoin ,a ,b ,@keys))
942                                            g (rest getter)))
943                      ,setter)))))
944              (t
945               ;; Single value
946               (let ((g (gensym)))
947                 `(let* ((,g ,obj)
948                         ,@(mapcar #'list vars vals)
949                         (,@stores (adjoin ,g ,getter ,@keys)))
950                    ,setter)))))))
951    
952  (defmacro pop (place &environment env)  (defmacro pop (place &environment env)
953    "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

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

  ViewVC Help
Powered by ViewVC 1.1.5