crystal/step9_try.cr

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