Macros 如何对使用语法分析捕获的可选属性进行分组？

在编写使用

语法/parse

的宏时，我创建了一个拼接语法类，该类捕获可能提供给宏的选项。这些选项都是可选的，可以按任何顺序提供。使用

~可选的

省略号头部模式可以很容易地做到这一点：

(define-splicing-syntax-class opts
  (pattern (~seq (~or (~optional (~seq #:a a))
                      (~optional (~seq #:b b))
                      (~optional (~seq #:x x))
                      (~optional (~seq #:y y)))
                 ...))

但是，有一个问题：我希望能够将这些选项分为两组：一组包含

a

和

b

，另一组包含

x

和

y

。但是，用户仍然可以按任何顺序指定选项，因此对于本示例输入：

(foobar #:b 3 #:y 7 #:a 2)

我希望能够生成以下属性：

first-opts:  (#:a 2 #:b 3)
second-opts: (#:y 7)

到目前为止，我已经设法使用

#：with

手动完成了这项工作，但它并不漂亮：

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~optional (~seq #:a a))
                      (~optional (~seq #:b b))
                      (~optional (~seq #:x x))
                      (~optional (~seq #:y y)))
                 ...)
           #:with (first-opts ...)
           #`(#,@(if (attribute a) #'(#:a a) #'())
              #,@(if (attribute b) #'(#:b b) #'()))
           #:with (second-opts ...)
           #`(#,@(if (attribute x) #'(#:x x) #'())
              #,@(if (attribute y) #'(#:y y) #'()))))

使用

syntax/parse/experimental/template

中的

template

可以稍微简化这一点：

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~optional (~seq #:a a))
                      (~optional (~seq #:b b))
                      (~optional (~seq #:x x))
                      (~optional (~seq #:y y)))
                 ...)
           #:with (first-opts ...)
           (template ((?? (?@ #:a a))
                      (?? (?@ #:b b))))
           #:with (second-opts ...)
           (template ((?? (?@ #:a x))
                      (?? (?@ #:b y))))))

然而，这实际上只是上面提到的一些糖分，实际上并没有解决必须在每个子句中枚举每个选项的问题。例如，如果我添加了一个

#：c

选项，我需要记住将其添加到

first opts

组，否则它将被完全忽略

我真正想要的是一些声明性的方式来对这些可选值集进行分组。例如，我想要这样的语法：

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~group first-opts
                              (~optional (~seq #:a a))
                              (~optional (~seq #:b b)))
                      (~group second-opts
                              (~optional (~seq #:x x))
                              (~optional (~seq #:y y))))
                 ...)))

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~and first-opts
                            (~seq (~optional (~seq #:a a))
                                  (~optional (~seq #:b b))))
                      (~and second-opts
                            (~seq (~optional (~seq #:x x))
                                  (~optional (~seq #:y y)))))
                 ...)))

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~optional (~seq #:a a) #:defaults ([a #'#f]))
                      (~optional (~seq #:b b) #:defaults ([b #'#f]))
                      (~optional (~seq #:x x) #:defaults ([x #'#f]))
                      (~optional (~seq #:y y) #:defaults ([y #'#f])))
                 ...)
           #:with (first-opts ...) #'(#:a a #:b b)
           #:with (second-opts ...) #'(#:x x #:y y)

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  [pattern (~groups-no-order
            [first-opts
             (~optional (~seq #:a a))
             (~optional (~seq #:b b))]
            [second-opts
             (~optional (~seq #:x x))
             (~optional (~seq #:y y))])])

(syntax-parse #'(foobar #:b 3 #:y 7 #:a 2)
  [(foobar opts:opts)
   (values #'(opts.first-opts ...)
           #'(opts.second-opts ...))])
; #<syntax (#:a 2 #:b 3)>
; #<syntax (#:y 7)>

#lang racket
(provide ~groups-no-order)

(require syntax/parse
         seq-no-order
         (for-syntax racket/syntax
                     syntax/stx))

(define-syntax ~groups-no-order
  (pattern-expander
   (lambda (stx)
     (syntax-case stx ()
       [(groups [group-name member-pat ...] ...)
        (with-syntax ([ooo (quote-syntax ...)])
          (define/with-syntax [[member-tmp ...] ...]
            (stx-map generate-temporaries #'[[member-pat ...] ...]))
          (define/with-syntax [group-tmp ...]
            (generate-temporaries #'[group-name ...]))
          #'(~and (~seq-no-order (~and (~seq (~var member-tmp) ooo)
                                       member-pat)
                                 ... ...)
                  (~parse [[(~var group-tmp) ooo] ooo] #'[[member-tmp ooo] ...])
                  ...
                  (~parse [group-name ooo] #'[group-tmp ooo ooo])
                  ...))]))))

或者，更好的是，如果我可以使用现有的原语，就像这样：

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~group first-opts
                              (~optional (~seq #:a a))
                              (~optional (~seq #:b b)))
                      (~group second-opts
                              (~optional (~seq #:x x))
                              (~optional (~seq #:y y))))
                 ...)))

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~and first-opts
                            (~seq (~optional (~seq #:a a))
                                  (~optional (~seq #:b b))))
                      (~and second-opts
                            (~seq (~optional (~seq #:x x))
                                  (~optional (~seq #:y y)))))
                 ...)))

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~optional (~seq #:a a) #:defaults ([a #'#f]))
                      (~optional (~seq #:b b) #:defaults ([b #'#f]))
                      (~optional (~seq #:x x) #:defaults ([x #'#f]))
                      (~optional (~seq #:y y) #:defaults ([y #'#f])))
                 ...)
           #:with (first-opts ...) #'(#:a a #:b b)
           #:with (second-opts ...) #'(#:x x #:y y)

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  [pattern (~groups-no-order
            [first-opts
             (~optional (~seq #:a a))
             (~optional (~seq #:b b))]
            [second-opts
             (~optional (~seq #:x x))
             (~optional (~seq #:y y))])])

(syntax-parse #'(foobar #:b 3 #:y 7 #:a 2)
  [(foobar opts:opts)
   (values #'(opts.first-opts ...)
           #'(opts.second-opts ...))])
; #<syntax (#:a 2 #:b 3)>
; #<syntax (#:y 7)>

#lang racket
(provide ~groups-no-order)

(require syntax/parse
         seq-no-order
         (for-syntax racket/syntax
                     syntax/stx))

(define-syntax ~groups-no-order
  (pattern-expander
   (lambda (stx)
     (syntax-case stx ()
       [(groups [group-name member-pat ...] ...)
        (with-syntax ([ooo (quote-syntax ...)])
          (define/with-syntax [[member-tmp ...] ...]
            (stx-map generate-temporaries #'[[member-pat ...] ...]))
          (define/with-syntax [group-tmp ...]
            (generate-temporaries #'[group-name ...]))
          #'(~and (~seq-no-order (~and (~seq (~var member-tmp) ooo)
                                       member-pat)
                                 ... ...)
                  (~parse [[(~var group-tmp) ooo] ooo] #'[[member-tmp ooo] ...])
                  ...
                  (~parse [group-name ooo] #'[group-tmp ooo ooo])
                  ...))]))))

然而，这两种方法都不起作用。使用

syntax/parse

提供的内置代码有什么方法可以做到这一点吗？如果没有，有什么简单的方法来定义像

~group

这样的东西吗？

我（还）不确定有什么方法可以用

~group

这样的东西来实现这一点，但是有一种方法可以让你现有的（正在工作的）解决方案使用

：with

看起来更好。也许对你的案子有用，也许不行

接受默认参数

#：默认值

，可以将其设置为空语法列表、

#'#f

或其他一些前哨值，从而删除在

#：with

子句中包含

if

语句的要求。它看起来像这样：

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~group first-opts
                              (~optional (~seq #:a a))
                              (~optional (~seq #:b b)))
                      (~group second-opts
                              (~optional (~seq #:x x))
                              (~optional (~seq #:y y))))
                 ...)))

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~and first-opts
                            (~seq (~optional (~seq #:a a))
                                  (~optional (~seq #:b b))))
                      (~and second-opts
                            (~seq (~optional (~seq #:x x))
                                  (~optional (~seq #:y y)))))
                 ...)))

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~optional (~seq #:a a) #:defaults ([a #'#f]))
                      (~optional (~seq #:b b) #:defaults ([b #'#f]))
                      (~optional (~seq #:x x) #:defaults ([x #'#f]))
                      (~optional (~seq #:y y) #:defaults ([y #'#f])))
                 ...)
           #:with (first-opts ...) #'(#:a a #:b b)
           #:with (second-opts ...) #'(#:x x #:y y)

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  [pattern (~groups-no-order
            [first-opts
             (~optional (~seq #:a a))
             (~optional (~seq #:b b))]
            [second-opts
             (~optional (~seq #:x x))
             (~optional (~seq #:y y))])])

(syntax-parse #'(foobar #:b 3 #:y 7 #:a 2)
  [(foobar opts:opts)
   (values #'(opts.first-opts ...)
           #'(opts.second-opts ...))])
; #<syntax (#:a 2 #:b 3)>
; #<syntax (#:y 7)>

#lang racket
(provide ~groups-no-order)

(require syntax/parse
         seq-no-order
         (for-syntax racket/syntax
                     syntax/stx))

(define-syntax ~groups-no-order
  (pattern-expander
   (lambda (stx)
     (syntax-case stx ()
       [(groups [group-name member-pat ...] ...)
        (with-syntax ([ooo (quote-syntax ...)])
          (define/with-syntax [[member-tmp ...] ...]
            (stx-map generate-temporaries #'[[member-pat ...] ...]))
          (define/with-syntax [group-tmp ...]
            (generate-temporaries #'[group-name ...]))
          #'(~and (~seq-no-order (~and (~seq (~var member-tmp) ooo)
                                       member-pat)
                                 ... ...)
                  (~parse [[(~var group-tmp) ooo] ooo] #'[[member-tmp ooo] ...])
                  ...
                  (~parse [group-name ooo] #'[group-tmp ooo ooo])
                  ...))]))))

---

希望这能有所帮助。

有一种方法可以使用

~groups no order

模式扩展器做到这一点，如下所示：

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~group first-opts
                              (~optional (~seq #:a a))
                              (~optional (~seq #:b b)))
                      (~group second-opts
                              (~optional (~seq #:x x))
                              (~optional (~seq #:y y))))
                 ...)))

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~and first-opts
                            (~seq (~optional (~seq #:a a))
                                  (~optional (~seq #:b b))))
                      (~and second-opts
                            (~seq (~optional (~seq #:x x))
                                  (~optional (~seq #:y y)))))
                 ...)))

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  (pattern (~seq (~or (~optional (~seq #:a a) #:defaults ([a #'#f]))
                      (~optional (~seq #:b b) #:defaults ([b #'#f]))
                      (~optional (~seq #:x x) #:defaults ([x #'#f]))
                      (~optional (~seq #:y y) #:defaults ([y #'#f])))
                 ...)
           #:with (first-opts ...) #'(#:a a #:b b)
           #:with (second-opts ...) #'(#:x x #:y y)

(define-splicing-syntax-class opts
  #:attributes ([first-opts 1] [second-opts 1])
  [pattern (~groups-no-order
            [first-opts
             (~optional (~seq #:a a))
             (~optional (~seq #:b b))]
            [second-opts
             (~optional (~seq #:x x))
             (~optional (~seq #:y y))])])

(syntax-parse #'(foobar #:b 3 #:y 7 #:a 2)
  [(foobar opts:opts)
   (values #'(opts.first-opts ...)
           #'(opts.second-opts ...))])
; #<syntax (#:a 2 #:b 3)>
; #<syntax (#:y 7)>

#lang racket
(provide ~groups-no-order)

(require syntax/parse
         seq-no-order
         (for-syntax racket/syntax
                     syntax/stx))

(define-syntax ~groups-no-order
  (pattern-expander
   (lambda (stx)
     (syntax-case stx ()
       [(groups [group-name member-pat ...] ...)
        (with-syntax ([ooo (quote-syntax ...)])
          (define/with-syntax [[member-tmp ...] ...]
            (stx-map generate-temporaries #'[[member-pat ...] ...]))
          (define/with-syntax [group-tmp ...]
            (generate-temporaries #'[group-name ...]))
          #'(~and (~seq-no-order (~and (~seq (~var member-tmp) ooo)
                                       member-pat)
                                 ... ...)
                  (~parse [[(~var group-tmp) ooo] ooo] #'[[member-tmp ooo] ...])
                  ...
                  (~parse [group-name ooo] #'[group-tmp ooo ooo])
                  ...))]))))

---

这与使用

#的第一个解决方案的作用相同：使用
，但它将这些内容抽象到可重用的模式扩展器中。
我认为使用
~和
可以得到最简单的宏，但是，
~和
的头部模式版本限制性更强，不太有效，所以我将头部模式部分分离出来

下面的代码是否达到了您的要求

如果没有头部图案，则会丢失
~可选的
，因此我会手动检查重复的头部图案

另外，
第一个选项
和
第二个选项
也没有展平，但我怀疑这样可以吗

#lang racket
(require (for-syntax syntax/parse racket/list))

(define-for-syntax (check-duplicate-kws kws-stx)
  (check-duplicates (syntax->list kws-stx) #:key syntax->datum))

(define-syntax test
  (syntax-parser
    [(_ (~seq k:keyword v) ...)
     #:fail-when (check-duplicate-kws #'(k ...)) "duplicate keyword"
     #:with ((~or (~and first-opts (~or (#:a _) (#:b _)))
                  (~and second-opts (~or (#:c _) (#:d _)))) ...)
            #'((k v) ...)
     #'(void)]))

这对我不起作用，因为我没有使用默认值——我需要没有提供的关键字参数，以避免在扩展中出现。