如何让宏评估它的一些参数？

Question

我正在尝试制作一个使用宏 (doc) 编写文档的玩具系统：

示例 #1：

(doc id: 1
     title: "First document"
     "First sentence."
     "Second sentence.")

预期扩展：

(make-doc (list (list 'id: 1) (list 'title: "First document"))
          (list "First sentence" "Second sentence"))

示例 #2：

(let ((my-name "XYZ"))
 (doc title: "Second document"
      id: (+ 1 1)
      "First sentence."
      (string-append "My name is " my-name ".")
      "Last sentence."))

预期扩展：

(let ((my-name "XYZ"))
  (make-doc (list (list 'title: "Second document") (list 'id: (+ 1 1)))
            (list "First sentence."
                  (string-append "My name is " my-name ".")
                  "Last sentence.")))

对该宏的更多示例调用是：

(doc id: 1 "First sentence." "Second sentence.")

(doc id: 1 title: "First document" subtitle: "First subdocument" 
     "First sentence." "Second sentence." "Third sentence.")

首先是元数据规范，然后是句子。元数据必须在句子之前。宏必须接受任意数量的元数据规范。

评估(doc ...) 应该返回一个字符串，或者将结果文本写入文件。但是我还没有实现这个功能，因为我被困在doc 宏的定义上（这是这个问题的重点）。

下面是我对doc 宏的实现。词汇：title: "ABC"和id: 123被称为“元数据”； title: 和 id: 被称为“元数据 ID”。

