プロトタイプチェーンの試作版。Racket用。第5版。 4版でバグ修正。 5版はalist->malistの余計な処理をprototype側に移動。

prototype-chain-alpha.scm

(require compatibility/mlist)

(define (alist->malist alist)
  (list->mlist (map (lambda (i) (mcons (car i) (cdr i))) alist)))

(define (prototype malist)
  (set! malist (mlist (mcons 'prototype malist)))
  (define (search malist name t f)
    (let ((res (massq name malist)))
      (if (mpair? res) (t res) (f))))
  (lambda (name . value)
    (if (null? value)
        (letrec ((chain (lambda (l)
                          (search l name
                                  (lambda (res) (mcdr res))
                                  (lambda ()
                                    (search l 'prototype
                                            (lambda (res) (chain (mcdr res)))
                                            (lambda () (error "undefind " . (car value)))))))))
          (chain malist))
        (search malist name
                (lambda (res) (set-mcdr! res (car value)))
                (lambda () (set! malist (mcons (mcons name (car value)) malist)))))))