小さなLisp

純Lispというものがあります

• define
• lambda
• quote
• if(cond)
• atom, eq
• cons, car, cdr
• #true, #false, #nil

これらの関数と命令しか持ち合わせていないながらも、十分な表現力があり
最初のLispかつ最小のLispだそうです

素朴な再帰を使ったインタープリターを書いてみました

Spec

ちょっと仕様変更

• define => def
• lambda => lam
• doとputs追加

よく使う名前は短く
putsはrubyで言うp
doは複数の式を一つの式として扱うための言葉になります
そうするとevalが書きやすくなります

Parser

文字列からAST(Abstract Syntax Tree)を生成するのがParserです
strscanをlexerとして使います
余分なスペースや改行、コメントはlexerに捨ててもらい
位置情報をインクリメントしながら、scanしていきます
今回のParserはスタックを使うことで再帰を使うことなく再帰的なS式を処理できています

lisp.rb

module Lisp
  class Parser
    require "strscan"
    attr :scanner, :pos
    def initialize(s = "")
      @scanner = StringScanner.new(s)
      @pos = [1,1]
    end

    Token = /[()]|(\w|[#'\-!?])+/

    def pos_plus(s = "")
      return if s == nil
      s.each_char do |c|
        if c == "\n"
          @pos[0] += 1
          @pos[1] = 1
        else
          @pos[1] += 1
        end
      end
    end

    def scan
      pos_plus(@scanner.scan(/\s*|(;[^\n]*$)/))
      p = @pos.dup
      t = @scanner.scan(Token)
      pos_plus(t)
      pos_plus(@scanner.scan(/\s*|(;[^\n]*$)/))
      {atom: t, pos: p}
    end

    def run 
      ls = [[]]
      ps = 0
      while !@scanner.eos? 
        a = scan
        case a[:atom]
        when nil
          raise "illegal token"
        when "("
          ps += 1
          ls.push([])
        when ")"
          ps -= 1
          if ps < 0
            raise "closed too much"
          end

          a = ls.pop
          ls.last.push(a)
        else
          ls.last.push(a)
        end
      end

      if ps > 0
        raise "opened too much"
      end

      ls.last.unshift({atom: "do", pos: [0,0]})
      ls.last
    end
  end

Show

いわゆるPrettyPrinter
ASTから文字列としてのS式を生成
Parser#runと同じように再帰的な処理はスタックを使うとフラットなループにできるのですが
めんど臭い
速度的にもスタックを使った方が効率的なんですけどね
それとrubyのmoduleは名前の扱いがちょっと面倒ですね

lisp.rb

  module Show
    def show(s)
      case s
      when Array
        "(" + s.map { |e| show(e) }.join(" ") + ")"
      when Hash
        s[:atom]
      else
        raise s.inspect
      end
    end

    module_function :show
  end

State

evalで引き回すことになるState
exprは現在評価中の式
envは変数テーブル
superは外側のState
外側のStateのenvを辿っていき、クロージャーの自由変数を解決するのに必要なのがsuperなのです
ちょっと名前変かもね

lisp.rb

  class State
    attr :expr, :env, :super
    def initialize(e = nil, ev = {}, s = nil)
      @expr = e
      @env = ev
      @super = s
    end
  end

Eval

メインになります
eval_stateがディスパッチをして各命令を出しています
ほぼ全てで新しいStateとenvを作っていますがとても非効率でしょう
そのおかげでシンプル（手抜き）な実装となりました

lisp.rb

 module Eval
    def error(a,s)
      raise "%s:%s %s" % [a[:pos].join(":"), a[:atom], s]
    end

    def first_atom(s)
      case s.expr
      when Array
        s.expr.flatten.first
      when Hash
        s.expr
      else
        {atom: "??", pos: [0,0]}
      end
    end

    def eval(e)
      eval_state(State.new(e)).expr
    end

    def eval_state(s)
      case s.expr
      when Hash
        eval_var(s)
      when Array
        case s.expr[0]
        when Hash
          case s.expr[0][:atom]
          when "do"
            eval_do(s)
          when "def"
            eval_def(s)
          when "lam"
            eval_lam(s)
          when "quote"
            eval_quote(s)
          when "if"
            eval_if(s)
          when "atom"
            eval_atom(s)
          when "eq"
            eval_eq(s)
          when "cons"
            eval_cons(s)
          when "car"
            eval_car(s)
          when "cdr"
            eval_cdr(s)
          when "puts"
            eval_puts(s)
          else
            eval_apply(s)
          end
        when Array
          eval_apply(s)
        else
          raise "ilegal sexpr " + s.expr.inspect
        end
      else
        raise "ilegal sexpr " + s.expr.inspect
      end
    end

    def eval_var(s)
      ss = s
      while ss != nil
        if ss.env.key?(s.expr[:atom])
          return ss.env[s.expr[:atom]]
        else
          ss = ss.super
        end
      end

      s
    end

    def eval_do(s)
      for e in s.expr[1..-1]
        s = eval_state(State.new(e, s.env, s))
      end
      s
    end


    def eval_def(s)
      s.env[s.expr[1][:atom]] = eval_state(State.new(s.expr[2], s.env.dup, s))
      s
    end

    def eval_lam(s)
      s
    end

    def eval_quote(s)
      s
    end

    def eval_apply(s)
      lam = eval_state(State.new(s.expr[0], s.env.dup, s))

      unless lam.expr.class == Array && lam.expr[0].class == Hash &&
        lam.expr[0][:atom] == "lam"
        error(first_atom(lam), "apply expect lam, unexpect #{lam.expr.inspect}")
      end

      if lam.expr[1].class == Hash
        lam.expr[1] = [lam.expr[1]] 
      end

      unless lam.expr[1].size == s.expr[1..-1].size
        error(lam.expr[0], "expect #{lam.expr[1].size}, unexpect #{s.expr[1..-1].size}")
      end

      for a,b in lam.expr[1].zip(s.expr[1..-1])
        s.env[a[:atom]] = eval_state(State.new(b, s.env.dup, s))
      end

      eval_state(State.new(lam.expr[2], s.env.dup, s))
    end

    def eval_if(s)
      bool = eval_state(State.new(s.expr[1], s.env.dup, s))

      unless bool.expr.class == Hash &&
          (bool.expr[:atom] == "#true" || bool.expr[:atom] == "#false")
        error(s.expr[0], "expect bool, unexpect #{bool.expr.inspect}")
      end

      if bool.expr[:atom] == "#true"
        eval_state(State.new(s.expr[2], s.env.dup, s))
      else
        eval_state(State.new(s.expr[3], s.env.dup, s))
      end
    end

    def eval_atom(s)
      a = eval_state(State.new(s.expr[1], s.env.dup, s))
      State.new({atom: a.expr.class == Hash ? "#true" : "#false", pos: [0,0]}, s.env.dup, s)
    end

    def eval_eq(s)
      eq = -> a,b do
        if a.class == b.class
          if a.class == Array
            if a.size == b.size
              a.zip(b).all? { |c,d| eq.call(a,b) }
            else
              false
            end
          elsif a.class == Hash
            a[:atom] == b[:atom]
          else
            false
          end
        else
          false
        end
      end

      a = eval_state(State.new(s.expr[1], s.env.dup, s)).expr
      b = eval_state(State.new(s.expr[2], s.env.dup, s)).expr
      State.new({atom: eq.call(a,b) ? "#true" : "#false", pos: [0,0]})
    end

    def eval_cons(s)
      a = eval_state(State.new(s.expr[1], s.env.dup, s)).expr
      b = eval_state(State.new(s.expr[2], s.env.dup, s)).expr
      State.new([s.expr[0], a, b], s.env.dup, s)
    end

    def eval_car(s)
      c = eval_state(State.new(s.expr[1], s.env.dup, s))

      unless c.expr.class == Array && c.expr[0].class == Hash && 
          (c.expr[0][:atom] == "cons" || c.expr[0][:atom] == "quote")
        error(s.expr[0], "expect cons or quote, unexpect #{c.expr.inspect}")
      end

      if c.expr[0][:atom] == "cons"
        State.new(c.expr[1], c.env.dup, s)
      else
        State.new([c.expr[0], c.expr[1]], c.env.dup, s)
      end
    end

    def eval_cdr(s)
      c = eval_state(State.new(s.expr[1], s.env.dup, s))

      unless c.expr.class == Array && c.expr[0].class == Hash &&
        (c.expr[0][:atom] == "cons" || c.expr[0][:atom] == "quote")
        error(s.expr[0], "expect cons or quote, unexpect #{c.expr.inspect}")
      end

      if c.expr[0][:atom] == "cons"
        State.new(c.expr[2], c.env.dup, s)
      else
        State.new([c.expr[0], c.expr[2]], c.env.dup, s)
      end
    end

    def eval_puts(s)
      a = eval_state(State.new(s.expr[1], s.env.dup, s))
      puts Show.show(a.expr)
      a
    end

    Eval.instance_methods.each do |s|
      module_function s
    end
  end

Lisp

top levelの関数です
文字列とファイル名から実行できます

lisp.rb

  def run(s)
    Show.show(
      Eval.eval(
        Parser.new(s).run
      )
    )
  end

  def run_file(f)
    f = File.expand_path(f)
    if File.exist?(f)
      run(File.read(f))
    else
      raise "no exist #{f}"
    end
  end

  module_function :run, :run_file
end

rule90

こちらのrule90を例に実装してみます
括弧だらけですね
数字はただの変数名です
定義されていない変数名はそのまま名前を返すだけなのでこのような扱いができます
ただ数字計算の関数などを用意していないのでそれ以上に扱えません
counterもリスト数で表現しています
チャーチ数などで頑張ればどうにかなりそうな気もしない

果たして動くのか（動きます）

rule90.lisp

(def and 
  (lam (a b)
    (if (eq a #true)
      (eq b #true)
      #false)))

(def and3 
  (lam (a b c) (and (and a b) c)))

(def rule90 
  (lam (a b c)
    (if (and3 (eq a 1) (eq b 1) (eq c 1))
      0
    (if (and3 (eq a 1) (eq b 0) (eq c 1)) 
      0
    (if (and3 (eq a 0) (eq b 1) (eq c 0))
      0
    (if (and3 (eq a 0) (eq b 0) (eq c 0))
      0
      1))))))

(def apply
  (lam (rule cells)
    (do
      (def go 
        (lam (l m cs)
          (if (eq cs #nil)
            (cons 
              (rule l m 0) 
              (cons (rule m 0 0) #nil))
            (cons 
              (rule l m (car cs)) 
              (go m (car cs) (cdr cs))))))
      (go 0 0 cells))))

(def append
  (lam (x ls)
    (if (eq #nil ls) 
      (cons x #nil)
      (cons (car ls) (append x (cdr ls))))))

(def main 
  (lam (counter cells)
    (if (atom counter)
      cells
      (do
        (puts cells)
        (main
          (cdr counter) 
          (cons 0 (append 0 (apply rule90 cells))))))))

(def counter 
  (cons 0 (cons 0 (cons 0 (cons 0 (cons 0 (cons 0 (cons 0 (cons 0 
  (cons 0 (cons 0 (cons 0 (cons 0 (cons 0 (cons 0 (cons 0 (cons 0 #nil)))))))))))))))))

(def cells (cons 1 #nil))

(main counter cells)

見やすくするためにruby側にちょっと手を加えます
標準出力をhack
lisp側のputsはS式を吐くのでそのままParserに流せます

lisp.rb

require "io/console"

_, width = IO.console.winsize
$stdout = StringIO.new
Lisp.run_file("lisp/rule90.lisp")
$stdout.rewind
$stdout.each do |s|
  se = Lisp::Parser.new(s).run
  se = se.flatten.map { |a| a[:atom] }.select { |a| a =~ /0|1/ }.join.center(width)
  STDERR.puts se
end

 ❯ ruby lisp.rb
                                                1
                                              01010
                                            001000100
                                          0001010101000
                                        00001000000010000
                                      000001010000010100000
                                    0000001000100010001000000
                                  00000001010101010101010000000
                                000000001000000000000000100000000
                              0000000001010000000000000101000000000
                            00000000001000100000000000100010000000000
                          000000000001010101000000000101010100000000000
                        0000000000001000000010000000100000001000000000000
                      00000000000001010000010100000101000001010000000000000
                    000000000000001000100010001000100010001000100000000000000
                  0000000000000001010101010101010101010101010101000000000000000

OK!
ゼロがかなり余分ですがちゃんと三角がありますね！

end

素朴なインタープリターでした
非効率で簡素です
しかし言語処理系を実装できると言うのは自信にもなるようですし
質素なものから初めて見るのも良いのかもしれません