如何用Guile Scheme的syntax-case实现Clojure风格loop/recur宏？

问题背景 #

我正在学习syntax-case宏系统，想要实现一个类似Clojure的loop宏：它的行为和Scheme的命名let一致，但变量与初始值采用扁平列表的写法，而非(var val)成对列表。

尝试的代码与问题 #

最初的实现代码：

(define-syntax loop
  (lambda (x)
    (syntax-case x ()
      [(_ (var val x ...) body)
       (with-syntax ([recur (datum->syntax #'var 'recur)])
         #'(let recur ((var val) x ...)
                body))])))

(loop [i 0 j 10]
  (if (< i 10)
      (begin
        (display i)
        (display " ")
        (display j)
        (newline)
        (recur (+ i 1) (- j 1)))))

这段代码生成的let绑定存在错误，结果为：

[(i 0) j 10]

修改后的代码：

(define-syntax loop
  (lambda (x)
    (syntax-case x ()
      [(_ (var val ...) body)
       (with-syntax ([recur (datum->syntax #'var 'recur)])
         #'(let recur ((var val) ...)
                body))])))

生成的绑定变成了：

[(i 0) (i j) (i 10)]

我意识到需要用递归宏处理，但不清楚如何在syntax-case中实现。

语法参考 #

• Clojure的loop示例：

(loop [i 10 j 20]
  (if (> i 0)
      (recur (- i 1) (- j 2))))

• 对应的Scheme命名let写法：

(let recur ((i 10)
            (j 20))
  (if (> i 0)
      (recur (- i 1) (- j 2))))

解决方案 #

要将扁平的参数列表转换为(var val)成对绑定，需要在syntax-case中使用递归模式匹配，每次提取一对变量和值，直到处理完所有参数。

完整实现 #

(define-syntax loop
  (lambda (stx)
    (syntax-case stx ()
      ;; 边界情况：无参数时生成空绑定的命名let
      [(_ () body)
       (with-syntax ([recur (datum->syntax stx 'recur)])
         #'(let recur () body))]
      ;; 递归情况：提取一对var val，处理剩余参数
      [(_ (var val . rest) body)
       (with-syntax ([recur (datum->syntax #'var 'recur)]
                     ;; 递归展开剩余参数为成对绑定
                     [(bind ...) (syntax-case #'(rest) ()
                                   [(r ...) #'((r ...) ...)])])
         #'(let recur ((var val) bind ...) body))])))

代码说明 #

1. 边界模式：(_ () body)处理参数列表为空的情况，生成不带绑定的命名let，避免递归无限循环。
2. 递归模式：(_ (var val . rest) body)每次从扁平列表中提取第一个变量var和对应初始值val，然后通过递归处理剩余的rest部分，将剩余参数也转换为(var val)的成对形式。
3. 语法环境处理：使用datum->syntax生成recur标识符，确保它和循环变量处于同一语法作用域，避免命名冲突或作用域错误。

测试验证 #

运行测试代码：

(loop [i 0 j 10]
  (if (< i 10)
      (begin
        (display i)
        (display " ")
        (display j)
        (newline)
        (recur (+ i 1) (- j 1)))))

会被正确展开为：

(let recur ((i 0) (j 10))
  (if (< i 10)
      (begin
        (display i)
        (display " ")
        (display j)
        (newline)
        (recur (+ i 1) (- j 1)))))

执行后输出预期结果：

0 10
1 9
2 8
3 7
4 6
5 5
6 4
7 3
8 2
9 1

内容的提问来源于stack exchange，提问作者jcubic