2
votes

Suppose I want to define a macro in Racket/Scheme that instruments "defines". Specifically, it counts number literals in the body of a define and then adds this number to all those literals (this should happen in the macro-expansion phase).

Here is the macro defined in a normal function style (operating on the syntax tree as lists):

#lang racket

(require
  (for-syntax racket/syntax)
  (rename-in racket [define define/racket]))

(define-for-syntax (count-and-transform e)
  (define tree (syntax->datum e))
  ; count number literals
  (define (count t)
    (if (list? t)
        (apply + (map count t))
        (if (number? t) 1 0)))
  (define n (count tree))
  ; transform number literals
  (define (transform t)
    (if (list? t)
        (map transform t)
        (if (number? t) (+ t n) t)))
  (values n (datum->syntax e (transform tree))))

; rewrite defines
(define-syntax (define stx)
  (syntax-case stx ()
    [(_ signature body)
     (let-values ([(n new-body)
                   (count-and-transform #'body)])
       #`(begin
           (display "number of literals in function ")
           (display 'signature) (display ": ") (displayln #,n)
           (define/racket signature #,new-body)))]))

(define (add-some x) (if (= x 0) (+ x 1) 2))

I want to rewrite it in normal Racket/Scheme template macros style. Here was my (unsuccessful) try:

#lang racket

(require
  (for-syntax racket/syntax)
  (rename-in racket [define define/racket]))

(define-for-syntax n 0)

; rewrite defines
(define-syntax-rule
  (define signature body)
  (begin
    (display "number of literals in function ")
    (display 'signature) (display ": ") (display-counted-n)
    (define/racket signature (descent body))))

; descent the syntax tree and mark all nodes
(define-syntax descent
  (syntax-rules (f-node a-node)
    [(_ (f etc ...)) (mark (f (descent etc) ...))]
    [(_ a etc ...) (mark a (descent etc) ...)]))

; count number literals
(define-syntax (mark stx)
  (syntax-case stx ()
    [(_ node)
     (begin
       ;(display n) (display " : ") (displayln (syntax->datum #'node))
       (if (number? (syntax-e #'node))
           (begin
             (set! n (add1 n))
             #'(transform node))
           #'node))]))

; transform number literals
(define-syntax (transform stx)
  (syntax-case stx ()
    [(_ node)
     (let* ([i (syntax->datum #'node)]
            [i+n (+ i n)])
       (begin
         ;(display i) (display " -> ") (displayln i+n)
         (datum->syntax stx i+n)))]))

(define-syntax (display-counted-n stx)
  (syntax-case stx ()
    [(_) #`(displayln #,n)]))

(define (add-some x) (if (= x 0) (+ x 11) 13))

The idea was to instrument code in stages: first mark all nodes in a syntax tree, then count literals, replacing marks with "transform" macro where needed... Well, as the commented "displays" would show, macro "mark" starts expansion before all "descents" are finished (so they are still in the captured by the macro code). Even "display-counted-n" is expanded too quickly, while "n" is still 0.

Is there a way to change the order of macros expansion? I want Racket/Scheme to do expansion in stages: first "descent", then "mark", then "transform", then "display-counted-n".

I've read the answer to How to control order of Scheme macro expansion? - and it seems the only way to realize such a task with template macros is to use "secret literals" and define everything within one big macro definition. I guess, however, this would make code harder to write and read. Is there some other way, perhaps?

1

1 Answers

2
votes

Here's my version of a syntax-case version of your macro:

(define-syntax (lambda-fun stx)
  (define (count-numeric-literals stx2)
    (syntax-case stx2 ()
      (num (number? (syntax->datum #'num)) 1)
      ((first rest ...) (+ (count-numeric-literals #'first)
                           (count-numeric-literals #'(rest ...))))
      (_ 0)))

  (define (instrument-numeric-literals stx3 n)
    (syntax-case stx3 ()
      (num (number? (syntax->datum #'num))
           (datum->syntax #'num (+ (syntax->datum #'num) n)))
      ((first rest ...)
       (with-syntax ((a (instrument-numeric-literals #'first n))
                     ((b ...) (instrument-numeric-literals #'(rest ...) n)))
         #'(a b ...)))
      (x #'x)))

  (syntax-case stx ()
    ((_ params . body)
     (let ((count (count-numeric-literals #'body)))
       (with-syntax ((instrumented (instrument-numeric-literals #'body count)))
         #'(lambda params . instrumented))))))

(define-syntax define-fun
  (syntax-rules ()
    ((_ (f . params) . body)
     (define f (lambda-fun params . body)))
    ((_ . passthrough)
     (define . passthrough))))

This makes use of syntax guards (also known as fenders) to decide whether a syntax datum is numeric or not. For something easier to read, you can use syntax-parse, which allows you to specify syntax classes, like number, instead of using syntax guards:

(require (for-syntax syntax/parse))

(define-syntax (lambda-fun stx)
  (define (count-numeric-literals stx2)
    (syntax-parse stx2
      (num:number 1)
      ((first rest ...) (+ (count-numeric-literals #'first)
                           (count-numeric-literals #'(rest ...))))
      (_ 0)))

  (define (instrument-numeric-literals stx3 n)
    (syntax-parse stx3
      (num:number (datum->syntax #'num (+ (syntax->datum #'num) n)))
      ((first rest ...)
       (with-syntax ((a (instrument-numeric-literals #'first n))
                     ((b ...) (instrument-numeric-literals #'(rest ...) n)))
         #'(a b ...)))
      (x #'x)))

  (syntax-parse stx
    ((_ params . body)
     (let ((count (count-numeric-literals #'body)))
       (with-syntax ((instrumented (instrument-numeric-literals #'body count)))
         #'(lambda params . instrumented))))))

Example:

> (define-fun (fun) (+ 1 2 3 4))
> (fun)
26