crystal/step8_macros.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].each_with_object(Mal::List.new) { |e, l| l << e }
  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].each_with_object(Mal::List.new) { |e, l| l << e }
  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].each_with_object(Mal::List.new){|i, l| l << i}, {{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].each_with_object(Mal::List.new) { |i, l| l << i }, 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       else
 214         invoke_list(list, env)
 215       end
 216     end
 217   end
 218
 219   def print(result)
 220     pr_str(result, true)
 221   end
 222
 223   def rep(str)
 224     print(eval(read(str), REPL_ENV))
 225   end
 226 end
 227
 228 REPL_ENV = Mal::Env.new nil
 229 Mal::NS.each { |k, v| REPL_ENV.set(k, Mal::Type.new(v)) }
 230 REPL_ENV.set("eval", Mal::Type.new ->(args : Array(Mal::Type)) { Mal.eval(args[0], REPL_ENV) })
 231 Mal.rep "(def! not (fn* (a) (if a false true)))"
 232 Mal.rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
 233 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)))))))"
 234 Mal.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))))))))"
 235
 236 argv = Mal::List.new
 237 REPL_ENV.set("*ARGV*", Mal::Type.new argv)
 238
 239 unless ARGV.empty?
 240   if ARGV.size > 1
 241     ARGV[1..-1].each do |a|
 242       argv << Mal::Type.new(a)
 243     end
 244   end
 245
 246   begin
 247     Mal.rep "(load-file \"#{ARGV[0]}\")"
 248   rescue e
 249     STDERR.puts e
 250   end
 251   exit
 252 end
 253
 254 while line = Readline.readline("user> ", true)
 255   begin
 256     puts Mal.rep(line)
 257   rescue e : Mal::RuntimeException
 258     STDERR.puts "Error: #{pr_str(e.thrown, true)}"
 259   rescue e
 260     STDERR.puts "Error: #{e}"
 261   end
 262 end