r/step3_env.r

   1 if(!exists("..readline..")) source("readline.r")
   2 if(!exists("..types..")) source("types.r")
   3 if(!exists("..reader..")) source("reader.r")
   4 if(!exists("..printer..")) source("printer.r")
   5 if(!exists("..env..")) source("env.r")
   6
   7 READ <- function(str) {
   8     return(read_str(str))
   9 }
  10
  11 eval_ast <- function(ast, env) {
  12     if (.symbol_q(ast)) {
  13         Env.get(env, ast)
  14     } else if (.list_q(ast)) {
  15         new.listl(lapply(ast, function(a) EVAL(a, env)))
  16     } else if (.vector_q(ast)) {
  17         new.vectorl(lapply(ast, function(a) EVAL(a, env)))
  18     } else if (.hash_map_q(ast)) {
  19         lst <- list()
  20         for(k in ls(ast)) {
  21             lst[[length(lst)+1]] = k
  22             lst[[length(lst)+1]] = EVAL(ast[[k]], env)
  23         }
  24         new.hash_mapl(lst)
  25     } else {
  26         ast
  27     }
  28 }
  29
  30 EVAL <- function(ast, env) {
  31     #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="")
  32     if (!.list_q(ast)) {
  33         return(eval_ast(ast, env))
  34     }
  35
  36     # apply list
  37     switch(paste("l",length(ast),sep=""),
  38            l0={ return(ast) },
  39            l1={ a0 <- ast[[1]]; a1 <- NULL;     a2 <- NULL },
  40            l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL },
  41               { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] })
  42     a0sym <- as.character(a0)
  43     if (a0sym == "def!") {
  44         res <- EVAL(ast[[3]], env)
  45         return(Env.set(env, a1, res))
  46     } else if (a0sym == "let*") {
  47         let_env <- new.Env(env)
  48         for(i in seq(1,length(a1),2)) {
  49             Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env))
  50         }
  51         return(EVAL(a2, let_env))
  52     } else {
  53         el <- eval_ast(ast, env)
  54         f <- el[[1]]
  55         return(do.call(f,slice(el,2)))
  56     }
  57 }
  58
  59 PRINT <- function(exp) {
  60     return(.pr_str(exp, TRUE))
  61 }
  62
  63 repl_env <- new.Env()
  64 Env.set(repl_env, "+", function(a,b) a+b)
  65 Env.set(repl_env, "-", function(a,b) a-b)
  66 Env.set(repl_env, "*", function(a,b) a*b)
  67 Env.set(repl_env, "/", function(a,b) a/b)
  68
  69 rep <- function(str) return(PRINT(EVAL(READ(str), repl_env)))
  70
  71 repeat {
  72     line <- readline("user> ")
  73     if (is.null(line)) { cat("\n"); break }
  74     tryCatch({
  75         cat(rep(line),"\n", sep="")
  76     }, error=function(err) {
  77         cat("Error: ", get_error(err),"\n", sep="")
  78     })
  79     # R debug/fatal with tracebacks:
  80     #cat(rep(line),"\n", sep="")
  81 }