デフォルトの評価

Scheme では標準の構文では手続の引数にデフォルト値を設定することは出来ないが Gauche や Chicken Scheme には一部 (又は全て) の引数を渡すことを省略できる仕組が用意されている。 省略した場合には予め指定しておいた式を評価してデフォルト値とするわけだ。
さて、一方で Python では関数の引数のデフォルト値は、関数の定義時に一回しか評価されないという話を小耳に狭んだので、それを Scheme でも実現するマクロを書いてみた。

#!r6rs
(library (optional-arguments)
  (export
   (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 %%opt:lambda
    (syntax-rules ()
      ((_ () (f ...) (i ...) (n ...) body ...)
       (let (i ...)
         (lambda (f ... . opt)
           (let-optionals* opt (n ...) body ...))))
      ((_ rest (f ...) (i ...) (n ...) body ...)
       (let (i ...)
         (lambda (f ... . opt)
           (let-optionals* opt (n ... . rest) body ...))))))
  
  (define-syntax %opte:lambda
    (syntax-rules (:opti :opte)
      ((_ ((var default) . rest) f (i ...) (n ...) body ...)
       (%opti:lambda rest f (i ...) (n ... (var default)) body ...))
      ((_ (:opti . rest) f (i ...) (n ...) body ...)
       (%opti:lambda rest f (i ...) (n ...) body ...))
      ((_ a ...)
       (%%opt:lambda a ...))))

  (define-syntax %opti:lambda
    (syntax-rules (:opti :opte)
      ((_ ((var default) . rest) f (i ...) (n ...) body ...)
       (%opti:lambda rest f (i ... (t default)) (n ... (var t)) body ...))
      ((_ (:opte . rest) f (i ...) (n ...) body ...)
       (%opte:lambda rest f (i ...) (n ...) body ...))
      ((_ a ...)
       (%%opt:lambda a ...))))
  
  (define-syntax %opt:lambda
    (syntax-rules (:opti :opte)
      ((_ (:opti . rest) (f ...) body ...)
       (%opti:lambda rest (f ...) () ()  body ...))
      ((_ (:opte . rest) (f ...) body ...)
       (%opte:lambda rest (f ...) () () body ...))
      ((_ () (f ...) body ...)
       (lambda (f ...) body ...))
      ((_ (arg . rest) (f ...) body ...)
       (%opt:lambda rest (f ... arg) body ...))
      ((_ rest (f ...) body ...)
       (lambda (f ... . rest) body ...))))

  (define-syntax opt:lambda
    (syntax-rules ()
      ((_ () b0 b1 ...)
       (lambda() b0 b1 ...))
      ((_ args b0 b1 ...)
       (%opt:lambda args () 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))))
  )

使い方の例は以下のようになる。

#!r6rs
(import
 (except (rnrs) define)
 (only (optional-arguments) define))

(define (test1) (display "test1\n") 1)
(define (test2) (display "test2\n") 2)

(display "Start definition\n")

(define (hoge :opti (a (test1)) (b (test2)) :opte (c (test2)))
  (write (list "hoge" a b c))
  (newline))

(display "End definition\n")
(display "Run\n")
(hoge)
(display "End\n")

:opti に続く引数はデフォルト引数が定義時に評価され、 :opte に続く引数は手続の評価時に評価される。
Document ID: ed2249c19e4d9fda414ebceb01a622f0