lis.p8/eval.lua

-- 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