((Rで) 書く (Lisp) インタプリタ)

Rに慣れるために、Lispインタプリタを書いてみました。

元ねたはPeter Norvigの (How to Write a (Lisp) Interpreter (in Python)) （日本語訳: ((Pythonで) 書く (Lisp) インタプリタ)）です。

コード

	## Scheme Interpreter in R
	## (an R port of the Peter Norvig's "lis.py")
	Env <- setRefClass('Env',
	fields = c(".outer", ".dict"),
	methods = list(
	initialize = function(outer=NULL) {
	.outer <<- outer
	.dict <<- list()
	},
	get = function(key) {
	.dict[[key]]
	},
	set = function(key, value) {
	if (is.list(key)) {
	.dict[unlist(key)] <<- value
	} else {
	.dict[[key]] <<- value
	}
	},
	find = function(key) {
	if (!is.null(.dict[[key]])) .self else .outer$find(key)
	}
	))
	addGlobals <- function(env) {
	procs <- list("+" = function(x) do.call(sum, x),
	"*" = function(x) do.call(prod, x),
	"-" = function(x) Reduce("-", x),
	"/" = function(x) Reduce("/", x),
	"=" = function(x) do.call("==", x),
	"eq?" = function(x) do.call("==", x),
	"equal?" = function(x) do.call("identical", x),
	"not" = function(x) do.call("!", x),
	"cons" = function(x) append(x[1], x[[-1]]),
	"car" = function(x) x[[1]][[1]],
	"cdr" = function(x) x[[1]][-1],
	"list?" = function(x) is.list(x[[1]]),
	"null?" = function(x) length(x[[1]]) == 0,
	"symbol?" = function(x) is.character(x[[1]])
	)
	rfname <- c(">", "<", ">=", "<=",
	"list", "length")
	rfunc <- lapply(rfname,
	function(name) {
	n <- name
	function(x) do.call(n, x)
	})
	names(rfunc) <- rfname
	procs <- append(procs, rfunc)
	env$set(as.list(names(procs)), procs)
	}
	eval <- function(x, env) {
	if (is.character(x)) { # variable reference
	env$find(x)$get(x)
	} else if (!is.list(x)) { # constant literal
	x
	} else if (identical(x[[1]], "quote")) { # (quote exp)
	x[-1][[1]]
	} else if (identical(x[[1]], "if")) { # (if test conseq alt)
	test <- x[[2]]
	conseq <- x[[3]]
	alt <- x[[4]]
	if (eval(test, env)) {
	eval(conseq, env)
	} else {
	eval(alt, env)
	}
	} else if (identical(x[[1]], "set!")) { # (set! var exp)
	var <- x[[2]]
	exp <- x[[3]]
	env$find(var)$set(var, eval(exp, env))
	} else if (identical(x[[1]], "define")) { # (define var exp)
	var <- x[[2]]
	exp <- x[[3]]
	env$set(var, eval(exp, env))
	} else if (identical(x[[1]], "lambda")) { # (lambda (var*) exp*)
	vars <- x[[2]]
	exps <- x[-c(1, 2)]
	function(args) {
	inner <- Env$new(env)
	inner$set(vars, args)
	for (exp in exps) val <- eval(exp, inner)
	val
	}
	} else if (identical(x[[1]], "begin")) { # (begin exp*)
	for (exp in x[-1]) val <- eval(exp, env)
	val
	} else { # (proc exp*)
	xeval <- lapply(x, function(exp) eval(exp, env))
	proc <- xeval[[1]]
	exps <- xeval[-1]
	proc(exps)
	}
	}
	read <- function(s) {
	readFrom(tokenize(s), 1)[[1]]
	}
	parse <- read
	tokenize <- function(s) {
	s <- gsub("\\(", " ( ", s)
	s <- gsub("\\)", " ) ", s)
	s <- sub("^\\s+", "", s)
	strsplit(s, "\\s+")[[1]]
	}
	readFrom <- function(tokens, i) {
	if (length(tokens) < i) stop("unexpected EOF while reading")
	if (tokens[i] == "(") {
	L <- list()
	i <- i + 1 # skip "("
	while(tokens[i] != ")") {
	res <- readFrom(tokens, i)
	L <- append(L, res[1])
	i <- res[[2]]
	}
	i <- i + 1 # skip ")"
	return(list(L, i))
	} else if (tokens[i] == ")") {
	stop("unexpected )")
	} else {
	return(list(atom(tokens[i]), i + 1))
	}
	}
	atom <- function(token) {
	num <- suppressWarnings(as.numeric(token))
	if (is.na(num)) token else num
	}
	toString <- function(exp) {
	if (is.list(exp)) {
	paste("(", do.call(paste, lapply(exp, toString)), ")", sep="")
	} else {
	tryCatch(as.character(exp),
	error=function(e) paste("#<", typeof(exp), ">", sep=""))
	}
	}
	repl <- function(prompt='lisp.R> ') {
	env <- Env$new()
	addGlobals(env)
	while(TRUE) {
	val <- eval(parse(readline(prompt)), env)
	cat(toString(val))
	cat("\n")
	}
	}

view raw lisp.R hosted with ❤ by GitHub

遊び方

コードを取ってきます。

$ git clone https://gist.github.com/5598108.git

Rインタプリタを起動してコードを読み込ませます。
repl() を実行するとLispの対話式インタプリタが起動します。

$ cd 5598108/
$ R -q
> source("lisp.R")
> repl()
lisp.R> (+ 1 2)
3
lisp.R> (define l (list 1 2 3))
(1 2 3)
lisp.R> (car l)
1
lisp.R> (cdr l)
(2 3)
lisp.R> (define add2 (lambda (x) (+ x 2)))
#<closure>
lisp.R> (add2 40)
42
lisp.R> (equal? (list 1 2) (list 1 (- 5 3)))
TRUE
lisp.R> (define map (lambda (f l) (if (null? l) (quote ()) (cons (f (car l)) (map f (cdr l))))))
#<closure>
lisp.R> (map add2 (list 10 20 30))
(12 22 32)
lisp.R>

感想

Rの言語機能（ファーストクラスの関数、レキシカルスコープ、クロージャなど）のおかげで、割と楽に書けたと思います。

ただリストの操作はちょっと面倒くさいかな、と思いました。
あと値渡しとか遅延評価とかでところどころはまりました。まだまだ慣れが必要です。

でも今回初めて使った機能がいくつかあって勉強になったし、何より言語処理系を作るのはとても楽しいです。

(追記)

続編を書きました。((Rで) 書く ((もっとRっぽい) Lisp) インタプリタ)