[Openmcl-devel] expanding macros

Taoufik Dachraoui dachraoui.taoufik at gmail.com
Sat Dec 11 10:03:07 PST 2010


Hi

I had a bug in my compiler generator and found it difficult to trace the
root of the error
I could not find something like macroexpand-1 but expands all macros

I wrote the following macro to do that and would like to share it (any
comments are welcome)

? (defun expand-macros (code macros)
  (labels ((%expand-macros (code)
   (cond
    ((null code) nil)
    ((atom code) code)
    ((member (car code) macros)
     (%expand-macros (macroexpand-1 code)))
    (t
     (loop for c in code
   collect (%expand-macros c))))))
    (pprint (%expand-macros (macroexpand-1 code)))))
EXPAND-MACROS
? (expand-macros '(gen-guido-compiler) '(destructuring-match-specials
cond-match-specials))

(DEFUN COMPILE/0 (EXPR &OPTIONAL (GENV (MAKE-HASH-TABLE)))
  (DELCARE (SPECIAL X) (SPECIAL L))
  (LET ((#:G28589
         (BLOCK NIL
           (LET* ((#:G28590 EXPR)
                  (N
                   (IF (AND (ATOM #:G28590)
                            (TYPEP #:G28590 '(UNSIGNED-BYTE 32)))
                       #:G28590
                       (RETURN-FROM NIL NIL))))
             (DECLARE (SPECIAL N))
             (PROGN (EMIT 17 *OPCODE-SIZE*) (EMIT N *WORD-SIZE*))))))
    (IF (NOT (NULL #:G28589))
        (PROGN (FORMAT T
                       "expression ~A matched ~A~%"
                       EXPR
                       '(:TYPE N '(UNSIGNED-BYTE 32)))
               #:G28589)
        (LET ((#:G28589
               (LET ((#:G28591
                      (BLOCK NIL
                        (LET* ((#:G28592 EXPR)
                               (X
                                (IF (AND (ATOM #:G28592)
                                         (TYPEP #:G28592 'SYMBOL))
                                    #:G28592
                                    (RETURN-FROM NIL NIL))))
                          (DECLARE (SPECIAL X))
                          (PROGN (EMIT 8 *OPCODE-SIZE*)
                                 (EMIT (IFNULL. (CAR (GETHASH X GENV)) 0)
                                       *WORD-SIZE*)
                                 (EMIT 0 *WORD-SIZE*)
                                 (EMIT 19 *OPCODE-SIZE*))))))
 ........

Kind regatds
Taoufik
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.clozure.com/pipermail/openmcl-devel/attachments/20101211/5bdda3f7/attachment.htm>


More information about the Openmcl-devel mailing list