スロット番号付き cut

前の記事 (id:SaitoAtsushi:20080810:1218355014) では引数を複数回使う機能を持った cut について考察した。 それについて参考になる文章を shiro さんから紹介してもらったので、ここにメモしておく。
http://srfi.schemers.org/srfi-26/mail-archive/msg00018.html
http://srfi.schemers.org/srfi-26/mail-archive/msg00020.html
私は英語があまりわからないのでかなりおおざっぱな理解ではあるけれども、番号による参照は混乱しやすいので変数に適切な名前を付けるべきというのが提案者の主張のようだ。 実際に cut は充分に便利であるし、 cut では機能不足と思うようなものは cut でやるべきことではないのだろう。
と、まあ考察はここまでにして、スロット番号付きの cut を実装してみた。 原理的には syntax-rules でも出来そうだが、根性がないので syntax-case を使っている。
Gauche 上で slib のマクロ機構を利用しているので、試したければまず slib を導入して欲しい。 その上で以下の通りに入力すると slib の repl が動きはじめる。

(use slib)
(require 'repl)
(require 'syntax-case)
(repl:top-level macro:eval)

プロンプトが変わっただろうか。 どこかでエラーが出たりしたなら slib の導入に失敗していると思われるので参考サイトを見る等して問題点を修正しよう。
さて、ここからがスロット番号付き cut の実装である。

(use srfi-1)

(define slot-list
  (list (syntax <0>)
        (syntax <1>)
        (syntax <2>)
        (syntax <3>)
        (syntax <4>)
        (syntax <5>)
        (syntax <6>)
        (syntax <7>)
        (syntax <8>)
        (syntax <9>)))

(define (slot-number x)
  (list-index (lambda(y) (free-identifier=? x y)) slot-list))

(define (slot-max x mx)
  (syntax-case x ()
    (() mx)
    ((arg args ...)
     (let1 p (slot-number (syntax arg))
       (if p
           (slot-max (syntax (args ...)) (if (> p mx) p mx))
           (slot-max (syntax (args ...)) mx))))))

(define (slot-args lst cnt)
  (if (zero? cnt)
      (with-syntax ((a (car lst)))
        (syntax (a)))
      (with-syntax ((a (car lst))
                    (d (slot-args (cdr lst) (- cnt 1))))
        (syntax (a . d)))))

(define (slot-params x)
  (syntax-case x ()
    (() (syntax ()))
    ((arg args ...)
     (let ((a (find (pa$ free-identifier=? (syntax arg)) slot-list)))
       (with-syntax ((f (if a a (syntax arg)))
                     (s (slot-params (syntax (args ...)))))
         (syntax (f . s)))))))

(define-syntax cut*
  (lambda(x)
    (syntax-case x ()
      ((_ f args ...)
       (let ((mx (slot-max (syntax (args ...)) 0)))
         (with-syntax ((a (slot-args slot-list mx))
                       (p (slot-params (syntax (args ...)))))
           (syntax (lambda a (f . p)))))))))

この実装では最も大きい番号のスロットで arity を決定するようにしている。

(cut* + <5> <2> <4>)

このようにすれば arity は 6 になる。
0 から 9 までのスロットしか想定していないが、それを使いきるような使い方は馬鹿げているので無視してもよいだろう。
実用出来るほどのものになっているかどうかは疑問だけれど、久々にちょっと長いマクロを書いて Scheme のマクロ機構の強力さを感じることが出来たので満足だ。
Document ID: a61ae2cbfcf0746fd88c550e213c3ca7