Lisp HUG Maillist Archive

Macro context

Hi!

I'm trying to do something like

(debug-context *test1*
  ...
  (debug-log "Log message")
  ...
)

and I want (debug-log "Log message") to expand to
(when *test1* (format t "Log message"))

Is this possible with ordinary macros in CL?

I've tried

(defvar *current-debug-context* nil)

(defmacro debug-context (var &body body)
  (let ((*current-debug-context* var))
    `(progn ,@body)))

but that doesn't work, as *current-debug-context* is still nil at the time body is compiled. setf-ing *current-debug-context* works, but then it will not be scoped correctly.

Any suggestions?

Thank you!
Erik


Re: Macro context

On Mon, Jul 11, 2011 at 6:41 AM, Erik Ronström
<erik.ronstrom@doremir.com> wrote:
> Hi!
> I'm trying to do something like
> (debug-context *test1*
>   ...
>   (debug-log "Log message")
>   ...
> )
> and I want (debug-log "Log message") to expand to
> (when *test1* (format t "Log message"))
> Is this possible with ordinary macros in CL?

As you pointed out, the evaluation of *test1* needs to happen at run
time, and you'll need some way to keep track of that.  This seems like
a good application for closures.  Would the following work for you?

(defparameter *debug-context-thunks* '()
  "A list of functions that take zero arguments.  When every function
returns true, debug messages will be printed \(by debug-log\).")

(defmacro debug-context (context-form &body body)
  "Debug-context arranges for the body forms to be evaluated in a
dynamic environment where *debug-context-thunks* includes a function
whose body is context-form."
  `(let ((*debug-context-thunks*
          (list* #'(lambda () ,context-form)
                 *debug-context-thunks*)))
     ,@body))

(defun debug-log (control-string &rest format-arguments)
  "Debug-log applies format to the control-string and format-arguments
when every function in *debug-context-thunks* returns true."
  (when (every 'funcall *debug-context-thunks*)
    (apply 'format t control-string format-arguments)))

It would be used as follows:

CL-USER 2 >
(defparameter *test1* nil)
*TEST1*

CL-USER 3 >
(debug-context *test1*
  (let ((*test1* t))
    (debug-log "~&Log Message ~A" 1))
  (let ((*test1* nil))
    (debug-log "~&Log Message ~A" 2)))
Log Message 1
NIL

This isn't necessarily a final solution.  For instance, since
*debug-context-thunks* is a special variable, and debug-context adds
thunks onto it at each step, you'll end up with a whole bunch of
combined context tests when you're in deeply nested function calls.
This may or may not be what you want.  You could also have something
that checks just the most recent context, e.g.,

(defmacro single-debug-context (form &body body)
  `(let ((*debug-context-thunks* (list #'(lambda () ,form))))
     ,@body))

At any rate, I hope this is a useful starting point.

//JT


-- 
Joshua Taylor, http://www.cs.rpi.edu/~tayloj/

Re: Macro context

On 11 Jul 2011, at 11:41, Erik Ronström wrote:

> Any suggestions?

I'm not sure if you're after a compile-time solution (so debugging code may not be generated at all) or just a run-time switch.  For a run-time switch the solutions I use look something like this:

(defvar *debug-level* 0)
(defparameter *debug-threshold* 0)

(defun debug-log (control &rest args)
  (progn
    (when (> *debug-level* *debug-threshold*)
      (apply #'format *debug-io* control args))
    (values)))

(defmacro with-debug-level ((l) &body forms)
  `(let ((*debug-level* ,l))
     ,@forms))

Then you can say, for instance:

(let ((x 1))
  (with-debug-level (x)
    (debug-log "foo")))

The compile-time approach is fiddlier to get right (or I find it so).

--tim

Re: Macro context (continued)

Hi!

I believe, you need a local macro or symbol-macro.

> (defmacro with-debug-context (var &body body)
     `(symbol-macrolet ((*current-debug-context* ,var))
         ,@body))

> (defmacro debug-log (message &rest args)
     `(when *current-debug-context*
        (format *error-output* ,message ,@args)))

> (let ((test t))
    (with-debug-context test
      (debug-log "true")))

true

Hope this helps!

On Mon, Jul 11, 2011 at 5:00 PM, Erik Ronström
<erik.ronstrom@doremir.com> wrote:
> Thinking about it a little bit more...
> While your solution solves my problem very well, it would still be
> interesting to know if my first approach is at all possible.
>
> As you pointed out, the evaluation of *test1* needs to happen at run
>
> time, and you'll need some way to keep track of that.
>
> But that doesn't mean that the "meta-variable" *current-debug-context* has
> to be evaluated at run time!
> Now we've been talking about debug logging, but imagining another context
> where performance was important, it would be very nice to have the expansion
> to be evaluated at compile time, so that
> (debug-context *test1*
>   (debug-log "Log message")
> )
> would expand to
> (when *test1* (do-some-logging "Log message"))
> Of course, *test1* is still evauated at run time, but the expansion is made
> at compile time. Is this possible in CL?
> Regards
> Erik
>
>
>
> This seems like
>
> a good application for closures.  Would the following work for you?
>
> (defparameter *debug-context-thunks* '()
>
>  "A list of functions that take zero arguments.  When every function
>
> returns true, debug messages will be printed \(by debug-log\).")
>
> (defmacro debug-context (context-form &body body)
>
>  "Debug-context arranges for the body forms to be evaluated in a
>
> dynamic environment where *debug-context-thunks* includes a function
>
> whose body is context-form."
>
>  `(let ((*debug-context-thunks*
>
>         (list* #'(lambda () ,context-form)
>
>                *debug-context-thunks*)))
>
>    ,@body))
>
> (defun debug-log (control-string &rest format-arguments)
>
>  "Debug-log applies format to the control-string and format-arguments
>
> when every function in *debug-context-thunks* returns true."
>
>  (when (every 'funcall *debug-context-thunks*)
>
>   (apply 'format t control-string format-arguments)))
>
> It would be used as follows:
>
> CL-USER 2 >
>
> (defparameter *test1* nil)
>
> *TEST1*
>
> CL-USER 3 >
>
> (debug-context *test1*
>
>  (let ((*test1* t))
>
>   (debug-log "~&Log Message ~A" 1))
>
>  (let ((*test1* nil))
>
>   (debug-log "~&Log Message ~A" 2)))
>
> Log Message 1
>
> NIL
>
> This isn't necessarily a final solution.  For instance, since
>
> *debug-context-thunks* is a special variable, and debug-context adds
>
> thunks onto it at each step, you'll end up with a whole bunch of
>
> combined context tests when you're in deeply nested function calls.
>
> This may or may not be what you want.  You could also have something
>
> that checks just the most recent context, e.g.,
>
> (defmacro single-debug-context (form &body body)
>
>  `(let ((*debug-context-thunks* (list #'(lambda () ,form))))
>
>    ,@body))
>
> At any rate, I hope this is a useful starting point.
>
> //JT
>
>
> --
>
> Joshua Taylor, http://www.cs.rpi.edu/~tayloj/
>
>
>
>
>
> --
> Joshua Taylor, http://www.cs.rpi.edu/~tayloj/
>
>



-- 
Best regards,
   Paul A. Anokhin

Re: Macro context (continued)

Erik,

and you probably want a gensym insteam of *current-debug-context*:

(defparameter *debug-context-var* (gensym))

(defmacro with-debug-context (var &body body)
  `(symbol-macrolet ((,*debug-context-var* ,var))
     ,@body))

(defmacro debug-log (message &rest args)
  `(when ,*debug-context-var*
     (format *error-output* ,message ,@args)))

CL-USER>  (sb-cltl2:macroexpand-all
                     `(with-debug-context test2
                         (debug-log "true")))
(SYMBOL-MACROLET ((#:G1154 TEST2)) (IF TEST2 (PROGN (FORMAT
*ERROR-OUTPUT* "true")) NIL))

On Mon, Jul 11, 2011 at 5:13 PM, Paul A. Anokhin <paul7@paul7.net> wrote:
> Hi!
>
> I believe, you need a local macro or symbol-macro.
>
>> (defmacro with-debug-context (var &body body)
>     `(symbol-macrolet ((*current-debug-context* ,var))
>         ,@body))
>
>> (defmacro debug-log (message &rest args)
>     `(when *current-debug-context*
>        (format *error-output* ,message ,@args)))
>
>> (let ((test t))
>    (with-debug-context test
>      (debug-log "true")))
>
> true
>
> Hope this helps!
>
> On Mon, Jul 11, 2011 at 5:00 PM, Erik Ronström
> <erik.ronstrom@doremir.com> wrote:
>> Thinking about it a little bit more...
>> While your solution solves my problem very well, it would still be
>> interesting to know if my first approach is at all possible.
>>
>> As you pointed out, the evaluation of *test1* needs to happen at run
>>
>> time, and you'll need some way to keep track of that.
>>
>> But that doesn't mean that the "meta-variable" *current-debug-context* has
>> to be evaluated at run time!
>> Now we've been talking about debug logging, but imagining another context
>> where performance was important, it would be very nice to have the expansion
>> to be evaluated at compile time, so that
>> (debug-context *test1*
>>   (debug-log "Log message")
>> )
>> would expand to
>> (when *test1* (do-some-logging "Log message"))
>> Of course, *test1* is still evauated at run time, but the expansion is made
>> at compile time. Is this possible in CL?
>> Regards
>> Erik
>>
>>
>>
>> This seems like
>>
>> a good application for closures.  Would the following work for you?
>>
>> (defparameter *debug-context-thunks* '()
>>
>>  "A list of functions that take zero arguments.  When every function
>>
>> returns true, debug messages will be printed \(by debug-log\).")
>>
>> (defmacro debug-context (context-form &body body)
>>
>>  "Debug-context arranges for the body forms to be evaluated in a
>>
>> dynamic environment where *debug-context-thunks* includes a function
>>
>> whose body is context-form."
>>
>>  `(let ((*debug-context-thunks*
>>
>>         (list* #'(lambda () ,context-form)
>>
>>                *debug-context-thunks*)))
>>
>>    ,@body))
>>
>> (defun debug-log (control-string &rest format-arguments)
>>
>>  "Debug-log applies format to the control-string and format-arguments
>>
>> when every function in *debug-context-thunks* returns true."
>>
>>  (when (every 'funcall *debug-context-thunks*)
>>
>>   (apply 'format t control-string format-arguments)))
>>
>> It would be used as follows:
>>
>> CL-USER 2 >
>>
>> (defparameter *test1* nil)
>>
>> *TEST1*
>>
>> CL-USER 3 >
>>
>> (debug-context *test1*
>>
>>  (let ((*test1* t))
>>
>>   (debug-log "~&Log Message ~A" 1))
>>
>>  (let ((*test1* nil))
>>
>>   (debug-log "~&Log Message ~A" 2)))
>>
>> Log Message 1
>>
>> NIL
>>
>> This isn't necessarily a final solution.  For instance, since
>>
>> *debug-context-thunks* is a special variable, and debug-context adds
>>
>> thunks onto it at each step, you'll end up with a whole bunch of
>>
>> combined context tests when you're in deeply nested function calls.
>>
>> This may or may not be what you want.  You could also have something
>>
>> that checks just the most recent context, e.g.,
>>
>> (defmacro single-debug-context (form &body body)
>>
>>  `(let ((*debug-context-thunks* (list #'(lambda () ,form))))
>>
>>    ,@body))
>>
>> At any rate, I hope this is a useful starting point.
>>
>> //JT
>>
>>
>> --
>>
>> Joshua Taylor, http://www.cs.rpi.edu/~tayloj/
>>
>>
>>
>>
>>
>> --
>> Joshua Taylor, http://www.cs.rpi.edu/~tayloj/
>>
>>
>
>
>
> --
> Best regards,
>    Paul A. Anokhin
>



-- 
   Павел Анохин

Re: Macro context

Erik Ronström <erik.ronstrom@doremir.com> writes:

> I'm trying to do something like
>
> (debug-context *test1*
>   ...
>   (debug-log "Log message")
>   ...
> )
>
> and I want (debug-log "Log message") to expand to
> (when *test1* (format t "Log message"))
>
> Is this possible with ordinary macros in CL?
>
> I've tried
>
> (defvar *current-debug-context* nil)
>
> (defmacro debug-context (var &body body)
>   (let ((*current-debug-context* var))
>     `(progn ,@body)))
>
> but that doesn't work, as *current-debug-context* is still nil at the time body is compiled. setf-ing *current-debug-context* works, but then it will not be scoped correctly.
>
> Any suggestions?

This is typically a use case for macrolet, or flet.

It seems in this case that debug-log can be defined as a function:

    (defmacro debug-context (var &body body)
      (check-type var symbol "a symbol denoting a variable")
      `(flet ((debug-log (control-string &rest arguments)
                (when ,var (format t "~?" control-string arguments))))
         ,@body))

but if it has to be a macro, you could apply the same principle, using
macrolet instead of flet:

    (defmacro debug-context (var &body body)
      (check-type var symbol "a symbol denoting a variable")
      `(macrolet ((debug-log (control-string &rest arguments)
                   `(when ,,var (format t ,control-string ,@arguments))))
         ,@body))



-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
A bad day in () is better than a good day in {}.
Updated at: 2020-12-10 08:37 UTC