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")
8 READ
<- function(str
) {
12 eval_ast
<- function(ast
, env
) {
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
)))
24 EVAL
<- function(ast
, env
) {
25 #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="")
27 return(eval_ast(ast
, env
))
31 switch(paste("l",length(ast
),sep
=""),
33 l1
={ a0
<- ast
[[1]]; a1
<- NULL; a2
<- NULL },
34 l2
={ a0
<- ast
[[1]]; a1
<- ast
[[2]]; a2
<- NULL },
35 { a0
<- ast
[[1]]; a1
<- ast
[[2]]; a2
<- ast
[[3]] })
36 if (length(a0
) > 1) a0sym
<- "__<*fn*>__"
37 else a0sym
<- as
.character(a0
)
38 if (a0sym
== "def!") {
39 res
<- EVAL(ast
[[3]], env
)
40 return(Env
.set(env
, a1
, res
))
41 } else if (a0sym
== "let*") {
42 let_env
<- new
.Env(env
)
43 for(i
in seq(1,length(a1
),2)) {
44 Env
.set(let_env
, a1
[[i
]], EVAL(a1
[[i
+1]], let_env
))
46 return(EVAL(a2
, let_env
))
47 } else if (a0sym
== "do") {
48 el
<- eval_ast(slice(ast
,2), env
)
49 return(el
[[length(el
)]])
50 } else if (a0sym
== "if") {
52 if (.nil_q(cond
) || identical(cond
, FALSE)) {
53 if (length(ast
) < 4) return(nil
)
54 return(EVAL(ast
[[4]], env
))
58 } else if (a0sym
== "fn*") {
59 return(function(...) {
60 EVAL(a2
, new
.Env(env
, a1
, list(...)))
63 el
<- eval_ast(ast
, env
)
65 return(do
.call(f
,slice(el
,2)))
69 PRINT
<- function(exp
) {
70 return(.pr_str(exp
, TRUE))
74 rep
<- function(str
) return(PRINT(EVAL(READ(str
), repl_env
)))
76 # core.r: defined using R
77 for(k
in names(core_ns
)) { Env
.set(repl_env
, k
, core_ns
[[k
]]) }
79 # core.mal: defined using the language itself
80 . <- rep("(def! not (fn* (a) (if a false true)))")
84 line
<- readline("user> ")
85 if (is
.null(line
)) { cat("\n"); break }
87 cat(rep(line
),"\n", sep
="")
88 }, error
=function(err
) {
89 cat("Error: ", get_error(err
),"\n", sep
="")
91 # R debug/fatal with tracebacks:
92 #cat(rep(line),"\n", sep="")