Demonstration of using a closure over a macro

macro-closure-demo.lisp

;; Closed-over macro demo
;;
;; To answer a question, yes, you can close over macro definitions.
;; There's lots of ways to do that!
;;
;; The key is to remember that macros are "code-rewriting" functions.
;; When code is compiled, each time the macro is used, the macro
;; definition runs.  Whatever it returns is what gets compiled.
;; Here's some examples.

;; I use a function that prints its argument neatly (like
;; princ) but with a preceding newline (like print).  I combine
;; print and princ into "printc".
(defun printc (object &optional (output-stream *standard-output*))
  "Output a newline, the aesthetic (but not necessarily READable)
printed representation of OBJECT to the specified STREAM."
  (terpri output-stream)
  (princ object output-stream))

;; Here, we keep a global counter, closed over the macro definition.
;; Each time the macro is expanded, the counter is incremented.
(let ((counter 0))
  (defmacro count-when-compiling (&body body)
    (incf counter)
    (format t "~&Count when compiling: ~A" counter)
    `(progn ,@body)))
;; Each time the macro is used in a definition, the counter is
;; incremented and printed.
(defun hello-cwc ()
  (count-when-compiling
    (printc "Hello, world, from a COUNT-WHEN-COMPILING function!")))
;; The counter is not referred to in the places when the function is
;; called.
(hello-cwc)
(hello-cwc)
;; But if it's used in a different definition, the counter is again
;; incremented.
(defun hello-again-cwc ()
  (count-when-compiling
    (printc "Hello again, world, from a COUNT-WHEN-COMPILING function!")))
(hello-again-cwc)
(hello-again-cwc)

;; This time, we define the closed-over variable in the macro
;; definition again, but refer to it in the expansion.  That means
;; that when the expanded macro body is executed, the counter will be
;; incremented and returned.
(let ((counter 0))
  (defmacro count-when-executing (&body body)
    ;; The counter variable is only available within the macro
    ;; definition.  But our return value is going to be used outside
    ;; the macro definition.  That means that, to refer to the
    ;; closed-over binding, we need to have a function that refers to
    ;; it, and inject that function into the expanded body.
    (flet ((increment-counter ()
             (incf counter)
             (format t "~&Count when executing: ~A" counter)))
      `(progn
         ;; Now, we can execute a call to the function we defined.  We
         ;; use the , operator followed by the #' operator to tell it
         ;; to find the function definition of increment-counter, and
         ;; do so at macro expansion time.  There are other ways to do
         ;; this; try some out!
         (apply ,#'increment-counter ())
         ,@body))))
;; The counter isn't referred to when the macro is expanded.
(printc "Compiling HELLO-CWE")
(defun hello-cwe ()
  (count-when-executing
    (printc "Hello, world, from a COUNT-WHEN-EXECUTING function!")))
(printc "Done compiling HELLO-CWE")
;; But it is used when the function is run!
(hello-cwe)
(hello-cwe)
;; If it's used in a different definition, it refers to the same
;; counter.
(printc "Compiling HELLO-AGAIN-CWE")
(defun hello-again-cwe ()
  (count-when-executing
    (printc "Hello again, world, from a COUNT-WHEN-EXECUTING function!")))
(printc "Done compiling HELLO-AGAIN-CWE")
(hello-again-cwe)
(hello-again-cwe)
(hello-cwe)
(hello-again-cwe)

