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
コメント 0