-- eval.lua -- e_create(lib, "defmacro!", function(ast, env, cont) -- (defmacro! name normal-function) if #ast < 2 then return "macro needs 2 args" end return eval(ast[2], env, function(val) return e_create(env, ast[1], val, "macro", cont) end) end, "special", id) e_create(lib, "quote", function(ast, env, cont) return cont(deep_copy(ast[1])) -- no mutate end, "special", id) e_create(lib, "comma", function(ast, env, cont) return "comma outside of backquote" end, "special", id) e_create(lib, "backquote", function(ast, env, cont) if #ast < 1 then return "backquote need arg" end ast = ast[1] --todo: implement backquote, where we iterate on the quoted thing --and look for invokations of (comma thing) in which we eval --thing and replace comma thing with it --todo: could i define backquote from within lisp now that i have --macros ????? return "nope lol oiuhre4swiuhsrgiuhjswegfoij oijerws" end, "special", id) e_create(lib, "set!", function(ast, env, cont) -- (set! symbol value) if #ast < 2 then return "too few args for set!" end return eval(ast[2], env, function(val, type) return e_set(env, ast[1], val, type, cont) end) end, "special", id) e_create(lib, "def!", function(ast, env, cont) -- (def! symbol value) if #ast < 2 then return "too few args for def!" end return eval(ast[2], env, function(val, type) return e_create(env, ast[1], val, type, cont) end) end, "special", id) e_create(lib, "let", function(ast, env, cont) -- (let ((a 2) (b 4) (c 8)) ...) if #ast < 2 then return "let needs binds and body" end -- todo: check args to make sure it's a list of (bind expr) if not is_tab(ast[1]) then return "first args must be a list" end local new_env = { __p = env, __t = {}, } local binds, body = ast[1], rest(ast) local function do_body(idx, val) if idx >= #body then return cont(val) end return eval(body[idx + 1], new_env, bind(do_body, idx + 1)) end local function do_binds(idx, val) return e_create(new_env, binds[idx][1], val, nil, function() if idx == #binds then return do_body(0, nil) end return eval(binds[idx + 1][2], env, bind(do_binds, idx + 1)) end) end if #binds > 0 then return eval(binds[1][2], env, bind(do_binds, 1)) end return do_body(0, nil) end, "special", id) --todo: cond is more generic, replace this with cond ? e_create(lib, "if", function(ast, env, cont) -- (if cond a b) if #ast < 2 then return "if requires pred and body" end return eval(ast[1], env, function(pred) if pred == false or pred == none then if ast[3] then return eval(ast[3], env, cont) end return cont(none) end return eval(ast[2], env, cont) end) end, "special", id) e_create(lib, "\\", function(ast, env, cont) -- (lam (a b c...) body...) if #ast < 2 then return "lam needs args and body" end if not is_tab(ast[1]) then return "lam binds have to be list" end local binds, body = ast[1], rest(ast) return cont(function(args, _, cont) local lam_env = { __p = env, __t = {}, } if #args < #binds then return "lambda needs more args" end local function do_body(idx, val) if idx - 1 >= #body then return cont(val) end return eval(body[idx], lam_env, bind(do_body, idx + 1)) end local function do_binds(idx) if idx - 1 >= #binds then return do_body(1, nil) end return e_create(lam_env, binds[idx], args[idx], nil, bind(do_binds, idx + 1)) end return do_binds(1) end) end, "special", id) function eval_fun_call(ast, env, cont) return eval(ast[1], env, function(fn) if not is_fun(fn) then return tostr(ast[1]) .. " is not a function" end -- todo: if we can avoid cloning args -- and just bind args_length instead -- this should be faster local ast_args, zeroth = rest(ast), {} local function eval_args(args, val) if val != zeroth then args = pack(unpack(args)) -- no mutate if val == nil then args[#args + 1] = none else args[#args + 1] = val end end if #args == #ast_args then return fn(args, env, cont) end return eval(ast_args[#args + 1], env, bind(eval_args, args)) end return eval_args({}, zeroth) end) end -- eval :: error : string or nil (on success) function eval(ast, env, cont) if ast == nil then return "error ast is nil" end if is_num(ast) or is_bool(ast) or is_str(ast) or ast == none then return cont(ast) end if is_sym(ast) then return e_get(env, ast, cont) end if is_tab(ast) and #ast == 0 then return "cannot eval empty list" end if is_tab(ast) then if is_tab(ast[1]) then return eval_fun_call(ast, env, cont) end return e_get(env, ast[1], function(val, type) if type == "special" then return val(rest(ast), env, cont) elseif type == "macro" then --todo: write macro-expand function ? --todo: can we write this back into the ast ? (for SPEED) return val(rest(ast), env, function(new_ast) return eval(new_ast, env, cont) end) else return eval_fun_call(ast, env, cont) end end) end return "unimplemented ast: " .. tostr(ast) end