SRFI-16の紹介

(LISP Library 365参加エントリ)

SRFI-16は可変長引数を受け取る手続きに対する構文です。要するにcase-lambdaです。R6RSから標準になった構文なので、あまり目新しいものは無いかもしれません。

以下のように使います。

;; because it's very famous I've become a bit lazy
;; so just a bit of taste...
(define foo
  (case-lambda
    ((c key) (foo c key #f))
    ((c key default) (ref c key default))))

上記の(いい加減な)例では、束縛される手続きは2つもしくは3つの引数を受け取ります。2つの場合は3つ目の引数にデフォルトの値として#fを設定して自身を呼びなおします。以下のように書くのとそんなに変わりません。

(define (foo c key . rest)
  (let ((default (if (null? rest) #f (car rest))))
    (ref c key default)))

ちなみに、参照実装だと上記のcase-lambdaは以下のように展開されます。

(define foo
  (lambda args
    (let ((l (length args)))
      (if (= l (length '(c key)))
          (apply (lambda (c key) (foo c key #f)) args)
          (if (= l (length '(c key default)))
              (apply (lambda (c key default) (ref c key default)) args)
              (error #f "Wrong number of arguments to CASE-LAMBDA"))))))

これだと多少手間が減る程度の恩恵しかありません。(もちろん処理系によっては引数のパックとapplyが異常なまでに安い処理系もあるかもしれませんが･･･) また、コンパイル時に手続きの呼び出しを行わない処理系だと、lengthの呼び出しが定義された分だけ呼び出されるので精神衛生上あまり好ましくありません。

さすがにこれはどうかとも思ったらしく、以前syntax-rulesのみを使った多少効率のいいcase-lambdaの実装を作っていました。(ちなみに、Sagittariusではもう少し前に書き直しています。やってることは一緒なのでsyntax-rules版にしてもいいかとは思いますが。)

	(import (except (rnrs) case-lambda))
	(define-syntax count-args
	(syntax-rules ()
	((count-args n "count" e e* ...)
	(count-args (+ n 1) "count" e* ...))
	((count-args n "count") n)
	;; entry point
	((_ e* ...)
	(count-args 0 "count" e* ...))))
	(define-syntax case-lambda-let
	(syntax-rules ()
	((_ "parse" args (a . d) (vars ...) (inits ...) (body ...))
	(case-lambda-let "parse" (cdr args) d
	(vars ... a)
	(inits ... (car args))
	(body ...)))
	((_ "parse" args () (vars ...) (inits ...) (body ...))
	(case-lambda-let "final" (vars ...) (inits ...)
	(body ...)))
	((_ "parse" args v (vars ...) (inits ...) (body ...))
	(case-lambda-let "parse" () ()
	(vars ... v)
	(inits ... args)
	(body ...)))
	((_ "final" (vars ...) (inits ...) (body ...))
	(let ((vars inits) ...) body ...))
	;; entry point
	((_ args formals body)
	(case-lambda-let "parse" args formals () () body))))
	(define-syntax case-lambda-aux
	(syntax-rules ()
	((_ args n)
	(syntax-violation 'case-lambda "unexpected number of arguments" args))
	((_ args n ((x ...) b ...) more ...)
	(if (= n (count-args x ...))
	(case-lambda-let args (x ...) (b ...))
	(case-lambda-aux args n more ...)))
	((_ args n ((x1 x2 ... . r) b ...) more ...)
	(if (>= n (count-args x1 x2 ...))
	(case-lambda-let args (x1 x2 ... . r) (b ...))
	(case-lambda-aux args n more ...)))
	((_ args n (r b ...) more ...)
	(let ((r args)) b ...))))
	(define-syntax case-lambda
	(syntax-rules ()
	((_ (fmls b1 b2 ...))
	(lambda fmls b1 b2 ...))
	((_ (fmls b1 b2 ...) ...)
	(lambda args
	(let ((n (length args)))
	(case-lambda-aux args n (fmls b1 b2 ...) ...))))))

view raw case-lambda.scm hosted with ❤ by GitHub

これならば引数がパックされるだけでapplyを呼び出すことがないので、参照実装よりは多少効率がいいはずです(オプション引数として受け取るのと同等程度)。もう少し進めるのであれば、組み込みの構文にしてしまってコンパイラが受け取る引数をうまいこと解決するということも可能かもしれません。

今回はSRFI-16を紹介しました。RnRS準拠でもっと効率のいい実装があるよ！という方がいらしたらご一報くださいm(_ _)m