メッセージパッシングスタイルでselfを使う

SICP第2版の186ページ(原著)から出てくるMessage passingについて。

例、動物が鳴きます。名前はシンボルもしくは文字列で、表示時に必要に応じてcoerceします。

animal.scm

(define (animal name voice)
  (lambda (m)
    (cond
      [(eq? m 'name) (if (symbol? name) (symbol->string name) name)]
      [(eq? m 'talkTo) 
       (lambda (x) 
         (print (string-append (if (symbol? name) (symbol->string name) name) " said " voice " to " x)))])))

(define felix (animal "Felix the Cat" "meooow"))
(felix 'name) ;; "Felix the Cat"
((felix 'talkTo) "me") ;; "Felix the Cat said meooow to me" #<undef>

メッセージパッシングスタイル、なにかに似ています。そう、オブジェクト指向です。animalを呼び出した際に返されるクロージャはanimalクラスのインスタンスと見ることができます。
上の例ではnameとtalkToで同じ事(coerce)をしています。オブジェクト指向では普通こういうときselfを使います。

animal.st

Object subclass: #Animal
	instanceVariableNames: 'name voice'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Example'!

!Animal methodsFor: 'as yet unclassified' stamp: 'ympbyc 12/29/2012 02:32'!
initWithName: n voice: v
  name := n.
  voice := v! !

!Animal methodsFor: 'as yet unclassified' stamp: 'ympbyc 12/29/2012 02:25'!
name
  ^ name asString! !

!Animal methodsFor: 'as yet unclassified' stamp: 'ympbyc 12/29/2012 02:29'!
talkTo: whom
  ^ self name ,' said ' , voice ,' to ' , whom! !

self参照を利用して、自分自身のメソッドを呼ぶ事で、同じコードを2カ所に書かずに済んでいます。

前振りが長かったですがここからが本題。Schemeのメッセージパッシングスタイルでselfを使ってみましょう。
selfというシンボルに、あるオブジェクトを勝手に結びつけるので、アナフォリックマクロというものを書きます。ついでにインスタンスとなるlambdaも作ってやります。メソッド名はシンボル=>に束縛する事にします。

define-class.scm

;;Unhygenic anaphoric macro
(define-macro (define-class class args body)
  `(define ,class (lambda ,args 
      (Z (lambda (self) (lambda (=>) ,body))))))

インスタンスは(lambda (=>) ,body)の部分です。こいつをselfに入れたいので、無名関数だけで再帰を実現するZコンビネータという関数を使います。

z.scm

(define Z (lambda (f) ((lambda (p)
 (f (lambda (a) ((p p) a))))
 (lambda (p)
   (f (lambda (a) ((p p) a)))))))

(Z (lambda (f) ...))と呼び出すと、fに(lambda (f) ...)自身が入るので、...の部分でfを参照すれば再帰ができるというものです。
これでselfが手に入りました。

実際に使ってみる前にもう一つ便利なマクロを定義しておきます。これを使うと、(on メソッド名 => メソッド本体 ...という風に書けます

on.scm

(define-syntax on
  (syntax-rules ()
    ((_ x y a b) (if (equal? x y) a b))
    ((_ x y a) (if (equal? x y) a))))

準備ができました！使ってみましょう。

animal2.scm

(define-class animal (name voice)
  (on 'name  => (if (symbol? name) (symbol->string name) name)
  (on 'talkTo => (lambda (x) (print (string-append (self 'name) " said " voice " to " x))))))

(define felix (animal "Felix the Cat" "meooow"))
(felix 'name) ;;"Felix the Cat"
((felix 'talkTo) "me") ;;"Felix the Cat said meooow to me" #<undef>

以上、小ネタでした。
アナフォリックマクロとZコンビネータの使い道を発見して嬉しくなったので書いてみました。

よいお年を！