如何用模板宏重寫這個宏？

Question

假設我想在球拍/方案中定義一個工具「定義」的宏。具體來說，它計算定義體中的數字文字，然後將此數字添加到所有這些文字（這應發生在宏觀擴展階段）。

這是一個正常功能的風格（如列表上的語法樹操作）中定義的宏：我想重寫它在正常球拍/方案模板的宏風格

#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)) 

。這裏是我的（失敗）嘗試：

#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)) 

的想法是分階段儀器代碼：首先標誌着語法樹的所有節點，再算上文字，以「改造」，其中需要更換宏觀痕跡......好吧，正如所評論的「顯示」將顯示的那樣，宏「標記」在所有「下降」完成之前開始擴展（因此它們仍然處於由宏代碼捕獲的狀態）。即使「display-counting-n」擴展得太快，而「n」仍然是0.

有沒有辦法改變宏擴展的順序？我希望球拍/方案分階段進行擴展：首先是「下降」，然後是「標記」，然後是「變形」，然後是「顯示計數-n」。

我讀過How to control order of Scheme macro expansion?的答案 - 看起來用模板宏來實現這樣一個任務的唯一方法是使用「祕密文字」並在一個大的宏定義中定義所有的東西。不過，我想這會讓代碼更難寫和讀。有沒有其他的方式，也許？

Answer 1

這裏是我的版本的syntax-case版本的宏：

(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)))) 

這使得使用語法後衛（也被稱爲擋泥板）的決定語法數據是否是數字或沒有。對於一些更易於閱讀，你可以使用syntax-parse，它允許你指定語法類，如number，而不是使用語法後衛：

(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)))))) 

例子：

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