/[gcl]/gcl/lsp/gcl_setf.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_setf.lsp

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

revision 1.2 by camm, Sun Sep 14 02:43:06 2003 UTC revision 1.3 by camm, Tue Oct 7 21:06:32 2003 UTC
# Line 99  Line 99 
99    
100  ;;;; GET-SETF-METHOD-MULTIPLE-VALUE.  ;;;; GET-SETF-METHOD-MULTIPLE-VALUE.
101    
102    ;; FIXME  when all is well, remove this and the setf tests in the pcl directory
103    (push 'setf *features*)
104    
105  (defun get-setf-method-multiple-value (form &optional env &aux tem)  (defun get-setf-method-multiple-value (form &optional env &aux tem)
106    (cond ((symbolp form)    (cond ((symbolp form)
107           (let ((store (gensym)))           (let ((store (gensym)))
# Line 141  Line 144 
144                     (cons (car form) vars))))                     (cons (car form) vars))))
145          ((macro-function (car form))          ((macro-function (car form))
146           (get-setf-method-multiple-value (macroexpand form)))           (get-setf-method-multiple-value (macroexpand form)))
147          (t          (t
148           (error "Cannot expand the SETF form ~S." form))))           (let ((vars (mapcar #'(lambda (x)
149                                     (declare (ignore x))
150                                     (gensym))
151                                 (cdr form)))
152                   (store (gensym)))
153               (values vars (cdr form) (list store)
154                       `(funcall
155                         #'(setf ,(car form))
156                         ,store ,@vars )
157                       (cons (car form) vars))))))
158    
159    
160  ;;;; SETF definitions.  ;;;; SETF definitions.
# Line 372  Line 384 
384  (defun setf-helper (rest env)  (defun setf-helper (rest env)
385    (setq rest (cdr rest))    (setq rest (cdr rest))
386    (cond ((endp rest) nil)    (cond ((endp rest) nil)
387          ((endp (cdr rest)) (error "~S is an illegal SETF form." rest))  ;        ((endp (cdr rest)) (error "~S is an illegal SETF form." rest))
388          ((endp (cddr rest)) (setf-expand-1 (car rest) (cadr rest) env))          ((endp (cddr rest)) (setf-expand-1 (car rest) (cadr rest) env))
389          (t (cons 'progn (setf-expand rest env)))))          (t (cons 'progn (setf-expand rest env)))))
390    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26