let-optionals - 主題のない日記

経緯

Scheme 処理系 Gauche にはオプショナル引数を扱うための便利なマクロがある。 let-optionals* がそれだ。更に lambda 構文も拡張されていて、より簡潔な記法で書けるようになっている。
先日、私はそれを R6RS 用に実装してみた。
http://saito.hatenablog.jp/entry/20110222/1298366644
そして、スコープが Scheme 的では無いような気がしたことも書いたのだった。
http://saito.hatenablog.jp/entry/20110302/1299077281
それに対して shiro さんからコメントをもらった。
http://d.hatena.ne.jp/SaitoAtsushi/20110302/1299077281#c1299150580
結論から言えば考え方によるという話なのだけれども、それなら私の考え方もアリってことで書いてみることにした。
ちなみに、 chicken scheme には let-optionals と let-optionals* の両方があり、使い分けできるようになっている。しかし、 chicken scheme の let-optionals や let-optionals* はポータブルなコードでは無いのであえて再実装する価値はあるだろう。

実装

(library (optional)
  (export let-optionals*
          let-optionals
          (rename (opt:define define)
                  (opt:lambda lambda)))
  (import (rnrs))
  
  (define-syntax let-optionals*
    (syntax-rules ()
      ((_ a ((v d) . r) b0 b1 ...)
       (let* ((t a)
              (v (if (null? t) d (car t))))
         (let-optionals* (if (null? t) '() (cdr t)) r b0 b1 ...)))
      ((_ a () b0 b1 ...)
       (begin b0 b1 ...))
      ((_ a (v . r) b0 b1 ...)
       (let* ((t a)
              (v (if (null? t) #f (car t))))
         (let-optionals* (if (null? t) '() (cdr t)) r b0 b1 ...)))
      ((_ a rv b0 b1 ...)
       (let ((rv a)) b0 b1 ...))))

  (define-syntax let-opt%
    (syntax-rules ()
      ((_ args (acc ...) ((v d) . r) b ...)
       (let-opt% args (acc ... (v d t)) r b ...))
      ((_ args (acc ...) (v . r) b ...)
       (let-opt% args (acc ... (v #f t)) r b ...))
      ;; ↓R6RS 的にはこの節は不要
      ((_ args ((v d t) ...) () b ...) 
       (let-syntax ((t (syntax-rules ()((_) d))) ...)
         (let-optionals* args ((v (t)) ...) b ...)))
      ((_ args ((v d t) ...) r b ...)
       (let-syntax ((t (syntax-rules ()((_) d))) ...)
         (let-optionals* args ((v (t)) ... . r) b ...)))))
  
  (define-syntax let-optionals
    (syntax-rules ()
      ((_ args r b0 b1 ...)
       (let-opt% args () r b0 b1 ...))))

  (define-syntax lambda%
    (syntax-rules (:optional* :optional)
      ((_ (a ...) (:optional* . r) c0 c1 ...)
       (lambda(a ... . t)
         (let-optionals* t r c0 c1 ...)))
      ((_ (a ...) (:optional . r) c0 c1 ...)
       (lambda(a ... . t)
         (let-optionals t r c0 c1 ...)))
      ((_ (a ...) (o . r) c0 c1 ...)
       (lambda% (a ... o) r c0 c1 ...))
      ((_ (a ...) rv c0 c1 ...)
       (lambda (a ... . rv) c0 c1 ...))))

  (define-syntax opt:lambda
    (syntax-rules ()
      ((_ a b0 b1 ...)
       (lambda% () a b0 b1 ...))))

  (define-syntax opt:define
    (syntax-rules ()
      ((_ (name . args) b0 b1 ...)
       (opt:define name (opt:lambda args b0 b1 ...)))
      ((_ name obj)
       (define name obj))))
  )

実行例

let-optionals と let-optionals* の挙動の違いを見て欲しい。
それと、 Gauche では lambda 構文や define 構文で :optional という識別子を使うと let-optionals* 相当の機能が使えるが、この実装では :optional で let-optionals 相当の機能になるようにした。代わりに :optional* で let-optionals* 相当の機能となる。

(import (except (rnrs) define lambda)
        (optional))

(let ((a 'hoge))
  (let-optionals '(1) (a (b a))
    (display (list a b)))
  (let-optionals* '(1) (a (b a))
    (display (list a b)))
  (newline)
  )

(let ((b 'hoge))
  (define (test-1 a :optional b (c b) . t)
    (list a b c t))
  ;; ↓これが Gauche で :optional を使ったときの挙動
  (define (test-2 a :optional* b (c b) . t)
    (list a b c t))
  
  (display (test-1 1))
  (display (test-2 1))
  (newline)
  (display (test-1 1 2))
  (display (test-2 1 2))
  (newline)
  (display (test-1 1 2 3))
  (display (test-2 1 2 3))
  (newline)
  (display (test-1 1 2 3 4))
  (display (test-2 1 2 3 4))
  (newline)
  )

オマケ

今回の実装は外側を囲むライブラリフォームだけ外せば R5RS 範囲内のはず。少なくとも主要な R5RS 処理系では問題なく動くだろう。
Document ID: 1c8418ff9e81bd7ea520fa41fc61c0f1