Changeset 8936


Ignore:
Timestamp:
Mar 29, 2008, 7:34:47 PM (11 years ago)
Author:
mb
Message:

Addedd ccl:macroexpand-all

Location:
branches/working-0711/ccl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-readloop.lisp

    r8781 r8936  
    266266    (multiple-value-bind (expansion win) (gethash sym *symbol-macros*)
    267267      (if win (values (expand-it expansion) t) (values sym nil)))))
     268
     269(defun macroexpand-all (form &optional (env (new-lexical-environment)))
     270  "Recursivly expand all macros in FORM."
     271  (flet ((mexpand (forms env)
     272           (mapcar (lambda (form) (macroexpand-all form env)) forms)))
     273    (macrolet ((destructuring-bind-body (binds form &body body)
     274                 (if (eql '&body (first (last binds)))
     275                   (let ((&body (gensym "&BODY")))
     276                     `(destructuring-bind ,(append (butlast binds) (list '&body &body))
     277                          ,form
     278                        (multiple-value-bind (body decls)
     279                            (parse-body ,&body env nil)
     280                          ,@body)))
     281                   `(destructuring-bind ,binds ,form ,@body))))
     282      (multiple-value-bind (expansion win)
     283          (macroexpand-1 form env)
     284        (if win
     285          (macroexpand-all expansion env)
     286          (if (atom form)
     287            form
     288            (case (first form)
     289              (macrolet
     290               (destructuring-bind-body (macros &body) (rest form)
     291                (setf env (augment-environment env
     292                                               :macro (mapcar (lambda (macro)
     293                                                                (destructuring-bind
     294                                                                      (name arglist &body body)
     295                                                                    macro
     296                                                                  (list name (enclose (parse-macro name arglist body env)))))
     297                                                              macros)
     298                                               :declare (decl-specs-from-declarations decls)))
     299                (let ((body (mexpand body env)))
     300                  (if decls
     301                    `(locally ,@decls ,@body)
     302                    `(progn ,@body)))))
     303              (symbol-macrolet
     304               (destructuring-bind-body (symbol-macros &body) (rest form)
     305                (setf env (augment-environment env :symbol-macro symbol-macros :declare (decl-specs-from-declarations decls)))
     306                (let ((body (mexpand body env)))
     307                  (if decls
     308                    `(locally ,@decls ,@body)
     309                    `(progn ,@body)))))
     310              ((let let*)
     311               (destructuring-bind-body (bindings &body) (rest form)
     312                `(,(first form)
     313                   ,(mapcar (lambda (binding)
     314                              (list (first binding) (macroexpand-all (second binding) env)))
     315                            bindings)
     316                   ,@decls
     317                   ,@(mexpand body env))))
     318              ((flet labels)
     319               (destructuring-bind-body (bindings &body) (rest form)
     320                `(,(first form)
     321                   ,(mapcar (lambda (binding)
     322                              (list* (first binding) (cdr (macroexpand-all `(lambda ,@(rest binding)) env))))
     323                            bindings)
     324                   ,@decls
     325                   ,@(mexpand body env))))
     326              (nfunction (list* 'nfunction (second form) (macroexpand-all (third form) env)))
     327              (function
     328                 (if (and (consp (second form))
     329                          (eql 'lambda (first (second form))))
     330                   (destructuring-bind (lambda arglist &body body&decls)
     331                       (second form)
     332                     (declare (ignore lambda))
     333                     (multiple-value-bind (body decls)
     334                         (parse-body body&decls env)
     335                       `(lambda ,arglist ,@decls ,@(mexpand body env))))
     336                   form))
     337              ((eval-when the locally block return-from)
     338                 (list* (first form) (second form) (mexpand (cddr form) env)))
     339              (setq
     340                 `(setq ,@(loop for (name value) on (rest form) by #'cddr
     341                                collect name
     342                                collect (macroexpand-all value env))))
     343              ((go quote) form)
     344              ;; catch, if, load-time-value, multiple-value-call, multiple-value-prog1, progn,
     345              ;; progv, tagbody, throw and unwind-protect also fall in this case (all 'argument forms'
     346              ;; are evaluated)
     347              (t (cons (first form) (mexpand (rest form) env))))))))))
    268348
    269349(defun macroexpand-1 (form &optional env &aux fn)
  • branches/working-0711/ccl/lib/ccl-export-syms.lisp

    r8872 r8936  
    5757     *backtrace-show-internal-frames*
    5858     *quit-on-eof*
     59     macroexpand-all
    5960     compiler-macroexpand
    6061     compiler-macroexpand-1
Note: See TracChangeset for help on using the changeset viewer.