defmacro

Lisp 系言語はひとくくりにされがちであるが、実際には無数に分かれている。 大抵の場合、それぞれの間にある違いは些細なものではない。
私自身は Scheme ばかり使っていて、他についてはあまり知らないのだが、 CommonLisp のマクロ定義の機構である defmacro は Gauche にある define-macro と同じようなものだろうと思っていた。
しかし、 CommonLisp で解説している書籍「On Lisp」においてこんなコードがあるのが目に止まった。

(defmacro for ((var start stop) &body body)
  `(do ((,var ,start (1+ ,var))
        (limit ,stop))
     ((> ,var limit))
     ,@body))

引数部分がネスト構造になっている。 単純なパターンマッチが可能らしい。
同等の機能を Scheme で再現しようと試みた。 CommonLisp の仕様を読んでいるわけではないし、完全な再現を目指すものでもない余興である。
R6RS の範囲内で書いているつもり。

(library (defmacro)
  (export defmacro gensym)
  (import (rnrs))

  (define-syntax defmacro
    (lambda(s1)

      (define (flatten x)
        (define (%flatten x)
          (syntax-case x ()
            (((a ...))
             (syntax (a ...)))
            (((a ...) (x ...) y ...)
             (%flatten (syntax ((a ...) x ... y ...))))
            (((a ...) (x ...) y ... . z)
             (%flatten (syntax ((a ...) x ... y ... z))))
            (((a ...) (x v ... . z) y ...)
             (%flatten (syntax ((a ...) x v ... z y ...))))
            (((a ...) x y ...)
             (%flatten (syntax ((a ... x) y ...))))
            (((a ...) x y ... . z)
             (%flatten (syntax ((a ... x) y ... z))))))
        (%flatten #`(() . #,x)))    

      (define (filter-id x)
        (define (%filter-id x)
          (syntax-case x ()
            (((acc ...))
             (syntax (acc ...)))
            (((acc ...) id ids ...)
             (identifier? (syntax id))
             (%filter-id (syntax ((acc ... id) ids ...))))
            (((acc ...) id ids ...)
             (%filter-id (syntax ((acc ...) ids ...))))))
        (%filter-id #`(() . #,x)))

      (syntax-case s1 ()
        ((k name args body ...)
         (with-syntax (((fargs ...) (filter-id (flatten #'args))))
           (syntax
            (define-syntax name
              (lambda(s2)
                (syntax-case s2 ()
                  ((m . args)
                   (let ((fargs (syntax->datum (syntax fargs))) ...)
                     (datum->syntax #'m
                       ((lambda() body ...))
                       ))))))))))))

  (define (gensym)
    (car (syntax->datum (generate-temporaries #'(k)))))

  )

使い方はこんな感じ。

(import (rnrs) (defmacro))

;; Scheme では 1+ という関数は無いので代用品を用意
(define (inc x) (+ x 1))

;; &body キーワードを再現していないので
;; ちょっとだけ Scheme 風の記法に変更
(defmacro for ((var start stop) . body)
  `(do ((,var ,start (inc ,var))
        (limit ,stop))
       ((> ,var limit))
     ,@body))

;; 1 から 5 まで表示する
(for (x 1 5)
     (display x))

;; 意図せぬ変数補足を避けるバージョン
;; gensym の使用例
(defmacro for* ((var start stop) . body)
  (let ((gstop (gensym)))
    `(do ((,var ,start (inc ,var))
          (,gstop ,stop))
         ((> ,var ,gstop))
       ,@body)))

;; 1 から 5 まで表示する
(for* (limit 1 5)
      (display limit))

ところで、書いている途中で気が付いたのだが、 R6RS では generate-temporaries は任意のリストかリスト構造を表現する構文オブジェクトを受取ることになっているにもかかわらず、現時点の Ypsilon だと前者でないと駄目っぽい。
dotted list にマッチするように syntax-case のパターン部を書くのが面倒だった。 全てのパターンをちゃんと書けているか自信がない。
Document ID: 4d034790b72811d4c5c7b3896af0e111