Merge pull request #379 from bjh21/bjh21-unterminated-string-fixes
[jackhill/mal.git] / julia / step8_macros.jl
1 #!/usr/bin/env julia
2
3 push!(LOAD_PATH, pwd(), "/usr/share/julia/base")
4 import readline_mod
5 import reader
6 import printer
7 using env
8 import core
9 using types
10
11 # READ
12 function READ(str)
13 reader.read_str(str)
14 end
15
16 # EVAL
17 function ispair(ast)
18 (isa(ast, Array) || isa(ast, Tuple)) && length(ast) > 0
19 end
20
21 function quasiquote(ast)
22 if !ispair(ast)
23 [[:quote]; Any[ast]]
24 elseif ast[1] == :unquote
25 ast[2]
26 elseif ispair(ast[1]) && ast[1][1] == symbol("splice-unquote")
27 [[:concat]; Any[ast[1][2]]; Any[quasiquote(ast[2:end])]]
28 else
29 [[:cons]; Any[quasiquote(ast[1])]; Any[quasiquote(ast[2:end])]]
30 end
31 end
32
33 function ismacroCall(ast, env)
34 return isa(ast, Array) &&
35 !isempty(ast) &&
36 isa(ast[1], Symbol) &&
37 env_find(env, ast[1]) != nothing &&
38 isa(env_get(env, ast[1]), MalFunc) &&
39 env_get(env, ast[1]).ismacro
40 end
41
42 function macroexpand(ast, env)
43 while ismacroCall(ast, env)
44 mac = env_get(env, ast[1])
45 ast = mac.fn(ast[2:end]...)
46 end
47 ast
48 end
49
50 function eval_ast(ast, env)
51 if typeof(ast) == Symbol
52 env_get(env,ast)
53 elseif isa(ast, Array) || isa(ast, Tuple)
54 map((x) -> EVAL(x,env), ast)
55 elseif isa(ast, Dict)
56 [EVAL(x[1],env) => EVAL(x[2], env) for x=ast]
57 else
58 ast
59 end
60 end
61
62 function EVAL(ast, env)
63 while true
64 #println("EVAL: $(printer.pr_str(ast,true))")
65 if !isa(ast, Array) return eval_ast(ast, env) end
66
67 # apply
68 ast = macroexpand(ast, env)
69 if !isa(ast, Array) return eval_ast(ast, env) end
70 if isempty(ast) return ast end
71
72 if :def! == ast[1]
73 return env_set(env, ast[2], EVAL(ast[3], env))
74 elseif symbol("let*") == ast[1]
75 let_env = Env(env)
76 for i = 1:2:length(ast[2])
77 env_set(let_env, ast[2][i], EVAL(ast[2][i+1], let_env))
78 end
79 env = let_env
80 ast = ast[3]
81 # TCO loop
82 elseif :quote == ast[1]
83 return ast[2]
84 elseif :quasiquote == ast[1]
85 ast = quasiquote(ast[2])
86 # TCO loop
87 elseif :defmacro! == ast[1]
88 func = EVAL(ast[3], env)
89 func.ismacro = true
90 return env_set(env, ast[2], func)
91 elseif :macroexpand == ast[1]
92 return macroexpand(ast[2], env)
93 elseif :do == ast[1]
94 eval_ast(ast[2:end-1], env)
95 ast = ast[end]
96 # TCO loop
97 elseif :if == ast[1]
98 cond = EVAL(ast[2], env)
99 if cond === nothing || cond === false
100 if length(ast) >= 4
101 ast = ast[4]
102 # TCO loop
103 else
104 return nothing
105 end
106 else
107 ast = ast[3]
108 # TCO loop
109 end
110 elseif symbol("fn*") == ast[1]
111 return MalFunc(
112 (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])),
113 ast[3], env, ast[2])
114 else
115 el = eval_ast(ast, env)
116 f, args = el[1], el[2:end]
117 if isa(f, MalFunc)
118 ast = f.ast
119 env = Env(f.env, f.params, args)
120 # TCO loop
121 else
122 return f(args...)
123 end
124 end
125 end
126 end
127
128 # PRINT
129 function PRINT(exp)
130 printer.pr_str(exp)
131 end
132
133 # REPL
134 repl_env = nothing
135 function REP(str)
136 return PRINT(EVAL(READ(str), repl_env))
137 end
138
139 # core.jl: defined using Julia
140 repl_env = Env(nothing, core.ns)
141 env_set(repl_env, :eval, (ast) -> EVAL(ast, repl_env))
142 env_set(repl_env, symbol("*ARGV*"), ARGS[2:end])
143
144 # core.mal: defined using the language itself
145 REP("(def! not (fn* (a) (if a false true)))")
146 REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
147 REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
148 REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
149
150
151 if length(ARGS) > 0
152 REP("(load-file \"$(ARGS[1])\")")
153 exit(0)
154 end
155
156 while true
157 line = readline_mod.do_readline("user> ")
158 if line === nothing break end
159 try
160 println(REP(line))
161 catch e
162 if isa(e, ErrorException)
163 println("Error: $(e.msg)")
164 else
165 println("Error: $(string(e))")
166 end
167 # TODO: show at least part of stack
168 if !isa(e, StackOverflowError)
169 bt = catch_backtrace()
170 Base.show_backtrace(STDERR, bt)
171 end
172 println()
173 end
174 end