`log-once` - A macro for printing an expression a limited number of times

[Fictitious-Rotor]

Macro

#lang racket/base

(require racket/function
         syntax/parse/define
         (for-syntax racket/base
                     syntax/parse
                     racket/format
                     syntax/parse))

(provide log-defs
         log-once)

(define log-var (curry printf "~a = ~s. "))
(define-syntax-parser log-def
  [(_ expr:expr)
   #`(log-var #,(~s (syntax->datum #'expr)) expr)])

(begin-for-syntax
  (define (make-incrementor id)
    (with-syntax ([id id])
      #'(λ ()
          (set! id (add1 id))
          id))))

(define-syntax-parser log-defs
  [(_ (~optional (~seq #:newline use-newline-stx:boolean))
      exprs*:expr ...+)
   #:attr use-newline (syntax-e #'(~? use-newline-stx #f))
   #:attr intermediate-newline-clause (if (attribute use-newline) #'(newline) #f)
   #:attr ultimate-newline-clause (if (attribute use-newline) #f #'(newline))
   #'(begin
       (~@ (log-def exprs*)
           (~? intermediate-newline-clause)) ...
       (~? ultimate-newline-clause))])

(define-syntax-parser log-once 
  [(_ (~alt (~optional (~seq #:skip-count target-skip-count:nat) #:name "#:skip-count keyword"
                       #:defaults ([target-skip-count #'0]))
            (~optional (~seq #:log-count target-log-count:nat) #:name "#:log-count keyword"
                       #:defaults ([target-log-count #'1]))
            (~optional (~seq #:when condition:expr) #:name "#:when keyword")
            (~optional (~seq #:message message:str) #:name "#:message keyword")
            (~optional (~seq #:newline newline:boolean) #:name "#:newline keyword")) ...
      exprs* ...+)
   #:with logged (syntax-local-lift-expression #'#f)
   #:with run-count (syntax-local-lift-expression #'0)
   #:with ++run-count (make-incrementor #'run-count)
   #:with log-count (syntax-local-lift-expression #'0)
   #:with ++log-count (make-incrementor #'log-count)
   #:with should-run?! (syntax-local-lift-expression
                        #'(λ ()
                            (and (> (++run-count) target-skip-count)
                                 (<= (++log-count) target-log-count))))
   #:with stop-logging?! (syntax-local-lift-expression
                          #'(λ ()
                              (when (<= target-log-count log-count)
                                (set! logged #t))))
   #'(and (not logged)
          (when (and (~? condition)
                     (should-run?!))
            (~? (display message))
            (log-defs (~? (~@ #:newline newline)) exprs* ...)
            (stop-logging?!)))])

The purpose of this macro was to make it possible to view a sample of values within tight loops - rather than being inundated with thousands of lines of irrelevant data. It achieves this by providing a variety of tools that can be used to constrain what is logged down to what actually interests the observer.

The set of macros have gone through many revisions as I have become more knowledgable regarding syntax and syntax-parse, with this iteration making use of ~? and ~@, as well as the excellent ... from syntax-parse.

Example

#lang racket

;; The expression
(for ([char (in-string "abcdefghijklmnopqrstuvwxyz")])
    (log-once #:skip-count 18
              #:log-count 3
              char))
;; should print
;; char = #\s. 
;; char = #\t. 
;; char = #\u. 

;; This would expand out to become
(for ([char (in-string "abcdefghijklmnopqrstuvwxyz")])
    (and (not lifted/logged)
         (when (and (lifted/should-run?!))
           (log-defs char)
           (lifted/stop-logging?!))))


;; The expression
(for ([char (in-string "abcdefGhijkLmnopQrstuVwxyz")])
    (log-once #:skip-count 2
              #:when (char-upper-case? char)
              char))
;; should print
;; char = #\Q. 

;; This would expand out to become
(for ([char (in-string "abcdefGhijkLmnopQrstuVwxyz")])
    (and (not lifted/logged)
         (when (and (char-upper-case? char)
                (lifted/should-run?!))
           (log-defs char)
           (lifted/stop-logging?!))))

Before and After

The macro replaces patterns of code that would look something like this:

#lang racket
(define is-logged #f)
(define skip-count 0)
(for ([char (in-string "abcdefGhijkLmnopQrstuVwxyz")])
  (when (and (not is-logged)
             (char-upper-case? char)
             (begin
               (set! skip-count (add1 skip-count))
               (> skip-count 2)))
    (printf "char = ~s\n" char)
    (set! is-logged #t)))

;; You have to define the variables somewhere where they won't fall out of scope so that the mutations matter
;; You also have to be wary of leaving any of this code lying around once you're finished with debugging

I wrote the original edition of this macro while I was comparatively new to racket. It was my first ernest attempt at a macro.
While the original version of the macro is lost (it used a hash map of the syntax info to track what had been logged)
I do have this previous revision:

#lang racket/base

(require (only-in racket/function curry)
         (only-in syntax/parse/define define-syntax-parser)
         (for-syntax racket/base
                     syntax/parse
                     (only-in racket/format ~s)))

(provide log-defs
         log-once)

(define (return-#t . args) #t)
(define print-val-of-var (curry printf "~a = ~s. "))
(define-syntax-parser log-def
  [(_ expr:expr)
   #`(print-val-of-var #,(~s (syntax->datum #'expr)) expr)])

(define-syntax-parser log-defs
  [(_ ids*:expr ...+ (~optional (~seq #:newline use-newline?) #:defaults ([use-newline? #'#f])))
   (define newline? (syntax-e #'use-newline?))
   #`(begin
       #,@(for/foldr ([out null])
                     ([id (syntax->list #'(ids* ...))])
            (let ([log-stmt #`(log-def #,id)])
              (if newline?
                  (list* log-stmt #'(newline) out)
                  (cons log-stmt out)))))])

(define-syntax-parser log-once 
    [(_ (~optional (~seq #:count count) #:defaults ([count #'1]))
        (~optional (~seq #:when condition) #:defaults ([condition #'return-#t]))
        (~optional (~seq #:message message) #:defaults ([message #'""]))
        (~optional (~seq #:newline newline) #:defaults ([newline #'#f]))
        next* ...+)
     (define logged #f)
     (define (not-logged?) (not logged))
     (define (mark-as-logged) (set! logged #t))
     
     (define run-count 0)
     (define (increment-run-count)
       (set! run-count (add1 run-count))
       run-count)
     
     #`(and (#,not-logged?)
            (when (and condition
                       (>= (#,increment-run-count) count))
              (display message)
              (log-defs next* ...)
              (#,mark-as-logged)))])

It was here that I realised that I could declare a variable during phase 1 and store a reference to it for use later in phase 0.
As a direct reference to the variable would simply put the value within the expanded syntax, I put a reference to a function instead, the function being responsible for mutating the variable.

This varient of the macro featured an improved implementation of log-defs, which makes handy use of syntax-parse's ellipsis to repeat patterns of syntax. I also exchanged references to procedures for references to a box, which I considered more idiomatic to racket.

#lang racket/base

(require racket/function
         syntax/parse/define
         (for-syntax racket/base
                     syntax/parse
                     racket/format
                     syntax/parse))

(provide log-defs
         log-once)

(define log-var (curry printf "~a = ~s. "))
(define-syntax-parser log-def
  [(_ expr:expr)
   #`(log-var #,(~s (syntax->datum #'expr)) expr)])

(begin-for-syntax
  (require syntax/parse/define
           (for-syntax racket/base
                       racket/syntax))
  (define-syntax-parser define/incrementor
    [(_ id:id expr:expr)
     #:with increment-id (format-id #'id "++~a" #'id)
     #'(begin
         (define id expr)
         (define (increment-id)
           (set! id (add1 id))
           id))]))

(define-syntax-parser log-defs
  [(_ (~optional (~seq #:newline use-newline-stx:boolean))
      exprs*:expr ...+)
   #:attr use-newline (syntax-e #'(~? use-newline-stx #f))
   #:attr intermediate-newline-clause (if (attribute use-newline) #'(newline) #f)
   #:attr ultimate-newline-clause (if (attribute use-newline) #f #'(newline))
   #'(begin
       (~@ (log-def exprs*)
           (~? intermediate-newline-clause)) ...
       (~? ultimate-newline-clause))])

(define-syntax-parser log-once 
  [(_ (~alt (~optional (~seq #:skip-count target-skip-count:nat) #:name "#:skip-count keyword"
                       #:defaults ([target-skip-count #'0]))
            (~optional (~seq #:log-count target-log-count:nat) #:name "#:log-count keyword"
                       #:defaults ([target-log-count #'1]))
            (~optional (~seq #:when condition:expr) #:name "#:when keyword")
            (~optional (~seq #:message message:str) #:name "#:message keyword")
            (~optional (~seq #:newline newline:boolean) #:name "#:newline keyword")) ...
      exprs* ...+)
   (define logged (box #f))
   (define/incrementor run-count 0)
   (define/incrementor log-count 0)

   (define (should-run?! target-skip-count target-log-count)
     (and (> (++run-count) target-skip-count)
          (<= (++log-count) target-log-count)))

   (define (stop-logging?! target-log-count)
     (when (<= target-log-count log-count)
       (set-box! logged #t)))
     
   #`(and (not (unbox #,logged))
          (when (and (~? condition)
                     (#,should-run?! target-skip-count target-log-count))
            (~? (display message))
            (log-defs (~? (~@ #:newline newline)) exprs* ...)
            (#,stop-logging?! target-log-count)))])

The box and procedures has subsequently been replaced by usage of syntax-local-lift-expression, which eliminates the need for phase 1 variables to be referenced in phase 0 (thank you to yjqww6 for this suggestion!).

As there is no further need to interface between phases then the procedures should-run?! & stop-logging?! can take no arguments - instead relying on embedded references to other lifted identifiers.

Licence

Please confirm that you are submitting this code under the same MIT License that the Racket language uses. https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt
Please confirm that the associated text is licensed under the Creative Commons Attribution 4.0 International License http://creativecommons.org/licenses/by/4.0/

I confirm that the code is under the same license as the Racket language, and associated text is under Creative Commons Attribution 4.0 International License

Contact

To receive prizes and/or provide feedback please complete
the form at https://forms.gle/Z5CN2xzK13dfkBnF7 (google account not required / email optional).

[yjqww6]

It might be better to use syntax-local-lift-expression rather than embed a phase-1 value.

[Fictitious-Rotor]

It might be better to use syntax-local-lift-expression rather than embed a phase-1 value.

You're completely right! I've just gone through and updated my main post to use that procedure - I've also shifted my old code to the 'previous revisions' section at the bottom. Thank you for spotting that!

[spdegabrielle]

Thank you for your contribution!

If you haven’t already please take the time to fill in the form https://forms.gle/Z5CN2xzK13dfkBnF7

Bw
Stephen