r/step2_eval.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
   6 READ <- function(str) {
   7     return(read_str(str))
   8 }
   9
  10 eval_ast <- function(ast, env) {
  11     if (is.symbol(ast)) {
  12         env[[as.character(ast)]]
  13     } else if (.list_q(ast)) {
  14         new.listl(lapply(ast, function(a) EVAL(a, env)))
  15     } else if (.vector_q(ast)) {
  16         new.vectorl(lapply(ast, function(a) EVAL(a, env)))
  17     } else {
  18         ast
  19     }
  20 }
  21
  22 EVAL <- function(ast, env) {
  23     #cat("EVAL: ", .pr_str(ast,true), "\n", sep="")
  24     if (!.list_q(ast)) {
  25         return(eval_ast(ast, env))
  26     }
  27
  28
  29     # apply list
  30     el <- eval_ast(ast, env)
  31     f <- el[[1]]
  32     return(do.call(f,el[-1]))
  33 }
  34
  35 PRINT <- function(exp) {
  36     return(.pr_str(exp, TRUE))
  37 }
  38
  39 repl_env <- new.env()
  40 repl_env[["+"]] <- function(a,b) a+b
  41 repl_env[["-"]] <- function(a,b) a-b
  42 repl_env[["*"]] <- function(a,b) a*b
  43 repl_env[["/"]] <- function(a,b) a/b
  44
  45 rep <- function(str) return(PRINT(EVAL(READ(str), repl_env)))
  46
  47 repeat {
  48     line <- readline("user> ")
  49     if (is.null(line)) { cat("\n"); break }
  50     tryCatch({
  51         cat(rep(line),"\n", sep="")
  52     }, error=function(err) {
  53         cat("Error: ", get_error(err),"\n", sep="")
  54     })
  55     # R debug/fatal with tracebacks:
  56     #cat(rep(line),"\n", sep="")
  57 }