macro-hack

macro-hack.lisp

(defpackage :test-macro (:use :cl))
(in-package :test-macro)

(define-condition some-info ()
  ((data :accessor data :initarg :data)))

(defmacro with-metadata (macro-name &body body &environment env)
  (let (stuff)
    (handler-bind ((some-info (lambda (c) (push (data c) stuff))))
      (sb-cltl2:macroexpand-all
       `(macrolet ((info (&whole w &rest x) (signal 'some-info :data w))) ,@body) env))
    `(,macro-name ,(nreverse stuff) ,@body)))

(defun visit-tree (tree function item)
  (typecase tree
    (null)
    (cons (let ((m (member item tree)))
            (if m
                (let ((before (ldiff tree m))
                      (after (rest m)))
                  (funcall function before after))
                (mapcar (lambda (x) (visit-tree x function item)) tree))))
    (t tree)))

(defmacro my-macro (bindings &body body)
  (if bindings
      (destructuring-bind (head . tail) bindings
        (destructuring-bind (_info (_dclr v &optional w)) head
          (declare (ignore _info _dclr))
          `(my-macro ,tail
             ,@(visit-tree body
                           (lambda (before after)
                             (append before `((let ((,v ,w)) ,@after))))
                           head))))
      `(progn ,@body)))


(macroexpand '(with-metadata my-macro
               (print (quote (info (declare-var x))))
               (info (declare-var x))
               (print x)
               (info (declare-var y 0))
               (print y)))

;  (PRINT '(INFO (DECLARE-VAR X)))
;  (LET ((X NIL))
;    (PRINT X)
;    (LET ((Y 0))
;      (PRINT Y))))