PasteRack.org
Paste # 27170
2020-02-22 06:10:53

Fork as a new paste.

Paste viewed 387 times.


Embed:

#lang racket/base
(require racket/match racket/function (for-syntax racket/base syntax/parse))

(begin-for-syntax
  (struct syntax-info (position module) #:transparent))
(define logged-syntax (make-hash))
(define (return-#t . args) #t)
(define print-variable (curry printf "The value of '~a' is: '~a'. "))

(define-syntax (log-loop stx)  
  (syntax-parse stx
    [(_ id:expr next* ...+)
     #'(begin
         (print-variable (syntax->datum #'id) id)
         (log-loop next* ...))]
    [(_ id:expr)
     #'(print-variable (syntax->datum #'id) id)]))

(define-syntax (log-conditions-met stx)
  (syntax-parse stx
    [(_ id:expr count:expr condition:expr message:expr vars* ...+)
     (with-syntax ([id-stx (syntax-info (syntax-position #'id)
                                        (syntax-source-module #'id))])
       #'(let ([current-count (add1 (hash-ref logged-syntax id-stx 0))])
           (when (and (<= current-count count)
                      (condition vars* ...))
             (when (= current-count count)
               (when (not (eq? message 'none)) (display message))
               (log-loop vars* ...)
               (display "\n"))
             (hash-set! logged-syntax id-stx current-count))))]))

(define-syntax (log-once stx)
  (syntax-parse stx
    [(name (~optional (~seq #:count count) #:defaults ([count #'1]))
           (~optional (~seq #:when condition) #:defaults ([condition #'return-#t]))
           (~optional (~seq #:message message) #:defaults ([message #''none]))
           next* ...+)
     #'(log-conditions-met name count condition message next* ...)]))