SSブログ

OCaml + sexplib で Scheme もどきを作る [OCaml]

よく Scheme や Lisp の本で Scheme/Lisp を使って Scheme/Lisp 処理系を書くというのがあって大層簡潔に書いてあったりするのですが、これは要するに S 式リーダ機能がビルトインで存在するというのが有利に働いているので、他の言語でも S 式を簡単に読めれば同じくらいにはできそうです。
そこで OCaml の sexplib [1] を使ってみたかったこともあって、それを使ってなんちゃって Scheme を書いてみました。

なお sexplib は「産業界における関数型言語の事例」でよく引き合いに出されている Jane Street Capital で開発された OCaml 向けの S 式ライブラリです。

#use "topfind";;
#require "sexplib";;
#require "extlib";;

open ExtList;;
open Sexplib;;
open Sexplib.Sexp;;

module Data = struct
  type t = Int of int | Bool of bool | Closure of (t list -> t)

  let show = function
  | Int x -> print_int x; print_newline ()
  | Bool true -> print_endline "#t"
  | Bool false -> print_endline "#f"
  | Closure _ -> print_endline "#<closure>"
end

module Env = struct
  type rib = string list * Data.t array
  type t = rib list

  let globals = Hashtbl.create 256
  let set_global id v = (Hashtbl.replace globals id v; v)
  let get_global id = Hashtbl.find globals id

  let empty_env : t = []
  let rec apply_env x = function
  | [] -> get_global x
  | (ids, vals)::rs ->
    try
      let (pos, _)  = List.findi (fun _ y -> x = y) ids in
      vals.(pos)
    with Not_found -> apply_env x rs
  let extend_env ids vals env =
    (ids, Array.of_list vals)::env
  let rec set_var id v = function
  | [] -> set_global id v
  | (ids, vals)::rs ->
    try
      let (pos, _)  = List.findi (fun _ y -> id = y) ids in
      (vals.(pos) <- v; v)
    with Not_found -> set_var id v rs
end

open Data;; open Env;;

let is_integer x = try (ignore (int_of_string x); true) with Failure _ -> false

let rec interp x env =
  match x with
  | Atom "#t" -> Bool true
  | Atom "#f" -> Bool false
  | Atom x when is_integer x -> Int (int_of_string x)
  | Atom x -> apply_env x env
  | List (Atom "begin" :: xs) ->
    let results = List.map (fun y -> interp y env) xs in
    List.last results
  | List [Atom "set!"; Atom x; y] ->
    set_var x (interp y env) env
  | List [Atom "if"; cond; true_exp; false_exp] ->
    (match (interp cond env) with
    | Bool false -> interp false_exp env
    | _          -> interp true_exp  env
    )
  | List (Atom "lambda" :: List ids :: body) ->
    let closure args =
      let ids = List.map (function Atom x -> x) ids in
      let new_env = extend_env ids args env in
      let results = List.map (fun y -> interp y new_env) body in
      List.last results
    in
    Closure closure
  | List (x :: xs) ->
    let Closure f = interp x env in
    f (List.map (fun y -> interp y env) xs)

let procs = [
  ("+", fun [Int a; Int b] -> Int (a + b));
  ("-", fun [Int a; Int b] -> Int (a - b));
  ("*", fun [Int a; Int b] -> Int (a * b));
  ("/", fun [Int a; Int b] -> Int (a / b));
  ("=", fun [Int a; Int b] -> Bool (a = b));
  ("<", fun [Int a; Int b] -> Bool (a < b));
  (">", fun [Int a; Int b] -> Bool (a > b));
  ("<=", fun [Int a; Int b] -> Bool (a <= b));
  (">=", fun [Int a; Int b] -> Bool (a >= b));
]

let init_interp () =
  List.iter (fun (name, f) -> ignore (set_global name (Closure f))) procs

let repl () =
  init_interp ();
  while true do
    print_string "=> ";
    let input = read_line () in
    show (interp (Sexp.of_string input) [])
  done

ちょうど100行くらいでなかなかいい感じではないでしょうか。

この Scheme もどきが扱うデータは Data.t 型で定義されているように整数と真偽値とクロージャのみです。文字列も扱いたかったのですが sexplib ではシンボルと文字列、例えば (a b c) と ("a" "b" "c") を区別できなかったのであきらめました。これは sexplib の限界です。

環境は EOPL でもやったようなオーソドックスな rib cage 実装で、大域変数のためにハッシュテーブルも使っています。

使用例は以下の通りです。

# repl ();;
=> (set! double (lambda (x) (+ x x)))
#<closure>
=> (double 45)
90
=> ((if (= 1 2) * +) 3 4)
7
=> ((if (= 1 1) * +) 3 4)
12
=> (set! fact (lambda (n) (if (= n 0) 1 (* n (fact (- n 1))))))
#<closure>
=> (fact 5)
120
=> (set! counter ((lambda (c) (lambda (n) (set! c (+ c n)))) 0))
#<closure>
=> counter
#<closure>
=> (counter 1)
1
=> (counter 1)
2
=> (counter 4)
6
=> (counter 2)
8

[1] http://www.ocaml.info/home/ocaml_sources.html#toc9


nice!(0)  コメント(0)  トラックバック(0) 
共通テーマ:パソコン・インターネット

nice! 0

コメント 0

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。