/[gcl]/gcl/ansi-tests/define-setf-expander.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/define-setf-expander.lsp

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

revision 1.3 by pfdietz, Sun Jun 26 02:49:20 2005 UTC revision 1.4 by pfdietz, Tue Jun 28 13:48:36 2005 UTC
# Line 12  Line 12 
12    
13  (defun my-car (x) (car x))  (defun my-car (x) (car x))
14    
15  (defparameter *define-setf-expander-vals.1*  (ignore-errors
16    (multiple-value-list    (defparameter *define-setf-expander-vals.1*
17     (define-setf-expander my-car (place &environment env)      (multiple-value-list
18       (multiple-value-bind (temps vals stores set-form get-form)       (define-setf-expander my-car (place &environment env)
19           (get-setf-expansion place env)         (multiple-value-bind (temps vals stores set-form get-form)
20         (declare (ignore stores set-form))             (get-setf-expansion place env)
21         (let ((store (gensym))           (declare (ignore stores set-form))
22               (temp (gensym)))           (let ((store (gensym))
23           (values                 (temp (gensym)))
24            `(,@temps ,temp)             (values
25            `(,@vals ,get-form)              `(,@temps ,temp)
26            `(,store)              `(,@vals ,get-form)
27            `(progn (rplaca ,temp ,store) ,store)              `(,store)
28            `(my-car ,temp)))))))              `(progn (rplaca ,temp ,store) ,store)
29                `(my-car ,temp))))))))
30    
31  (deftest define-setf-expander.1  (deftest define-setf-expander.1
32    *define-setf-expander-vals.1*    *define-setf-expander-vals.1*

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

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