;;; (metadata-id? 'x:) -> #t
;;; (metadata-id? 'x) -> #f
;;; (metadata-id? "Hi!") -> #f
(define (metadata-id? x)
  (cond [(symbol? x)
         (let* ([str (symbol->string x)]
                [last-char (string-ref str (- (string-length str) 1))])
           (char=? last-char #\:))]
        [else #f]))

;;; (pair-elements '(1 2 3 4 5)) -> '((1 2) (3 4) (5)).
(define (pair-elements l [acc '()] [temp null])
  (cond [(and (null? l) (null? temp)) acc]
        [(null? l)
         (append acc (list (list temp)))]
        [(null? temp)
         (pair-elements (cdr l) acc (car l))]
        [else
         (pair-elements (cdr l)
                        (append acc (list (list temp (car l)))))]))

(define-syntax doc
  (syntax-rules ()
    ((doc arg . args)
     (let* ([orig-args (cons 'arg 'args)]
            [metadata-bindings (takef (pair-elements orig-args)
                                      (lambda (e)
                                        (metadata-id? (car e))))]
            [sentences (drop orig-args (* 2 (length metadata-bindings)))])
       (make-doc metadata-bindings sentences)))))

(define (make-doc metadata-bindings sentences)
  ;; Do something ...
  ;; Placeholder stubs:
  (writeln metadata-bindings)
  (writeln sentences))

使用此实现，评估示例 #1 会按预期打印：

((id: 1) (title: "First document"))
("First sentence." "Second sentence.")

但是，评估示例 #2 打印：

((id: (+ 1 1)) (title: "Second document"))
("First sentence." (string-append "My name is " my-name ".") "Last sentence.")

显然，参数没有被评估。示例 #2 的预期结果应该是这样的：

((id: 2) (title: "Second document"))
("First sentence." "My name is XYZ." "Last sentence.")

doc 宏的实现有什么问题？如何让宏评估它的一些参数？

Answer 1

原因是您引用了'args，这导致它在宏扩展后是一个s-表达式，而不是使用函数应用程序进行评估。要解决此问题，您可能需要使用 quasiquote。这还需要您重新设计宏模式的指定方式。我建议使用... 表示法。这是我所描述内容的草图：

(define-syntax doc
  (syntax-rules ()
    [(doc arg rest-args ...)
     (let* ([orig-args `(arg ,rest-args ...)]
            ; the rest is the same
            ))])) 

Answer 2

我不确定这是否是正确的方法，但我已经设法在 Racket 中使用 syntax-case 编写了一个辅助宏 parse-args。它的工作原理是这样的：

(parse-args title: "Interesting document"
            id: (+ 1 2)
            "First sentence."
            (string-append "Second sentence" "!")
            "Last sentence.")

上面被转换成一个列表：

'((metadata title: "Interesting document")
  (metadata id: 3)
  (sentences "First sentence."
             "Second sentence!"
             "Last sentence."))

实施：

(begin-for-syntax
  ;;; (metadata-id? 'x:) -> #t; (metadata-id? 'x) -> #f.
  (define (metadata-id? x)
    (cond [(symbol? x)
           (let* ([str (symbol->string x)]
                  [last-char (string-ref str (- (string-length str) 1))])
             (char=? last-char #\:))]
          [else #f])))

(define-syntax (parse-args stx)
  (syntax-case stx ()
    [(_ arg1 arg2)  ; If no sentences.
     (metadata-id? (syntax->datum (syntax arg1)))
     (syntax `((metadata arg1 ,arg2)))]
    [(_ arg1 arg2 rest-args ...)
     (metadata-id? (syntax->datum (syntax arg1)))
     (syntax `((metadata arg1 ,arg2) ,@(parse-args rest-args ...)))]
    [(_ sentence rest-sentences ...)
     (syntax (list `(sentences ,sentence ,rest-sentences ...)))]))

请注意我是如何使用“挡泥板”的 ((metadata-id? (syntax->datum (syntax arg1))))。这是syntax-rules 宏中缺少的关键功能，这就是我使用syntax-case 实现宏的原因。

现在我能够解析参数，剩下的就是在doc 的定义中使用parse-args。

(define-syntax (doc stx)
  (syntax-case stx ()
    ((doc arg rest-args ...)
     (syntax (apply make-doc
                    (group-args (parse-args arg rest-args ...)))))))

group-args 重新排列parse-args 返回的列表，如下所示：

(group-args '((metadata a: 1)
              (metadata b: 2)
              (sentences "ABC" "DEF")))
;; Returns:
;;   '(((a: 1)
;;      (b: 2))
;;     ("ABC" "DEF"))
;; The car is an assoc list of metadata.
;; The cadr is the list of sentences.

实施：

;;; 'lst' is valid even if there is no 'metadata'.
;;; 'lst' is valid even if there is no 'sentences'.
;;; However, if there is a 'sentences', it must be the last item in the list.
(define (group-args lst [metadata-acc '()])
  (define tag-name car)
  (define remove-tag cdr)
  (cond [(null? lst) (list metadata-acc '())]
        [(eq? 'metadata (tag-name (car lst)))
         (group-args (cdr lst)
                     (cons (remove-tag (car lst))
                           metadata-acc))]
        [(eq? 'sentences (tag-name (car lst)))
         (cons metadata-acc
               (list (remove-tag (car lst))))]
        [else
         (error "Invalid values" lst)]))

make-doc 现在可以这样定义：

;;; 'metadata' is an assoc list of metadata.
;;; 'sentences' is a list of strings.
(define (make-doc metadata sentences)
  ;; ... create the document ...
  ;; Placeholder stubs:
  (display "ID: ")
  (displayln (cadr (assq 'id: metadata)))
  (display "Title: ")
  (displayln (cadr (assq 'title: metadata)))
  (displayln sentences))

用法：

(let ((my-name "XYZ"))
 (doc title: "Second document"
      id: (+ 1 1)
      "First sentence."
      (string-append "My name is " my-name ".")
      "Last sentence."))

打印：

ID: 2
Title: Second document
(First sentence. My name is XYZ. Last sentence.)

Answer 3

我建议您使用syntax/parse 库，因为用它编写这种宏要容易得多。

#lang racket

(require syntax/parse/define)

(define (make-doc x y) `(make-doc ,x ,y))

(begin-for-syntax
  ;; metadata-id? :: symbol? -> boolean?
  (define (metadata-id? x)
    (define str (symbol->string x))
    (define len (string-length str))
    ;; Need to check that len > 0.
    ;; Otherwise, the empty identifier (||)
    ;; would cause an "internal" error
    (and (> len 0)
         (char=? (string-ref str (sub1 len)) #\:)))
  
  (define-splicing-syntax-class key-val-class
    (pattern (~seq key:id val:expr)
             #:when (metadata-id? (syntax-e #'key)))))

(define-simple-macro (doc key-val:key-val-class ... xs ...)
  (make-doc (list (list (quote key-val.key) key-val.val) ...)
            (list xs ...)))

;;;;;;;;;;;;;;;;;

(doc id: 1
     title: "First document"
     "First sentence."
     "Second sentence.")

;; '(make-doc ((id: 1) (title: "First document")) ("First sentence." "Second sentence."))

(let ([my-name "XYZ"])
  (doc title: "Second document"
       id: (+ 1 1)
       "First sentence."
       (string-append "My name is " my-name ".")
       "Last sentence."))

;; '(make-doc
;;   ((title: "Second document") (id: 2))
;;   ("First sentence." "My name is XYZ." "Last sentence."))

(let ([|| 1])
  (doc || 2))

;; '(make-doc () (1 2))