/[gcl]/gcl/cmpnew/gcl_cmplet.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmplet.lsp

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

revision 1.11 by camm, Fri Jan 7 17:58:33 2005 UTC revision 1.12 by camm, Sun Apr 10 03:08:00 2005 UTC
# Line 49  Line 49 
49        form        form
50      (let ((cf (car form)))      (let ((cf (car form)))
51        (let ((new-cdr-bf (or (and (eq bf 'quote) 'quote)        (let ((new-cdr-bf (or (and (eq bf 'quote) 'quote)
52                              (car (member cf '(let let* lambda flet labels macrolet quote function)))                              (and (eq bf 'declare) 'declare)
53                                (car (member cf '(let let* lambda flet labels macrolet declare quote function)))
54                              (and (consp bf)                              (and (consp bf)
55                                   (if (atom (car bf)) bf                                   (if (atom (car bf)) bf
56                                     (and (member (caar bf) '(flet labels macrolet) :test #'eq) 'lambda)))))                                     (and (member (caar bf) '(flet labels macrolet) :test #'eq) 'lambda)))))
57              (new-car-bf (and (consp cf) bf (if (eq bf 'quote) bf (list bf))))              (new-car-bf (and (consp cf) bf (if (or (eq bf 'quote) (eq bf 'declare)) bf (list bf))))
58              (new-cf (if (or bf (atom cf) (eq (car cf) 'lambda))              (new-cf (if (or bf (atom cf) (eq (car cf) 'lambda))
59                          cf (cmp-macroexp-with-compiler-macros cf))))                          cf (cmp-macroexp-with-compiler-macros cf))))
60          (cons (recursively-cmp-macroexpand new-cf new-car-bf)          (cons (recursively-cmp-macroexpand new-cf new-car-bf)
# Line 110  Line 111 
111        
112  (defun binding-decls-new (bindings star body out)  (defun binding-decls-new (bindings star body out)
113    (cond ((atom bindings) (nreverse out))    (cond ((atom bindings) (nreverse out))
114          ((atom (car bindings)) (binding-decls-new (cdr bindings) star body out))          ((atom (car bindings))
115             (let ((var (car bindings)))
116              (let ((*vars* (if (not star) *vars*
117                             (cons (c1make-var var nil nil (list (cons var t))) *vars*))))
118               (binding-decls-new (cdr bindings) star body out))))
119          (t          (t
120           (let* ((bf (car bindings))           (let* ((bf (car bindings))
121                  (var (car bf))                  (var (car bf))

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

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