| 1 | #! /usr/bin/env crystal run |
| 2 | |
| 3 | require "colorize" |
| 4 | |
| 5 | require "readline" |
| 6 | require "./reader" |
| 7 | require "./printer" |
| 8 | require "./types" |
| 9 | require "./env" |
| 10 | require "./core" |
| 11 | require "./error" |
| 12 | |
| 13 | # Note: |
| 14 | # Employed downcase names because Crystal prohibits uppercase names for methods |
| 15 | |
| 16 | module Mal |
| 17 | extend self |
| 18 | |
| 19 | def func_of(env, binds, body) |
| 20 | ->(args : Array(Mal::Type)) { |
| 21 | new_env = Mal::Env.new(env, binds, args) |
| 22 | eval(body, new_env) |
| 23 | }.as(Mal::Func) |
| 24 | end |
| 25 | |
| 26 | def eval_ast(ast, env) |
| 27 | return ast.map { |n| eval(n, env).as(Mal::Type) } if ast.is_a? Array |
| 28 | |
| 29 | val = ast.unwrap |
| 30 | |
| 31 | Mal::Type.new case val |
| 32 | when Mal::Symbol |
| 33 | if e = env.get(val.str) |
| 34 | e |
| 35 | else |
| 36 | eval_error "'#{val.str}' not found" |
| 37 | end |
| 38 | when Mal::List |
| 39 | val.each_with_object(Mal::List.new) { |n, l| l << eval(n, env) } |
| 40 | when Mal::Vector |
| 41 | val.each_with_object(Mal::Vector.new) { |n, l| l << eval(n, env) } |
| 42 | when Mal::HashMap |
| 43 | new_map = Mal::HashMap.new |
| 44 | val.each { |k, v| new_map[k] = eval(v, env) } |
| 45 | new_map |
| 46 | else |
| 47 | val |
| 48 | end |
| 49 | end |
| 50 | |
| 51 | def read(str) |
| 52 | read_str str |
| 53 | end |
| 54 | |
| 55 | macro pair?(list) |
| 56 | {{list}}.is_a?(Array) && !{{list}}.empty? |
| 57 | end |
| 58 | |
| 59 | def quasiquote(ast) |
| 60 | list = ast.unwrap |
| 61 | |
| 62 | unless pair?(list) |
| 63 | return Mal::Type.new( |
| 64 | Mal::List.new << gen_type(Mal::Symbol, "quote") << ast |
| 65 | ) |
| 66 | end |
| 67 | |
| 68 | head = list.first.unwrap |
| 69 | |
| 70 | case |
| 71 | # ("unquote" ...) |
| 72 | when head.is_a?(Mal::Symbol) && head.str == "unquote" |
| 73 | list[1] |
| 74 | # (("splice-unquote" ...) ...) |
| 75 | when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" |
| 76 | tail = Mal::Type.new list[1..-1].to_mal |
| 77 | Mal::Type.new( |
| 78 | Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) |
| 79 | ) |
| 80 | else |
| 81 | tail = Mal::Type.new list[1..-1].to_mal |
| 82 | Mal::Type.new( |
| 83 | Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) |
| 84 | ) |
| 85 | end |
| 86 | end |
| 87 | |
| 88 | def macro_call?(ast, env) |
| 89 | list = ast.unwrap |
| 90 | return false unless list.is_a? Mal::List |
| 91 | return false if list.empty? |
| 92 | |
| 93 | sym = list.first.unwrap |
| 94 | return false unless sym.is_a? Mal::Symbol |
| 95 | |
| 96 | func = env.find(sym.str).try(&.data[sym.str]) |
| 97 | return false unless func && func.macro? |
| 98 | |
| 99 | true |
| 100 | end |
| 101 | |
| 102 | def macroexpand(ast, env) |
| 103 | while macro_call?(ast, env) |
| 104 | # Already checked in macro_call? |
| 105 | list = ast.unwrap.as(Mal::List) |
| 106 | func_sym = list[0].unwrap.as(Mal::Symbol) |
| 107 | func = env.get(func_sym.str).unwrap |
| 108 | |
| 109 | case func |
| 110 | when Mal::Func |
| 111 | ast = func.call(list[1..-1]) |
| 112 | when Mal::Closure |
| 113 | ast = func.fn.call(list[1..-1]) |
| 114 | else |
| 115 | eval_error "macro '#{func_sym.str}' must be function: #{ast}" |
| 116 | end |
| 117 | end |
| 118 | |
| 119 | ast |
| 120 | end |
| 121 | |
| 122 | macro invoke_list(l, env) |
| 123 | f = eval({{l}}.first, {{env}}).unwrap |
| 124 | args = eval_ast({{l}}[1..-1], {{env}}).as(Array) |
| 125 | |
| 126 | case f |
| 127 | when Mal::Closure |
| 128 | ast = f.ast |
| 129 | {{env}} = Mal::Env.new(f.env, f.params, args) |
| 130 | next # TCO |
| 131 | when Mal::Func |
| 132 | return f.call args |
| 133 | else |
| 134 | eval_error "expected function as the first argument: #{f}" |
| 135 | end |
| 136 | end |
| 137 | |
| 138 | def debug(ast) |
| 139 | puts print(ast).colorize.red |
| 140 | end |
| 141 | |
| 142 | def eval(ast, env) |
| 143 | # 'next' in 'do...end' has a bug in crystal 0.7.1 |
| 144 | # https://github.com/manastech/crystal/issues/659 |
| 145 | while true |
| 146 | list = ast.unwrap |
| 147 | |
| 148 | return eval_ast(ast, env) unless list.is_a? Mal::List |
| 149 | return ast if list.empty? |
| 150 | |
| 151 | ast = macroexpand(ast, env) |
| 152 | |
| 153 | list = ast.unwrap |
| 154 | |
| 155 | return eval_ast(ast, env) unless list.is_a? Mal::List |
| 156 | return ast if list.empty? |
| 157 | |
| 158 | head = list.first.unwrap |
| 159 | |
| 160 | return invoke_list(list, env) unless head.is_a? Mal::Symbol |
| 161 | |
| 162 | return Mal::Type.new case head.str |
| 163 | when "def!" |
| 164 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 |
| 165 | a1 = list[1].unwrap |
| 166 | eval_error "1st argument of 'def!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol |
| 167 | env.set(a1.str, eval(list[2], env)) |
| 168 | when "let*" |
| 169 | eval_error "wrong number of argument for 'def!'" unless list.size == 3 |
| 170 | |
| 171 | bindings = list[1].unwrap |
| 172 | eval_error "1st argument of 'let*' must be list or vector" unless bindings.is_a? Array |
| 173 | eval_error "size of binding list must be even" unless bindings.size.even? |
| 174 | |
| 175 | new_env = Mal::Env.new env |
| 176 | bindings.each_slice(2) do |binding| |
| 177 | key, value = binding |
| 178 | name = key.unwrap |
| 179 | eval_error "name of binding must be specified as symbol #{name}" unless name.is_a? Mal::Symbol |
| 180 | new_env.set(name.str, eval(value, new_env)) |
| 181 | end |
| 182 | |
| 183 | ast, env = list[2], new_env |
| 184 | next # TCO |
| 185 | when "do" |
| 186 | if list.empty? |
| 187 | ast = Mal::Type.new nil |
| 188 | next |
| 189 | end |
| 190 | |
| 191 | eval_ast(list[1..-2].to_mal, env) |
| 192 | ast = list.last |
| 193 | next # TCO |
| 194 | when "if" |
| 195 | ast = unless eval(list[1], env).unwrap |
| 196 | list.size >= 4 ? list[3] : Mal::Type.new(nil) |
| 197 | else |
| 198 | list[2] |
| 199 | end |
| 200 | next # TCO |
| 201 | when "fn*" |
| 202 | params = list[1].unwrap |
| 203 | unless params.is_a? Array |
| 204 | eval_error "'fn*' parameters must be list or vector: #{params}" |
| 205 | end |
| 206 | Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) |
| 207 | when "quote" |
| 208 | list[1] |
| 209 | when "quasiquote" |
| 210 | ast = quasiquote list[1] |
| 211 | next # TCO |
| 212 | when "defmacro!" |
| 213 | eval_error "wrong number of argument for 'defmacro!'" unless list.size == 3 |
| 214 | a1 = list[1].unwrap |
| 215 | eval_error "1st argument of 'defmacro!' must be symbol: #{a1}" unless a1.is_a? Mal::Symbol |
| 216 | env.set(a1.str, eval(list[2], env).tap { |n| n.is_macro = true }) |
| 217 | when "macroexpand" |
| 218 | macroexpand(list[1], env) |
| 219 | when "try*" |
| 220 | catch_list = list.size >= 3 ? list[2].unwrap : Mal::Type.new(nil) |
| 221 | return eval(list[1], env) unless catch_list.is_a? Mal::List |
| 222 | |
| 223 | catch_head = catch_list.first.unwrap |
| 224 | return eval(list[1], env) unless catch_head.is_a? Mal::Symbol |
| 225 | return eval(list[1], env) unless catch_head.str == "catch*" |
| 226 | |
| 227 | begin |
| 228 | eval(list[1], env) |
| 229 | rescue e : Mal::RuntimeException |
| 230 | new_env = Mal::Env.new(env, [catch_list[1]], [e.thrown]) |
| 231 | eval(catch_list[2], new_env) |
| 232 | rescue e |
| 233 | new_env = Mal::Env.new(env, [catch_list[1]], [Mal::Type.new e.message]) |
| 234 | eval(catch_list[2], new_env) |
| 235 | end |
| 236 | else |
| 237 | invoke_list(list, env) |
| 238 | end |
| 239 | end |
| 240 | end |
| 241 | |
| 242 | def print(result) |
| 243 | pr_str(result, true) |
| 244 | end |
| 245 | |
| 246 | def rep(str) |
| 247 | print(eval(read(str), REPL_ENV)) |
| 248 | end |
| 249 | end |
| 250 | |
| 251 | REPL_ENV = Mal::Env.new nil |
| 252 | Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) } |
| 253 | REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) }) |
| 254 | Mal.rep "(def! not (fn* (a) (if a false true)))" |
| 255 | Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" |
| 256 | Mal.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)))))))" |
| 257 | Mal.rep "(def! inc (fn* [x] (+ x 1)))" |
| 258 | Mal.rep "(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))" |
| 259 | Mal.rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))" |
| 260 | Mal.rep("(def! *host-language* \"crystal\")") |
| 261 | |
| 262 | argv = Mal::List.new |
| 263 | REPL_ENV.set("*ARGV*", Mal::Type.new argv) |
| 264 | |
| 265 | unless ARGV.empty? |
| 266 | if ARGV.size > 1 |
| 267 | ARGV[1..-1].each do |a| |
| 268 | argv << Mal::Type.new(a) |
| 269 | end |
| 270 | end |
| 271 | |
| 272 | begin |
| 273 | Mal.rep "(load-file \"#{ARGV[0]}\")" |
| 274 | rescue e |
| 275 | STDERR.puts e |
| 276 | end |
| 277 | exit |
| 278 | end |
| 279 | |
| 280 | Mal.rep("(println (str \"Mal [\" *host-language* \"]\"))") |
| 281 | |
| 282 | while line = Readline.readline("user> ", true) |
| 283 | begin |
| 284 | puts Mal.rep(line) |
| 285 | rescue e : Mal::RuntimeException |
| 286 | STDERR.puts "Error: #{pr_str(e.thrown, true)}" |
| 287 | rescue e |
| 288 | STDERR.puts "Error: #{e}" |
| 289 | end |
| 290 | end |