如何将涉及语法大小写的r6rs宏转换为racket？

Question

我正在学习方案/球拍宏，并试图使以下宏从甜宏工作在球拍8.6下。

#lang racket

(require (for-meta 1 srfi/1)) ; for cons* and fold-right
(provide guarded-syntax-case)

;;GUARDED-SYNTAX-CASE
(define-syntax guarded-syntax-case
  (let ((add-clause
         (lambda (clause acc)
           (syntax-case clause ()
             ((pattern skeleton . rest)
                (syntax-case #'rest ()
                  ((cond? else1 else2 ...)
                   (cons*
                    #'(pattern cond? skeleton)
                    #'(pattern (begin else1 else2 ...))
                    acc))
                  ((cond?)
                   (cons #'(pattern cond? skeleton) acc))
                  (()
                   (cons #'(pattern skeleton) acc))
                  ))))))
    (lambda (x)
      (syntax-case x ()
        ((guarded-syntax-case y (literal ...) clause ...)
         (with-syntax (((c ...) (fold-right add-clause '() #'(clause ...))))
           #'(syntax-case y (literal ...) c ...)))))))
;;END

宏是为plt-r6rs编写的，但我想在球拍解释器/REPL中进行实验(这在球拍的r6rs中是禁止的)。

除了添加进口产品之外，我无法取得很大进展：

(require (for-meta 1 srfi/1))

现在，在测试guarded-syntax-case时，我假设它类似于racket/r6rs syntax-case，但是有一些附加的功能。因此，我测试了以下经过调整的示例：

(syntax->datum
   (guarded-syntax-case #'(+ 1 2) ()
    [(op n1 n2) #'(- n1 n2)]))

但有个错误：

. . null-list?: argument out of domain #<syntax:my-sweet.rkt:26:61 (((op n1 n2) (syntax (- n1 n2))))>

很长一段时间后，我不知道如何修复这个错误，因为我刚刚开始学习宏。

有人能帮我解释一下为什么这个宏不适用于球拍，以及如何让它与球拍一起工作？

我只能猜到树枝：

              (()
               (cons #'(pattern skeleton) acc))

在上面的示例中达到。我看到不同的方案实现在转换到/从语法对象时可以不同地处理#'(pattern skeleton)。所以这里的cons可能是个问题。

Answer 1

(不是对问题的回答，而是太长，不能发表评论)：

人们可能会注意到，guarded-syntax-case似乎在模仿syntax-case的标准R6RS护舷选项，这是在球拍中提供的。可以编写在multi-define中使用guarded-syntax-case的甜宏示例：

#lang racket
(require test-engine/racket-tests)
        
(define-syntax multi-define
  (lambda (x)
    (syntax-case x ()
      [(_ (name ...) (value ...))                       ; pattern
       (or (= (length (syntax->datum #'(name ...)))     ; fender ("guard")
              (length (syntax->datum #'(value ...))))   ;
         (raise-syntax-error 'multi-define "Names and values do not match" #f #f
                             (list #'(name ...) #'(value ...))))
       #'(begin (define name value) ...) ])))           ; template ("skeleton")

(multi-define (a b) (1 2))
(check-expect a 1)
(check-expect b 2)

(multi-define (a b c) (1 2))

(test)