← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to lsp/gcl_desetq.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
lsp/gcl_desetq.lsp
 
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))))))