lis.p8/lib.lua

-- lib.lua --

local lib = { __p = nil, __t = {}, }

-- todo: we can set these directly when we know that e_create works right
function id(a) return a end

e_create(lib, "call/cc", function(args, env, cont)
	if not is_fun(args[1]) then
		return "call/cc takes a function"
	end
	local function escape(args, env, _cont)
		if args[1] == nil then
			return cont("no value passed")
		end
		return cont(args[1])
	end
	return args[1]({escape}, env, cont)
end, nil, id)

e_create(lib, "do", function(args, env, cont)
	return cont(args[#args])
end, nil, id)

-- todo: error on wrong arg type
e_create(lib, "+", function(args, env, cont)
	local acc = 0
	for i = 1, #args do
		acc += args[i]
	end
	return cont(acc)
end, nil, id)

e_create(lib, "*", function(args, env, cont)
	local acc = args[1]
	for i = 2, #args do
		acc *= args[i]
	end
	return cont(acc)
end, nil, id)

e_create(lib, "-", function(args, env, cont)
	-- todo: return errors for bad types
	-- todo: unary minus
	local acc = args[1] or 0
	for i = 2, #args do
		acc -= args[i]
	end
	return cont(acc)
end, nil, id)

e_create(lib, "/", function(args, env, cont)
	local acc = args[1] or 0
	for i = 2, #args do
		acc /= args[i]
	end
	return cont(acc)
end, nil, id)

e_create(lib, "even?", function(args, env, cont)
	return cont(args[1] % 2 == 0)
end, nil, id)

e_create(lib, "?!", function(args, env, cont)
	local s = ""
	for i = 1, #args do
		if is_str(args[i]) then
			s = s .. sub(args[i], 2) .. " "
		elseif args[i] == none then
			s = s .. "[none] "
		else
			s = s .. tostr(args[i]) .. " "
		end
	end
	print(s)
	return cont(";" .. s)
end, nil, id)

e_create(lib, "<", function(args, env, cont)
	local acc = -32768 -- lowest pico-8 value i think
	for i = 1, #args do
		if not (args[i] > acc) then
			return cont(false)
		end
		acc = args[i]
	end
	return cont(true)
end, nil, id)

e_create(lib, "=", function(args, env, cont)
	local acc = args[1]
	for i = 2, #args do
		if args[i] != acc then
			return cont(false)
		end
	end
	return cont(true)
end, nil, id)

e_create(lib, "list", function(args, env, cont)
	return cont(args)
end, nil, id)

e_create(lib, "[]", function(args, env, cont)
	if not is_tab(args[1]) then
		return "[] 1st arg must be table"
	end
	return cont(args[1][args[2]])
end, nil, id)

e_create(lib, "len", function(args, env, cont)
	if not is_tab(args[1]) then
		return "len arg must be table"
	end
	return cont(#(args[1]))
end, nil, id)

e_create(lib, "join", function(args, env, cont)
	local new, len = {}, 0
	for i = 1, #args do
		local arg = args[i]
		if not is_tab(arg) then
			len += 1
			new[len] = arg
			goto next
		end
		for j = 1, #arg do
			new[len + j] = arg[j]
		end
		len += #arg
		::next::
	end
	return cont(new)
end, nil, id)

e_create(lib, "fold", function(args, env, cont)
	if not is_fun(args[1]) then
		return "1st arg should be func"
	elseif args[2] == nil then
		return "2nd arg should be start val"
	elseif not is_tab(args[3]) then
		return "3rd arg should be table"
	end
	local fn, acc, list = args[1], args[2], args[3]
	local len = #list
	if len < 1 then
		return "cant fold empty list"
	end

	local function do_fold(idx, val)
		if idx == len then
			return cont(val)
		end
		return fn({val, list[idx + 1]}, env, bind(do_fold, idx + 1))
	end

	return fn({acc, list[1]}, env, bind(do_fold, 1))
end, nil, id)

function wrap_fn(fn, name)
	e_create(lib, name, function(args, env, cont)
		return cont(fn(unpack(args)))
	end, nil, id)
end

for i = 1, #wraps do
	-- todo: should i / do i need to prefix these ??
	-- todo: post these with ! since almost all of them can mutate
	wrap_fn(wraps[i].v, wraps[i].k)
end
wraps = nil -- let there be garbage collection

for k, v in pairs({
	["sym?"] = is_sym,
	["num?"] = is_num,
	["fun?"] = is_fun,
	["tab?"] = is_tab,
	["str?"] = is_str,
	["bool?"] = is_bool,
}) do
	wrap_fn(v, k)
end