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)))))) |