[Openmcl-devel] expanding macros

rm at tuxteam.de rm at tuxteam.de
Sat Dec 11 20:25:19 UTC 2010


On Sat, Dec 11, 2010 at 07:03:07PM +0100, Taoufik Dachraoui wrote:
> 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

You mean like macroexpand-all ?


> 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

But this definition doesn't match your own description.
And the third cond expression seems to be buggy: a macro call in the
macro's arguments doesn't get expanded.


 Cheers, Ralf Mattes

> ? (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

> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> http://clozure.com/mailman/listinfo/openmcl-devel




More information about the Openmcl-devel mailing list