Lisp 処理系を書いてみる

自分の勉強がてら簡単な Lisp 処理系を書いたので、その内容をメモとして整理しておく(コードはこちら)。

基本方針

実装は Ruby で行う。ガベージコレクションが不要だし、パーザも書きやすいので、長さを 500行くらいに収めることができる。
超シンプル仕様。Lisp の基本5関数(car, cdr, cons, atom, eq)の他には lambda(手抜き), define, quote, if, +, -, * だけを用意。数値は整数のみ扱う。文字列はなし。
書くまでもないけれど、当然インタプリタ。最適化の類は一切なし。

処理系の構成要素

Lisp 処理系は大きく3つの要素に大別できる。

型システム: 基本的なデータ構造。
字句・構文解析: 与えられた入力を解析し、S式を作る。
評価: S式を評価し、結果を表示する。

これらのそれぞれについて、以下で説明する。

型システム

Lisp のデータ型は、親子関係を持っている。今回はシンプルな構成を目指して、次のようにする。

S式(Sexp)
│
├──────────┬──┐
アトム          　  リスト　(関数)
(Atom)　　　　　　　(List)
├────┬──┐ 　 │
シンボル　数　　 t　  │
(Sym)　(Number) (t)　 │
│　　　　│　　 　　 │
│　　　整数(Int)　　 │
└──────────nil(nil)

ただし関数については手抜きをする予定(後述)。

S式とアトム

S式(Sexp)とアトム(Atom)は、それ自体では具体的なデータを持たず、他のデータ型の親になるだけである。よって、定義はあっさりとすませる。

module Sexp
end

class Atom
  include Sexp
end

セルとリスト

Lispでは下図のようにセルを繋いでリストを作る。

┌──┬──┐┌──┬──┐
│　　│　─┼┼→　│　─┼→ nil
└──┴──┘└──┴──┘
  car   cdr     car   cdr

したがって、car, cdr の読み書きができれば、基本部分は完成。

class List
  def initialize
    @car = nil
    @cdr = $nil_sexp
  end
  
  def car
    return @car
  end
  
  def cdr
    return @cdr
  end
  
  def set_car(v)
    @car = v
  end
  
  def set_cdr(v)
    @cdr = v
  end
  
  def print_sexp
    ls = self
    print "("
    while true
      if (ls == $nil_sexp)
        break
      end
      ls.car.print_sexp
      print " "
      ls = ls.cdr
    end
    print ")"
  end
end

car, cdr の読み書き以外にはデータ表示の処理も必要(print_sexp メソッド)。処理としてはセルの cdr をたどりながら car 部の内容を表示する。 car 部がリストの場合は、再帰呼び出しで処理。

シンボルとシンボル管理

シンボルが最低限満たす必要がある条件は次の2つ。

名前と1個以上の値を持てること
同じ名前のシンボルは必ず同じものを表す(唯一性の保証)

したがって、シンボルが持てる値を1個だけに絞ってしまえば、ruby のハッシュそのままで表現できる。

class SymbolTable
  def initialize
    @hash = Hash.new
  end
  
  def set(name, value)
    @hash[name] = value
  end
  
  def get(name)
    if (@hash.has_key?(name))
      return @hash[name];
    else
      return $nil_sexp
    end
  end
  
  def remove(name)
    @hash.delete(name)
  end
end

シンボル自体には、名前と値の読み書き、同値比較を実装する。

class Sym < Atom
  def initialize(name)
    @name = name
    @value = $nil_sexp
  end
  
  def set_value(value)
    @value = value
  end
  
  def print_sexp
    print @name
  end
  
  def name
    return @name
  end
  
  def value
    return @value
  end
  
  def equal(obj)
    if (symbolp(obj))
      return (obj.name == @name)
    else
      return false
    end
  end
end

数値

値の読み書き、同値比較を実装する。

class Number < Atom
end

class Int < Number
  def initialize(i)
    @value = i
  end
  
  def print_sexp
    print "#{@value}"
  end
  
  def value
    @value
  end
  
  def equal(obj)
    if (numberp(obj))
      return (obj.value == @value)
    else
      return false
    end
  end
end

関数

関数定義は、定義している文字列をそのままシンボルテーブルに登録してしまう。シンボルに値を登録する時とほぼ同じ扱い。

ただし、このように実装してしまうと無名関数は使えなくなってしまう。本来は型システムにちゃんと関数を組込む必要があるが、字句解析で手抜きをするため、今回の実装はこのようにした。

def func_define(ls)
  sym = ls.car
  val = ls.cdr.car
  if (atomp(val))
    $symtable.set(sym.name, val)
    return val
  else
    $symtable.set(sym.name, val)
    return sym
  end
end

t/nil

システム全体でユニークなオブジェクトでなければならないのでシングルトンにする。短いコードでそこまでする必要はないと思うけど。

class Nil < Atom
  include Singleton
  include Sexp
  
  def print_sexp
    print "nil"
  end
  
  def equal(obj)
    if (obj == $nil_sexp)
      return true
    else
      return false
    end
  end
end

