lua/stepA_mal.lua

   1 #!/usr/bin/env lua
   2
   3 local table = require('table')
   4
   5 package.path = '../lua/?.lua;' .. package.path
   6 local readline = require('readline')
   7 local utils = require('utils')
   8 local types = require('types')
   9 local reader = require('reader')
  10 local printer = require('printer')
  11 local Env = require('env')
  12 local core = require('core')
  13 local List, Vector, HashMap = types.List, types.Vector, types.HashMap
  14
  15 -- read
  16 function READ(str)
  17     return reader.read_str(str)
  18 end
  19
  20 -- eval
  21 function is_pair(x)
  22     return types._sequential_Q(x) and #x > 0
  23 end
  24
  25 function quasiquote(ast)
  26     if not is_pair(ast) then
  27         return types.List:new({types.Symbol:new("quote"), ast})
  28     elseif types._symbol_Q(ast[1]) and ast[1].val == 'unquote' then
  29         return ast[2]
  30     elseif is_pair(ast[1]) and
  31            types._symbol_Q(ast[1][1]) and
  32            ast[1][1].val == 'splice-unquote' then
  33         return types.List:new({types.Symbol:new("concat"),
  34                                ast[1][2],
  35                                quasiquote(ast:slice(2))})
  36     else
  37         return types.List:new({types.Symbol:new("cons"),
  38                                quasiquote(ast[1]),
  39                                quasiquote(ast:slice(2))})
  40     end
  41 end
  42
  43 function is_macro_call(ast, env)
  44     if types._list_Q(ast) and
  45        types._symbol_Q(ast[1]) and
  46        env:find(ast[1]) then
  47         local f = env:get(ast[1])
  48         return types._malfunc_Q(f) and f.ismacro
  49     end
  50 end
  51
  52 function macroexpand(ast, env)
  53     while is_macro_call(ast, env) do
  54         local mac = env:get(ast[1])
  55         ast = mac.fn(table.unpack(ast:slice(2)))
  56     end
  57     return ast
  58 end
  59
  60 function eval_ast(ast, env)
  61     if types._symbol_Q(ast) then
  62         return env:get(ast)
  63     elseif types._list_Q(ast) then
  64         return List:new(utils.map(function(x) return EVAL(x,env) end,ast))
  65     elseif types._vector_Q(ast) then
  66         return Vector:new(utils.map(function(x) return EVAL(x,env) end,ast))
  67     elseif types._hash_map_Q(ast) then
  68         local new_hm = {}
  69         for k,v in pairs(ast) do
  70             new_hm[EVAL(k, env)] = EVAL(v, env)
  71         end
  72         return HashMap:new(new_hm)
  73     else
  74         return ast
  75     end
  76 end
  77
  78 function EVAL(ast, env)
  79   while true do
  80     --print("EVAL: "..printer._pr_str(ast,true))
  81     if not types._list_Q(ast) then return eval_ast(ast, env) end
  82
  83     -- apply list
  84     ast = macroexpand(ast, env)
  85     if not types._list_Q(ast) then return eval_ast(ast, env) end
  86
  87     local a0,a1,a2,a3 = ast[1], ast[2],ast[3],ast[4]
  88     if not a0 then return ast end
  89     local a0sym = types._symbol_Q(a0) and a0.val or ""
  90     if 'def!' == a0sym then
  91         return env:set(a1, EVAL(a2, env))
  92     elseif 'let*' == a0sym then
  93         local let_env = Env:new(env)
  94         for i = 1,#a1,2 do
  95             let_env:set(a1[i], EVAL(a1[i+1], let_env))
  96         end
  97         env = let_env
  98         ast = a2 -- TCO
  99     elseif 'quote' == a0sym then
 100         return a1
 101     elseif 'quasiquote' == a0sym then
 102         ast = quasiquote(a1) -- TCO
 103     elseif 'defmacro!' == a0sym then
 104         local mac = EVAL(a2, env)
 105         mac.ismacro = true
 106         return env:set(a1, mac)
 107     elseif 'macroexpand' == a0sym then
 108         return macroexpand(a1, env)
 109     elseif 'try*' == a0sym then
 110         local exc, result = nil, nil
 111         xpcall(function()
 112             result = EVAL(a1, env)
 113         end, function(err)
 114             exc = err
 115         end)
 116         if exc ~= nil then
 117             if types._malexception_Q(exc) then
 118                 exc = exc.val
 119             end
 120             if a2 and a2[1].val == 'catch*' then
 121                 result = EVAL(a2[3], Env:new(env, {a2[2]}, {exc}))
 122             else
 123                 types.throw(exc)
 124             end
 125         end
 126         return result
 127     elseif 'do' == a0sym then
 128         local el = eval_ast(ast:slice(2,#ast-1), env)
 129         ast = ast[#ast]  -- TCO
 130     elseif 'if' == a0sym then
 131         local cond = EVAL(a1, env)
 132         if cond == types.Nil or cond == false then
 133             if #ast > 3 then ast = a3 else return types.Nil end -- TCO
 134         else
 135             ast = a2 -- TCO
 136         end
 137     elseif 'fn*' == a0sym then
 138         return types.MalFunc:new(function(...)
 139             return EVAL(a2, Env:new(env, a1, table.pack(...)))
 140         end, a2, env, a1)
 141     else
 142         local args = eval_ast(ast, env)
 143         local f = table.remove(args, 1)
 144         if types._malfunc_Q(f) then
 145             ast = f.ast
 146             env = Env:new(f.env, f.params, args) -- TCO
 147         else
 148             return f(table.unpack(args))
 149         end
 150     end
 151   end
 152 end
 153
 154 -- print
 155 function PRINT(exp)
 156     return printer._pr_str(exp, true)
 157 end
 158
 159 -- repl
 160 local repl_env = Env:new()
 161 function rep(str)
 162     return PRINT(EVAL(READ(str),repl_env))
 163 end
 164
 165 -- core.lua: defined using Lua
 166 for k,v in pairs(core.ns) do
 167     repl_env:set(types.Symbol:new(k), v)
 168 end
 169 repl_env:set(types.Symbol:new('eval'),
 170              function(ast) return EVAL(ast, repl_env) end)
 171 repl_env:set(types.Symbol:new('*ARGV*'), types.List:new(types.slice(arg,2)))
 172
 173 -- core.mal: defined using mal
 174 rep("(def! *host-language* \"lua\")")
 175 rep("(def! not (fn* (a) (if a false true)))")
 176 rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
 177 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)))))))")
 178 rep("(def! inc (fn* [x] (+ x 1)))")
 179 rep("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str \"G__\" (swap! counter inc))))))")
 180 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)))))))))")
 181
 182 function print_exception(exc)
 183     if exc then
 184         if types._malexception_Q(exc) then
 185             exc = printer._pr_str(exc.val, true)
 186         end
 187         print("Error: " .. exc)
 188         print(debug.traceback())
 189     end
 190 end
 191
 192 if #arg > 0 and arg[1] == "--raw" then
 193     readline.raw = true
 194     table.remove(arg,1)
 195 end
 196
 197 if #arg > 0 then
 198     xpcall(function() rep("(load-file \""..arg[1].."\")") end,
 199            print_exception)
 200     os.exit(0)
 201 end
 202
 203 rep("(println (str \"Mal [\" *host-language* \"]\"))")
 204 while true do
 205     line = readline.readline("user> ")
 206     if not line then break end
 207     xpcall(function() print(rep(line)) end,
 208            print_exception)
 209 end