The Little Schemerを読み解く ~ Schemeインタープリタ

前置き

The Little Schemer(邦題は「Scheme手習い」)の最終章では、valueという名前のSchemeインタープリタを実装します。ペーパーバック 4th EditionのP174です。

ユーティリティ

小道具

まずは、ごくシンプルな小道具を定義しておきます。

build
引数aとbからなるリストを返す。
first
リストの先頭の要素を返す。
second
リストの2番目の要素を返す。
third
リストの3番目の要素を返す。
小道具
(define build
  (lambda (a b)
    (cons a (cons b (quote ())))))

(define first car)

(define second
  (lambda (l)
    (car (cdr l))))

(define third
  (lambda (l)
    (car (cdr (cdr l)))))

変数バインディングを管理する

次に、変数バインディングを管理する構造と関数を用意しておきましょう。変数バインディングは、変数リストと値のリストとのペアで管理し、これをエントリと呼びます。

例えば、

((x) (1))

とか

((x y z) (1 2 3))

は、エントリです。

((x 1) (y 2) (z 3))

としない理由は、関数は複数の引数を取ることがあり、それらをまとめて管理する方が分解して管理するより簡単だからです。

変数リストと値リストを使って新しいエントリを作るには、buildすれば良いですね。

new-entry
(define new-entry build)

エントリから、特定の変数の値を見つける関数lookup-in-entryは以下のように定義できます。見つからなかったときに呼ばれる関数failを引数で指定できるようになっています。

lookup-in-entry
(define lookup-in-entry
  (lambda (var-name entry fail)
    (lookup-in-entry-help
      var-name
      (first entry)
      (second entry)
      fail)))

(define lookup-in-entry-help
  (lambda (var-name vars vals fail)
    (cond
      ((null? vars) (fail var-name))
      ((eq? (car vars) var-name) (car vals))
      (else (lookup-in-entry-help var-name (cdr vars) (cdr vals) fail)))))

1回の関数適用で、1つのエントリが作られるイメージです。関数適用がネストした場合は複数のエントリが作られるので、エントリのリストで管理しましょう。これを変数テーブルと呼ぶことにします。変数テーブルに新しいエントリを追加するには、consすれば良いですね。

extend-table
(define extend-table cons)

最後に、テーブルから、特定の変数の値を見つける関数lookup-in-tableを定義します。

lookup-in-table
(define lookup-in-table
  (lambda (var-name table fail)
    (cond
      ((null? table) (fail var-name))
      (else (lookup-in-entry
              var-name
              (car table)
              (lambda (var-name)
                (lookup-in-table
                  var-name
                  (cdr table)
                  fail)))))))

テーブルの最初のエントリにvar-nameが見つからなかった場合は、「テーブルのcdrに対してlookup-in-tableを再帰呼び出し」したいので、lookup-in-entryの第3引数に、そのような無名関数を指定しています。

6つの型

Schemeインタープリタvalueは、式を6つの型に分類して評価します。式と型の対応は以下の通りです。

