((Rで) 書く ((もっとRっぽい) Lisp) インタプリタ)

((Rで) 書く (Lisp) インタプリタ)の続きです。

以前の記事を見た@kohskeさんから、 環境はRの環境オブジェクトを使えば良いのでは、とアドバイスを頂きました。

やってみたら自前で環境を実装しなくて良い分簡潔になったし、より面白い使い方ができるようになりました。

コード

前回同様Gistに上げておきました。 変なところがあったら教えてください。

	## Scheme Interpreter in R
	## (more R-ish implementation of "lisp.R")
	addGlobals <- function(env) {
	procs <- list("+" = sum,
	"*" = prod,
	"-" = function(...) Reduce(`-`, list(...)),
	"/" = function(...) Reduce(`/`, list(...)),
	"=" = `==`,
	"eq?" = `==`,
	"equal?" = identical,
	"not" = `!`,
	"cons" = function(x, y) append(list(x), y),
	"car" = function(x) x[[1]],
	"cdr" = function(x) x[-1],
	"list?" = is.list,
	"null?" = function(x) identical(x, list()),
	"symbol?" = is.character
	)
	rfname <- c(">", "<", ">=", "<=", "list", "length")
	rfunc <- list()
	rfunc[rfname] <- rfname
	procs <- append(procs, rfunc)
	for (name in names(procs)) assign(name, procs[[name]], envir=env)
	}
	evaluate <- function(x, env) {
	if (is.character(x)) { # variable reference
	get(x, envir=env)
	} else if (!is.list(x)) { # constant literal
	x
	} else if (identical(x[[1]], "quote")) { # (quote exp)
	x[[2]]
	} else if (identical(x[[1]], "if")) { # (if test conseq alt)
	test <- x[[2]]
	conseq <- x[[3]]
	alt <- x[[4]]
	if (evaluate(test, env)) {
	evaluate(conseq, env)
	} else {
	evaluate(alt, env)
	}
	} else if (identical(x[[1]], "set!")) { # (set! var exp)
	var <- x[[2]]
	exp <- x[[3]]
	assign(var, evaluate(exp, env), envir=env)
	} else if (identical(x[[1]], "define")) { # (define var exp)
	var <- x[[2]]
	exp <- x[[3]]
	assign(var, evaluate(exp, env), envir=env)
	} else if (identical(x[[1]], "lambda")) { # (lambda (var*) exp*)
	vars <- x[[2]]
	exps <- x[-c(1, 2)]
	function(...) {
	args = list(...)
	inner <- new.env(parent=env)
	for (i in seq(vars)) assign(vars[[i]], args[[i]], envir=inner)
	for (exp in exps) val <- evaluate(exp, inner)
	val
	}
	} else if (identical(x[[1]], "begin")) { # (begin exp*)
	for (exp in x[-1]) val <- evaluate(exp, env)
	val
	} else { # (proc exp*)
	xeval <- lapply(x, function(exp) evaluate(exp, env))
	proc <- xeval[[1]]
	exps <- xeval[-1]
	do.call(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)) {
	sprintf("(%s)", do.call(paste, lapply(exp, toString)))
	} else {
	tryCatch(as.character(exp),
	error=function(e) sprintf("#<%s>", typeof(exp)))
	}
	}
	repl <- function(prompt='lispr> ', parent=.GlobalEnv) {
	env <- new.env(parent=parent)
	addGlobals(env)
	while(TRUE) {
	val <- evaluate(parse(readline(prompt)), env)
	cat(toString(val))
	cat("\n")
	}
	}

view raw lispr.R hosted with ❤ by GitHub

主な変更点は

• Rの環境オブジェクトを流用
• Lispの関数の呼び出し方法を変更: proc(exps) から do.call(proc, exps) に

遊び方

前回と同様です。

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

$ ls
lispr.R
$ R -q
> source("lispr.R")
> repl()
lispr> (+ 1 2)
3
lispr> (define add2 (lambda (x) (+ x 2)))
#<closure>
lispr> (add2 40)
42
lispr>

関数 repl の引数 parent に渡した環境がLispの環境の親になります。(デフォルトだとRのグローバル環境)
よって今回はLispの環境からRの環境を参照できるので、LispでRの関数が使えます。

lispr> (: 1 10)
1 2 3 4 5 6 7 8 9 10
lispr> (rnorm 3)
0.536481224524994 -0.547993231580984 -2.14041393248752
lispr> (seq 0 10 2)
0 2 4 6 8 10
lispr> (begin (plot cars) (lines (lowess cars)) 1)
1
lispr> 

S式でRを使える！楽しい！

感想

やはり言語処理系を作るのは楽しいです。