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 (.symbol_q(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 if (.hash_map_q(ast)) {
  18         lst <- list()
  19         for(k in ls(ast)) {
  20             lst[[length(lst)+1]] = k
  21             lst[[length(lst)+1]] = EVAL(ast[[k]], env)
  22         }
  23         new.hash_mapl(lst)
  24     } else {
  25         ast
  26     }
  27 }
  28
  29 EVAL <- function(ast, env) {
  30     #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="")
  31     if (!.list_q(ast)) {
  32         return(eval_ast(ast, env))
  33     }
  34
  35     # apply list
  36     if (length(ast) == 0) {
  37         return(ast)
  38     }
  39     el <- eval_ast(ast, env)
  40     f <- el[[1]]
  41     return(do.call(f,el[-1]))
  42 }
  43
  44 PRINT <- function(exp) {
  45     return(.pr_str(exp, TRUE))
  46 }
  47
  48 repl_env <- new.env()
  49 repl_env[["+"]] <- function(a,b) a+b
  50 repl_env[["-"]] <- function(a,b) a-b
  51 repl_env[["*"]] <- function(a,b) a*b
  52 repl_env[["/"]] <- function(a,b) a/b
  53
  54 rep <- function(str) return(PRINT(EVAL(READ(str), repl_env)))
  55
  56 repeat {
  57     line <- readline("user> ")
  58     if (is.null(line)) { cat("\n"); break }
  59     tryCatch({
  60         cat(rep(line),"\n", sep="")
  61     }, error=function(err) {
  62         cat("Error: ", get_error(err),"\n", sep="")
  63     })
  64     # R debug/fatal with tracebacks:
  65     #cat(rep(line),"\n", sep="")
  66 }