Commit | Line | Data |
---|---|---|
01feedfe JM |
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 | if(!exists("..core..")) source("core.r") | |
7 | ||
8 | READ <- function(str) { | |
9 | return(read_str(str)) | |
10 | } | |
11 | ||
12 | eval_ast <- function(ast, env) { | |
c30efef4 | 13 | if (.symbol_q(ast)) { |
01feedfe JM |
14 | Env.get(env, ast) |
15 | } else if (.list_q(ast)) { | |
16 | new.listl(lapply(ast, function(a) EVAL(a, env))) | |
17 | } else if (.vector_q(ast)) { | |
18 | new.vectorl(lapply(ast, function(a) EVAL(a, env))) | |
36737ae5 JM |
19 | } else if (.hash_map_q(ast)) { |
20 | lst <- list() | |
21 | for(k in ls(ast)) { | |
22 | lst[[length(lst)+1]] = k | |
23 | lst[[length(lst)+1]] = EVAL(ast[[k]], env) | |
24 | } | |
25 | new.hash_mapl(lst) | |
01feedfe JM |
26 | } else { |
27 | ast | |
28 | } | |
29 | } | |
30 | ||
31 | EVAL <- function(ast, env) { | |
32 | repeat { | |
33 | ||
34 | #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") | |
35 | if (!.list_q(ast)) { | |
36 | return(eval_ast(ast, env)) | |
37 | } | |
38 | ||
39 | # apply list | |
40 | switch(paste("l",length(ast),sep=""), | |
41 | l0={ return(ast) }, | |
42 | l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, | |
43 | l2={ a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- NULL }, | |
44 | { a0 <- ast[[1]]; a1 <- ast[[2]]; a2 <- ast[[3]] }) | |
45 | if (length(a0) > 1) a0sym <- "__<*fn*>__" | |
46 | else a0sym <- as.character(a0) | |
47 | if (a0sym == "def!") { | |
48 | res <- EVAL(a2, env) | |
49 | return(Env.set(env, a1, res)) | |
50 | } else if (a0sym == "let*") { | |
51 | let_env <- new.Env(env) | |
52 | for(i in seq(1,length(a1),2)) { | |
53 | Env.set(let_env, a1[[i]], EVAL(a1[[i+1]], let_env)) | |
54 | } | |
55 | ast <- a2 | |
56 | env <- let_env | |
57 | } else if (a0sym == "do") { | |
58 | eval_ast(slice(ast,2,length(ast)-1), env) | |
59 | ast <- ast[[length(ast)]] | |
60 | } else if (a0sym == "if") { | |
61 | cond <- EVAL(a1, env) | |
62 | if (.nil_q(cond) || identical(cond, FALSE)) { | |
8128c69a | 63 | if (length(ast) < 4) return(nil) |
01feedfe JM |
64 | ast <- ast[[4]] |
65 | } else { | |
66 | ast <- a2 | |
67 | } | |
68 | } else if (a0sym == "fn*") { | |
8128c69a | 69 | return(malfunc(EVAL, a2, env, a1)) |
01feedfe JM |
70 | } else { |
71 | el <- eval_ast(ast, env) | |
72 | f <- el[[1]] | |
73 | if (class(f) == "MalFunc") { | |
74 | ast <- f$ast | |
75 | env <- f$gen_env(slice(el,2)) | |
76 | } else { | |
77 | return(do.call(f,slice(el,2))) | |
78 | } | |
79 | } | |
80 | ||
81 | } | |
82 | } | |
83 | ||
84 | PRINT <- function(exp) { | |
85 | return(.pr_str(exp, TRUE)) | |
86 | } | |
87 | ||
88 | repl_env <- new.Env() | |
89 | rep <- function(str) return(PRINT(EVAL(READ(str), repl_env))) | |
90 | ||
91 | # core.r: defined using R | |
92 | for(k in names(core_ns)) { Env.set(repl_env, k, core_ns[[k]]) } | |
93 | ||
94 | # core.mal: defined using the language itself | |
95 | . <- rep("(def! not (fn* (a) (if a false true)))") | |
96 | ||
97 | ||
98 | repeat { | |
99 | line <- readline("user> ") | |
100 | if (is.null(line)) { cat("\n"); break } | |
101 | tryCatch({ | |
102 | cat(rep(line),"\n", sep="") | |
103 | }, error=function(err) { | |
104 | cat("Error: ", get_error(err),"\n", sep="") | |
105 | }) | |
106 | # R debug/fatal with tracebacks: | |
107 | #cat(rep(line),"\n", sep="") | |
108 | } |