class T < Atom
  include Singleton
  
  def print_sexp
    print "t"
  end
  
  def equal(obj)
    if (obj == $t_sexp)
      return true
    else
      return false
    end
  end
end

型の判定

データ型を持つ処理系の常として、あるデータがどの型であるのかを知る方法は必須である。さもないと、異なる型のデータを比較しようとした際などに処理が破綻してしまう。

型システムは ruby のクラスを使って組み立てたので、型判定には ruby のクラス判定メソッドを使えばよい。

def atomp(sexp)
  return (sexp.instance_of?(Atom) || sexp.kind_of?(Atom))
end

def symbolp(sexp)
  return sexp.instance_of?(Sym)
end

def numberp(sexp)
  return sexp.kind_of?(Number)
end

def listp(sexp)
  return sexp.instance_of?(List)
end

字句・構文解析

楽をするために次の手抜きをしている。

行単位で解析を行う。したがって、行をまたぐ式は書けない。
クォート(') のような簡略記法は用意しない。

class Line
  def initialize(str)
    @str = str
    @idx = 0
    @prev_idx = 0
  end
  
  def unget_token
    @idx = @prev_idx
  end
  
  def get_token
    @prev_idx = @idx
    result = ""
    if (@idx == @str.length)
      return nil
    end
    while true
      ch = @str.slice(@idx, 1)
      if (ch != " ")
        break
      end
      @idx = @idx + 1
    end
    while true
      if (@idx == @str.length)
        break
      end
      ch = @str.slice(@idx, 1)
      if (ch == ")" || ch == "(" || ch == " ")
        @idx = @idx + 1
        if (result.length > 0)
          @idx = @idx - 1 if ch == ")"
          return result
        else
          return ch
        end
      end
      result = result + ch
      @idx = @idx + 1
    end
    return result
  end
end

def get_sexp(l)
  while t = l.get_token
    if (t == "(")
      return get_list(l)
    elsif (t =~ /^[0-9]+$/)
      return get_number(t)
    elsif (t == "t")
      return $t_sexp
    elsif (t == "nil")
      return $nil_sexp
    else
      return get_symbol(t)
    end
  end
  return $nil_sexp
end

def get_list(line)
  t = line.get_token
  if (t == ")")
    return $nil_sexp
  end
  top = List.new
  ls = top
  line.unget_token
  ls.set_car(get_sexp(line))
  
  while true
    t = line.get_token
    if (t == nil)
      break
    end
    if (t == ")")
      return top
    end
    new_cell = List.new
    line.unget_token
    new_cell.set_car(get_sexp(line))
    ls.set_cdr(new_cell)
    ls = new_cell
  end
  return $nil_sexp
end

def get_symbol(token)
  return Sym.new(token)
end

def get_number(token)
  return Int.new(token.to_i)
end

式の評価

考え方は簡単。アトムであれば自身が持っている値を返し、リストであれば関数と見なして評価するだけ。

def eval_sexp(sexp)
  if (numberp(sexp))
    return sexp
  elsif (sexp == $t_sexp || sexp == $nil_sexp)
    return sexp
  elsif (symbolp(sexp))
    return $symtable.get(sexp.name)
  elsif (listp(sexp))
    return funcall(sexp)
  else
    print "unexpected error.\n"
    sexp.print_sexp
  end
end

関数評価

関数の評価は次の手順で行う。

組み込み関数なら、予めシンボルテーブルに登録してあるメソッドを呼び出す
ユーザ定義関数なら、シンボルテーブルには関数定義の文字列が登録されているので、これを解析・評価するメソッドを呼び出す

def funcall(ls)
  car = ls.car
  cdr = ls.cdr
  
  func = $symtable.get(car.name)
  if (func == $nil_sexp)
    print "#{car.name} is not a function.\n"
  elsif (listp(func))
    lmdls = func.cdr.car
    body = func.cdr.cdr.car
    return eval_lambda(lmdls, body, cdr)
  else
    return func.call(cdr)
  end
end

ユーザ定義の関数については引数の処理が必要になる。関数に与えられた引数は、関数内だけで有効なシンボルとして扱われ、関数の呼び出し時に与えられた値が登録される。この処理を束縛という。

束縛の実現方法はいくつかあるが、今回はいわゆる「浅い束縛」方式で実現する。その理由は、シンボルテーブルを管理しているハッシュとの相性がよいため。処理の手順は下記のようになる。

関数を評価する前に、シンボルテーブルにシンボルと値を追加。ただし、追加する前にシンボルテーブルの現在の値は退避しておく。
関数を評価する。
退避させていたシンボルと値のセットをシンボルテーブルに書き戻す。

def eval_lambda(lmdls, body, args)
  env = Hash.new
  l = lmdls
  a = args
  while (l != $nil_sexp)
    key = l.car.name
    val = eval_sexp(a.car)
    env[key] = $symtable.get(key)
    $symtable.set(key, val)
    l = l.cdr
    a = a.cdr
  end
  ret = eval_sexp(body)
  env.each_pair do |key, value|
    $symtable.set(key, value)
  end
  return ret
end

組み込み関数

car/cdr

引数がリストであることを確認した上で、car/cdr 部をそれぞれ返す。

def func_car(ls)
  if (listp(ls))
    arg = eval_sexp(ls.car)
    return eval_sexp(arg.car)
  else
    print "Invalid argument: car\n"
  end
end

def func_cdr(ls)
  if (listp(ls))
    arg = eval_sexp(ls.car)
    return arg.cdr
  else
    print "Invalid argument: cdr\n"
  end
end

cons

新しいセルを生成し、car部/cdr部に引数をセットする。

def func_cons(ls)
  ln = List.new
  car = eval_sexp(ls.car)
  ln.set_car(car)
  cadr = eval_sexp(ls.cdr.car)
  ln.set_cdr(cadr)
  return ln
end

atom

型チェックのメソッドを呼び出して、atom かどうかを確認する。

def func_atom(ls)
  if (atomp(ls.car))
    return $t_sexp
  else
    return $nil_sexp
  end
end

eq

同値比較の処理は、それぞれのデータ型(を定義するクラス)が持っているので、それらを呼び出す。

def func_eq(ls)
  ref = eval_sexp(ls.car)
  cdr = ls.cdr
  while (cdr != $nil_sexp)
    val = eval_sexp(cdr.car)
    unless (ref.equal(val))
      return $nil_sexp
    end
    cdr = cdr.cdr
  end
  return $t_sexp
end

そのほかの関数

if, quote, +, -, * を用意しているが詳細は略。これらはたとえなかったとしても、pure Lisp として成立する!

def func_if(ls)
  cond = ls.car
  tform = ls.cdr.car
  if (ls.cdr.cdr == $nil_sexp)
    fform = $nil_sexp
  else
    fform = ls.cdr.cdr.car
  end
  if (eval_sexp(cond) == $t_sexp)
    return eval_sexp(tform)
  else
    return eval_sexp(fform)
  end
end

def func_quote(ls)
  if (listp(ls))
    return ls
  else
    print "Invalid argument: quote\n"
  end
end

def func_plus(ls)
  if (ls == $nil_sexp)
    return Int.new(0)
  else
    return Int.new(eval_sexp(ls.car).value + func_plus(ls.cdr).value)
  end
end

def func_minus(ls)
  if (ls == $nil_sexp)
    return Int.new(0)
  else
    return Int.new(eval_sexp(ls.car).value - func_plus(ls.cdr).value)
  end
end

def func_multiply(ls)
  if (ls == $nil_sexp)
    return Int.new(1)
  else
    return Int.new(eval_sexp(ls.car).value * func_multiply(ls.cdr).value)
  end
end

メイン処理

以上で必要なパーツはすべて揃ったので、後は「読み込み、評価、結果表示」をひたすら繰り返せばよい。初期化を含めた具体的な処理は下記のようになる。

t/nil(シングルトン)のインスタンスを作成する
組み込み関数をシンボルテーブルに登録する
init.l を読み込み、評価する(このファイルに、よく使う関数を登録しておくとよい)
標準入力から行を読み込み、評価し、その結果を表示するループを回す("quit" が入力されるとループ終了)。

print "initializing..."
$t_sexp = T.instance
$nil_sexp = Nil.instance

$symtable = SymbolTable.new

$symtable.set("car", self.method(:func_car))
$symtable.set("cdr", self.method(:func_cdr))
$symtable.set("cons", self.method(:func_cons))
$symtable.set("atom", self.method(:func_atom))
$symtable.set("eq", self.method(:func_eq))

$symtable.set("if", self.method(:func_if))
$symtable.set("define", self.method(:func_define))
$symtable.set("quote", self.method(:func_quote))

$symtable.set("+", self.method(:func_plus))
$symtable.set("-", self.method(:func_minus))
$symtable.set("*", self.method(:func_multiply))

f = open("init.l")
while l = f.gets
  l = l.chomp
  line = Line.new(l)
  s = get_sexp(line)
  eval_sexp(s)
end
f.close
print "done.\n"

while l = gets
  l = l.chomp
  line = Line.new(l)
  s = get_sexp(line)
  break if (symbolp(s) && s.name == "quit")
  v = eval_sexp(s)
  print "=> "
  if (listp(v))
    v.print_sexp
  elsif (numberp(v))
    print "#{v.value}"
  elsif (v == $nil_sexp)
    print "nil"
  elsif (v == $t_sexp)
    print "t"
  elsif (symbolp(v))
    print v.name
  else
    print v.print_sexp
  end
  print "\n"
end

実行例

階乗を計算する関数 fact を定義し、実行した例。

$ ./rlisp.rb
initializing...done.
(define fact (lambda (n) (if (eq n 0) 1 (* n (fact (- n 1))))))
=> fact
(fact 5)
=> 120
quit
$

再帰呼び出しもうまく動作している。

おまけ

少し改良したもの。

関数の扱いを少し改善。無名関数を扱えるようにした。ただし、スコープの処理をちゃんとしていないので、引数の名前が同じ関数をネストさせると変なことになる。
funcallを用意。これを使ってfold(畳み込み関数)を書き、さらにこれを使って reverse, length を書いた(init.lを参照)。

Back to the top page.

FUJIWARA Teruyoshi <tf at dsl.gr.jp>