;; Another possibility is to set up a new closure over each expansion
;; of the macro.  This would be similar to COUNT-WHEN-EXECUTING, but
;; it keeps a separate macro for each expansion.  All we do is to move
;; the COUNTER binding inside the DEFMACRO.
(defmacro count-separately-when-executing (&body body)
  (let ((counter 0))
    (flet ((increment-counter ()
             (incf counter)
             (format t "~&Count separately when executing: ~A" counter)))
      `(progn
         ;; Now, we can execute a call to the function we defined.  We
         ;; use the , operator followed by the #' operator to tell it
         ;; to find the function definition of increment-counter, and
         ;; do so at macro expansion time.  There are other ways to do
         ;; this; try some out!
         (apply ,#'increment-counter ())
         ,@body))))
;; Again, the counter isn't used when the function is compiled.
(printc "Compiling HELLO-CSWE")
(defun hello-cswe ()
  (count-separately-when-executing
    (printc "Hello, world, from a COUNT-SEPARATELY-WHEN-EXECUTING function!")))
(printc "Done compiling HELLO-CSWE")
;; But it is used when the function is run!
(hello-cswe)
(hello-cswe)
;; If it's used in a different definition, it refers to the same
;; counter.
(printc "Compiling HELLO-AGAIN-CSWE")
(defun hello-again-cswe ()
  (count-separately-when-executing
    (printc "Hello again, from a COUNT-SEPARATELY-WHEN-EXECUTING function!")))
(printc "Done compiling HELLO-AGAIN-CSWE")
(hello-again-cswe)
(hello-again-cswe)
(hello-again-cswe)
(hello-again-cswe)
(hello-again-cswe)
(hello-again-cswe)
(hello-again-cswe)
(hello-again-cswe)
(hello-again-cswe)
;; Now, demonstrate that the above didn't change the HELLO-CSWE counter.
(hello-cswe)
(hello-cswe)
(hello-cswe)
(hello-cswe)

;; Let's look at the things we've demonstrated:
;; * When do we create the LET binding?
;;   Either globally (like in count-when-executing), or per-expansion
;;   (like in count-separately-when-executing).
;; * When do we increment the counter?
;;   Either when we expand the macro (like in count-when-compiling),
;;   or when the expanded body is run (like in count-when-executing).
;; * When do we report on the counter?
;;   Here, we do it at the same time as when we increment, but that's
;;   not really necessary.
;; Could we make one macro to cover them all?  Sure!  We'll have
;; one global counter for the global uses, covering a definition
;; that will adapt what it does based on options passed in.
(let ((global-counter 0))
  (defmacro with-counter ((&key     ;; The first argument is a (possibly-empty)
                             global ;; list of keyword options.
                             increment-when-expanding
                             (report-when-expanding nil rwe-supplied-p))
                          &body body)
    "Use a counter in a configurable way.
Call as
    (WITH-COUNTER (OPTIONS ...)
      BODY...)

By default, a separate counter is used for each place that
WITH-COUNTER is expanded.  You can use a global counter by suppling
the :GLOBAL T option.

By default, the counter is incremented when the expansion is executed.
You can instead increment the counter when WITH-COUNTER is expanded by
supplying the :INCREMENT-WHEN-EXPANDING T option.

By default, the counter is reported at the same time it's incremented.
You can be explicit about when to report the counter using
:REPORT-WHEN-EXPANDING T or NIL."

  ;; If the caller didn't supply a value for REPORT-WHEN-EXPANDING,
  ;; then set it to the same as INCREMENT-WHEN-EXPANDING.
  (unless rwe-supplied-p
    (setq report-when-expanding increment-when-expanding))

  ;; It's fairly useless to have a local counter, but only increment
  ;; it when at expansion time.  That would mean that you only
  ;; increment it once!
  (when (and (not global) increment-when-expanding)
    (warn 'style-warning 
          :format-control "You asked for a local counter that is only incremented while expanding. It will always be 1."))
  
  ;; We set up a local counter and the functions to manipulate
  ;; counters; it's easier to structure the code that way.  The
  ;; compiler will generally eliminate the local-counter from
  ;; expansions that don't actually use it.
  (let ((local-counter 0))
    (flet ((increment-counter ()
             (cond
               (global (incf global-counter))
               (t (incf local-counter))))
           (report-counter ()
             (format t "~&Count: ~A" (cond
                                       (global global-counter)
                                       (t local-counter)))))
      (when increment-when-expanding
        (increment-counter))
      (when report-when-expanding
        (report-counter))

      ;; Decide now whether or not to put the increment and report
      ;; calls into the compiled body.  (There are other ways to do
      ;; this.)  We define a couple of variables that are either
      ;; lists of the forms we want to call at execution time, or
      ;; are empty.
      (let ((increment-body-clause
              (cond
                ((not increment-when-expanding)
                 `((apply ,#'increment-counter ())))
                (t ())))
            (report-body-clause
              (cond
                ((not report-when-expanding)
                 `((apply ,#'report-counter ())))
                (t ()))))
        ;; Now return the body of the expansion.
        `(progn
           ,@increment-body-clause
           ,@report-body-clause
           ,@body))))))

;; Let's test this out by repeating our earlier tests, but with the
;; new general WITH-COUNTER!
(defun general-hello-cwc ()
  (with-counter (:global t :increment-when-expanding t)
    (printc "Hello, world, from GENERAL-HELLO-CWC!")))
(general-hello-cwc)
(general-hello-cwc)
(defun general-hello-again-cwc ()
  (with-counter (:global t :increment-when-expanding t)
    (printc "Hello again, from GENERAL-HELLO-AGAIN-CWC!")))
(general-hello-again-cwc)
(general-hello-again-cwc)
(defun general-hello-cwe ()
  (with-counter (:global t)
    (printc "Hello, world, from GENERAL-HELLO-CWC!")))
(printc "Compiling GENERAL-HELLO-AGAIN-CWE")
(defun general-hello-again-cwe ()
  (with-counter (:global t)
    (printc "Hello again, from GENERAL-HELLO-AGAIN-CWE!")))
(printc "Done compiling GENERAL-HELLO-AGAIN-CWE")
(general-hello-again-cwe)
(general-hello-again-cwe)
(general-hello-cwe)
(general-hello-again-cwe)
(printc "Compiling GENERAL-HELLO-CSWE")
(defun general-hello-cswe ()
  (count-separately-when-executing
    (printc "Hello, world, from GENERAL-HELLO-CSWE!")))
(printc "Done compiling GENERAL-HELLO-CSWE")
(general-hello-cswe)
(general-hello-cswe)
(printc "Compiling GENERAL-HELLO-AGAIN-CSWE")
(defun general-hello-again-cswe ()
  (count-separately-when-executing
    (printc "Hello again, from GENERAL-HELLO-AGAIN-CSWE!")))
(printc "Done compiling GENERAL-HELLO-AGAIN-CSWE")
(general-hello-again-cswe)
(general-hello-again-cswe)
(general-hello-again-cswe)
(general-hello-again-cswe)
(general-hello-again-cswe)
(general-hello-again-cswe)
(general-hello-again-cswe)
(general-hello-again-cswe)
(general-hello-again-cswe)
(general-hello-cswe)
(general-hello-cswe)
(general-hello-cswe)
(general-hello-cswe)

;; Exercises:
;;
;; 1. The global counter in WITH-COUNTER is shared between the -CWC and
;; -CWE functions.  You might want different counters.  Can you think
;; of a way to make one counter that applies to both the -CWC functions,
;; and another counter that applies to both the -CWE functions?
;;
;; 2. Write a macro that makes other macros that have counters.  As an
;; example, suppose you such make a macro called DEFINE-COUNTER-MACRO,
;; that takes the name of a new macro to create, and options similar
;; to WITH-COUNTER.
;;
;; Then, I could use it to create a new macro called WITH-CWC-COUNTER,
;; and could use it like this:
;; (define-counter-macro with-cwc-counter :global t :increment-when-expanding t)
;; (defun hello-cwc ()
;;   (with-cwc-counter
;;     (printc "Hello, world, from HELLO-CWC!")))
;;
;; 3. Having read the problem in #2, reconsider the question posed
;; in #1.  It may have occurred to you that we may want to expand our
;; two counter scopes (global and local) to three (global, one per
;; defined macro, and local).
;;
;; Modify your answer to #2, in a way that lets you use these three
;; different scopes.

;; You can run this using "sbcl --script macro-closure-demo.lisp".  In
;; that case, let's put a newline at the end of the output before the
;; shell prompt.
(terpri)