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

Diff of /gcl/lsp/gcl_desetq.lsp

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

revision 1.1 by camm, Sun Sep 14 02:30:35 2003 UTC revision 1.2 by camm, Sun Sep 14 02:43:05 2003 UTC
# Line 0  Line 1 
1    
2    
3    
4    
5    (defun desetq-consp-check (val)
6      (or (consp val) (error "~a is not a cons" val)))
7    
8    (defun desetq1 (form val)
9      (cond ((symbolp form)
10             (cond (form                    ;(push form *desetq-binds*)
11                    `(setf ,form ,val))))
12            ((consp form)
13             `(progn
14                (desetq-consp-check ,val)
15                ,(desetq1 (car form) `(car ,val))
16                ,@ (if (consp (cdr form))
17                       (list(desetq1 (cdr form) `(cdr ,val)))
18                     (and (cdr form) `((setf ,(cdr form) (cdr ,val)))))))
19            (t (error ""))))
20    
21    
22    (defmacro desetq (form val)
23      (cond ((atom val) (desetq1 form val))
24            (t (let ((value (gensym)))
25                 `(let ((,value ,val)) , (desetq1 form value))))))

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

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