1*const
2*const
3*const
#f*const
#t*const
cons*const
car*const
(quote something)*quote
something*identifier
(lambda (x xs) (cons x xs))*lambda
((lambda (x xs) (cons x xs)) #t (quote ()))*application
(cond (nothing (quote something)) (else (quote nothing)))*cond

ここでは、型を、*constや*quoteといった、*で始まる関数名で表現します。型を表現する関数のことをアクションと呼びます。

valueは、式に、(その式に対応する)アクションを適用するように実装されます。

骨格

式をアクションに対応付ける
(define expression-to-action
  (lambda (e)
    (cond
      ((atom? e) (atom-to-action e))
      (else (list-to-action e)))))

アトム用とリスト用の、2つのヘルパ関数に分岐します。

アトムをアクションに対応付ける
(define atom-to-action
  (lambda (e)
    (cond
      ((number? e) *const)
      ((eq? e #t) *const)
      ((eq? e #f) *const)
      ((eq? e (quote cons)) *const)
      ((eq? e (quote car)) *const)
      ((eq? e (quote cdr)) *const)
      ((eq? e (quote null?)) *const)
      ((eq? e (quote eq?)) *const)
      ((eq? e (quote atom?)) *const)
      ((eq? e (quote zero?)) *const)
      ((eq? e (quote add1)) *const)
      ((eq? e (quote sub1)) *const)
      ((eq? e (quote number?)) *const)
      (else *identifier))))

式がアトムの場合、数値か、真偽値か、プリミティブ関数か、識別子(変数)です。consからnumber?までが、Schemeに最低限必要なプリミティブ関数です。言い換えれば、プリミティブ関数以外は、すべてユーザ定義関数(defineはサポートしないので、実質的には無名関数)です。

リストをアクションに対応付ける
(define list-to-action
  (lambda (e)
    (cond
      ((atom? (car e))
        (cond
          ((eq? (car e) (quote quote)) *quote)
          ((eq? (car e) (quote lambda)) *lambda)
          ((eq? (car e) (quote cond)) *cond)
          (else *application)))
      (else *application))))

式がリストの場合、スペシャルフォームか、関数適用のどちらかです。quote、lambda、condの3つがスペシャルフォームです。

value
(define value
  (lambda (e)
    (meaning e (quote ()))))

meaningの第二引数は、変数バインディングを管理するテーブルです。最初は空っぽですが、eを評価する過程で育っていきます。

meaning
(define meaning
  (lambda (e table)
    ((expression-to-action e) e table)))

各アクションも、meaningと同様に、式と変数テーブルを引数に取ります。

アクション

*const
(define *const
  (lambda (e table)
    (cond
      ((number? e) e)
      ((eq? e #t) #t)
      ((eq? e #f) #f)
      (else (build (quote primitive) e)))))

数値や真偽値を評価した結果は、その値そのものです。それ以外はプリミティブ関数ですが、例えば、carという式の評価結果は、(primitive car)になります。何それ? って感じですが、こうしておけば、あとで関数適用を評価するときに、その関数がプリミティブ関数なのか無名関数なのかを判定しやすくなります。

*quote
(define *quote
  (lambda (e table)
    (second e)))

(quote xxx)の評価結果は、リストの第2要素ですね。

*identifier
(define *identifier
  (lambda (e table)
    (lookup-in-table e table table-fail)))

識別子(変数)は、つまりlambdaの仮引数のことです。関数適用時に実引数が仮引数へバインドされるので、それを変数テーブルに登録する、という作戦です。よって識別子を評価するには、変数テーブルを検索して、仮引数に対応する実引数を見つけてくればOKです。もし見つからない場合は、valueで評価しようとした式がバグってるということになります。なので、table-failには何を指定しても構いません(これが使われるような事態になったらアウトです)。

*lambda
(define *lambda
  (lambda (e table)
    (build (quote non-primitive) (cons table (cdr e)))))

プリミティブ関数のcarが(primitive car)に評価されたのに対し、無名関数は(non-primitive xxx)になります。xxxの部分には、あとで関数適用を評価するときに必要な情報を置きます。具体的には以下の3つです。

  • その時点の変数テーブル
  • 無名関数の仮引数リスト(原文では"formals")
  • 無名関数のボディ

変数テーブルが必要な理由がピンとこないかもしれませんが、後で分かります。ヒントは「クロージャ」です。

例えば、変数テーブルが(((y z) ((8) 9)))のときに、(lambda (x) (cons x y))を評価すると、

(non-primitive ((((y z) ((8) 9))) (x) (cons x y)))

になります。

*cond

次は*condです。スペシャルフォームcondは、(cond cond-line cond-line cond-line ...)のような形式になっています。各cond-lineはリストで、最初の要素を評価した結果が#tなら2番目の要素がcondフォームの結果になります。最初の要素がelseなら、そのcond-lineの2番目の要素がcondフォームの結果になります。

まず、cond-lineの最初の要素がelseかどうかを判定する関数else?を定義します。

else?
(define else?
  (lambda (x)
    (cond
      ((atom? x) (eq? x (quote else)))
      (else #f))))

次に、cond-lineのリスト、つまりcondフォームのcdr部を評価する関数evconを定義します。式を評価する必要があるので、cond-lineリストに加えてtableも引数に取ります。

evcon
(define evcon
  (lambda (lines table)
    (cond
      ((else? (first (car lines)))         (meaning (second (car lines)) table))
      ((meaning (first (car lines)) table) (meaning (second (car lines)) table))
      (else                                (evcon (cdr lines) table)))))

もしlinesが空になってしまったらアウトです。

これで、*condを定義する準備が整いました。

*cond
(define *cond
  (lambda (e table)
    (evcon (cdr e) table)))

*application

最後に残ったのが、*application、つまり関数適用です。関数適用は、(f arg arg arg...)のような形式になっています。最初の要素が関数、残りの要素が引数です。

関数適用の前に全ての引数を評価するのがSchemeのルールです。そこでまず、関数適用の引数リスト(arg arg arg...)を評価し、その結果リスト(val val val...)を返す関数evlisを定義します。

*evlis
(define evlis
  (lambda (args table)
    (cond
      ((null? args) (quote ()))
      (else (cons (meaning (car args) table) (evlis (cdr args) table))))))

さて、関数適用は、(fun arg arg arg...)のような形式でした。fをmeaningで評価すれば、*constか*lambdaにより、(primitive xxx)か(non-primitive yyy)になるはずです。また、(arg arg arg...)はevlisで評価すれば、(val val val...)になります。

次に必要なのは、(val val val...)へ、(primitive xxx)や(non-primitive yyy)を適用する関数applyです。しかしapplyは少し複雑なので、先に、applyを使って*applicationを定義してしまいましょう。

*application
(define *application
  (lambda (e table)
    (apply (meaning (car e) table) (evlis (cdr e) table))))

apply

applyが相手にする関数はプリミティブ関数か無名関数のどちらかで、それぞれ、(primitive xxx)か(non-primitive yyy)のような形式です。それぞれを判定する補助関数を定義しましょう。

primitive?
(define primitive?
  (lambda (l)
    (eq? (first l) (quote primitive))))
non-primitive?
(define non-primitive?
  (lambda (l)
    (eq? (first l) (quote non-primitive))))

applyも、プリミティブ用と無名関数用に分けて定義します。

apply
(define apply
  (lambda (fun vals)
    (cond
      ((primitive? fun)     (apply-primitive     (second fun) vals))
      ((non-primitive? fun) (apply-non-primitive (second fun) vals)))))

原文では、apply-non-primitiveの代わりにapply-closureという名前を使っています。

さて、apply-primitiveの第1引数は何でしょうか? (primitive xxx)のsecondなので、xxx、つまりプリミティブ関数の名前ですね。それを踏まえて、apply-primitiveを定義してしまいましょう。

apply-primitive
(define apply-primitive
  (lambda (name vals)
    (cond
      ((eq? name (quote cons))    (cons (first vals) (second vals)))
      ((eq? name (quote car))     (car (first vals)))
      ((eq? name (quote cdr))     (cdr (first vals)))
      ((eq? name (quote null?))   (null? (first vals)))
      ((eq? name (quote eq?))     (eq? (first vals) (second vals)))
      ((eq? name (quote atom?))   (*atom? (first vals)))   ;;☆
      ((eq? name (quote zero?))   (zero? (first vals)))
      ((eq? name (quote add1))    (add1 (first vals)))
      ((eq? name (quote sub1))    (sub1 (first vals)))
      ((eq? name (quote number?)) (number? (first vals))))))

☆の所だけイレギュラーですね。atom?ではなく、*atom?を使っています。*atom?の定義は以下の通りです。

*atom?
(define *atom?
  (lambda (x)
    (cond
      ((atom? x) #t)
      ((null? x) #f)
      ((eq? (car x) (quote primitive)) #t)       ;;★
      ((eq? (car x) (quote non-primitive)) #t)   ;;★
      (else #f))))

なぜ、★を#tにしたいのでしょう? 端的に言えば、いま実装中のSchemeインタープリタでは、(atom? car)も、(atom? (lambda (x) x))も、#tに評価されるべきだからです。atom?の引数を評価するときに、carや(lambda (x) x)は、一旦(primitive xxx)や(non-primitive yyy)に変換されてしまいます。よって、☆のところでatom?を使うと、#fに評価されてしまうわけですね。

apply-non-primitive

さて、最後の最後に残ったのが、apply-non-primitive(別名apply-closure)です。applyの中で、apply-non-primitiveは、次のように使われていました。

((non-primitive? fun) (apply-non-primitive (second fun) vals))

ここでfunは、(non-primitive yyy)のような形式になっています。さらにyyyの部分、つまり(second fun)は、*lambdaの項で示したように、①変数テーブル、②仮引数リスト、③関数ボディの3つからなるリストです。これをvalsに適用するのが、apply-non-primitiveの仕事です。

簡単な例を挙げて考えてみましょう。

((lambda (x y) (cons x y)) 1 (quote (2)))

変数テーブルが空っぽだとすると、無名関数の部分は*lambdaにより以下のように評価されます。

(non-primitive (() (x y) (cons x y)))       ;;λ

また、実引数の部分は、(1 (2))に評価されます。

λを(1 (2))に適用するには、λの仮引数リストに実引数をバインドしたうえで、λのボディ部を評価すれば良いですね。

もう少し複雑な例として、関数適用がネストした例を挙げます。

((lambda (y) ((lambda (x) (cons x y)) 1)) (quote (2)))

内側の無名関数のボディ部では、自由変数(引数以外の変数)yを使っています。つまりクロージャです。なので、内側の関数適用を評価するとき、xに1をバインドしただけではボディ部を評価できません。ここが変数テーブルの出番です。外側の関数適用によりyに(2)をバインドするので、その情報を変数テーブルに追加して、内側の関数適用へ引き継げば、内側のボディ部のyが評価できますね。

以上をまとめると、apply-non-primitiveの仕事は以下の通りです。

  1. 仮引数リストに実引数リストをバインドする
  2. それを変数テーブルへ追加する
  3. その変数テーブルと共に、ボディ部を評価する
apply-non-primitive
(define apply-non-primitive
  (lambda (closure vals)
    (meaning (third closure)
      (extend-table (new-entry (second closure) vals) (first closure)))))

繰り返しになりますが、仮引数closureは、①変数テーブル、②仮引数リスト、③関数ボディの3つからなるリストです。

以上で、Schemeインタープリタvalueが完成しました。

使ってみる

Gaucheで実行してみます。ただ、Gaucheにはatom?とadd1とsub1が無いので、以下のように定義しておきます。

Gaucheに無いプリミティブ関数
(define atom?
  (lambda (e)
    (and (not (pair? e)) (not (null? e)))))

(define add1
  (lambda (n)
    (+ n 1)))

(define sub1
  (lambda (n)
    (- n 1)))

では、使ってみましょう。valueに式を評価させるには、式をクオートしてやる必要があります(そうしないとGaucheが評価してしまうので)。まずは、簡単なやつから。

gosh> (value '1)
1
gosh> (value '#t)
#t
gosh> (value '(quote (a b c)))
(a b c)
gosh> (value '(car (quote (a b c))))
a
gosh> (value '(cons (quote a) (quote (b c))))
(a b c)
gosh> (value '(cdr (quote (a b c))))
(b c)
gosh> (value '(null? (quote ())))
#t
gosh> (value '(add1 1))
2
gosh> (value '(sub1 1))
0

無名関数も。

gosh> (value '((lambda (y) ((lambda (x) (cons x y)) 1)) (quote (2))))
(1 2)

別の記事で説明したYコンビネータだって動きます。

gosh> (value '(((lambda (le)
                     ((lambda (f) (f f))
                      (lambda (f)
                        (le (lambda (x) ((f f) x))))))
                 (lambda (length)
                       (lambda (lis) (cond
                                      ((null? lis) 0)
                                      (else (add1 (length (cdr lis))))))))
                   (quote (a b c))))
3

全ソースコードを添付しておきます。

Last modified:2013/04/20 10:42:34
Keyword(s):
References:[FP: 関数型プログラミング]
This page is frozen.