((Rで) 書く (Lisp) インタプリタ)の続きです。
以前の記事を見た@kohskeさんから、 環境はRの環境オブジェクトを使えば良いのでは、とアドバイスを頂きました。
やってみたら自前で環境を実装しなくて良い分簡潔になったし、より面白い使い方ができるようになりました。
コード
前回同様Gistに上げておきました。 変なところがあったら教えてください。
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ## 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") | |
| } | |
| } |
主な変更点は
- 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を使える！楽しい！
感想
やはり言語処理系を作るのは楽しいです。
