From d9e70aa52e121044a538cc0466438e3c87decb85 Mon Sep 17 00:00:00 2001 From: Walter Leibbrandt Date: Fri, 7 Oct 2022 02:35:32 +0200 Subject: [PATCH] Update aniseed --- lua/conjure-macroexpand/aniseed/autoload.lua | 107 +- lua/conjure-macroexpand/aniseed/compile.lua | 205 +- lua/conjure-macroexpand/aniseed/core.lua | 1313 ++---- .../aniseed/deps/fennel.lua | 4115 +++++++++++------ .../aniseed/deps/fennelview.lua | 382 -- lua/conjure-macroexpand/aniseed/deps/fun.lua | 1058 +++++ lua/conjure-macroexpand/aniseed/env.lua | 153 +- lua/conjure-macroexpand/aniseed/eval.lua | 131 +- lua/conjure-macroexpand/aniseed/fennel.lua | 151 +- lua/conjure-macroexpand/aniseed/fs.lua | 190 +- lua/conjure-macroexpand/aniseed/macros.fnl | 332 +- lua/conjure-macroexpand/aniseed/nvim.lua | 49 +- lua/conjure-macroexpand/aniseed/nvim/util.lua | 171 +- lua/conjure-macroexpand/aniseed/setup.lua | 61 + lua/conjure-macroexpand/aniseed/string.lua | 236 +- lua/conjure-macroexpand/aniseed/test.lua | 362 +- lua/conjure-macroexpand/aniseed/view.lua | 69 +- 17 files changed, 5046 insertions(+), 4039 deletions(-) delete mode 100644 lua/conjure-macroexpand/aniseed/deps/fennelview.lua create mode 100644 lua/conjure-macroexpand/aniseed/deps/fun.lua create mode 100644 lua/conjure-macroexpand/aniseed/setup.lua diff --git a/lua/conjure-macroexpand/aniseed/autoload.lua b/lua/conjure-macroexpand/aniseed/autoload.lua index c1382f2..6864453 100644 --- a/lua/conjure-macroexpand/aniseed/autoload.lua +++ b/lua/conjure-macroexpand/aniseed/autoload.lua @@ -1,78 +1,37 @@ local _2afile_2a = "fnl/aniseed/autoload.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.autoload" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.autoload" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end -local autoload0 +local _2amodule_2a do - local v_0_ - do - local v_0_0 - local function autoload1(name) - local res = {["aniseed/autoload-enabled?"] = true, ["aniseed/autoload-module"] = false} - local function ensure() - if res["aniseed/autoload-module"] then - return res["aniseed/autoload-module"] - else - local m = require(name) - do end (res)["aniseed/autoload-module"] = m - return m - end - end - local function _3_(t, ...) - return ensure()(...) - end - local function _4_(t, k) - return ensure()[k] - end - local function _5_(t, k, v) - ensure()[k] = v - return nil - end - return setmetatable(res, {__call = _3_, __index = _4_, __newindex = _5_}) - end - v_0_0 = autoload1 - _0_["autoload"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["autoload"] = v_0_ - autoload0 = v_0_ + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] end -return nil +local _2amodule_locals_2a +do + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end +local function autoload(name) + local res = {["aniseed/autoload-enabled?"] = true, ["aniseed/autoload-module"] = false} + local function ensure() + if res["aniseed/autoload-module"] then + return res["aniseed/autoload-module"] + else + local m = require(name) + do end (res)["aniseed/autoload-module"] = m + return m + end + end + local function _2_(t, ...) + return ensure()(...) + end + local function _3_(t, k) + return ensure()[k] + end + local function _4_(t, k, v) + ensure()[k] = v + return nil + end + return setmetatable(res, {__call = _2_, __index = _3_, __newindex = _4_}) +end +_2amodule_2a["autoload"] = autoload +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/compile.lua b/lua/conjure-macroexpand/aniseed/compile.lua index deaac94..e4733f8 100644 --- a/lua/conjure-macroexpand/aniseed/compile.lua +++ b/lua/conjure-macroexpand/aniseed/compile.lua @@ -1,146 +1,83 @@ local _2afile_2a = "fnl/aniseed/compile.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.compile" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.fennel"), autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim")} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {autoload = {a = "conjure-macroexpand.aniseed.core", fennel = "conjure-macroexpand.aniseed.fennel", fs = "conjure-macroexpand.aniseed.fs", nvim = "conjure-macroexpand.aniseed.nvim"}} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local a = _local_0_[1] -local fennel = _local_0_[2] -local fs = _local_0_[3] -local nvim = _local_0_[4] -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.compile" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end -local macros_prefix +local _2amodule_2a do - local v_0_ - do - local v_0_0 - local function macros_prefix0(code, opts) - local macros_module = "conjure-macroexpand.aniseed.macros" - local filename - do - local _3_ = a.get(opts, "filename") - if _3_ then - filename = string.gsub(_3_, (nvim.fn.getcwd() .. fs["path-sep"]), "") - else - filename = _3_ - end - end - local _4_ - if filename then - _4_ = ("\"" .. string.gsub(filename, "\\", "\\\\") .. "\"") - else - _4_ = "nil" - end - return ("(local *file* " .. _4_ .. ")" .. "(require-macros \"" .. macros_module .. "\")\n" .. code) - end - v_0_0 = macros_prefix0 - _0_["macros-prefix"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["macros-prefix"] = v_0_ - macros_prefix = v_0_ + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] end -local str +local _2amodule_locals_2a do - local v_0_ - do - local v_0_0 - local function str0(code, opts) - local fnl = fennel.impl() - local function _3_() - return fnl.compileString(macros_prefix(code, opts), a.merge({allowedGlobals = false}, opts)) - end - return xpcall(_3_, fnl.traceback) - end - v_0_0 = str0 - _0_["str"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["str"] = v_0_ - str = v_0_ + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] end -local file -do - local v_0_ +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local a, fennel, fs, nvim = autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.fennel"), autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim") +do end (_2amodule_locals_2a)["a"] = a +_2amodule_locals_2a["fennel"] = fennel +_2amodule_locals_2a["fs"] = fs +_2amodule_locals_2a["nvim"] = nvim +local function wrap_macros(code, opts) + local macros_module = "conjure-macroexpand.aniseed.macros" + local filename do - local v_0_0 - local function file0(src, dest) - local code = a.slurp(src) - local _3_, _4_ = str(code, {filename = src}) - if ((_3_ == false) and (nil ~= _4_)) then - local err = _4_ - return nvim.err_writeln(err) - elseif ((_3_ == true) and (nil ~= _4_)) then - local result = _4_ - fs.mkdirp(fs.basename(dest)) - return a.spit(dest, result) - end + local _1_ = a.get(opts, "filename") + if (nil ~= _1_) then + filename = string.gsub(_1_, (nvim.fn.getcwd() .. fs["path-sep"]), "") + else + filename = _1_ end - v_0_0 = file0 - _0_["file"] = v_0_0 - v_0_ = v_0_0 end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["file"] = v_0_ - file = v_0_ -end -local glob -do - local v_0_ - do - local v_0_0 - local function glob0(src_expr, src_dir, dest_dir) - for _, path in ipairs(fs.relglob(src_dir, src_expr)) do - if fs["macro-file-path?"](path) then - a.spit((dest_dir .. path), a.slurp((src_dir .. path))) - else - file((src_dir .. path), string.gsub((dest_dir .. path), ".fnl$", ".lua")) - end - end - return nil + local function _3_() + if filename then + return ("\"" .. string.gsub(filename, "\\", "\\\\") .. "\"") + else + return "nil" end - v_0_0 = glob0 - _0_["glob"] = v_0_0 - v_0_ = v_0_0 end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["glob"] = v_0_ - glob = v_0_ + return ("(local *file* " .. _3_() .. ")" .. "(require-macros \"" .. macros_module .. "\")\n" .. "(wrap-module-body " .. (code or "") .. ")") end -return nil +_2amodule_2a["wrap-macros"] = wrap_macros +local marker_prefix = "ANISEED_" +_2amodule_2a["marker-prefix"] = marker_prefix +local delete_marker = (marker_prefix .. "DELETE_ME") +do end (_2amodule_2a)["delete-marker"] = delete_marker +local delete_marker_pat = ("\n[^\n]-\"" .. delete_marker .. "\".-") +do end (_2amodule_locals_2a)["delete-marker-pat"] = delete_marker_pat +local function str(code, opts) + ANISEED_STATIC_MODULES = (true == a.get(opts, "static?")) + local fnl = fennel.impl() + local function _4_() + return string.gsub(string.gsub(fnl.compileString(wrap_macros(code, opts), a["merge!"]({allowedGlobals = false, compilerEnv = _G}, opts)), (delete_marker_pat .. "\n"), "\n"), (delete_marker_pat .. "$"), "") + end + return xpcall(_4_, fnl.traceback) +end +_2amodule_2a["str"] = str +local function file(src, dest, opts) + local code = a.slurp(src) + local _5_, _6_ = str(code, a["merge!"]({filename = src, ["static?"] = true}, opts)) + if ((_5_ == false) and (nil ~= _6_)) then + local err = _6_ + return nvim.err_writeln(err) + elseif ((_5_ == true) and (nil ~= _6_)) then + local result = _6_ + fs.mkdirp(fs.basename(dest)) + return a.spit(dest, result) + else + return nil + end +end +_2amodule_2a["file"] = file +local function glob(src_expr, src_dir, dest_dir, opts) + for _, path in ipairs(fs.relglob(src_dir, src_expr)) do + if fs["macro-file-path?"](path) then + local dest = (dest_dir .. path) + fs.mkdirp(fs.basename(dest)) + a.spit(dest, a.slurp((src_dir .. path))) + else + file((src_dir .. path), string.gsub((dest_dir .. path), ".fnl$", ".lua"), opts) + end + end + return nil +end +_2amodule_2a["glob"] = glob +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/core.lua b/lua/conjure-macroexpand/aniseed/core.lua index 4c89d0d..aabccf5 100644 --- a/lua/conjure-macroexpand/aniseed/core.lua +++ b/lua/conjure-macroexpand/aniseed/core.lua @@ -1,957 +1,458 @@ local _2afile_2a = "fnl/aniseed/core.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.core" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {autoload("conjure-macroexpand.aniseed.view")} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {autoload = {view = "conjure-macroexpand.aniseed.view"}} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local view = _local_0_[1] -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.core" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end +local _2amodule_2a +do + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] +end +local _2amodule_locals_2a +do + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local view = autoload("conjure-macroexpand.aniseed.view") +do end (_2amodule_locals_2a)["view"] = view math.randomseed(os.time()) -local rand -do - local v_0_ - do - local v_0_0 - local function rand0(n) - return (math.random() * (n or 1)) - end - v_0_0 = rand0 - _0_["rand"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["rand"] = v_0_ - rand = v_0_ +local function rand(n) + return (math.random() * (n or 1)) end -local string_3f -do - local v_0_ - do - local v_0_0 - local function string_3f0(x) - return ("string" == type(x)) - end - v_0_0 = string_3f0 - _0_["string?"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["string?"] = v_0_ - string_3f = v_0_ +_2amodule_2a["rand"] = rand +local function nil_3f(x) + return (nil == x) end -local nil_3f -do - local v_0_ - do - local v_0_0 - local function nil_3f0(x) - return (nil == x) - end - v_0_0 = nil_3f0 - _0_["nil?"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["nil?"] = v_0_ - nil_3f = v_0_ +_2amodule_2a["nil?"] = nil_3f +local function number_3f(x) + return ("number" == type(x)) end -local table_3f -do - local v_0_ - do - local v_0_0 - local function table_3f0(x) - return ("table" == type(x)) - end - v_0_0 = table_3f0 - _0_["table?"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["table?"] = v_0_ - table_3f = v_0_ +_2amodule_2a["number?"] = number_3f +local function boolean_3f(x) + return ("boolean" == type(x)) end -local count -do - local v_0_ - do - local v_0_0 - local function count0(xs) - if table_3f(xs) then - return table.maxn(xs) - elseif not xs then - return 0 - else - return #xs +_2amodule_2a["boolean?"] = boolean_3f +local function string_3f(x) + return ("string" == type(x)) +end +_2amodule_2a["string?"] = string_3f +local function table_3f(x) + return ("table" == type(x)) +end +_2amodule_2a["table?"] = table_3f +local function function_3f(value) + return ("function" == type(value)) +end +_2amodule_2a["function?"] = function_3f +local function keys(t) + local result = {} + if t then + for k, _ in pairs(t) do + table.insert(result, k) + end + else + end + return result +end +_2amodule_2a["keys"] = keys +local function count(xs) + if table_3f(xs) then + local maxn = table.maxn(xs) + if (0 == maxn) then + return table.maxn(keys(xs)) + else + return maxn + end + elseif not xs then + return 0 + else + return #xs + end +end +_2amodule_2a["count"] = count +local function empty_3f(xs) + return (0 == count(xs)) +end +_2amodule_2a["empty?"] = empty_3f +local function first(xs) + if xs then + return xs[1] + else + return nil + end +end +_2amodule_2a["first"] = first +local function second(xs) + if xs then + return xs[2] + else + return nil + end +end +_2amodule_2a["second"] = second +local function last(xs) + if xs then + return xs[count(xs)] + else + return nil + end +end +_2amodule_2a["last"] = last +local function inc(n) + return (n + 1) +end +_2amodule_2a["inc"] = inc +local function dec(n) + return (n - 1) +end +_2amodule_2a["dec"] = dec +local function even_3f(n) + return ((n % 2) == 0) +end +_2amodule_2a["even?"] = even_3f +local function odd_3f(n) + return not even_3f(n) +end +_2amodule_2a["odd?"] = odd_3f +local function vals(t) + local result = {} + if t then + for _, v in pairs(t) do + table.insert(result, v) + end + else + end + return result +end +_2amodule_2a["vals"] = vals +local function kv_pairs(t) + local result = {} + if t then + for k, v in pairs(t) do + table.insert(result, {k, v}) + end + else + end + return result +end +_2amodule_2a["kv-pairs"] = kv_pairs +local function run_21(f, xs) + if xs then + local nxs = count(xs) + if (nxs > 0) then + for i = 1, nxs do + f(xs[i]) end + return nil + else + return nil end - v_0_0 = count0 - _0_["count"] = v_0_0 - v_0_ = v_0_0 + else + return nil end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["count"] = v_0_ - count = v_0_ end -local empty_3f -do - local v_0_ - do - local v_0_0 - local function empty_3f0(xs) - return (0 == count(xs)) +_2amodule_2a["run!"] = run_21 +local function filter(f, xs) + local result = {} + local function _11_(x) + if f(x) then + return table.insert(result, x) + else + return nil end - v_0_0 = empty_3f0 - _0_["empty?"] = v_0_0 - v_0_ = v_0_0 end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["empty?"] = v_0_ - empty_3f = v_0_ + run_21(_11_, xs) + return result end -local first -do - local v_0_ - do - local v_0_0 - local function first0(xs) - if xs then - return xs[1] - end - end - v_0_0 = first0 - _0_["first"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["first"] = v_0_ - first = v_0_ -end -local second -do - local v_0_ - do - local v_0_0 - local function second0(xs) - if xs then - return xs[2] - end - end - v_0_0 = second0 - _0_["second"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["second"] = v_0_ - second = v_0_ -end -local last -do - local v_0_ - do - local v_0_0 - local function last0(xs) - if xs then - return xs[count(xs)] - end - end - v_0_0 = last0 - _0_["last"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["last"] = v_0_ - last = v_0_ -end -local inc -do - local v_0_ - do - local v_0_0 - local function inc0(n) - return (n + 1) - end - v_0_0 = inc0 - _0_["inc"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["inc"] = v_0_ - inc = v_0_ -end -local dec -do - local v_0_ - do - local v_0_0 - local function dec0(n) - return (n - 1) - end - v_0_0 = dec0 - _0_["dec"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["dec"] = v_0_ - dec = v_0_ -end -local even_3f -do - local v_0_ - do - local v_0_0 - local function even_3f0(n) - return ((n % 2) == 0) - end - v_0_0 = even_3f0 - _0_["even?"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["even?"] = v_0_ - even_3f = v_0_ -end -local odd_3f -do - local v_0_ - do - local v_0_0 - local function odd_3f0(n) - return not even_3f(n) - end - v_0_0 = odd_3f0 - _0_["odd?"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["odd?"] = v_0_ - odd_3f = v_0_ -end -local keys -do - local v_0_ - do - local v_0_0 - local function keys0(t) - local result = {} - if t then - for k, _ in pairs(t) do - table.insert(result, k) - end - end - return result - end - v_0_0 = keys0 - _0_["keys"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["keys"] = v_0_ - keys = v_0_ -end -local vals -do - local v_0_ - do - local v_0_0 - local function vals0(t) - local result = {} - if t then - for _, v in pairs(t) do - table.insert(result, v) - end - end - return result - end - v_0_0 = vals0 - _0_["vals"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["vals"] = v_0_ - vals = v_0_ -end -local kv_pairs -do - local v_0_ - do - local v_0_0 - local function kv_pairs0(t) - local result = {} - if t then - for k, v in pairs(t) do - table.insert(result, {k, v}) - end - end - return result - end - v_0_0 = kv_pairs0 - _0_["kv-pairs"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["kv-pairs"] = v_0_ - kv_pairs = v_0_ -end -local run_21 -do - local v_0_ - do - local v_0_0 - local function run_210(f, xs) - if xs then - local nxs = count(xs) - if (nxs > 0) then - for i = 1, nxs do - f(xs[i]) - end - return nil - end - end - end - v_0_0 = run_210 - _0_["run!"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["run!"] = v_0_ - run_21 = v_0_ -end -local filter -do - local v_0_ - do - local v_0_0 - local function filter0(f, xs) - local result = {} - local function _3_(x) - if f(x) then - return table.insert(result, x) - end - end - run_21(_3_, xs) - return result - end - v_0_0 = filter0 - _0_["filter"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["filter"] = v_0_ - filter = v_0_ -end -local map -do - local v_0_ - do - local v_0_0 - local function map0(f, xs) - local result = {} - local function _3_(x) - local mapped = f(x) - local function _4_() - if (0 == select("#", mapped)) then - return nil - else - return mapped - end - end - return table.insert(result, _4_()) - end - run_21(_3_, xs) - return result - end - v_0_0 = map0 - _0_["map"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["map"] = v_0_ - map = v_0_ -end -local map_indexed -do - local v_0_ - do - local v_0_0 - local function map_indexed0(f, xs) - return map(f, kv_pairs(xs)) - end - v_0_0 = map_indexed0 - _0_["map-indexed"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["map-indexed"] = v_0_ - map_indexed = v_0_ -end -local identity -do - local v_0_ - do - local v_0_0 - local function identity0(x) - return x - end - v_0_0 = identity0 - _0_["identity"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["identity"] = v_0_ - identity = v_0_ -end -local reduce -do - local v_0_ - do - local v_0_0 - local function reduce0(f, init, xs) - local result = init - local function _3_(x) - result = f(result, x) +_2amodule_2a["filter"] = filter +local function map(f, xs) + local result = {} + local function _13_(x) + local mapped = f(x) + local function _14_() + if (0 == select("#", mapped)) then return nil - end - run_21(_3_, xs) - return result - end - v_0_0 = reduce0 - _0_["reduce"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["reduce"] = v_0_ - reduce = v_0_ -end -local some -do - local v_0_ - do - local v_0_0 - local function some0(f, xs) - local result = nil - local n = 1 - while (nil_3f(result) and (n <= count(xs))) do - local candidate = f(xs[n]) - if candidate then - result = candidate - end - n = inc(n) - end - return result - end - v_0_0 = some0 - _0_["some"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["some"] = v_0_ - some = v_0_ -end -local butlast -do - local v_0_ - do - local v_0_0 - local function butlast0(xs) - local total = count(xs) - local function _4_(_3_) - local _arg_0_ = _3_ - local n = _arg_0_[1] - local v = _arg_0_[2] - return (n ~= total) - end - return map(second, filter(_4_, kv_pairs(xs))) - end - v_0_0 = butlast0 - _0_["butlast"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["butlast"] = v_0_ - butlast = v_0_ -end -local rest -do - local v_0_ - do - local v_0_0 - local function rest0(xs) - local function _4_(_3_) - local _arg_0_ = _3_ - local n = _arg_0_[1] - local v = _arg_0_[2] - return (n ~= 1) - end - return map(second, filter(_4_, kv_pairs(xs))) - end - v_0_0 = rest0 - _0_["rest"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["rest"] = v_0_ - rest = v_0_ -end -local concat -do - local v_0_ - do - local v_0_0 - local function concat0(...) - local result = {} - local function _3_(xs) - local function _4_(x) - return table.insert(result, x) - end - return run_21(_4_, xs) - end - run_21(_3_, {...}) - return result - end - v_0_0 = concat0 - _0_["concat"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["concat"] = v_0_ - concat = v_0_ -end -local mapcat -do - local v_0_ - do - local v_0_0 - local function mapcat0(f, xs) - return concat(unpack(map(f, xs))) - end - v_0_0 = mapcat0 - _0_["mapcat"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["mapcat"] = v_0_ - mapcat = v_0_ -end -local pr_str -do - local v_0_ - do - local v_0_0 - local function pr_str0(...) - local s - local function _3_(x) - return view.serialise(x, {["one-line"] = true}) - end - s = table.concat(map(_3_, {...}), " ") - if (nil_3f(s) or ("" == s)) then - return "nil" else - return s + return mapped end end - v_0_0 = pr_str0 - _0_["pr-str"] = v_0_0 - v_0_ = v_0_0 + return table.insert(result, _14_()) end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["pr-str"] = v_0_ - pr_str = v_0_ + run_21(_13_, xs) + return result end -local str -do - local v_0_ - do - local v_0_0 - local function str0(...) - local function _3_(acc, s) - return (acc .. s) - end - local function _4_(s) - if string_3f(s) then - return s - else - return pr_str(s) - end - end - return reduce(_3_, "", map(_4_, {...})) +_2amodule_2a["map"] = map +local function map_indexed(f, xs) + return map(f, kv_pairs(xs)) +end +_2amodule_2a["map-indexed"] = map_indexed +local function identity(x) + return x +end +_2amodule_2a["identity"] = identity +local function reduce(f, init, xs) + local result = init + local function _15_(x) + result = f(result, x) + return nil + end + run_21(_15_, xs) + return result +end +_2amodule_2a["reduce"] = reduce +local function some(f, xs) + local result = nil + local n = 1 + while (nil_3f(result) and (n <= count(xs))) do + local candidate = f(xs[n]) + if candidate then + result = candidate + else end - v_0_0 = str0 - _0_["str"] = v_0_0 - v_0_ = v_0_0 + n = inc(n) end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["str"] = v_0_ - str = v_0_ + return result end -local println -do - local v_0_ - do - local v_0_0 - local function println0(...) - local function _3_(acc, s) - return (acc .. s) - end - local function _5_(_4_) - local _arg_0_ = _4_ - local i = _arg_0_[1] - local s = _arg_0_[2] - if (1 == i) then - return s - else - return (" " .. s) - end - end - local function _6_(s) - if string_3f(s) then - return s - else - return pr_str(s) - end - end - return print(reduce(_3_, "", map_indexed(_5_, map(_6_, {...})))) +_2amodule_2a["some"] = some +local function butlast(xs) + local total = count(xs) + local function _19_(_17_) + local _arg_18_ = _17_ + local n = _arg_18_[1] + local v = _arg_18_[2] + return (n ~= total) + end + return map(second, filter(_19_, kv_pairs(xs))) +end +_2amodule_2a["butlast"] = butlast +local function rest(xs) + local function _22_(_20_) + local _arg_21_ = _20_ + local n = _arg_21_[1] + local v = _arg_21_[2] + return (n ~= 1) + end + return map(second, filter(_22_, kv_pairs(xs))) +end +_2amodule_2a["rest"] = rest +local function concat(...) + local result = {} + local function _23_(xs) + local function _24_(x) + return table.insert(result, x) end - v_0_0 = println0 - _0_["println"] = v_0_0 - v_0_ = v_0_0 + return run_21(_24_, xs) end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["println"] = v_0_ - println = v_0_ + run_21(_23_, {...}) + return result end -local pr -do - local v_0_ - do - local v_0_0 - local function pr0(...) - return println(pr_str(...)) +_2amodule_2a["concat"] = concat +local function mapcat(f, xs) + return concat(unpack(map(f, xs))) +end +_2amodule_2a["mapcat"] = mapcat +local function pr_str(...) + local s + local function _25_(x) + return view.serialise(x, {["one-line"] = true}) + end + s = table.concat(map(_25_, {...}), " ") + if (nil_3f(s) or ("" == s)) then + return "nil" + else + return s + end +end +_2amodule_2a["pr-str"] = pr_str +local function str(...) + local function _27_(acc, s) + return (acc .. s) + end + local function _28_(s) + if string_3f(s) then + return s + else + return pr_str(s) end - v_0_0 = pr0 - _0_["pr"] = v_0_0 - v_0_ = v_0_0 end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["pr"] = v_0_ - pr = v_0_ + return reduce(_27_, "", map(_28_, {...})) end -local slurp -do - local v_0_ - do - local v_0_0 - local function slurp0(path, silent_3f) - local _3_, _4_ = io.open(path, "r") - if ((_3_ == nil) and (nil ~= _4_)) then - local msg = _4_ - return nil - elseif (nil ~= _3_) then - local f = _3_ - local content = f:read("*all") - f:close() - return content +_2amodule_2a["str"] = str +local function println(...) + local function _30_(acc, s) + return (acc .. s) + end + local function _33_(_31_) + local _arg_32_ = _31_ + local i = _arg_32_[1] + local s = _arg_32_[2] + if (1 == i) then + return s + else + return (" " .. s) + end + end + local function _35_(s) + if string_3f(s) then + return s + else + return pr_str(s) + end + end + return print(reduce(_30_, "", map_indexed(_33_, map(_35_, {...})))) +end +_2amodule_2a["println"] = println +local function pr(...) + return println(pr_str(...)) +end +_2amodule_2a["pr"] = pr +local function slurp(path, silent_3f) + local _37_, _38_ = io.open(path, "r") + if ((_37_ == nil) and (nil ~= _38_)) then + local msg = _38_ + return nil + elseif (nil ~= _37_) then + local f = _37_ + local content = f:read("*all") + f:close() + return content + else + return nil + end +end +_2amodule_2a["slurp"] = slurp +local function spit(path, content) + local _40_, _41_ = io.open(path, "w") + if ((_40_ == nil) and (nil ~= _41_)) then + local msg = _41_ + return error(("Could not open file: " .. msg)) + elseif (nil ~= _40_) then + local f = _40_ + f:write(content) + f:close() + return nil + else + return nil + end +end +_2amodule_2a["spit"] = spit +local function merge_21(base, ...) + local function _43_(acc, m) + if m then + for k, v in pairs(m) do + acc[k] = v end + else end - v_0_0 = slurp0 - _0_["slurp"] = v_0_0 - v_0_ = v_0_0 + return acc end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["slurp"] = v_0_ - slurp = v_0_ + return reduce(_43_, (base or {}), {...}) end -local spit -do - local v_0_ - do - local v_0_0 - local function spit0(path, content) - local _3_, _4_ = io.open(path, "w") - if ((_3_ == nil) and (nil ~= _4_)) then - local msg = _4_ - return error(("Could not open file: " .. msg)) - elseif (nil ~= _3_) then - local f = _3_ - f:write(content) - f:close() - return nil - end - end - v_0_0 = spit0 - _0_["spit"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["spit"] = v_0_ - spit = v_0_ +_2amodule_2a["merge!"] = merge_21 +local function merge(...) + return merge_21({}, ...) end -local merge_21 -do - local v_0_ - do - local v_0_0 - local function merge_210(base, ...) - local function _3_(acc, m) - if m then - for k, v in pairs(m) do - acc[k] = v - end - end - return acc - end - return reduce(_3_, (base or {}), {...}) - end - v_0_0 = merge_210 - _0_["merge!"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["merge!"] = v_0_ - merge_21 = v_0_ -end -local merge -do - local v_0_ - do - local v_0_0 - local function merge0(...) - return merge_21({}, ...) - end - v_0_0 = merge0 - _0_["merge"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["merge"] = v_0_ - merge = v_0_ -end -local select_keys -do - local v_0_ - do - local v_0_0 - local function select_keys0(t, ks) - if (t and ks) then - local function _3_(acc, k) - if k then - acc[k] = t[k] - end - return acc - end - return reduce(_3_, {}, ks) +_2amodule_2a["merge"] = merge +local function select_keys(t, ks) + if (t and ks) then + local function _45_(acc, k) + if k then + acc[k] = t[k] else - return {} end + return acc end - v_0_0 = select_keys0 - _0_["select-keys"] = v_0_0 - v_0_ = v_0_0 + return reduce(_45_, {}, ks) + else + return {} end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["select-keys"] = v_0_ - select_keys = v_0_ end -local get -do - local v_0_ - do - local v_0_0 - local function get0(t, k, d) - local res - if table_3f(t) then - local val = t[k] - if not nil_3f(val) then - res = val - else - res = nil - end - else +_2amodule_2a["select-keys"] = select_keys +local function get(t, k, d) + local res + if table_3f(t) then + local val = t[k] + if not nil_3f(val) then + res = val + else res = nil - end - if nil_3f(res) then - return d - else - return res - end end - v_0_0 = get0 - _0_["get"] = v_0_0 - v_0_ = v_0_0 + else + res = nil + end + if nil_3f(res) then + return d + else + return res end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["get"] = v_0_ - get = v_0_ end -local get_in -do - local v_0_ - do - local v_0_0 - local function get_in0(t, ks, d) - local res - local function _3_(acc, k) - if table_3f(acc) then - return get(acc, k) - end - end - res = reduce(_3_, t, ks) - if nil_3f(res) then - return d - else - return res - end +_2amodule_2a["get"] = get +local function get_in(t, ks, d) + local res + local function _51_(acc, k) + if table_3f(acc) then + return get(acc, k) + else + return nil end - v_0_0 = get_in0 - _0_["get-in"] = v_0_0 - v_0_ = v_0_0 end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["get-in"] = v_0_ - get_in = v_0_ + res = reduce(_51_, t, ks) + if nil_3f(res) then + return d + else + return res + end end -local assoc -do - local v_0_ - do - local v_0_0 - local function assoc0(t, ...) - local _let_0_ = {...} - local k = _let_0_[1] - local v = _let_0_[2] - local xs = {(table.unpack or unpack)(_let_0_, 3)} - local rem = count(xs) - local t0 = (t or {}) - if odd_3f(rem) then - error("assoc expects even number of arguments after table, found odd number") - end - if not nil_3f(k) then - t0[k] = v - end - if (rem > 0) then - assoc0(t0, unpack(xs)) - end - return t0 +_2amodule_2a["get-in"] = get_in +local function assoc(t, ...) + local _let_54_ = {...} + local k = _let_54_[1] + local v = _let_54_[2] + local xs = (function (t, k) local mt = getmetatable(t) if "table" == type(mt) and mt.__fennelrest then return mt.__fennelrest(t, k) else return {(table.unpack or unpack)(t, k)} end end)(_let_54_, 3) + local rem = count(xs) + local t0 = (t or {}) + if odd_3f(rem) then + error("assoc expects even number of arguments after table, found odd number") + else + end + if not nil_3f(k) then + t0[k] = v + else + end + if (rem > 0) then + assoc(t0, unpack(xs)) + else + end + return t0 +end +_2amodule_2a["assoc"] = assoc +local function assoc_in(t, ks, v) + local path = butlast(ks) + local final = last(ks) + local t0 = (t or {}) + local function _58_(acc, k) + local step = get(acc, k) + if nil_3f(step) then + return get(assoc(acc, k, {}), k) + else + return step end - v_0_0 = assoc0 - _0_["assoc"] = v_0_0 - v_0_ = v_0_0 end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["assoc"] = v_0_ - assoc = v_0_ + assoc(reduce(_58_, t0, path), final, v) + return t0 end -local assoc_in -do - local v_0_ - do - local v_0_0 - local function assoc_in0(t, ks, v) - local path = butlast(ks) - local final = last(ks) - local t0 = (t or {}) - local function _3_(acc, k) - local step = get(acc, k) - if nil_3f(step) then - return get(assoc(acc, k, {}), k) - else - return step - end - end - assoc(reduce(_3_, t0, path), final, v) - return t0 - end - v_0_0 = assoc_in0 - _0_["assoc-in"] = v_0_0 - v_0_ = v_0_0 +_2amodule_2a["assoc-in"] = assoc_in +local function update(t, k, f) + return assoc(t, k, f(get(t, k))) +end +_2amodule_2a["update"] = update +local function update_in(t, ks, f) + return assoc_in(t, ks, f(get_in(t, ks))) +end +_2amodule_2a["update-in"] = update_in +local function constantly(v) + local function _60_() + return v end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["assoc-in"] = v_0_ - assoc_in = v_0_ + return _60_ end -local update -do - local v_0_ - do - local v_0_0 - local function update0(t, k, f) - return assoc(t, k, f(get(t, k))) - end - v_0_0 = update0 - _0_["update"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["update"] = v_0_ - update = v_0_ -end -local update_in -do - local v_0_ - do - local v_0_0 - local function update_in0(t, ks, f) - return assoc_in(t, ks, f(get_in(t, ks))) - end - v_0_0 = update_in0 - _0_["update-in"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["update-in"] = v_0_ - update_in = v_0_ -end -local constantly -do - local v_0_ - do - local v_0_0 - local function constantly0(v) - local function _3_() - return v - end - return _3_ - end - v_0_0 = constantly0 - _0_["constantly"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["constantly"] = v_0_ - constantly = v_0_ -end -return nil +_2amodule_2a["constantly"] = constantly +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/deps/fennel.lua b/lua/conjure-macroexpand/aniseed/deps/fennel.lua index 3450abb..159cb42 100644 --- a/lua/conjure-macroexpand/aniseed/deps/fennel.lua +++ b/lua/conjure-macroexpand/aniseed/deps/fennel.lua @@ -3,15 +3,17 @@ package.preload["conjure-macroexpand.aniseed.fennel.repl"] = package.preload["co local parser = require("conjure-macroexpand.aniseed.fennel.parser") local compiler = require("conjure-macroexpand.aniseed.fennel.compiler") local specials = require("conjure-macroexpand.aniseed.fennel.specials") + local view = require("conjure-macroexpand.aniseed.fennel.view") + local unpack = (table.unpack or _G.unpack) local function default_read_chunk(parser_state) - local function _0_() + local function _565_() if (0 < parser_state["stack-size"]) then return ".." else return ">> " end end - io.write(_0_()) + io.write(_565_()) io.flush() local input = io.read() return (input and (input .. "\n")) @@ -21,22 +23,23 @@ package.preload["conjure-macroexpand.aniseed.fennel.repl"] = package.preload["co return io.write("\n") end local function default_on_error(errtype, err, lua_source) - local function _1_() - local _0_0 = errtype - if (_0_0 == "Lua Compile") then + local function _567_() + local _566_ = errtype + if (_566_ == "Lua Compile") then return ("Bad code generated - likely a bug with the compiler:\n" .. "--- Generated Lua Start ---\n" .. lua_source .. "--- Generated Lua End ---\n") - elseif (_0_0 == "Runtime") then + elseif (_566_ == "Runtime") then return (compiler.traceback(tostring(err), 4) .. "\n") - else - local _ = _0_0 + elseif true then + local _ = _566_ return ("%s error: %s\n"):format(errtype, tostring(err)) + else + return nil end end - return io.write(_1_()) + return io.write(_567_()) end local save_source = table.concat({"local ___i___ = 1", "while true do", " local name, value = debug.getlocal(1, ___i___)", " if(name and name ~= \"___i___\") then", " ___replLocals___[name] = value", " ___i___ = ___i___ + 1", " else break end end"}, "\n") local function splice_save_locals(env, lua_source) - env.___replLocals___ = (env.___replLocals___ or {}) local spliced_source = {} local bind = "local %s = ___replLocals___['%s']" for line in lua_source:gmatch("([^\n]+)\n?") do @@ -47,74 +50,180 @@ package.preload["conjure-macroexpand.aniseed.fennel.repl"] = package.preload["co end if ((1 < #spliced_source) and (spliced_source[#spliced_source]):match("^ *return .*$")) then table.insert(spliced_source, #spliced_source, save_source) + else end return table.concat(spliced_source, "\n") end + local function completer(env, scope, text) + local max_items = 2000 + local seen = {} + local matches = {} + local input_fragment = text:gsub(".*[%s)(]+", "") + local stop_looking_3f = false + local function add_partials(input, tbl, prefix) + local scope_first_3f = ((tbl == env) or (tbl == env.___replLocals___)) + local tbl_14_auto = matches + local i_15_auto = #tbl_14_auto + local function _570_() + if scope_first_3f then + return scope.manglings + else + return tbl + end + end + for k, is_mangled in utils.allpairs(_570_()) do + if (max_items <= #matches) then break end + local val_16_auto + do + local lookup_k + if scope_first_3f then + lookup_k = is_mangled + else + lookup_k = k + end + if ((type(k) == "string") and (input == k:sub(0, #input)) and not seen[k] and ((":" ~= prefix:sub(-1)) or ("function" == type(tbl[lookup_k])))) then + seen[k] = true + val_16_auto = (prefix .. k) + else + val_16_auto = nil + end + end + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end + end + return tbl_14_auto + end + local function descend(input, tbl, prefix, add_matches, method_3f) + local splitter + if method_3f then + splitter = "^([^:]+):(.*)" + else + splitter = "^([^.]+)%.(.*)" + end + local head, tail = input:match(splitter) + local raw_head = (scope.manglings[head] or head) + if (type(tbl[raw_head]) == "table") then + stop_looking_3f = true + if method_3f then + return add_partials(tail, tbl[raw_head], (prefix .. head .. ":")) + else + return add_matches(tail, tbl[raw_head], (prefix .. head)) + end + else + return nil + end + end + local function add_matches(input, tbl, prefix) + local prefix0 + if prefix then + prefix0 = (prefix .. ".") + else + prefix0 = "" + end + if (not input:find("%.") and input:find(":")) then + return descend(input, tbl, prefix0, add_matches, true) + elseif not input:find("%.") then + return add_partials(input, tbl, prefix0) + else + return descend(input, tbl, prefix0, add_matches, false) + end + end + for _, source in ipairs({scope.specials, scope.macros, (env.___replLocals___ or {}), env, env._G}) do + if stop_looking_3f then break end + add_matches(input_fragment, source) + end + return matches + end local commands = {} local function command_3f(input) return input:match("^%s*,") end local function command_docs() - local _0_ + local _579_ do - local tbl_0_ = {} + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto for name, f in pairs(commands) do - tbl_0_[(#tbl_0_ + 1)] = (" ,%s - %s"):format(name, ((compiler.metadata):get(f, "fnl/docstring") or "undocumented")) + local val_16_auto = (" ,%s - %s"):format(name, ((compiler.metadata):get(f, "fnl/docstring") or "undocumented")) + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end end - _0_ = tbl_0_ + _579_ = tbl_14_auto end - return table.concat(_0_, "\n") + return table.concat(_579_, "\n") end commands.help = function(_, _0, on_values) - return on_values({("Welcome to Fennel.\nThis is the REPL where you can enter code to be evaluated.\nYou can also run these repl commands:\n\n" .. command_docs() .. "\n ,exit - Leave the repl.\n\nUse (doc something) to see descriptions for individual macros and special forms.\n\nFor more information about the language, see https://fennel-lang.org/reference")}) + return on_values({("Welcome to Fennel.\nThis is the REPL where you can enter code to be evaluated.\nYou can also run these repl commands:\n\n" .. command_docs() .. "\n ,exit - Leave the repl.\n\nUse ,doc something to see descriptions for individual macros and special forms.\n\nFor more information about the language, see https://fennel-lang.org/reference")}) end do end (compiler.metadata):set(commands.help, "fnl/docstring", "Show this message.") local function reload(module_name, env, on_values, on_error) - local _0_0, _1_0 = pcall(specials["load-code"]("return require(...)", env), module_name) - if ((_0_0 == true) and (nil ~= _1_0)) then - local old = _1_0 - local _ = nil + local _581_, _582_ = pcall(specials["load-code"]("return require(...)", env), module_name) + if ((_581_ == true) and (nil ~= _582_)) then + local old = _582_ + local _ package.loaded[module_name] = nil _ = nil local ok, new = pcall(require, module_name) - local new0 = nil + local new0 if not ok then on_values({new}) new0 = old else new0 = new end + specials["macro-loaded"][module_name] = nil if ((type(old) == "table") and (type(new0) == "table")) then for k, v in pairs(new0) do old[k] = v end for k in pairs(old) do - if (nil == new0[k]) then + if (nil == (new0)[k]) then old[k] = nil + else end end package.loaded[module_name] = old + else end return on_values({"ok"}) - elseif ((_0_0 == false) and (nil ~= _1_0)) then - local msg = _1_0 - local function _3_() - local _2_0 = msg:gsub("\n.*", "") - return _2_0 + elseif ((_581_ == false) and (nil ~= _582_)) then + local msg = _582_ + if (specials["macro-loaded"])[module_name] then + specials["macro-loaded"][module_name] = nil + return nil + else + local function _587_() + local _586_ = msg:gsub("\n.*", "") + return _586_ + end + return on_error("Runtime", _587_()) end - return on_error("Runtime", _3_()) + else + return nil + end + end + local function run_command(read, on_error, f) + local _590_, _591_, _592_ = pcall(read) + if ((_590_ == true) and (_591_ == true) and (nil ~= _592_)) then + local val = _592_ + return f(val) + elseif (_590_ == false) then + return on_error("Parse", "Couldn't parse input.") + else + return nil end end commands.reload = function(env, read, on_values, on_error) - local _0_0, _1_0, _2_0 = pcall(read) - if ((_0_0 == true) and (_1_0 == true) and (nil ~= _2_0)) then - local module_sym = _2_0 - return reload(tostring(module_sym), env, on_values, on_error) - elseif ((_0_0 == false) and true and true) then - local _3fparse_ok = _1_0 - local _3fmsg = _2_0 - return on_error("Parse", (_3fmsg or _3fparse_ok)) + local function _594_(_241) + return reload(tostring(_241), env, on_values, on_error) end + return run_command(read, on_error, _594_) end do end (compiler.metadata):set(commands.reload, "fnl/docstring", "Reload the specified module.") commands.reset = function(env, _, on_values) @@ -122,123 +231,352 @@ package.preload["conjure-macroexpand.aniseed.fennel.repl"] = package.preload["co return on_values({"ok"}) end do end (compiler.metadata):set(commands.reset, "fnl/docstring", "Erase all repl-local scope.") - local function load_plugin_commands() - if (utils.root and utils.root.options and utils.root.options.plugins) then - for _, plugin in ipairs(utils.root.options.plugins) do - for name, f in pairs(plugin) do - local _0_0 = name:match("^repl%-command%-(.*)") - if (nil ~= _0_0) then - local cmd_name = _0_0 - commands[cmd_name] = (commands[cmd_name] or f) + commands.complete = function(env, read, on_values, on_error, scope, chars) + local function _595_() + return on_values(completer(env, scope, string.char(unpack(chars)):gsub(",complete +", ""):sub(1, -2))) + end + return run_command(read, on_error, _595_) + end + do end (compiler.metadata):set(commands.complete, "fnl/docstring", "Print all possible completions for a given input symbol.") + local function apropos_2a(pattern, tbl, prefix, seen, names) + for name, subtbl in pairs(tbl) do + if (("string" == type(name)) and (package ~= subtbl)) then + local _596_ = type(subtbl) + if (_596_ == "function") then + if ((prefix .. name)):match(pattern) then + table.insert(names, (prefix .. name)) + else end + elseif (_596_ == "table") then + if not seen[subtbl] then + local _599_ + do + local _598_ = seen + _598_[subtbl] = true + _599_ = _598_ + end + apropos_2a(pattern, subtbl, (prefix .. name:gsub("%.", "/") .. "."), _599_, names) + else + end + else + end + else + end + end + return names + end + local function apropos(pattern) + local names = apropos_2a(pattern, package.loaded, "", {}, {}) + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto + for _, name in ipairs(names) do + local val_16_auto = name:gsub("^_G%.", "") + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end + end + return tbl_14_auto + end + commands.apropos = function(_env, read, on_values, on_error, _scope) + local function _604_(_241) + return on_values(apropos(tostring(_241))) + end + return run_command(read, on_error, _604_) + end + do end (compiler.metadata):set(commands.apropos, "fnl/docstring", "Print all functions matching a pattern in all loaded modules.") + local function apropos_follow_path(path) + local paths + do + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto + for p in path:gmatch("[^%.]+") do + local val_16_auto = p + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else end end + paths = tbl_14_auto + end + local tgt = package.loaded + for _, path0 in ipairs(paths) do + if (nil == tgt) then break end + local _607_ + do + local _606_ = path0:gsub("%/", ".") + _607_ = _606_ + end + tgt = tgt[_607_] + end + return tgt + end + local function apropos_doc(pattern) + local names = {} + for _, path in ipairs(apropos(".*")) do + local tgt = apropos_follow_path(path) + if ("function" == type(tgt)) then + local _608_ = (compiler.metadata):get(tgt, "fnl/docstring") + if (nil ~= _608_) then + local docstr = _608_ + if docstr:match(pattern) then + table.insert(names, path) + else + end + else + end + else + end + end + return names + end + commands["apropos-doc"] = function(_env, read, on_values, on_error, _scope) + local function _612_(_241) + return on_values(apropos_doc(tostring(_241))) + end + return run_command(read, on_error, _612_) + end + do end (compiler.metadata):set(commands["apropos-doc"], "fnl/docstring", "Print all functions that match the pattern in their docs") + local function apropos_show_docs(on_values, pattern) + for _, path in ipairs(apropos(pattern)) do + local tgt = apropos_follow_path(path) + if (("function" == type(tgt)) and (compiler.metadata):get(tgt, "fnl/docstring")) then + on_values(specials.doc(tgt, path)) + on_values() + else + end + end + return nil + end + commands["apropos-show-docs"] = function(_env, read, on_values, on_error) + local function _614_(_241) + return apropos_show_docs(on_values, tostring(_241)) + end + return run_command(read, on_error, _614_) + end + do end (compiler.metadata):set(commands["apropos-show-docs"], "fnl/docstring", "Print all documentations matching a pattern in function name") + local function resolve(identifier, _615_, scope) + local _arg_616_ = _615_ + local ___replLocals___ = _arg_616_["___replLocals___"] + local env = _arg_616_ + local e + local function _617_(_241, _242) + return (___replLocals___[_242] or env[_242]) + end + e = setmetatable({}, {__index = _617_}) + local _618_, _619_ = pcall(compiler["compile-string"], tostring(identifier), {scope = scope}) + if ((_618_ == true) and (nil ~= _619_)) then + local code = _619_ + local _620_ = specials["load-code"](code, e)() + local function _621_() + local x = _620_ + return (type(x) == "function") + end + if ((nil ~= _620_) and _621_()) then + local x = _620_ + return x + else + return nil + end + else return nil end end - local function run_command(input, read, loop, env, on_values, on_error) - load_plugin_commands() + commands.find = function(env, read, on_values, on_error, scope) + local function _624_(_241) + local _625_ + do + local _626_ = utils["sym?"](_241) + if (nil ~= _626_) then + local _627_ = resolve(_626_, env, scope) + if (nil ~= _627_) then + _625_ = debug.getinfo(_627_) + else + _625_ = _627_ + end + else + _625_ = _626_ + end + end + if ((_G.type(_625_) == "table") and (nil ~= (_625_).linedefined) and ((_625_).what == "Lua") and (nil ~= (_625_).short_src) and (nil ~= (_625_).source)) then + local line = (_625_).linedefined + local src = (_625_).short_src + local source = (_625_).source + local fnlsrc + do + local t_630_ = compiler.sourcemap + if (nil ~= t_630_) then + t_630_ = (t_630_)[source] + else + end + if (nil ~= t_630_) then + t_630_ = (t_630_)[line] + else + end + if (nil ~= t_630_) then + t_630_ = (t_630_)[2] + else + end + fnlsrc = t_630_ + end + return on_values({string.format("%s:%s", src, (fnlsrc or line))}) + elseif (_625_ == nil) then + return on_error("Repl", "Unknown value") + elseif true then + local _ = _625_ + return on_error("Repl", "No source info") + else + return nil + end + end + return run_command(read, on_error, _624_) + end + do end (compiler.metadata):set(commands.find, "fnl/docstring", "Print the filename and line number for a given function") + commands.doc = function(env, read, on_values, on_error, scope) + local function _635_(_241) + local name = tostring(_241) + local is_ok, target = nil, nil + local function _636_() + return (scope.specials[name] or scope.macros[name] or resolve(name, env, scope)) + end + is_ok, target = pcall(_636_) + if is_ok then + return on_values({specials.doc(target, name)}) + else + return on_error("Repl", "Could not resolve value for docstring lookup") + end + end + return run_command(read, on_error, _635_) + end + do end (compiler.metadata):set(commands.doc, "fnl/docstring", "Print the docstring and arglist for a function, macro, or special form.") + local function load_plugin_commands(plugins) + for _, plugin in ipairs((plugins or {})) do + for name, f in pairs(plugin) do + local _638_ = name:match("^repl%-command%-(.*)") + if (nil ~= _638_) then + local cmd_name = _638_ + commands[cmd_name] = (commands[cmd_name] or f) + else + end + end + end + return nil + end + local function run_command_loop(input, read, loop, env, on_values, on_error, scope, chars) local command_name = input:match(",([^%s/]+)") do - local _0_0 = commands[command_name] - if (nil ~= _0_0) then - local command = _0_0 - command(env, read, on_values, on_error) - else - local _ = _0_0 + local _640_ = commands[command_name] + if (nil ~= _640_) then + local command = _640_ + command(env, read, on_values, on_error, scope, chars) + elseif true then + local _ = _640_ if ("exit" ~= command_name) then on_values({"Unknown command", command_name}) + else end + else end end if ("exit" ~= command_name) then return loop() - end - end - local function completer(env, scope, text) - local matches = {} - local input_fragment = text:gsub(".*[%s)(]+", "") - local function add_partials(input, tbl, prefix) - for k in utils.allpairs(tbl) do - local k0 = nil - if ((tbl == env) or (tbl == env.___replLocals___)) then - k0 = scope.unmanglings[k] - else - k0 = k - end - if ((#matches < 2000) and (type(k0) == "string") and (input == k0:sub(0, #input))) then - table.insert(matches, (prefix .. k0)) - end - end + else return nil end - local function add_matches(input, tbl, prefix) - local prefix0 = nil - if prefix then - prefix0 = (prefix .. ".") - else - prefix0 = "" - end - if not input:find("%.") then - return add_partials(input, tbl, prefix0) - else - local head, tail = input:match("^([^.]+)%.(.*)") - local raw_head = nil - if ((tbl == env) or (tbl == env.___replLocals___)) then - raw_head = scope.manglings[head] - else - raw_head = head - end - if (type(tbl[raw_head]) == "table") then - return add_matches(tail, tbl[raw_head], (prefix0 .. head)) - end - end - end - add_matches(input_fragment, (scope.specials or {})) - add_matches(input_fragment, (scope.macros or {})) - add_matches(input_fragment, (env.___replLocals___ or {})) - add_matches(input_fragment, env) - add_matches(input_fragment, (env._ENV or env._G or {})) - return matches end - local function repl(options) - local old_root_options = utils.root.options - local env = nil - if options.env then - env = specials["wrap-env"](options.env) + local function try_readline_21(opts, ok, readline) + if ok then + if readline.set_readline_name then + readline.set_readline_name("fennel") + else + end + readline.set_options({keeplines = 1000, histfile = ""}) + opts.readChunk = function(parser_state) + local prompt + if (0 < parser_state["stack-size"]) then + prompt = ".. " + else + prompt = ">> " + end + local str = readline.readline(prompt) + if str then + return (str .. "\n") + else + return nil + end + end + local completer0 = nil + opts.registerCompleter = function(repl_completer) + completer0 = repl_completer + return nil + end + local function repl_completer(text, from, to) + if completer0 then + readline.set_completion_append_character("") + return completer0(text:sub(from, to)) + else + return {} + end + end + readline.set_complete_function(repl_completer) + return readline else - env = setmetatable({}, {__index = (rawget(_G, "_ENV") or _G)}) + return nil end - local save_locals_3f = ((options.saveLocals ~= false) and env.debug and env.debug.getlocal) - local opts = {} - local _ = nil - for k, v in pairs(options) do - opts[k] = v - end - _ = nil + end + local function should_use_readline_3f(opts) + return (("dumb" ~= os.getenv("TERM")) and not opts.readChunk and not opts.registerCompleter) + end + local function repl(_3foptions) + local old_root_options = utils.root.options + local opts = ((_3foptions and utils.copy(_3foptions)) or {}) + local readline = (should_use_readline_3f(opts) and try_readline_21(opts, pcall(require, "readline"))) + local env = specials["wrap-env"]((opts.env or rawget(_G, "_ENV") or _G)) + local save_locals_3f = ((opts.saveLocals ~= false) and env.debug and env.debug.getlocal) local read_chunk = (opts.readChunk or default_read_chunk) local on_values = (opts.onValues or default_on_values) local on_error = (opts.onError or default_on_error) - local pp = (opts.pp or tostring) + local pp = (opts.pp or view) local byte_stream, clear_stream = parser.granulate(read_chunk) local chars = {} local read, reset = nil, nil - local function _1_(parser_state) + local function _649_(parser_state) local c = byte_stream(parser_state) table.insert(chars, c) return c end - read, reset = parser.parser(_1_) - local scope = compiler["make-scope"]() - opts.useMetadata = (options.useMetadata ~= false) + read, reset = parser.parser(_649_) + opts.env, opts.scope = env, compiler["make-scope"]() + opts.useMetadata = (opts.useMetadata ~= false) if (opts.allowedGlobals == nil) then - opts.allowedGlobals = specials["current-global-names"](opts.env) + opts.allowedGlobals = specials["current-global-names"](env) + else end if opts.registerCompleter then - local function _3_(...) - return completer(env, scope, ...) + local function _653_() + local _651_ = env + local _652_ = opts.scope + local function _654_(...) + return completer(_651_, _652_, ...) + end + return _654_ end - opts.registerCompleter(_3_) + opts.registerCompleter(_653_()) + else + end + load_plugin_commands(opts.plugins) + if save_locals_3f then + local function newindex(t, k, v) + if opts.scope.unmanglings[k] then + return rawset(t, k, v) + else + return nil + end + end + env.___replLocals___ = setmetatable({}, {__newindex = newindex}) + else end local function print_values(...) local vals = {...} @@ -253,443 +591,76 @@ package.preload["conjure-macroexpand.aniseed.fennel.repl"] = package.preload["co for k in pairs(chars) do chars[k] = nil end - local ok, parse_ok_3f, x = pcall(read) - local src_string = string.char((table.unpack or _G.unpack)(chars)) - utils.root.options = opts + reset() + local ok, not_eof_3f, x = pcall(read) + local src_string = string.char(unpack(chars)) if not ok then - on_error("Parse", parse_ok_3f) + on_error("Parse", __fnl_global__parse_2dok_3f) clear_stream() - reset() return loop() elseif command_3f(src_string) then - return run_command(src_string, read, loop, env, on_values, on_error) + return run_command_loop(src_string, read, loop, env, on_values, on_error, opts.scope, chars) else - if parse_ok_3f then + if not_eof_3f then do - local _4_0, _5_0 = pcall(compiler.compile, x, {["assert-compile"] = opts["assert-compile"], ["parse-error"] = opts["parse-error"], correlate = opts.correlate, moduleName = opts.moduleName, scope = scope, source = src_string, useBitLib = opts.useBitLib, useMetadata = opts.useMetadata}) - if ((_4_0 == false) and (nil ~= _5_0)) then - local msg = _5_0 + local _658_, _659_ = nil, nil + local function _661_() + local _660_ = opts + _660_["source"] = src_string + return _660_ + end + _658_, _659_ = pcall(compiler.compile, x, _661_()) + if ((_658_ == false) and (nil ~= _659_)) then + local msg = _659_ clear_stream() on_error("Compile", msg) - elseif ((_4_0 == true) and (nil ~= _5_0)) then - local src = _5_0 - local src0 = nil + elseif ((_658_ == true) and (nil ~= _659_)) then + local src = _659_ + local src0 if save_locals_3f then - src0 = splice_save_locals(env, src) + src0 = splice_save_locals(env, src, opts.scope) else src0 = src end - local _7_0, _8_0 = pcall(specials["load-code"], src0, env) - if ((_7_0 == false) and (nil ~= _8_0)) then - local msg = _8_0 + local _663_, _664_ = pcall(specials["load-code"], src0, env) + if ((_663_ == false) and (nil ~= _664_)) then + local msg = _664_ clear_stream() on_error("Lua Compile", msg, src0) - elseif (true and (nil ~= _8_0)) then - local _0 = _7_0 - local chunk = _8_0 - local function _9_() + elseif (true and (nil ~= _664_)) then + local _ = _663_ + local chunk = _664_ + local function _665_() return print_values(chunk()) end - local function _10_(...) - return on_error("Runtime", ...) + local function _666_() + local function _667_(...) + return on_error("Runtime", ...) + end + return _667_ end - xpcall(_9_, _10_) + xpcall(_665_, _666_()) + else end + else end end utils.root.options = old_root_options return loop() + else + return nil end end end - return loop() + loop() + if readline then + return readline.save_history() + else + return nil + end end return repl end -package.preload["conjure-macroexpand.aniseed.fennel.view"] = package.preload["conjure-macroexpand.aniseed.fennel.view"] or function(...) - local type_order = {["function"] = 5, boolean = 2, number = 1, string = 3, table = 4, thread = 7, userdata = 6} - local function sort_keys(_0_0, _1_0) - local _1_ = _0_0 - local a = _1_[1] - local _2_ = _1_0 - local b = _2_[1] - local ta = type(a) - local tb = type(b) - if ((ta == tb) and ((ta == "string") or (ta == "number"))) then - return (a < b) - else - local dta = type_order[ta] - local dtb = type_order[tb] - if (dta and dtb) then - return (dta < dtb) - elseif dta then - return true - elseif dtb then - return false - else - return (ta < tb) - end - end - end - local function table_kv_pairs(t) - local assoc_3f = false - local i = 1 - local kv = {} - local insert = table.insert - for k, v in pairs(t) do - if ((type(k) ~= "number") or (k ~= i)) then - assoc_3f = true - end - i = (i + 1) - insert(kv, {k, v}) - end - table.sort(kv, sort_keys) - if (#kv == 0) then - return kv, "empty" - else - local function _2_() - if assoc_3f then - return "table" - else - return "seq" - end - end - return kv, _2_() - end - end - local function count_table_appearances(t, appearances) - if (type(t) == "table") then - if not appearances[t] then - appearances[t] = 1 - for k, v in pairs(t) do - count_table_appearances(k, appearances) - count_table_appearances(v, appearances) - end - else - appearances[t] = ((appearances[t] or 0) + 1) - end - end - return appearances - end - local function save_table(t, seen) - local seen0 = (seen or {len = 0}) - local id = (seen0.len + 1) - if not seen0[t] then - seen0[t] = id - seen0.len = id - end - return seen0 - end - local function detect_cycle(t, seen, _3fk) - if ("table" == type(t)) then - seen[t] = true - local _2_0, _3_0 = next(t, _3fk) - if ((nil ~= _2_0) and (nil ~= _3_0)) then - local k = _2_0 - local v = _3_0 - return (seen[k] or detect_cycle(k, seen) or seen[v] or detect_cycle(v, seen) or detect_cycle(t, seen, k)) - end - end - end - local function visible_cycle_3f(t, options) - return (options["detect-cycles?"] and detect_cycle(t, {}) and save_table(t, options.seen) and (1 < (options.appearances[t] or 0))) - end - local function table_indent(t, indent, id) - local opener_length = nil - if id then - opener_length = (#tostring(id) + 2) - else - opener_length = 1 - end - return (indent + opener_length) - end - local pp = nil - local function concat_table_lines(elements, options, multiline_3f, indent, table_type, prefix) - local indent_str = ("\n" .. string.rep(" ", indent)) - local open = nil - local function _2_() - if ("seq" == table_type) then - return "[" - else - return "{" - end - end - open = ((prefix or "") .. _2_()) - local close = nil - if ("seq" == table_type) then - close = "]" - else - close = "}" - end - local oneline = (open .. table.concat(elements, " ") .. close) - if (not options["one-line?"] and (multiline_3f or ((indent + #oneline) > options["line-length"]))) then - return (open .. table.concat(elements, indent_str) .. close) - else - return oneline - end - end - local function pp_associative(t, kv, options, indent, key_3f) - local multiline_3f = false - local id = options.seen[t] - if (options.level >= options.depth) then - return "{...}" - elseif (id and options["detect-cycles?"]) then - return ("@" .. id .. "{...}") - else - local visible_cycle_3f0 = visible_cycle_3f(t, options) - local id0 = (visible_cycle_3f0 and options.seen[t]) - local indent0 = table_indent(t, indent, id0) - local slength = nil - local function _3_() - local _2_0 = rawget(_G, "utf8") - if _2_0 then - return _2_0.len - else - return _2_0 - end - end - local function _4_(_241) - return #_241 - end - slength = ((options["utf8?"] and _3_()) or _4_) - local prefix = nil - if visible_cycle_3f0 then - prefix = ("@" .. id0) - else - prefix = "" - end - local items = nil - do - local tbl_0_ = {} - for _, _6_0 in pairs(kv) do - local _7_ = _6_0 - local k = _7_[1] - local v = _7_[2] - local _8_ - do - local k0 = pp(k, options, (indent0 + 1), true) - local v0 = pp(v, options, (indent0 + slength(k0) + 1)) - multiline_3f = (multiline_3f or k0:find("\n") or v0:find("\n")) - _8_ = (k0 .. " " .. v0) - end - tbl_0_[(#tbl_0_ + 1)] = _8_ - end - items = tbl_0_ - end - return concat_table_lines(items, options, multiline_3f, indent0, "table", prefix) - end - end - local function pp_sequence(t, kv, options, indent) - local multiline_3f = false - local id = options.seen[t] - if (options.level >= options.depth) then - return "[...]" - elseif (id and options["detect-cycles?"]) then - return ("@" .. id .. "[...]") - else - local visible_cycle_3f0 = visible_cycle_3f(t, options) - local id0 = (visible_cycle_3f0 and options.seen[t]) - local indent0 = table_indent(t, indent, id0) - local prefix = nil - if visible_cycle_3f0 then - prefix = ("@" .. id0) - else - prefix = "" - end - local items = nil - do - local tbl_0_ = {} - for _, _3_0 in pairs(kv) do - local _4_ = _3_0 - local _0 = _4_[1] - local v = _4_[2] - local _5_ - do - local v0 = pp(v, options, indent0) - multiline_3f = (multiline_3f or v0:find("\n")) - _5_ = v0 - end - tbl_0_[(#tbl_0_ + 1)] = _5_ - end - items = tbl_0_ - end - return concat_table_lines(items, options, multiline_3f, indent0, "seq", prefix) - end - end - local function concat_lines(lines, options, indent, force_multi_line_3f) - if (#lines == 0) then - if options["empty-as-sequence?"] then - return "[]" - else - return "{}" - end - else - local oneline = nil - local _2_ - do - local tbl_0_ = {} - for _, line in ipairs(lines) do - tbl_0_[(#tbl_0_ + 1)] = line:gsub("^%s+", "") - end - _2_ = tbl_0_ - end - oneline = table.concat(_2_, " ") - if (not options["one-line?"] and (force_multi_line_3f or oneline:find("\n") or ((indent + #oneline) > options["line-length"]))) then - return table.concat(lines, ("\n" .. string.rep(" ", indent))) - else - return oneline - end - end - end - local function pp_metamethod(t, metamethod, options, indent) - if (options.level >= options.depth) then - if options["empty-as-sequence?"] then - return "[...]" - else - return "{...}" - end - else - local _ = nil - local function _2_(_241) - return visible_cycle_3f(_241, options) - end - options["visible-cycle?"] = _2_ - _ = nil - local lines, force_multi_line_3f = metamethod(t, pp, options, indent) - options["visible-cycle?"] = nil - local _3_0 = type(lines) - if (_3_0 == "string") then - return lines - elseif (_3_0 == "table") then - return concat_lines(lines, options, indent, force_multi_line_3f) - else - local _0 = _3_0 - return error("__fennelview metamethod must return a table of lines") - end - end - end - local function pp_table(x, options, indent) - options.level = (options.level + 1) - local x0 = nil - do - local _2_0 = nil - if options["metamethod?"] then - local _3_0 = x - if _3_0 then - local _4_0 = getmetatable(_3_0) - if _4_0 then - _2_0 = _4_0.__fennelview - else - _2_0 = _4_0 - end - else - _2_0 = _3_0 - end - else - _2_0 = nil - end - if (nil ~= _2_0) then - local metamethod = _2_0 - x0 = pp_metamethod(x, metamethod, options, indent) - else - local _ = _2_0 - local _4_0, _5_0 = table_kv_pairs(x) - if (true and (_5_0 == "empty")) then - local _0 = _4_0 - if options["empty-as-sequence?"] then - x0 = "[]" - else - x0 = "{}" - end - elseif ((nil ~= _4_0) and (_5_0 == "table")) then - local kv = _4_0 - x0 = pp_associative(x, kv, options, indent) - elseif ((nil ~= _4_0) and (_5_0 == "seq")) then - local kv = _4_0 - x0 = pp_sequence(x, kv, options, indent) - else - x0 = nil - end - end - end - options.level = (options.level - 1) - return x0 - end - local function number__3estring(n) - local _2_0 = string.gsub(tostring(n), ",", ".") - return _2_0 - end - local function colon_string_3f(s) - return s:find("^[-%w?^_!$%&*+./@|<=>]+$") - end - local function pp_string(str, options, indent) - local escs = nil - local _2_ - if (options["escape-newlines?"] and (#str < (options["line-length"] - indent))) then - _2_ = "\\n" - else - _2_ = "\n" - end - local function _4_(_241, _242) - return ("\\%03d"):format(_242:byte()) - end - escs = setmetatable({["\""] = "\\\"", ["\11"] = "\\v", ["\12"] = "\\f", ["\13"] = "\\r", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\\"] = "\\\\", ["\n"] = _2_}, {__index = _4_}) - return ("\"" .. str:gsub("[%c\\\"]", escs) .. "\"") - end - local function make_options(t, options) - local defaults = {["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["escape-newlines?"] = false, ["line-length"] = 80, ["metamethod?"] = true, ["one-line?"] = false, ["prefer-colon?"] = false, ["utf8?"] = true, depth = 128} - local overrides = {appearances = count_table_appearances(t, {}), level = 0, seen = {len = 0}} - for k, v in pairs((options or {})) do - defaults[k] = v - end - for k, v in pairs(overrides) do - defaults[k] = v - end - return defaults - end - local function _2_(x, options, indent, colon_3f) - local indent0 = (indent or 0) - local options0 = (options or make_options(x)) - local tv = type(x) - local function _4_() - local _3_0 = getmetatable(x) - if _3_0 then - return _3_0.__fennelview - else - return _3_0 - end - end - if ((tv == "table") or ((tv == "userdata") and _4_())) then - return pp_table(x, options0, indent0) - elseif (tv == "number") then - return number__3estring(x) - else - local function _5_() - if (colon_3f ~= nil) then - return colon_3f - elseif ("function" == type(options0["prefer-colon?"])) then - return options0["prefer-colon?"](x) - else - return options0["prefer-colon?"] - end - end - if ((tv == "string") and colon_string_3f(x) and _5_()) then - return (":" .. x) - elseif (tv == "string") then - return pp_string(x, options0, indent0) - elseif ((tv == "boolean") or (tv == "nil")) then - return tostring(x) - else - return ("#<" .. tostring(x) .. ">") - end - end - end - pp = _2_ - local function view(x, options) - return pp(x, make_options(x, options), 0) - end - return view -end package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload["conjure-macroexpand.aniseed.fennel.specials"] or function(...) local utils = require("conjure-macroexpand.aniseed.fennel.utils") local view = require("conjure-macroexpand.aniseed.fennel.view") @@ -698,15 +669,15 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local unpack = (table.unpack or _G.unpack) local SPECIALS = compiler.scopes.global.specials local function wrap_env(env) - local function _0_(_, key) - if (type(key) == "string") then + local function _364_(_, key) + if utils["string?"](key) then return env[compiler["global-unmangling"](key)] else return env[key] end end - local function _1_(_, key, value) - if (type(key) == "string") then + local function _366_(_, key, value) + if utils["string?"](key) then env[compiler["global-unmangling"](key)] = value return nil else @@ -714,31 +685,54 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload return nil end end - local function _2_() + local function _368_() local function putenv(k, v) - local _3_ - if (type(k) == "string") then - _3_ = compiler["global-unmangling"](k) + local _369_ + if utils["string?"](k) then + _369_ = compiler["global-unmangling"](k) else - _3_ = k + _369_ = k end - return _3_, v + return _369_, v end return next, utils.kvmap(env, putenv), nil end - return setmetatable({}, {__index = _0_, __newindex = _1_, __pairs = _2_}) + return setmetatable({}, {__index = _364_, __newindex = _366_, __pairs = _368_}) end - local function current_global_names(env) - return utils.kvmap((env or _G), compiler["global-unmangling"]) + local function current_global_names(_3fenv) + local mt + do + local _371_ = getmetatable(_3fenv) + if ((_G.type(_371_) == "table") and (nil ~= (_371_).__pairs)) then + local mtpairs = (_371_).__pairs + local tbl_11_auto = {} + for k, v in mtpairs(_3fenv) do + local _372_, _373_ = k, v + if ((nil ~= _372_) and (nil ~= _373_)) then + local k_12_auto = _372_ + local v_13_auto = _373_ + tbl_11_auto[k_12_auto] = v_13_auto + else + end + end + mt = tbl_11_auto + elseif (_371_ == nil) then + mt = (_3fenv or _G) + else + mt = nil + end + end + return (mt and utils.kvmap(mt, compiler["global-unmangling"])) end - local function load_code(code, environment, filename) - local environment0 = (environment or rawget(_G, "_ENV") or _G) + local function load_code(code, _3fenv, _3ffilename) + local env = (_3fenv or rawget(_G, "_ENV") or _G) if (rawget(_G, "setfenv") and rawget(_G, "loadstring")) then - local f = assert(_G.loadstring(code, filename)) - _G.setfenv(f, environment0) - return f + local f = assert(_G.loadstring(code, _3ffilename)) + local _376_ = f + setfenv(_376_, env) + return _376_ else - return assert(load(code, filename, "t", environment0)) + return assert(load(code, _3ffilename, "t", env)) end end local function doc_2a(tgt, name) @@ -749,52 +743,54 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local mt = getmetatable(tgt) if ((type(tgt) == "function") or ((type(mt) == "table") and (type(mt.__call) == "function"))) then local arglist = table.concat(((compiler.metadata):get(tgt, "fnl/arglist") or {"#"}), " ") - local _0_ + local _378_ if (#arglist > 0) then - _0_ = " " + _378_ = " " else - _0_ = "" + _378_ = "" end - return string.format("(%s%s%s)\n %s", name, _0_, arglist, docstring) + return string.format("(%s%s%s)\n %s", name, _378_, arglist, docstring) else return string.format("%s\n %s", name, docstring) end end end local function doc_special(name, arglist, docstring, body_form_3f) - compiler.metadata[SPECIALS[name]] = {["fnl/arglist"] = arglist, ["fnl/body-form?"] = body_form_3f, ["fnl/docstring"] = docstring} + compiler.metadata[SPECIALS[name]] = {["fnl/arglist"] = arglist, ["fnl/docstring"] = docstring, ["fnl/body-form?"] = body_form_3f} return nil end - local function compile_do(ast, scope, parent, start) - local start0 = (start or 2) + local function compile_do(ast, scope, parent, _3fstart) + local start = (_3fstart or 2) local len = #ast local sub_scope = compiler["make-scope"](scope) - for i = start0, len do + for i = start, len do compiler.compile1(ast[i], sub_scope, parent, {nval = 0}) end return nil end - SPECIALS["do"] = function(ast, scope, parent, opts, start, chunk, sub_scope, pre_syms) - local start0 = (start or 2) - local sub_scope0 = (sub_scope or compiler["make-scope"](scope)) - local chunk0 = (chunk or {}) + SPECIALS["do"] = function(ast, scope, parent, opts, _3fstart, _3fchunk, _3fsub_scope, _3fpre_syms) + local start = (_3fstart or 2) + local sub_scope = (_3fsub_scope or compiler["make-scope"](scope)) + local chunk = (_3fchunk or {}) local len = #ast local retexprs = {returned = true} local function compile_body(outer_target, outer_tail, outer_retexprs) - if (len < start0) then - compiler.compile1(nil, sub_scope0, chunk0, {tail = outer_tail, target = outer_target}) + if (len < start) then + compiler.compile1(nil, sub_scope, chunk, {tail = outer_tail, target = outer_target}) else - for i = start0, len do + for i = start, len do local subopts = {nval = (((i ~= len) and 0) or opts.nval), tail = (((i == len) and outer_tail) or nil), target = (((i == len) and outer_target) or nil)} local _ = utils["propagate-options"](opts, subopts) - local subexprs = compiler.compile1(ast[i], sub_scope0, chunk0, subopts) + local subexprs = compiler.compile1(ast[i], sub_scope, chunk, subopts) if (i ~= len) then compiler["keep-side-effects"](subexprs, parent, nil, ast[i]) + else end end end - compiler.emit(parent, chunk0, ast) + compiler.emit(parent, chunk, ast) compiler.emit(parent, "end", ast) + utils.hook("do", ast, sub_scope) return (outer_retexprs or retexprs) end if (opts.target or (opts.nval == 0) or opts.tail) then @@ -803,8 +799,8 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload elseif opts.nval then local syms = {} for i = 1, opts.nval do - local s = ((pre_syms and pre_syms[i]) or compiler.gensym(scope)) - syms[i] = s + local s = ((_3fpre_syms and (_3fpre_syms)[i]) or compiler.gensym(scope)) + do end (syms)[i] = s retexprs[i] = utils.expr(s, "sym") end local outer_target = table.concat(syms, ", ") @@ -813,14 +809,13 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload return compile_body(outer_target, opts.tail) else local fname = compiler.gensym(scope) - local fargs = nil + local fargs if scope.vararg then fargs = "..." else fargs = "" end compiler.emit(parent, string.format("local function %s(%s)", fname, fargs), ast) - utils.hook("do", ast, sub_scope0) return compile_body(nil, true, utils.expr((fname .. "(" .. fargs .. ")"), "statement")) end end @@ -835,36 +830,48 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload for j = 2, #subexprs do table.insert(exprs, subexprs[j]) end + else end end return exprs end doc_special("values", {"..."}, "Return multiple values from a function. Must be in tail position.") local function deep_tostring(x, key_3f) - local elems = {} if utils["sequence?"](x) then - local _0_ + local _387_ do - local tbl_0_ = {} + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto for _, v in ipairs(x) do - tbl_0_[(#tbl_0_ + 1)] = deep_tostring(v) + local val_16_auto = deep_tostring(v) + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end end - _0_ = tbl_0_ + _387_ = tbl_14_auto end - return ("[" .. table.concat(_0_, " ") .. "]") + return ("[" .. table.concat(_387_, " ") .. "]") elseif utils["table?"](x) then - local _0_ + local _389_ do - local tbl_0_ = {} + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto for k, v in pairs(x) do - tbl_0_[(#tbl_0_ + 1)] = (deep_tostring(k, true) .. " " .. deep_tostring(v)) + local val_16_auto = (deep_tostring(k, true) .. " " .. deep_tostring(v)) + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end end - _0_ = tbl_0_ + _389_ = tbl_14_auto end - return ("{" .. table.concat(_0_, " ") .. "}") - elseif (key_3f and (type(x) == "string") and x:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")) then + return ("{" .. table.concat(_389_, " ") .. "}") + elseif (key_3f and utils["string?"](x) and x:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")) then return (":" .. x) - elseif (type(x) == "string") then + elseif utils["string?"](x) then return string.format("%q", x):gsub("\\\"", "\\\\\""):gsub("\"", "\\\"") else return tostring(x) @@ -872,60 +879,95 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload end local function set_fn_metadata(arg_list, docstring, parent, fn_name) if utils.root.options.useMetadata then - local args = nil - local function _0_(_241) + local args + local function _392_(_241) return ("\"%s\""):format(deep_tostring(_241)) end - args = utils.map(arg_list, _0_) + args = utils.map(arg_list, _392_) local meta_fields = {"\"fnl/arglist\"", ("{" .. table.concat(args, ", ") .. "}")} if docstring then table.insert(meta_fields, "\"fnl/docstring\"") table.insert(meta_fields, ("\"" .. docstring:gsub("%s+$", ""):gsub("\\", "\\\\"):gsub("\n", "\\n"):gsub("\"", "\\\"") .. "\"")) + else end local meta_str = ("require(\"%s\").metadata"):format((utils.root.options.moduleName or "fennel")) return compiler.emit(parent, ("pcall(function() %s:setall(%s, %s) end)"):format(meta_str, fn_name, table.concat(meta_fields, ", "))) + else + return nil end end local function get_fn_name(ast, scope, fn_name, multi) if (fn_name and (fn_name[1] ~= "nil")) then - local _0_ + local _395_ if not multi then - _0_ = compiler["declare-local"](fn_name, {}, scope, ast) + _395_ = compiler["declare-local"](fn_name, {}, scope, ast) else - _0_ = compiler["symbol-to-expression"](fn_name, scope)[1] + _395_ = (compiler["symbol-to-expression"](fn_name, scope))[1] end - return _0_, not multi, 3 + return _395_, not multi, 3 else return nil, true, 2 end end - local function compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, local_3f, arg_name_list, arg_list, docstring) + local function compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, local_3f, arg_name_list, f_metadata) for i = (index + 1), #ast do compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)}) end - local _0_ + local _398_ if local_3f then - _0_ = "local function %s(%s)" + _398_ = "local function %s(%s)" else - _0_ = "%s = function(%s)" + _398_ = "%s = function(%s)" end - compiler.emit(parent, string.format(_0_, fn_name, table.concat(arg_name_list, ", ")), ast) + compiler.emit(parent, string.format(_398_, fn_name, table.concat(arg_name_list, ", ")), ast) compiler.emit(parent, f_chunk, ast) compiler.emit(parent, "end", ast) - set_fn_metadata(arg_list, docstring, parent, fn_name) + set_fn_metadata(f_metadata["fnl/arglist"], f_metadata["fnl/docstring"], parent, fn_name) utils.hook("fn", ast, f_scope) return utils.expr(fn_name, "sym") end - local function compile_anonymous_fn(ast, f_scope, f_chunk, parent, index, arg_name_list, arg_list, docstring, scope) + local function compile_anonymous_fn(ast, f_scope, f_chunk, parent, index, arg_name_list, f_metadata, scope) local fn_name = compiler.gensym(scope) - return compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, true, arg_name_list, arg_list, docstring) + return compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, true, arg_name_list, f_metadata) + end + local function get_function_metadata(ast, arg_list, index) + local f_metadata = {["fnl/arglist"] = arg_list} + local index_2a = (index + 1) + local expr = ast[index_2a] + if (utils["string?"](expr) and (index_2a < #ast)) then + local _401_ + do + local _400_ = f_metadata + _400_["fnl/docstring"] = expr + _401_ = _400_ + end + return _401_, index_2a + elseif (utils["table?"](expr) and (index_2a < #ast)) then + local _402_ + do + local tbl_11_auto = f_metadata + for k, v in pairs(expr) do + local _403_, _404_ = k, v + if ((nil ~= _403_) and (nil ~= _404_)) then + local k_12_auto = _403_ + local v_13_auto = _404_ + tbl_11_auto[k_12_auto] = v_13_auto + else + end + end + _402_ = tbl_11_auto + end + return _402_, index_2a + else + return f_metadata, index + end end SPECIALS.fn = function(ast, scope, parent) - local f_scope = nil + local f_scope do - local _0_0 = compiler["make-scope"](scope) - _0_0["vararg"] = false - f_scope = _0_0 + local _407_ = compiler["make-scope"](scope) + do end (_407_)["vararg"] = false + f_scope = _407_ end local f_chunk = {} local fn_sym = utils["sym?"](ast[2]) @@ -938,7 +980,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload compiler.assert((arg == arg_list[#arg_list]), "expected vararg as last parameter", ast) f_scope.vararg = true return "..." - elseif (utils["sym?"](arg) and (utils.deref(arg) ~= "nil") and not utils["multi-sym?"](utils.deref(arg))) then + elseif (utils["sym?"](arg) and (tostring(arg) ~= "nil") and not utils["multi-sym?"](tostring(arg))) then return compiler["declare-local"](arg, {}, f_scope, ast) elseif utils["table?"](arg) then local raw = utils.sym(compiler.gensym(scope)) @@ -946,62 +988,64 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload compiler.destructure(arg, raw, ast, f_scope, f_chunk, {declaration = true, nomulti = true, symtype = "arg"}) return declared else - return compiler.assert(false, ("expected symbol for function parameter: %s"):format(tostring(arg)), ast[2]) + return compiler.assert(false, ("expected symbol for function parameter: %s"):format(tostring(arg)), ast[index]) end end local arg_name_list = utils.map(arg_list, get_arg_name) - local index0, docstring = nil, nil - if ((type(ast[(index + 1)]) == "string") and ((index + 1) < #ast)) then - index0, docstring = (index + 1), ast[(index + 1)] - else - index0, docstring = index, nil - end + local f_metadata, index0 = get_function_metadata(ast, arg_list, index) if fn_name then - return compile_named_fn(ast, f_scope, f_chunk, parent, index0, fn_name, local_3f, arg_name_list, arg_list, docstring) + return compile_named_fn(ast, f_scope, f_chunk, parent, index0, fn_name, local_3f, arg_name_list, f_metadata) else - return compile_anonymous_fn(ast, f_scope, f_chunk, parent, index0, arg_name_list, arg_list, docstring, scope) + return compile_anonymous_fn(ast, f_scope, f_chunk, parent, index0, arg_name_list, f_metadata, scope) end end - doc_special("fn", {"name?", "args", "docstring?", "..."}, "Function syntax. May optionally include a name and docstring.\nIf a name is provided, the function will be bound in the current scope.\nWhen called with the wrong number of args, excess args will be discarded\nand lacking args will be nil, use lambda for arity-checked functions.", true) + doc_special("fn", {"name?", "args", "docstring?", "..."}, "Function syntax. May optionally include a name and docstring or a metadata table.\nIf a name is provided, the function will be bound in the current scope.\nWhen called with the wrong number of args, excess args will be discarded\nand lacking args will be nil, use lambda for arity-checked functions.", true) SPECIALS.lua = function(ast, _, parent) compiler.assert(((#ast == 2) or (#ast == 3)), "expected 1 or 2 arguments", ast) - if (ast[2] ~= nil) then + local _411_ + do + local _410_ = utils["sym?"](ast[2]) + if (nil ~= _410_) then + _411_ = tostring(_410_) + else + _411_ = _410_ + end + end + if ("nil" ~= _411_) then table.insert(parent, {ast = ast, leaf = tostring(ast[2])}) - end - if (ast[3] ~= nil) then - return tostring(ast[3]) - end - end - SPECIALS.doc = function(ast, scope, parent) - assert(utils.root.options.useMetadata, "can't look up doc with metadata disabled.") - compiler.assert((#ast == 2), "expected one argument", ast) - local target = utils.deref(ast[2]) - local special_or_macro = (scope.specials[target] or scope.macros[target]) - if special_or_macro then - return ("print(%q)"):format(doc_2a(special_or_macro, target)) else - local _0_ = compiler.compile1(ast[2], scope, parent, {nval = 1}) - local value = _0_[1] - return ("print(require('%s').doc(%s, '%s'))"):format((utils.root.options.moduleName or "fennel"), tostring(value), tostring(ast[2])) + end + local _415_ + do + local _414_ = utils["sym?"](ast[3]) + if (nil ~= _414_) then + _415_ = tostring(_414_) + else + _415_ = _414_ + end + end + if ("nil" ~= _415_) then + return tostring(ast[3]) + else + return nil end end - doc_special("doc", {"x"}, "Print the docstring and arglist for a function, macro, or special form.") local function dot(ast, scope, parent) compiler.assert((1 < #ast), "expected table argument", ast) local len = #ast - local _0_ = compiler.compile1(ast[2], scope, parent, {nval = 1}) - local lhs = _0_[1] + local _let_418_ = compiler.compile1(ast[2], scope, parent, {nval = 1}) + local lhs = _let_418_[1] if (len == 2) then return tostring(lhs) else local indices = {} for i = 3, len do local index = ast[i] - if ((type(index) == "string") and utils["valid-lua-identifier?"](index)) then + if (utils["string?"](index) and utils["valid-lua-identifier?"](index)) then table.insert(indices, ("." .. index)) else - local _1_ = compiler.compile1(index, scope, parent, {nval = 1}) - local index0 = _1_[1] + local _let_419_ = compiler.compile1(index, scope, parent, {nval = 1}) + local index0 = _let_419_[1] table.insert(indices, ("[" .. tostring(index0) .. "]")) end end @@ -1045,10 +1089,32 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload return nil end doc_special("var", {"name", "val"}, "Introduce new mutable local.") + local function kv_3f(t) + local _423_ + do + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto + for k in pairs(t) do + local val_16_auto + if not ("number" == type(k)) then + val_16_auto = k + else + val_16_auto = nil + end + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end + end + _423_ = tbl_14_auto + end + return (_423_)[1] + end SPECIALS.let = function(ast, scope, parent, opts) local bindings = ast[2] local pre_syms = {} - compiler.assert((utils["list?"](bindings) or utils["table?"](bindings)), "expected binding table", ast) + compiler.assert((utils["table?"](bindings) and not kv_3f(bindings)), "expected binding sequence", bindings) compiler.assert(((#bindings % 2) == 0), "expected even number of name/value bindings", ast[2]) compiler.assert((#ast >= 3), "expected body expression", ast[1]) for _ = 1, (opts.nval or 0) do @@ -1070,27 +1136,29 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload end end local function disambiguate_3f(rootstr, parent) - local function _1_() - local _0_0 = get_prev_line(parent) - if (nil ~= _0_0) then - local prev_line = _0_0 + local function _428_() + local _427_ = get_prev_line(parent) + if (nil ~= _427_) then + local prev_line = _427_ return prev_line:match("%)$") + else + return nil end end - return (rootstr:match("^{") or _1_()) + return (rootstr:match("^{") or _428_()) end SPECIALS.tset = function(ast, scope, parent) compiler.assert((#ast > 3), "expected table, key, and value arguments", ast) - local root = compiler.compile1(ast[2], scope, parent, {nval = 1})[1] + local root = (compiler.compile1(ast[2], scope, parent, {nval = 1}))[1] local keys = {} for i = 3, (#ast - 1) do - local _0_ = compiler.compile1(ast[i], scope, parent, {nval = 1}) - local key = _0_[1] + local _let_430_ = compiler.compile1(ast[i], scope, parent, {nval = 1}) + local key = _let_430_[1] table.insert(keys, tostring(key)) end - local value = compiler.compile1(ast[#ast], scope, parent, {nval = 1})[1] + local value = (compiler.compile1(ast[#ast], scope, parent, {nval = 1}))[1] local rootstr = tostring(root) - local fmtstr = nil + local fmtstr if disambiguate_3f(rootstr, parent) then fmtstr = "do end (%s)[%s] = %s" else @@ -1107,7 +1175,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local target_exprs = {} for i = 1, opts.nval do local s = compiler.gensym(scope) - accum[i] = s + do end (accum)[i] = s target_exprs[i] = utils.expr(s, "sym") end return "target", opts.tail, table.concat(accum, ", "), target_exprs @@ -1116,6 +1184,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload end end local function if_2a(ast, scope, parent, opts) + compiler.assert((2 < #ast), "expected condition and body", ast) local do_scope = compiler["make-scope"](scope) local branches = {} local wrapper, inner_tail, inner_target, target_exprs = calculate_target(scope, opts) @@ -1126,6 +1195,10 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload compiler["keep-side-effects"](compiler.compile1(ast[i], cscope, chunk, body_opts), chunk, nil, ast[i]) return {chunk = chunk, scope = cscope} end + if (1 == (#ast % 2)) then + table.insert(ast, utils.sym("nil")) + else + end for i = 2, (#ast - 1), 2 do local condchunk = {} local res = compiler.compile1(ast[i], do_scope, condchunk, {nval = 1}) @@ -1136,26 +1209,20 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload branch.nested = ((i ~= 2) and (next(condchunk, nil) == nil)) table.insert(branches, branch) end - local has_else_3f = ((#ast > 3) and ((#ast % 2) == 0)) - local else_branch = (has_else_3f and compile_body(#ast)) + local else_branch = compile_body(#ast) local s = compiler.gensym(scope) local buffer = {} local last_buffer = buffer for i = 1, #branches do local branch = branches[i] - local fstr = nil + local fstr if not branch.nested then fstr = "if %s then" else fstr = "elseif %s then" end local cond = tostring(branch.cond) - local cond_line = nil - if ((cond == "true") and branch.nested and (i == #branches) and not has_else_3f) then - cond_line = "else" - else - cond_line = fstr:format(cond) - end + local cond_line = fstr:format(cond) if branch.nested then compiler.emit(last_buffer, branch.condchunk, ast) else @@ -1166,20 +1233,16 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload compiler.emit(last_buffer, cond_line, ast) compiler.emit(last_buffer, branch.chunk, ast) if (i == #branches) then - if has_else_3f then - compiler.emit(last_buffer, "else", ast) - compiler.emit(last_buffer, else_branch.chunk, ast) - elseif (inner_target and (cond_line ~= "else")) then - compiler.emit(last_buffer, "else", ast) - compiler.emit(last_buffer, ("%s = nil"):format(inner_target), ast) - end + compiler.emit(last_buffer, "else", ast) + compiler.emit(last_buffer, else_branch.chunk, ast) compiler.emit(last_buffer, "end", ast) - elseif not branches[(i + 1)].nested then + elseif not (branches[(i + 1)]).nested then local next_buffer = {} compiler.emit(last_buffer, "else", ast) compiler.emit(last_buffer, next_buffer, ast) compiler.emit(last_buffer, "end", ast) last_buffer = next_buffer + else end end if (wrapper == "iife") then @@ -1207,13 +1270,17 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload if ("until" == bindings[(#bindings - 1)]) then table.remove(bindings, (#bindings - 1)) return table.remove(bindings) + else + return nil end end local function compile_until(condition, scope, chunk) if condition then - local _0_ = compiler.compile1(condition, scope, chunk, {nval = 1}) - local condition_lua = _0_[1] - return compiler.emit(chunk, ("if %s then break end"):format(tostring(condition_lua)), condition) + local _let_439_ = compiler.compile1(condition, scope, chunk, {nval = 1}) + local condition_lua = _let_439_[1] + return compiler.emit(chunk, ("if %s then break end"):format(tostring(condition_lua)), utils.expr(condition, "expression")) + else + return nil end end SPECIALS.each = function(ast, scope, parent) @@ -1226,16 +1293,17 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local new_manglings = {} local sub_scope = compiler["make-scope"](scope) local function destructure_binding(v) + compiler.assert(not utils["string?"](v), ("unexpected iterator clause " .. tostring(v)), binding) if utils["sym?"](v) then return compiler["declare-local"](v, {}, sub_scope, ast, new_manglings) else local raw = utils.sym(compiler.gensym(sub_scope)) - destructures[raw] = v + do end (destructures)[raw] = v return compiler["declare-local"](raw, {}, sub_scope, ast) end end local bind_vars = utils.map(binding, destructure_binding) - local vals = compiler.compile1(iter, sub_scope, parent) + local vals = compiler.compile1(iter, scope, parent) local val_names = utils.map(vals, tostring) local chunk = {} compiler.emit(parent, ("for %s in %s do"):format(table.concat(bind_vars, ", "), table.concat(val_names, ", ")), ast) @@ -1251,13 +1319,13 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload doc_special("each", {"[key value (iterator)]", "..."}, "Runs the body once for each set of values provided by the given iterator.\nMost commonly used with ipairs for sequential tables or pairs for undefined\norder, but can be used with any iterator.", true) local function while_2a(ast, scope, parent) local len1 = #parent - local condition = compiler.compile1(ast[2], scope, parent, {nval = 1})[1] + local condition = (compiler.compile1(ast[2], scope, parent, {nval = 1}))[1] local len2 = #parent local sub_chunk = {} if (len1 ~= len2) then for i = (len1 + 1), len2 do table.insert(sub_chunk, parent[i]) - parent[i] = nil + do end (parent)[i] = nil end compiler.emit(parent, "while true do", ast) compiler.emit(sub_chunk, ("if not %s then break end"):format(condition[1]), ast) @@ -1279,8 +1347,9 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local chunk = {} compiler.assert(utils["sym?"](binding_sym), ("unable to bind %s %s"):format(type(binding_sym), tostring(binding_sym)), ast[2]) compiler.assert((#ast >= 3), "expected body expression", ast[1]) + compiler.assert((#ranges <= 3), "unexpected arguments", ranges[4]) for i = 1, math.min(#ranges, 3) do - range_args[i] = tostring(compiler.compile1(ranges[i], sub_scope, parent, {nval = 1})[1]) + range_args[i] = tostring((compiler.compile1(ranges[i], scope, parent, {nval = 1}))[1]) end compiler.emit(parent, ("for %s = %s do"):format(compiler["declare-local"](binding_sym, {}, sub_scope, ast), table.concat(range_args, ", ")), ast) compile_until(until_condition, sub_scope, chunk) @@ -1291,12 +1360,12 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload SPECIALS["for"] = for_2a doc_special("for", {"[index start stop step?]", "..."}, "Numeric loop construct.\nEvaluates body once for each value between start and stop (inclusive).", true) local function native_method_call(ast, _scope, _parent, target, args) - local _0_ = ast - local _ = _0_[1] - local _0 = _0_[2] - local method_string = _0_[3] - local call_string = nil - if ((target.type == "literal") or (target.type == "expression")) then + local _let_443_ = ast + local _ = _let_443_[1] + local _0 = _let_443_[2] + local method_string = _let_443_[3] + local call_string + if ((target.type == "literal") or (target.type == "varg") or (target.type == "expression")) then call_string = "(%s):%s(%s)" else call_string = "%s:%s(%s)" @@ -1304,33 +1373,33 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload return utils.expr(string.format(call_string, tostring(target), method_string, table.concat(args, ", ")), "statement") end local function nonnative_method_call(ast, scope, parent, target, args) - local method_string = tostring(compiler.compile1(ast[3], scope, parent, {nval = 1})[1]) + local method_string = tostring((compiler.compile1(ast[3], scope, parent, {nval = 1}))[1]) local args0 = {tostring(target), unpack(args)} return utils.expr(string.format("%s[%s](%s)", tostring(target), method_string, table.concat(args0, ", ")), "statement") end local function double_eval_protected_method_call(ast, scope, parent, target, args) - local method_string = tostring(compiler.compile1(ast[3], scope, parent, {nval = 1})[1]) + local method_string = tostring((compiler.compile1(ast[3], scope, parent, {nval = 1}))[1]) local call = "(function(tgt, m, ...) return tgt[m](tgt, ...) end)(%s, %s)" table.insert(args, 1, method_string) return utils.expr(string.format(call, tostring(target), table.concat(args, ", ")), "statement") end local function method_call(ast, scope, parent) compiler.assert((2 < #ast), "expected at least 2 arguments", ast) - local _0_ = compiler.compile1(ast[2], scope, parent, {nval = 1}) - local target = _0_[1] + local _let_445_ = compiler.compile1(ast[2], scope, parent, {nval = 1}) + local target = _let_445_[1] local args = {} for i = 4, #ast do - local subexprs = nil - local _1_ + local subexprs + local _446_ if (i ~= #ast) then - _1_ = 1 + _446_ = 1 else - _1_ = nil + _446_ = nil end - subexprs = compiler.compile1(ast[i], scope, parent, {nval = _1_}) + subexprs = compiler.compile1(ast[i], scope, parent, {nval = _446_}) utils.map(subexprs, tostring, args) end - if ((type(ast[3]) == "string") and utils["valid-lua-identifier?"](ast[3])) then + if (utils["string?"](ast[3]) and utils["valid-lua-identifier?"](ast[3])) then return native_method_call(ast, scope, parent, target, args) elseif (target.type == "sym") then return nonnative_method_call(ast, scope, parent, target, args) @@ -1343,17 +1412,13 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload SPECIALS.comment = function(ast, _, parent) local els = {} for i = 2, #ast do - local function _1_() - local _0_0 = tostring(ast[i]):gsub("\n", " ") - return _0_0 - end - table.insert(els, _1_()) + table.insert(els, view(ast[i], {["one-line?"] = true})) end - return compiler.emit(parent, ("-- " .. table.concat(els, " ")), ast) + return compiler.emit(parent, ("--[[ " .. table.concat(els, " ") .. " ]]--"), ast) end doc_special("comment", {"..."}, "Comment which will be emitted in Lua output.", true) local function hashfn_max_used(f_scope, i, max) - local max0 = nil + local max0 if f_scope.symmeta[("$" .. i)].used then max0 = i else @@ -1367,12 +1432,12 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload end SPECIALS.hashfn = function(ast, scope, parent) compiler.assert((#ast == 2), "expected one argument", ast) - local f_scope = nil + local f_scope do - local _0_0 = compiler["make-scope"](scope) - _0_0["vararg"] = false - _0_0["hashfn"] = true - f_scope = _0_0 + local _451_ = compiler["make-scope"](scope) + do end (_451_)["vararg"] = false + _451_["hashfn"] = true + f_scope = _451_ end local f_chunk = {} local name = compiler.gensym(scope) @@ -1383,7 +1448,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload args[i] = compiler["declare-local"](utils.sym(("$" .. i)), {}, f_scope, ast) end local function walker(idx, node, parent_node) - if (utils["sym?"](node) and (utils.deref(node) == "$...")) then + if (utils["sym?"](node) and (tostring(node) == "$...")) then parent_node[idx] = utils.varg() f_scope.vararg = true return nil @@ -1396,10 +1461,11 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local max_used = hashfn_max_used(f_scope, 1, 0) if f_scope.vararg then compiler.assert((max_used == 0), "$ and $... in hashfn are mutually exclusive", ast) + else end - local arg_str = nil + local arg_str if f_scope.vararg then - arg_str = utils.deref(utils.varg()) + arg_str = tostring(utils.varg()) else arg_str = table.concat(args, ", ", 1, max_used) end @@ -1409,41 +1475,63 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload return utils.expr(name, "sym") end doc_special("hashfn", {"..."}, "Function literal shorthand; args are either $... OR $1, $2, etc.") - local function arithmetic_special(name, zero_arity, unary_prefix, ast, scope, parent) - local len = #ast - if (len == 1) then - compiler.assert(zero_arity, "Expected more than 0 arguments", ast) - return utils.expr(zero_arity, "literal") + local function maybe_short_circuit_protect(ast, i, name, _455_) + local _arg_456_ = _455_ + local mac = _arg_456_["macros"] + local call = (utils["list?"](ast) and tostring(ast[1])) + if ((("or" == name) or ("and" == name)) and (1 < i) and (mac[call] or ("set" == call) or ("tset" == call) or ("global" == call))) then + return utils.list(utils.sym("do"), ast) else - local operands = {} - local padded_op = (" " .. name .. " ") - for i = 2, len do - local subexprs = nil - local _0_ - if (i ~= len) then - _0_ = 1 - else - _0_ = nil - end - subexprs = compiler.compile1(ast[i], scope, parent, {nval = _0_}) - utils.map(subexprs, tostring, operands) - end - if (#operands == 1) then - if unary_prefix then - return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")") - else - return operands[1] - end - else - return ("(" .. table.concat(operands, padded_op) .. ")") - end + return ast end end - local function define_arithmetic_special(name, zero_arity, unary_prefix, lua_name) - local function _0_(...) - return arithmetic_special((lua_name or name), zero_arity, unary_prefix, ...) + local function arithmetic_special(name, zero_arity, unary_prefix, ast, scope, parent) + local len = #ast + local operands = {} + local padded_op = (" " .. name .. " ") + for i = 2, len do + local subast = maybe_short_circuit_protect(ast[i], i, name, scope) + local subexprs = compiler.compile1(subast, scope, parent) + if (i == len) then + utils.map(subexprs, tostring, operands) + else + table.insert(operands, tostring(subexprs[1])) + end end - SPECIALS[name] = _0_ + local _459_ = #operands + if (_459_ == 0) then + local _461_ + do + local _460_ = zero_arity + compiler.assert(_460_, "Expected more than 0 arguments", ast) + _461_ = _460_ + end + return utils.expr(_461_, "literal") + elseif (_459_ == 1) then + if unary_prefix then + return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")") + else + return operands[1] + end + elseif true then + local _ = _459_ + return ("(" .. table.concat(operands, padded_op) .. ")") + else + return nil + end + end + local function define_arithmetic_special(name, zero_arity, unary_prefix, _3flua_name) + local _467_ + do + local _464_ = (_3flua_name or name) + local _465_ = zero_arity + local _466_ = unary_prefix + local function _468_(...) + return arithmetic_special(_464_, _465_, _466_, ...) + end + _467_ = _468_ + end + SPECIALS[name] = _467_ return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.") end define_arithmetic_special("+", "0") @@ -1454,6 +1542,14 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload define_arithmetic_special("%") define_arithmetic_special("/", nil, "1") define_arithmetic_special("//", nil, "1") + SPECIALS["or"] = function(ast, scope, parent) + return arithmetic_special("or", "false", nil, ast, scope, parent) + end + SPECIALS["and"] = function(ast, scope, parent) + return arithmetic_special("and", "true", nil, ast, scope, parent) + end + doc_special("and", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.") + doc_special("or", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.") local function bitop_special(native_name, lib_name, zero_arity, unary_prefix, ast, scope, parent) if (#ast == 1) then return compiler.assert(zero_arity, "Expected more than 0 arguments.", ast) @@ -1463,14 +1559,14 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local padded_native_name = (" " .. native_name .. " ") local prefixed_lib_name = ("bit." .. lib_name) for i = 2, len do - local subexprs = nil - local _0_ + local subexprs + local _469_ if (i ~= len) then - _0_ = 1 + _469_ = 1 else - _0_ = nil + _469_ = nil end - subexprs = compiler.compile1(ast[i], scope, parent, {nval = _0_}) + subexprs = compiler.compile1(ast[i], scope, parent, {nval = _469_}) utils.map(subexprs, tostring, operands) end if (#operands == 1) then @@ -1489,10 +1585,18 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload end end local function define_bitop_special(name, zero_arity, unary_prefix, native) - local function _0_(...) - return bitop_special(native, name, zero_arity, unary_prefix, ...) + local _479_ + do + local _475_ = native + local _476_ = name + local _477_ = zero_arity + local _478_ = unary_prefix + local function _480_(...) + return bitop_special(_475_, _476_, _477_, _478_, ...) + end + _479_ = _480_ end - SPECIALS[name] = _0_ + SPECIALS[name] = _479_ return nil end define_bitop_special("lshift", nil, "1", "<<") @@ -1505,20 +1609,16 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload doc_special("band", {"x1", "x2", "..."}, "Bitwise AND of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.") doc_special("bor", {"x1", "x2", "..."}, "Bitwise OR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.") doc_special("bxor", {"x1", "x2", "..."}, "Bitwise XOR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.") - define_arithmetic_special("or", "false") - define_arithmetic_special("and", "true") - doc_special("and", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.") - doc_special("or", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.") doc_special("..", {"a", "b", "..."}, "String concatenation operator; works the same as Lua but accepts more arguments.") - local function native_comparator(op, _0_0, scope, parent) - local _1_ = _0_0 - local _ = _1_[1] - local lhs_ast = _1_[2] - local rhs_ast = _1_[3] - local _2_ = compiler.compile1(lhs_ast, scope, parent, {nval = 1}) - local lhs = _2_[1] - local _3_ = compiler.compile1(rhs_ast, scope, parent, {nval = 1}) - local rhs = _3_[1] + local function native_comparator(op, _481_, scope, parent) + local _arg_482_ = _481_ + local _ = _arg_482_[1] + local lhs_ast = _arg_482_[2] + local rhs_ast = _arg_482_[3] + local _let_483_ = compiler.compile1(lhs_ast, scope, parent, {nval = 1}) + local lhs = _let_483_[1] + local _let_484_ = compiler.compile1(rhs_ast, scope, parent, {nval = 1}) + local rhs = _let_484_[1] return string.format("(%s %s %s)", tostring(lhs), op, tostring(rhs)) end local function double_eval_protected_comparator(op, chain_op, ast, scope, parent) @@ -1528,22 +1628,22 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local chain = string.format(" %s ", (chain_op or "and")) for i = 2, #ast do table.insert(arglist, tostring(compiler.gensym(scope))) - table.insert(vals, tostring(compiler.compile1(ast[i], scope, parent, {nval = 1})[1])) + table.insert(vals, tostring((compiler.compile1(ast[i], scope, parent, {nval = 1}))[1])) end for i = 1, (#arglist - 1) do table.insert(comparisons, string.format("(%s %s %s)", arglist[i], op, arglist[(i + 1)])) end return string.format("(function(%s) return %s end)(%s)", table.concat(arglist, ","), table.concat(comparisons, chain), table.concat(vals, ",")) end - local function define_comparator_special(name, lua_op, chain_op) + local function define_comparator_special(name, _3flua_op, _3fchain_op) do - local op = (lua_op or name) + local op = (_3flua_op or name) local function opfn(ast, scope, parent) compiler.assert((2 < #ast), "expected at least two arguments", ast) if (3 == #ast) then return native_comparator(op, ast, scope, parent) else - return double_eval_protected_comparator(op, chain_op, ast, scope, parent) + return double_eval_protected_comparator(op, _3fchain_op, ast, scope, parent) end end SPECIALS[name] = opfn @@ -1556,11 +1656,11 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload define_comparator_special("<=") define_comparator_special("=", "==") define_comparator_special("not=", "~=", "or") - local function define_unary_special(op, realop) + local function define_unary_special(op, _3frealop) local function opfn(ast, scope, parent) compiler.assert((#ast == 2), "expected one argument", ast) local tail = compiler.compile1(ast[2], scope, parent, {nval = 1}) - return ((realop or op) .. tostring(tail[1])) + return ((_3frealop or op) .. tostring(tail[1])) end SPECIALS[op] = opfn return nil @@ -1571,196 +1671,336 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.") define_unary_special("length", "#") doc_special("length", {"x"}, "Returns the length of a table or string.") - SPECIALS["~="] = SPECIALS["not="] + do end (SPECIALS)["~="] = SPECIALS["not="] SPECIALS["#"] = SPECIALS.length SPECIALS.quote = function(ast, scope, parent) - compiler.assert((#ast == 2), "expected one argument") + compiler.assert((#ast == 2), "expected one argument", ast) local runtime, this_scope = true, scope while this_scope do this_scope = this_scope.parent if (this_scope == compiler.scopes.compiler) then runtime = false + else end end return compiler["do-quote"](ast[2], scope, parent, runtime) end doc_special("quote", {"x"}, "Quasiquote the following form. Only works in macro/compiler scope.") - local already_warned_3f = {} - local compile_env_warning = table.concat({"WARNING: Attempting to %s %s in compile scope.", "In future versions of Fennel this will not be allowed without the", "--no-compiler-sandbox flag or passing a :compilerEnv globals table", "in the options.\n"}, "\n") - local function compiler_env_warn(_, key) - local v = _G[key] - if (v and io and io.stderr and not already_warned_3f[key]) then - already_warned_3f[key] = true - do end (io.stderr):write(compile_env_warning:format("use global", key)) - end - return v - end + local macro_loaded = {} local function safe_getmetatable(tbl) local mt = getmetatable(tbl) assert((mt ~= getmetatable("")), "Illegal metatable access!") return mt end local safe_require = nil - local function safe_compiler_env(strict_3f) - local _1_ - if strict_3f then - _1_ = nil - else - _1_ = compiler_env_warn + local function safe_compiler_env() + local _488_ + do + local _487_ = rawget(_G, "utf8") + if (nil ~= _487_) then + _488_ = utils.copy(_487_) + else + _488_ = _487_ + end end - return setmetatable({assert = assert, bit = rawget(_G, "bit"), error = error, getmetatable = safe_getmetatable, ipairs = ipairs, math = utils.copy(math), next = next, pairs = pairs, pcall = pcall, print = print, rawequal = rawequal, rawget = rawget, rawlen = rawget(_G, "rawlen"), rawset = rawset, require = safe_require, select = select, setmetatable = setmetatable, string = utils.copy(string), table = utils.copy(table), tonumber = tonumber, tostring = tostring, type = type, xpcall = xpcall}, {__index = _1_}) + return {table = utils.copy(table), math = utils.copy(math), string = utils.copy(string), pairs = pairs, ipairs = ipairs, select = select, tostring = tostring, tonumber = tonumber, bit = rawget(_G, "bit"), pcall = pcall, xpcall = xpcall, next = next, print = print, type = type, assert = assert, error = error, setmetatable = setmetatable, getmetatable = safe_getmetatable, require = safe_require, rawlen = rawget(_G, "rawlen"), rawget = rawget, rawset = rawset, rawequal = rawequal, _VERSION = _VERSION, utf8 = _488_} end - local function make_compiler_env(ast, scope, parent, strict_3f) - local function _1_() + local function combined_mt_pairs(env) + local combined = {} + local _let_490_ = getmetatable(env) + local __index = _let_490_["__index"] + if ("table" == type(__index)) then + for k, v in pairs(__index) do + combined[k] = v + end + else + end + for k, v in next, env, nil do + combined[k] = v + end + return next, combined, nil + end + local function make_compiler_env(ast, scope, parent, _3fopts) + local provided + do + local _492_ = (_3fopts or utils.root.options) + if ((_G.type(_492_) == "table") and ((_492_)["compiler-env"] == "strict")) then + provided = safe_compiler_env() + elseif ((_G.type(_492_) == "table") and (nil ~= (_492_).compilerEnv)) then + local compilerEnv = (_492_).compilerEnv + provided = compilerEnv + elseif ((_G.type(_492_) == "table") and (nil ~= (_492_)["compiler-env"])) then + local compiler_env = (_492_)["compiler-env"] + provided = compiler_env + elseif true then + local _ = _492_ + provided = safe_compiler_env(false) + else + provided = nil + end + end + local env + local function _494_(base) + return utils.sym(compiler.gensym((compiler.scopes.macro or scope), base)) + end + local function _495_() return compiler.scopes.macro end - local function _2_(symbol) + local function _496_(symbol) compiler.assert(compiler.scopes.macro, "must call from macro", ast) return compiler.scopes.macro.manglings[tostring(symbol)] end - local function _3_(base) - return utils.sym(compiler.gensym((compiler.scopes.macro or scope), base)) - end - local function _4_(form) + local function _497_(form) compiler.assert(compiler.scopes.macro, "must call from macro", ast) return compiler.macroexpand(form, compiler.scopes.macro) end - local _6_ - do - local _5_0 = utils.root.options - if ((type(_5_0) == "table") and (_5_0["compiler-env"] == "strict")) then - _6_ = safe_compiler_env(true) - elseif ((type(_5_0) == "table") and (nil ~= _5_0.compilerEnv)) then - local compilerEnv = _5_0.compilerEnv - _6_ = compilerEnv - elseif ((type(_5_0) == "table") and (nil ~= _5_0["compiler-env"])) then - local compiler_env = _5_0["compiler-env"] - _6_ = compiler_env + env = {_AST = ast, _CHUNK = parent, _IS_COMPILER = true, _SCOPE = scope, _SPECIALS = compiler.scopes.global.specials, _VARARG = utils.varg(), ["macro-loaded"] = macro_loaded, unpack = unpack, ["assert-compile"] = compiler.assert, view = view, version = utils.version, metadata = compiler.metadata, list = utils.list, ["list?"] = utils["list?"], ["table?"] = utils["table?"], sequence = utils.sequence, ["sequence?"] = utils["sequence?"], sym = utils.sym, ["sym?"] = utils["sym?"], ["multi-sym?"] = utils["multi-sym?"], comment = utils.comment, ["comment?"] = utils["comment?"], ["varg?"] = utils["varg?"], gensym = _494_, ["get-scope"] = _495_, ["in-scope?"] = _496_, macroexpand = _497_} + env._G = env + return setmetatable(env, {__index = provided, __newindex = provided, __pairs = combined_mt_pairs}) + end + local function _499_(...) + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto + for c in string.gmatch((package.config or ""), "([^\n]+)") do + local val_16_auto = c + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto else - local _ = _5_0 - _6_ = safe_compiler_env(false) end end - return setmetatable({["assert-compile"] = compiler.assert, ["get-scope"] = _1_, ["in-scope?"] = _2_, ["list?"] = utils["list?"], ["multi-sym?"] = utils["multi-sym?"], ["sequence?"] = utils["sequence?"], ["sym?"] = utils["sym?"], ["table?"] = utils["table?"], ["varg?"] = utils["varg?"], _AST = ast, _CHUNK = parent, _IS_COMPILER = true, _SCOPE = scope, _SPECIALS = compiler.scopes.global.specials, _VARARG = utils.varg(), gensym = _3_, list = utils.list, macroexpand = _4_, sequence = utils.sequence, sym = utils.sym, unpack = unpack, view = view}, {__index = _6_}) + return tbl_14_auto end - local cfg = string.gmatch(package.config, "([^\n]+)") - local dirsep, pathsep, pathmark = (cfg() or "/"), (cfg() or ";"), (cfg() or "?") - local pkg_config = {dirsep = dirsep, pathmark = pathmark, pathsep = pathsep} + local _local_498_ = _499_(...) + local dirsep = _local_498_[1] + local pathsep = _local_498_[2] + local pathmark = _local_498_[3] + local pkg_config = {dirsep = (dirsep or "/"), pathmark = (pathmark or ";"), pathsep = (pathsep or "?")} local function escapepat(str) return string.gsub(str, "[^%w]", "%%%1") end - local function search_module(modulename, pathstring) + local function search_module(modulename, _3fpathstring) local pathsepesc = escapepat(pkg_config.pathsep) local pattern = ("([^%s]*)%s"):format(pathsepesc, pathsepesc) local no_dot_module = modulename:gsub("%.", pkg_config.dirsep) - local fullpath = ((pathstring or utils["fennel-module"].path) .. pkg_config.pathsep) + local fullpath = ((_3fpathstring or utils["fennel-module"].path) .. pkg_config.pathsep) local function try_path(path) local filename = path:gsub(escapepat(pkg_config.pathmark), no_dot_module) local filename2 = path:gsub(escapepat(pkg_config.pathmark), modulename) - local _1_0 = (io.open(filename) or io.open(filename2)) - if (nil ~= _1_0) then - local file = _1_0 + local _501_ = (io.open(filename) or io.open(filename2)) + if (nil ~= _501_) then + local file = _501_ file:close() return filename + elseif true then + local _ = _501_ + return nil, ("no file '" .. filename .. "'") + else + return nil end end - local function find_in_path(start) - local _1_0 = fullpath:match(pattern, start) - if (nil ~= _1_0) then - local path = _1_0 - return (try_path(path) or find_in_path((start + #path + 1))) + local function find_in_path(start, _3ftried_paths) + local _503_ = fullpath:match(pattern, start) + if (nil ~= _503_) then + local path = _503_ + local _504_, _505_ = try_path(path) + if (nil ~= _504_) then + local filename = _504_ + return filename + elseif ((_504_ == nil) and (nil ~= _505_)) then + local error = _505_ + local function _507_() + local _506_ = (_3ftried_paths or {}) + table.insert(_506_, error) + return _506_ + end + return find_in_path((start + #path + 1), _507_()) + else + return nil + end + elseif true then + local _ = _503_ + local function _509_() + local tried_paths = table.concat((_3ftried_paths or {}), "\n\9") + if (_VERSION < "Lua 5.4") then + return ("\n\9" .. tried_paths) + else + return tried_paths + end + end + return nil, _509_() + else + return nil end end return find_in_path(1) end - local function make_searcher(options) - local function _1_(module_name) + local function make_searcher(_3foptions) + local function _512_(module_name) local opts = utils.copy(utils.root.options) - for k, v in pairs((options or {})) do + for k, v in pairs((_3foptions or {})) do opts[k] = v end opts["module-name"] = module_name - local _2_0 = search_module(module_name) - if (nil ~= _2_0) then - local filename = _2_0 - local function _3_(...) - return utils["fennel-module"].dofile(filename, opts, ...) + local _513_, _514_ = search_module(module_name) + if (nil ~= _513_) then + local filename = _513_ + local _517_ + do + local _515_ = filename + local _516_ = opts + local function _518_(...) + return utils["fennel-module"].dofile(_515_, _516_, ...) + end + _517_ = _518_ end - return _3_, filename - end - end - return _1_ - end - local function macro_globals(env, globals) - local allowed = current_global_names(env) - for _, k in pairs((globals or {})) do - table.insert(allowed, k) - end - return allowed - end - local function default_macro_searcher(module_name) - local _1_0 = search_module(module_name) - if (nil ~= _1_0) then - local filename = _1_0 - local function _2_(...) - return utils["fennel-module"].dofile(filename, {env = "_COMPILER"}, ...) - end - return _2_, filename - end - end - local macro_searchers = {default_macro_searcher} - local function search_macro_module(modname, n) - local _1_0 = macro_searchers[n] - if (nil ~= _1_0) then - local f = _1_0 - local _2_0, _3_0 = f(modname) - if ((nil ~= _2_0) and true) then - local loader = _2_0 - local _3ffilename = _3_0 - return loader, _3ffilename + return _517_, filename + elseif ((_513_ == nil) and (nil ~= _514_)) then + local error = _514_ + return error else - local _ = _2_0 - return search_macro_module(modname, (n + 1)) + return nil end end + return _512_ + end + local function dofile_with_searcher(fennel_macro_searcher, filename, opts, ...) + local searchers = (package.loaders or package.searchers or {}) + local _ = table.insert(searchers, 1, fennel_macro_searcher) + local m = utils["fennel-module"].dofile(filename, opts, ...) + table.remove(searchers, 1) + return m + end + local function fennel_macro_searcher(module_name) + local opts + do + local _520_ = utils.copy(utils.root.options) + do end (_520_)["env"] = "_COMPILER" + _520_["requireAsInclude"] = false + _520_["allowedGlobals"] = nil + opts = _520_ + end + local _521_ = search_module(module_name, utils["fennel-module"]["macro-path"]) + if (nil ~= _521_) then + local filename = _521_ + local _522_ + if (opts["compiler-env"] == _G) then + local _523_ = fennel_macro_searcher + local _524_ = filename + local _525_ = opts + local function _527_(...) + return dofile_with_searcher(_523_, _524_, _525_, ...) + end + _522_ = _527_ + else + local _528_ = filename + local _529_ = opts + local function _531_(...) + return utils["fennel-module"].dofile(_528_, _529_, ...) + end + _522_ = _531_ + end + return _522_, filename + else + return nil + end + end + local function lua_macro_searcher(module_name) + local _534_ = search_module(module_name, package.path) + if (nil ~= _534_) then + local filename = _534_ + local code + do + local f = io.open(filename) + local function close_handlers_8_auto(ok_9_auto, ...) + f:close() + if ok_9_auto then + return ... + else + return error(..., 0) + end + end + local function _536_() + return assert(f:read("*a")) + end + code = close_handlers_8_auto(_G.xpcall(_536_, (package.loaded.fennel or debug).traceback)) + end + local chunk = load_code(code, make_compiler_env(), filename) + return chunk, filename + else + return nil + end + end + local macro_searchers = {fennel_macro_searcher, lua_macro_searcher} + local function search_macro_module(modname, n) + local _538_ = macro_searchers[n] + if (nil ~= _538_) then + local f = _538_ + local _539_, _540_ = f(modname) + if ((nil ~= _539_) and true) then + local loader = _539_ + local _3ffilename = _540_ + return loader, _3ffilename + elseif true then + local _ = _539_ + return search_macro_module(modname, (n + 1)) + else + return nil + end + else + return nil + end end - local macro_loaded = {} local function metadata_only_fennel(modname) if ((modname == "conjure-macroexpand.aniseed.fennel.macros") or (package and package.loaded and ("table" == type(package.loaded[modname])) and (package.loaded[modname].metadata == compiler.metadata))) then return {metadata = compiler.metadata} + else + return nil end end - local function _1_(modname) - local function _2_() + local function _544_(modname) + local function _545_() local loader, filename = search_macro_module(modname, 1) compiler.assert(loader, (modname .. " module not found.")) - macro_loaded[modname] = loader(modname, filename) + do end (macro_loaded)[modname] = loader(modname, filename) return macro_loaded[modname] end - return (macro_loaded[modname] or metadata_only_fennel(modname) or _2_()) + return (macro_loaded[modname] or metadata_only_fennel(modname) or _545_()) end - safe_require = _1_ + safe_require = _544_ local function add_macros(macros_2a, ast, scope) compiler.assert(utils["table?"](macros_2a), "expected macros to be table", ast) for k, v in pairs(macros_2a) do compiler.assert((type(v) == "function"), "expected each macro to be function", ast) - scope.macros[k] = v + do end (scope.macros)[k] = v end return nil end - SPECIALS["require-macros"] = function(ast, scope, parent, real_ast) - compiler.assert((#ast == 2), "Expected one module name argument", (real_ast or ast)) - local filename = (ast[2].filename or ast.filename) - local modname_chunk = load_code(compiler.compile(ast[2]), nil, filename) - local modname = modname_chunk(utils.root.options["module-name"], filename) - compiler.assert((type(modname) == "string"), "module name must compile to string", (real_ast or ast)) + local function resolve_module_name(_546_, _scope, _parent, opts) + local _arg_547_ = _546_ + local filename = _arg_547_["filename"] + local second = _arg_547_[2] + local filename0 = (filename or (utils["table?"](second) and second.filename)) + local module_name = utils.root.options["module-name"] + local modexpr = compiler.compile(second, opts) + local modname_chunk = load_code(modexpr) + return modname_chunk(module_name, filename0) + end + SPECIALS["require-macros"] = function(ast, scope, parent, _3freal_ast) + compiler.assert((#ast == 2), "Expected one module name argument", (_3freal_ast or ast)) + local modname = resolve_module_name(ast, scope, parent, {}) + compiler.assert(utils["string?"](modname), "module name must compile to string", (_3freal_ast or ast)) if not macro_loaded[modname] then - local env = make_compiler_env(ast, scope, parent) - local loader, filename0 = search_macro_module(modname, 1) + local loader, filename = search_macro_module(modname, 1) compiler.assert(loader, (modname .. " module not found."), ast) - macro_loaded[modname] = loader(modname, filename0) + do end (macro_loaded)[modname] = loader(modname, filename) + else + end + if ("import-macros" == tostring(ast[1])) then + return macro_loaded[modname] + else + return add_macros(macro_loaded[modname], ast, scope, parent) end - return add_macros(macro_loaded[modname], ast, scope, parent) end doc_special("require-macros", {"macro-module-name"}, "Load given module and use its contents as macro definitions in current scope.\nMacro module should return a table of macro functions with string keys.\nConsider using import-macros instead as it is more flexible.") local function emit_included_fennel(src, path, opts, sub_chunk) @@ -1768,12 +2008,13 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local forms = {} if utils.root.options.requireAsInclude then subscope.specials.require = compiler["require-include"] + else end for _, val in parser.parser(parser["string-stream"](src), path) do table.insert(forms, val) end for i = 1, #forms do - local subopts = nil + local subopts if (i == #forms) then subopts = {tail = true} else @@ -1786,21 +2027,21 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload end local function include_path(ast, opts, path, mod, fennel_3f) utils.root.scope.includes[mod] = "fnl/loading" - local src = nil + local src do local f = assert(io.open(path)) - local function close_handlers_0_(ok_0_, ...) + local function close_handlers_8_auto(ok_9_auto, ...) f:close() - if ok_0_ then + if ok_9_auto then return ... else return error(..., 0) end end - local function _2_() - return f:read("*all"):gsub("[\13\n]*$", "") + local function _553_() + return assert(f:read("*all")):gsub("[\13\n]*$", "") end - src = close_handlers_0_(xpcall(_2_, (package.loaded.fennel or debug).traceback)) + src = close_handlers_8_auto(_G.xpcall(_553_, (package.loaded.fennel or debug).traceback)) end local ret = utils.expr(("require(\"" .. mod .. "\")"), "statement") local target = ("package.preload[%q]"):format(mod) @@ -1824,11 +2065,25 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload if (utils.root.scope.includes[mod] == "fnl/loading") then compiler.assert(fallback, "circular include detected", ast) return fallback(modexpr) + else + return nil end end SPECIALS.include = function(ast, scope, parent, opts) compiler.assert((#ast == 2), "expected one argument", ast) - local modexpr = compiler.compile1(ast[2], scope, parent, {nval = 1})[1] + local modexpr + do + local _556_, _557_ = pcall(resolve_module_name, ast, scope, parent, opts) + if ((_556_ == true) and (nil ~= _557_)) then + local modname = _557_ + modexpr = utils.expr(string.format("%q", modname), "literal") + elseif true then + local _ = _556_ + modexpr = (compiler.compile1(ast[2], scope, parent, {nval = 1}))[1] + else + modexpr = nil + end + end if ((modexpr.type ~= "literal") or ((modexpr[1]):byte() ~= 34)) then if opts.fallback then return opts.fallback(modexpr) @@ -1837,13 +2092,18 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload end else local mod = load_code(("return " .. modexpr[1]))() - local function _3_() - local _2_0 = search_module(mod) - if (nil ~= _2_0) then - local fennel_path = _2_0 + local oldmod = utils.root.options["module-name"] + local _ + utils.root.options["module-name"] = mod + _ = nil + local res + local function _561_() + local _560_ = search_module(mod) + if (nil ~= _560_) then + local fennel_path = _560_ return include_path(ast, opts, fennel_path, mod, true) - else - local _ = _2_0 + elseif true then + local _0 = _560_ local lua_path = search_module(mod, package.path) if lua_path then return include_path(ast, opts, lua_path, mod, false) @@ -1852,9 +2112,13 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload else return compiler.assert(false, ("module not found " .. mod), ast) end + else + return nil end end - return (include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _3_()) + res = ((utils["member?"](mod, (utils.root.options.skipInclude or {})) and opts.fallback(modexpr, true)) or include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _561_()) + utils.root.options["module-name"] = oldmod + return res end end doc_special("include", {"module-name-literal"}, "Like require but load the target module during compilation and embed it in the\nLua output. The module must be a string literal and resolvable at compile time.") @@ -1862,7 +2126,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local env = make_compiler_env(ast, scope, parent) local opts = utils.copy(utils.root.options) opts.scope = compiler["make-scope"](compiler.scopes.compiler) - opts.allowedGlobals = macro_globals(env, current_global_names()) + opts.allowedGlobals = current_global_names(env) return load_code(compiler.compile(ast, opts), wrap_env(env))(opts["module-name"], ast.filename) end SPECIALS.macros = function(ast, scope, parent) @@ -1874,11 +2138,11 @@ package.preload["conjure-macroexpand.aniseed.fennel.specials"] = package.preload local old_first = ast[1] ast[1] = utils.sym("do") local val = eval_compiler_2a(ast, scope, parent) - ast[1] = old_first + do end (ast)[1] = old_first return val end doc_special("eval-compiler", {"..."}, "Evaluate the body at compile-time. Use the macro system instead if possible.", true) - return {["current-global-names"] = current_global_names, ["load-code"] = load_code, ["macro-loaded"] = macro_loaded, ["macro-searchers"] = macro_searchers, ["make-compiler-env"] = make_compiler_env, ["make-searcher"] = make_searcher, ["search-module"] = search_module, ["wrap-env"] = wrap_env, doc = doc_2a} + return {doc = doc_2a, ["current-global-names"] = current_global_names, ["load-code"] = load_code, ["macro-loaded"] = macro_loaded, ["macro-searchers"] = macro_searchers, ["make-compiler-env"] = make_compiler_env, ["search-module"] = search_module, ["make-searcher"] = make_searcher, ["wrap-env"] = wrap_env} end package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload["conjure-macroexpand.aniseed.fennel.compiler"] or function(...) local utils = require("conjure-macroexpand.aniseed.fennel.utils") @@ -1886,18 +2150,18 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload local friend = require("conjure-macroexpand.aniseed.fennel.friend") local unpack = (table.unpack or _G.unpack) local scopes = {} - local function make_scope(parent) - local parent0 = (parent or scopes.global) - local _0_ - if parent0 then - _0_ = ((parent0.depth or 0) + 1) + local function make_scope(_3fparent) + local parent = (_3fparent or scopes.global) + local _219_ + if parent then + _219_ = ((parent.depth or 0) + 1) else - _0_ = 0 + _219_ = 0 end - return {autogensyms = setmetatable({}, {__index = (parent0 and parent0.autogensyms)}), depth = _0_, gensyms = setmetatable({}, {__index = (parent0 and parent0.gensyms)}), hashfn = (parent0 and parent0.hashfn), includes = setmetatable({}, {__index = (parent0 and parent0.includes)}), macros = setmetatable({}, {__index = (parent0 and parent0.macros)}), manglings = setmetatable({}, {__index = (parent0 and parent0.manglings)}), parent = parent0, refedglobals = setmetatable({}, {__index = (parent0 and parent0.refedglobals)}), specials = setmetatable({}, {__index = (parent0 and parent0.specials)}), symmeta = setmetatable({}, {__index = (parent0 and parent0.symmeta)}), unmanglings = setmetatable({}, {__index = (parent0 and parent0.unmanglings)}), vararg = (parent0 and parent0.vararg)} + return {includes = setmetatable({}, {__index = (parent and parent.includes)}), macros = setmetatable({}, {__index = (parent and parent.macros)}), manglings = setmetatable({}, {__index = (parent and parent.manglings)}), specials = setmetatable({}, {__index = (parent and parent.specials)}), symmeta = setmetatable({}, {__index = (parent and parent.symmeta)}), unmanglings = setmetatable({}, {__index = (parent and parent.unmanglings)}), gensyms = setmetatable({}, {__index = (parent and parent.gensyms)}), autogensyms = setmetatable({}, {__index = (parent and parent.autogensyms)}), vararg = (parent and parent.vararg), depth = _219_, hashfn = (parent and parent.hashfn), refedglobals = {}, parent = parent} end local function assert_msg(ast, msg) - local ast_tbl = nil + local ast_tbl if ("table" == type(ast)) then ast_tbl = ast else @@ -1906,28 +2170,24 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload local m = getmetatable(ast) local filename = ((m and m.filename) or ast_tbl.filename or "unknown") local line = ((m and m.line) or ast_tbl.line or "?") - local target = nil - local function _1_() - if utils["sym?"](ast_tbl[1]) then - return utils.deref(ast_tbl[1]) - else - return (ast_tbl[1] or "()") - end - end - target = tostring(_1_()) - return string.format("Compile error in '%s' %s:%s: %s", target, filename, line, msg) + local target = tostring((utils["sym?"](ast_tbl[1]) or ast_tbl[1] or "()")) + return string.format("%s:%s: Compile error in '%s': %s", filename, line, target, msg) end local function assert_compile(condition, msg, ast) if not condition then - local _0_ = (utils.root.options or {}) - local source = _0_["source"] - local unfriendly = _0_["unfriendly"] - utils.root.reset() - if unfriendly then - error(assert_msg(ast, msg), 0) + local _let_222_ = (utils.root.options or {}) + local source = _let_222_["source"] + local unfriendly = _let_222_["unfriendly"] + if (nil == utils.hook("assert-compile", condition, msg, ast, utils.root.reset)) then + utils.root.reset() + if (unfriendly or not friend or not _G.io or not _G.io.read) then + error(assert_msg(ast, msg), 0) + else + friend["assert-compile"](condition, msg, ast, source) + end else - friend["assert-compile"](condition, msg, ast, source) end + else end return condition end @@ -1935,36 +2195,38 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload scopes.global.vararg = true scopes.compiler = make_scope(scopes.global) scopes.macro = scopes.global - local serialize_subst = {["\11"] = "\\v", ["\12"] = "\\f", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "n"} + local serialize_subst = {["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "n", ["\11"] = "\\v", ["\12"] = "\\f"} local function serialize_string(str) - local function _0_(_241) + local function _226_(_241) return ("\\" .. _241:byte()) end - return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _0_) + return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _226_) end local function global_mangling(str) if utils["valid-lua-identifier?"](str) then return str else - local function _0_(_241) + local function _227_(_241) return string.format("_%02x", _241:byte()) end - return ("__fnl_global__" .. str:gsub("[^%w]", _0_)) + return ("__fnl_global__" .. str:gsub("[^%w]", _227_)) end end local function global_unmangling(identifier) - local _0_0 = string.match(identifier, "^__fnl_global__(.*)$") - if (nil ~= _0_0) then - local rest = _0_0 - local _1_0 = nil - local function _2_(_241) + local _229_ = string.match(identifier, "^__fnl_global__(.*)$") + if (nil ~= _229_) then + local rest = _229_ + local _230_ + local function _231_(_241) return string.char(tonumber(_241:sub(2), 16)) end - _1_0 = string.gsub(rest, "_[%da-f][%da-f]", _2_) - return _1_0 - else - local _ = _0_0 + _230_ = string.gsub(rest, "_[%da-f][%da-f]", _231_) + return _230_ + elseif true then + local _ = _229_ return identifier + else + return nil end end local allowed_globals = nil @@ -1978,31 +2240,31 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload return mangling end end - local function local_mangling(str, scope, ast, temp_manglings) + local function local_mangling(str, scope, ast, _3ftemp_manglings) assert_compile(not utils["multi-sym?"](str), ("unexpected multi symbol " .. str), ast) - local raw = nil - if (utils["lua-keywords"][str] or str:match("^%d")) then + local raw + if ((utils["lua-keywords"])[str] or str:match("^%d")) then raw = ("_" .. str) else raw = str end - local mangling = nil - local function _1_(_241) + local mangling + local function _235_(_241) return string.format("_%02x", _241:byte()) end - mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _1_) + mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _235_) local unique = unique_mangling(mangling, mangling, scope, 0) - scope.unmanglings[unique] = str + do end (scope.unmanglings)[unique] = str do - local manglings = (temp_manglings or scope.manglings) - manglings[str] = unique + local manglings = (_3ftemp_manglings or scope.manglings) + do end (manglings)[str] = unique end return unique end local function apply_manglings(scope, new_manglings, ast) for raw, mangled in pairs(new_manglings) do assert_compile(not scope.refedglobals[mangled], ("use of global " .. raw .. " is aliased by a local"), ast) - scope.manglings[raw] = mangled + do end (scope.manglings)[raw] = mangled end return nil end @@ -2021,48 +2283,50 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload end return ret end - local function gensym(scope, base) - local append, mangling = 0, ((base or "") .. "_0_") + local function next_append() + utils.root.scope["gensym-append"] = ((utils.root.scope["gensym-append"] or 0) + 1) + return ("_" .. utils.root.scope["gensym-append"] .. "_") + end + local function gensym(scope, _3fbase, _3fsuffix) + local mangling = ((_3fbase or "") .. next_append() .. (_3fsuffix or "")) while scope.unmanglings[mangling] do - mangling = ((base or "") .. "_" .. append .. "_") - append = (append + 1) + mangling = ((_3fbase or "") .. next_append() .. (_3fsuffix or "")) end - scope.unmanglings[mangling] = (base or true) - scope.gensyms[mangling] = true + scope.unmanglings[mangling] = (_3fbase or true) + do end (scope.gensyms)[mangling] = true return mangling end local function autogensym(base, scope) - local _0_0 = utils["multi-sym?"](base) - if (nil ~= _0_0) then - local parts = _0_0 + local _238_ = utils["multi-sym?"](base) + if (nil ~= _238_) then + local parts = _238_ parts[1] = autogensym(parts[1], scope) return table.concat(parts, ((parts["multi-sym-method-call"] and ":") or ".")) - else - local _ = _0_0 - local function _1_() - local mangling = gensym(scope, base:sub(1, ( - 2))) - scope.autogensyms[base] = mangling + elseif true then + local _ = _238_ + local function _239_() + local mangling = gensym(scope, base:sub(1, ( - 2)), "auto") + do end (scope.autogensyms)[base] = mangling return mangling end - return (scope.autogensyms[base] or _1_()) + return (scope.autogensyms[base] or _239_()) + else + return nil end end - local already_warned = {} local function check_binding_valid(symbol, scope, ast) - local name = utils.deref(symbol) - if (io and io.stderr and name:find("&") and not already_warned[symbol]) then - already_warned[symbol] = true - do end (io.stderr):write(("-- Warning: & will not be allowed in identifier names in " .. "future versions: " .. (symbol.filename or "unknown") .. ":" .. (symbol.line or "?") .. "\n")) - end + local name = tostring(symbol) + assert_compile(not name:find("&"), "invalid character: &") + assert_compile(not name:find("^%."), "invalid character: .") assert_compile(not (scope.specials[name] or scope.macros[name]), ("local %s was overshadowed by a special form or macro"):format(name), ast) return assert_compile(not utils["quoted?"](symbol), string.format("macro tried to bind %s without gensym", name), symbol) end - local function declare_local(symbol, meta, scope, ast, temp_manglings) + local function declare_local(symbol, meta, scope, ast, _3ftemp_manglings) check_binding_valid(symbol, scope, ast) - local name = utils.deref(symbol) + local name = tostring(symbol) assert_compile(not utils["multi-sym?"](name), ("unexpected multi symbol " .. name), ast) - scope.symmeta[name] = meta - return local_mangling(name, scope, ast, temp_manglings) + do end (scope.symmeta)[name] = meta + return local_mangling(name, scope, ast, _3ftemp_manglings) end local function hashfn_arg_name(name, multi_sym_parts, scope) if not scope.hashfn then @@ -2072,12 +2336,15 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload elseif multi_sym_parts then if (multi_sym_parts and (multi_sym_parts[1] == "$")) then multi_sym_parts[1] = "$1" + else end return table.concat(multi_sym_parts, ".") + else + return nil end end - local function symbol_to_expression(symbol, scope, reference_3f) - utils.hook("symbol-to-expression", symbol, scope, reference_3f) + local function symbol_to_expression(symbol, scope, _3freference_3f) + utils.hook("symbol-to-expression", symbol, scope, _3freference_3f) local name = symbol[1] local multi_sym_parts = utils["multi-sym?"](name) local name0 = (hashfn_arg_name(name, multi_sym_parts, scope) or name) @@ -2086,24 +2353,28 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload local local_3f = scope.manglings[parts[1]] if (local_3f and scope.symmeta[parts[1]]) then scope.symmeta[parts[1]]["used"] = true + else end - assert_compile((not reference_3f or local_3f or ("_ENV" == parts[1]) or global_allowed_3f(parts[1])), ("unknown global in strict mode: " .. tostring(parts[1])), symbol) - if (allowed_globals and not local_3f) then - utils.root.scope.refedglobals[parts[1]] = true + assert_compile(not scope.macros[parts[1]], "tried to reference a macro at runtime", symbol) + assert_compile((not scope.specials[parts[1]] or ("require" == parts[1])), "tried to reference a special form at runtime", symbol) + assert_compile((not _3freference_3f or local_3f or ("_ENV" == parts[1]) or global_allowed_3f(parts[1])), ("unknown identifier in strict mode: " .. tostring(parts[1])), symbol) + if (allowed_globals and not local_3f and scope.parent) then + scope.parent.refedglobals[parts[1]] = true + else end return utils.expr(combine_parts(parts, scope), etype) end - local function emit(chunk, out, ast) + local function emit(chunk, out, _3fast) if (type(out) == "table") then return table.insert(chunk, out) else - return table.insert(chunk, {ast = ast, leaf = out}) + return table.insert(chunk, {ast = _3fast, leaf = out}) end end local function peephole(chunk) if chunk.leaf then return chunk - elseif ((#chunk >= 3) and (chunk[(#chunk - 2)].leaf == "do") and not chunk[(#chunk - 1)].leaf and (chunk[#chunk].leaf == "end")) then + elseif ((#chunk >= 3) and ((chunk[(#chunk - 2)]).leaf == "do") and not (chunk[(#chunk - 1)]).leaf and (chunk[#chunk].leaf == "end")) then local kid = peephole(chunk[(#chunk - 1)]) local new_chunk = {ast = chunk.ast} for i = 1, (#chunk - 3) do @@ -2117,10 +2388,6 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload return utils.map(chunk, peephole) end end - local function ast_source(ast) - local m = getmetatable(ast) - return ((m and m.line and m) or (("table" == type(ast)) and ast) or {}) - end local function flatten_chunk_correlated(main_chunk, options) local function flatten(chunk, out, last_line, file) local last_line0 = last_line @@ -2129,11 +2396,13 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload else for _, subchunk in ipairs(chunk) do if (subchunk.leaf or (#subchunk > 0)) then - local source = ast_source(subchunk.ast) + local source = utils["ast-source"](subchunk.ast) if (file == source.filename) then last_line0 = math.max(last_line0, (source.line or 0)) + else end last_line0 = flatten(subchunk, out, last_line0, file) + else end end end @@ -2144,6 +2413,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload for i = 1, last do if (out[i] == nil) then out[i] = "" + else end end return table.concat(out, "\n") @@ -2154,22 +2424,23 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload local info = chunk.ast if sm then table.insert(sm, {(info and info.filename), (info and info.line)}) + else end return code else - local tab0 = nil + local tab0 do - local _0_0 = tab - if (_0_0 == true) then + local _252_ = tab + if (_252_ == true) then tab0 = " " - elseif (_0_0 == false) then + elseif (_252_ == false) then tab0 = "" - elseif (_0_0 == tab) then + elseif (_252_ == tab) then tab0 = tab - elseif (_0_0 == nil) then + elseif (_252_ == nil) then tab0 = "" else - tab0 = nil + tab0 = nil end end local function parter(c) @@ -2180,12 +2451,14 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload else return sub end + else + return nil end end return table.concat(utils.map(chunk, parter), "\n") end end - local fennel_sourcemap = {} + local sourcemap = {} local function make_short_src(source) local source0 = source:gsub("\n", " ") if (#source0 <= 49) then @@ -2208,27 +2481,31 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload else sm.key = ret end - fennel_sourcemap[sm.key] = sm + sourcemap[sm.key] = sm + else end return ret, sm end end local function make_metadata() - local function _0_(self, tgt, key) + local function _261_(self, tgt, key) if self[tgt] then return self[tgt][key] + else + return nil end end - local function _1_(self, tgt, key, value) + local function _263_(self, tgt, key, value) self[tgt] = (self[tgt] or {}) - self[tgt][key] = value + do end (self[tgt])[key] = value return tgt end - local function _2_(self, tgt, ...) + local function _264_(self, tgt, ...) local kv_len = select("#", ...) local kvs = {...} if ((kv_len % 2) ~= 0) then error("metadata:setall() expected even number of k/v pairs") + else end self[tgt] = (self[tgt] or {}) for i = 1, kv_len, 2 do @@ -2236,10 +2513,10 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload end return tgt end - return setmetatable({}, {__index = {get = _0_, set = _1_, setall = _2_}, __mode = "k"}) + return setmetatable({}, {__index = {get = _261_, set = _263_, setall = _264_}, __mode = "k"}) end local function exprs1(exprs) - return table.concat(utils.map(exprs, 1), ", ") + return table.concat(utils.map(exprs, tostring), ", ") end local function keep_side_effects(exprs, chunk, start, ast) local start0 = (start or 1) @@ -2249,13 +2526,14 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload emit(chunk, string.format("do local _ = %s end", tostring(se)), ast) elseif (se.type == "statement") then local code = tostring(se) - local disambiguated = nil + local disambiguated if (code:byte() == 40) then disambiguated = ("do end " .. code) else disambiguated = code end emit(chunk, disambiguated, ast) + else end end return nil @@ -2275,28 +2553,32 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload exprs[i] = utils.expr("nil", "literal") end end + else end + else end if opts.tail then emit(parent, string.format("return %s", exprs1(exprs)), ast) + else end if opts.target then local result = exprs1(exprs) - local function _2_() + local function _272_() if (result == "") then return "nil" else return result end end - emit(parent, string.format("%s = %s", opts.target, _2_()), ast) + emit(parent, string.format("%s = %s", opts.target, _272_()), ast) + else end if (opts.tail or opts.target) then return {returned = true} else - local _3_0 = exprs - _3_0["returned"] = true - return _3_0 + local _274_ = exprs + _274_["returned"] = true + return _274_ end end local function find_macro(ast, scope, multi_sym_parts) @@ -2307,7 +2589,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload return t end end - local macro_2a = (utils["sym?"](ast[1]) and scope.macros[utils.deref(ast[1])]) + local macro_2a = (utils["sym?"](ast[1]) and scope.macros[tostring(ast[1])]) if (not macro_2a and multi_sym_parts) then local nested_macro = find_in_table(scope.macros, 1) assert_compile((not scope.macros[multi_sym_parts[1]] or (type(nested_macro) == "function")), "macro not found in imported macro module", ast) @@ -2316,47 +2598,71 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload return macro_2a end end - local function macroexpand_2a(ast, scope, once) - local _0_0 = nil - if utils["list?"](ast) then - _0_0 = find_macro(ast, scope, utils["multi-sym?"](ast[1])) + local function propagate_trace_info(_278_, _index, node) + local _arg_279_ = _278_ + local filename = _arg_279_["filename"] + local line = _arg_279_["line"] + local bytestart = _arg_279_["bytestart"] + local byteend = _arg_279_["byteend"] + if (("table" == type(node)) and (filename ~= node.filename)) then + local src = utils["ast-source"](node) + src.filename, src.line = filename, line + src.bytestart, src.byteend = bytestart, byteend else - _0_0 = nil end - if (_0_0 == false) then + return ("table" == type(node)) + end + local function macroexpand_2a(ast, scope, _3fonce) + local _281_ + if utils["list?"](ast) then + _281_ = find_macro(ast, scope, utils["multi-sym?"](ast[1])) + else + _281_ = nil + end + if (_281_ == false) then return ast - elseif (nil ~= _0_0) then - local macro_2a = _0_0 + elseif (nil ~= _281_) then + local macro_2a = _281_ local old_scope = scopes.macro - local _ = nil + local _ scopes.macro = scope _ = nil local ok, transformed = nil, nil - local function _2_() + local function _283_() return macro_2a(unpack(ast, 2)) end - ok, transformed = xpcall(_2_, debug.traceback) + ok, transformed = xpcall(_283_, debug.traceback) + local function _285_() + local _284_ = ast + local function _286_(...) + return propagate_trace_info(_284_, ...) + end + return _286_ + end + utils["walk-tree"](transformed, _285_()) scopes.macro = old_scope assert_compile(ok, transformed, ast) - if (once or not transformed) then + if (_3fonce or not transformed) then return transformed else return macroexpand_2a(transformed, scope) end - else - local _ = _0_0 + elseif true then + local _ = _281_ return ast + else + return nil end end local function compile_special(ast, scope, parent, opts, special) local exprs = (special(ast, scope, parent, opts) or utils.expr("nil", "literal")) - local exprs0 = nil - if (type(exprs) == "string") then + local exprs0 + if ("table" ~= type(exprs)) then exprs0 = utils.expr(exprs, "expression") else exprs0 = exprs end - local exprs2 = nil + local exprs2 if utils["expr?"](exprs0) then exprs2 = {exprs0} else @@ -2372,17 +2678,17 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload end local function compile_function_call(ast, scope, parent, opts, compile1, len) local fargs = {} - local fcallee = compile1(ast[1], scope, parent, {nval = 1})[1] + local fcallee = (compile1(ast[1], scope, parent, {nval = 1}))[1] assert_compile((("string" == type(ast[1])) or (fcallee.type ~= "literal")), ("cannot call literal value " .. tostring(ast[1])), ast) for i = 2, len do - local subexprs = nil - local _0_ + local subexprs + local _292_ if (i ~= len) then - _0_ = 1 + _292_ = 1 else - _0_ = nil + _292_ = nil end - subexprs = compile1(ast[i], scope, parent, {nval = _0_}) + subexprs = compile1(ast[i], scope, parent, {nval = _292_}) table.insert(fargs, (subexprs[1] or utils.expr("nil", "literal"))) if (i == len) then for j = 2, #subexprs do @@ -2392,7 +2698,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload keep_side_effects(subexprs, parent, 2, ast[i]) end end - local pat = nil + local pat if ("string" == type(ast[1])) then pat = "(%s)(%s)" else @@ -2406,27 +2712,33 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload local len = #ast local first = ast[1] local multi_sym_parts = utils["multi-sym?"](first) - local special = (utils["sym?"](first) and scope.specials[utils.deref(first)]) + local special = (utils["sym?"](first) and scope.specials[tostring(first)]) assert_compile((len > 0), "expected a function, macro, or special to call", ast) if special then return compile_special(ast, scope, parent, opts, special) elseif (multi_sym_parts and multi_sym_parts["multi-sym-method-call"]) then local table_with_method = table.concat({unpack(multi_sym_parts, 1, (#multi_sym_parts - 1))}, ".") local method_to_call = multi_sym_parts[#multi_sym_parts] - local new_ast = utils.list(utils.sym(":", nil, scope), utils.sym(table_with_method, nil, scope), method_to_call, select(2, unpack(ast))) + local new_ast = utils.list(utils.sym(":", ast), utils.sym(table_with_method, ast), method_to_call, select(2, unpack(ast))) return compile1(new_ast, scope, parent, opts) else return compile_function_call(ast, scope, parent, opts, compile1, len) end end local function compile_varg(ast, scope, parent, opts) - assert_compile(scope.vararg, "unexpected vararg", ast) + local _297_ + if scope.hashfn then + _297_ = "use $... in hashfn" + else + _297_ = "unexpected vararg" + end + assert_compile(scope.vararg, _297_, ast) return handle_compile_opts({utils.expr("...", "varg")}, parent, opts, ast) end local function compile_sym(ast, scope, parent, opts) local multi_sym_parts = utils["multi-sym?"](ast) assert_compile(not (multi_sym_parts and multi_sym_parts["multi-sym-method-call"]), "multisym method calls may only be in call position", ast) - local e = nil + local e if (ast[1] == "nil") then e = utils.expr("nil", "literal") else @@ -2435,94 +2747,101 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload return handle_compile_opts({e}, parent, opts, ast) end local function serialize_number(n) - local _0_0 = string.gsub(tostring(n), ",", ".") - return _0_0 + local _300_ = string.gsub(tostring(n), ",", ".") + return _300_ end local function compile_scalar(ast, _scope, parent, opts) - local serialize = nil + local serialize do - local _0_0 = type(ast) - if (_0_0 == "nil") then + local _301_ = type(ast) + if (_301_ == "nil") then serialize = tostring - elseif (_0_0 == "boolean") then + elseif (_301_ == "boolean") then serialize = tostring - elseif (_0_0 == "string") then + elseif (_301_ == "string") then serialize = serialize_string - elseif (_0_0 == "number") then + elseif (_301_ == "number") then serialize = serialize_number else - serialize = nil + serialize = nil end end return handle_compile_opts({utils.expr(serialize(ast), "literal")}, parent, opts) end local function compile_table(ast, scope, parent, opts, compile1) local buffer = {} - for i = 1, #ast do - local nval = ((i ~= #ast) and 1) - table.insert(buffer, exprs1(compile1(ast[i], scope, parent, {nval = nval}))) - end local function write_other_values(k) if ((type(k) ~= "number") or (math.floor(k) ~= k) or (k < 1) or (k > #ast)) then if ((type(k) == "string") and utils["valid-lua-identifier?"](k)) then return {k, k} else - local _0_ = compile1(k, scope, parent, {nval = 1}) - local compiled = _0_[1] + local _let_303_ = compile1(k, scope, parent, {nval = 1}) + local compiled = _let_303_[1] local kstr = ("[" .. tostring(compiled) .. "]") return {kstr, k} end + else + return nil end end do - local keys = nil + local keys do - local _0_0 = utils.kvmap(ast, write_other_values) - local function _1_(a, b) - return (a[1] < b[1]) + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto + for k, v in utils.stablepairs(ast) do + local val_16_auto = write_other_values(k, v) + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end end - table.sort(_0_0, _1_) - keys = _0_0 + keys = tbl_14_auto end - local function _1_(_2_0) - local _3_ = _2_0 - local k1 = _3_[1] - local k2 = _3_[2] - local _4_ = compile1(ast[k2], scope, parent, {nval = 1}) - local v = _4_[1] + local function _309_(_307_) + local _arg_308_ = _307_ + local k1 = _arg_308_[1] + local k2 = _arg_308_[2] + local _let_310_ = compile1(ast[k2], scope, parent, {nval = 1}) + local v = _let_310_[1] return string.format("%s = %s", k1, tostring(v)) end - utils.map(keys, _1_, buffer) + utils.map(keys, _309_, buffer) + end + for i = 1, #ast do + local nval = ((i ~= #ast) and 1) + table.insert(buffer, exprs1(compile1(ast[i], scope, parent, {nval = nval}))) end return handle_compile_opts({utils.expr(("{" .. table.concat(buffer, ", ") .. "}"), "expression")}, parent, opts, ast) end - local function compile1(ast, scope, parent, opts) - local opts0 = (opts or {}) + local function compile1(ast, scope, parent, _3fopts) + local opts = (_3fopts or {}) local ast0 = macroexpand_2a(ast, scope) if utils["list?"](ast0) then - return compile_call(ast0, scope, parent, opts0, compile1) + return compile_call(ast0, scope, parent, opts, compile1) elseif utils["varg?"](ast0) then - return compile_varg(ast0, scope, parent, opts0) + return compile_varg(ast0, scope, parent, opts) elseif utils["sym?"](ast0) then - return compile_sym(ast0, scope, parent, opts0) + return compile_sym(ast0, scope, parent, opts) elseif (type(ast0) == "table") then - return compile_table(ast0, scope, parent, opts0, compile1) + return compile_table(ast0, scope, parent, opts, compile1) elseif ((type(ast0) == "nil") or (type(ast0) == "boolean") or (type(ast0) == "number") or (type(ast0) == "string")) then - return compile_scalar(ast0, scope, parent, opts0) + return compile_scalar(ast0, scope, parent, opts) else return assert_compile(false, ("could not compile value of type " .. type(ast0)), ast0) end end local function destructure(to, from, ast, scope, parent, opts) local opts0 = (opts or {}) - local _0_ = opts0 - local declaration = _0_["declaration"] - local forceglobal = _0_["forceglobal"] - local forceset = _0_["forceset"] - local isvar = _0_["isvar"] - local symtype = _0_["symtype"] + local _let_312_ = opts0 + local isvar = _let_312_["isvar"] + local declaration = _let_312_["declaration"] + local forceglobal = _let_312_["forceglobal"] + local forceset = _let_312_["forceset"] + local symtype = _let_312_["symtype"] local symtype0 = ("_" .. (symtype or "dst")) - local setter = nil + local setter if declaration then setter = "local %s = %s" else @@ -2537,32 +2856,36 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload else local parts = (utils["multi-sym?"](raw) or {raw}) local meta = scope.symmeta[parts[1]] + assert_compile(not raw:find(":"), "cannot set method sym", symbol) if ((#parts == 1) and not forceset) then assert_compile(not (forceglobal and meta), string.format("global %s conflicts with local", tostring(symbol)), symbol) assert_compile(not (meta and not meta.var), ("expected var " .. raw), symbol) assert_compile((meta or not opts0.noundef), ("expected local " .. parts[1]), symbol) + else end if forceglobal then assert_compile(not scope.symmeta[scope.unmanglings[raw]], ("global " .. raw .. " conflicts with local"), symbol) - scope.manglings[raw] = global_mangling(raw) - scope.unmanglings[global_mangling(raw)] = raw + do end (scope.manglings)[raw] = global_mangling(raw) + do end (scope.unmanglings)[global_mangling(raw)] = raw if allowed_globals then table.insert(allowed_globals, raw) + else end + else end return symbol_to_expression(symbol, scope)[1] end end local function compile_top_target(lvalues) - local inits = nil - local function _2_(_241) + local inits + local function _318_(_241) if scope.manglings[_241] then return _241 else return "nil" end end - inits = utils.map(lvalues, _2_) + inits = utils.map(lvalues, _318_) local init = table.concat(inits, ", ") local lvalue = table.concat(lvalues, ", ") local plen, plast = #parent, parent[#parent] @@ -2571,6 +2894,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload for pi = plen, #parent do if (parent[pi] == plast) then plen = pi + else end end if ((#parent == (plen + 1)) and parent[#parent].leaf) then @@ -2580,6 +2904,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload else table.insert(parent, (plen + 1), {ast = ast, leaf = ("local " .. lvalue .. " = " .. init)}) end + else end return ret end @@ -2592,46 +2917,48 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload emit(parent, setter:format(lname, exprs1(rightexprs)), left) end if declaration then - scope.symmeta[utils.deref(left)] = {var = isvar} + scope.symmeta[tostring(left)] = {var = isvar} + return nil + else return nil end end local function destructure_table(left, rightexprs, top_3f, destructure1) local s = gensym(scope, symtype0) - local right = nil + local right do - local _2_0 = nil + local _325_ if top_3f then - _2_0 = exprs1(compile1(from, scope, parent)) + _325_ = exprs1(compile1(from, scope, parent)) else - _2_0 = exprs1(rightexprs) + _325_ = exprs1(rightexprs) end - if (_2_0 == "") then + if (_325_ == "") then right = "nil" - elseif (nil ~= _2_0) then - local right0 = _2_0 + elseif (nil ~= _325_) then + local right0 = _325_ right = right0 else - right = nil + right = nil end end emit(parent, string.format("local %s = %s", s, right), left) for k, v in utils.stablepairs(left) do if not (("number" == type(k)) and tostring(left[(k - 1)]):find("^&")) then - if (utils["sym?"](v) and (utils.deref(v) == "&")) then - local unpack_str = "{(table.unpack or unpack)(%s, %s)}" - local formatted = string.format(unpack_str, s, k) + if (utils["sym?"](v) and (tostring(v) == "&")) then + local unpack_str = "(function (t, k)\n local mt = getmetatable(t)\n if \"table\" == type(mt) and mt.__fennelrest then\n return mt.__fennelrest(t, k)\n else\n return {(table.unpack or unpack)(t, k)}\n end\n end)(%s, %s)" + local formatted = string.format(string.gsub(unpack_str, "\n%s*", " "), s, k) local subexpr = utils.expr(formatted, "expression") assert_compile((utils["sequence?"](left) and (nil == left[(k + 2)])), "expected rest argument before last parameter", left) destructure1(left[(k + 1)], {subexpr}, left) - elseif (utils["sym?"](k) and (utils.deref(k) == "&as")) then + elseif (utils["sym?"](k) and (tostring(k) == "&as")) then destructure_sym(v, {utils.expr(tostring(s))}, left) - elseif (utils["sequence?"](left) and (utils.deref(v) == "&as")) then + elseif (utils["sequence?"](left) and (tostring(v) == "&as")) then local _, next_sym, trailing = select(k, unpack(left)) assert_compile((nil == trailing), "expected &as argument before last parameter", left) destructure_sym(next_sym, {utils.expr(tostring(s))}, left) else - local key = nil + local key if (type(k) == "string") then key = serialize_string(k) else @@ -2640,6 +2967,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload local subexpr = utils.expr(string.format("%s[%s]", s, key), "expression") destructure1(v, {subexpr}, left) end + else end end return nil @@ -2652,7 +2980,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload else local symname = gensym(scope, symtype0) table.insert(left_names, symname) - tables[i] = {name, utils.expr(symname, "sym")} + do end (tables)[i] = {name, utils.expr(symname, "sym")} end end assert_compile(top_3f, "can't nest multi-value destructuring", left) @@ -2660,9 +2988,11 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload if declaration then for _, sym in ipairs(left) do if utils["sym?"](sym) then - scope.symmeta[utils.deref(sym)] = {var = isvar} + scope.symmeta[tostring(sym)] = {var = isvar} + else end end + else end for _, pair in utils.stablepairs(tables) do destructure1(pair[1], {pair[2]}, left) @@ -2677,10 +3007,12 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload elseif utils["list?"](left) then destructure_values(left, up1, top_3f, destructure1) else - assert_compile(false, string.format("unable to bind %s %s", type(left), tostring(left)), (((type(up1[2]) == "table") and up1[2]) or up1)) + assert_compile(false, string.format("unable to bind %s %s", type(left), tostring(left)), (((type((up1)[2]) == "table") and (up1)[2]) or up1)) end if top_3f then return {returned = true} + else + return nil end end local ret = destructure1(to, nil, ast, true) @@ -2689,7 +3021,11 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload return ret end local function require_include(ast, scope, parent, opts) - opts.fallback = function(e) + opts.fallback = function(e, no_warn) + if (not no_warn and ("literal" == e.type)) then + utils.warn(("include module not found, falling back to require: %s"):format(tostring(e))) + else + end return utils.expr(string.format("require(%s)", tostring(e)), "statement") end return scopes.global.specials.include(ast, scope, parent, opts) @@ -2700,14 +3036,15 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload local scope = (opts.scope or make_scope(scopes.global)) local vals = {} local chunk = {} - local _0_ = utils.root - _0_["set-reset"](_0_) + do end (function(tgt, m, ...) return tgt[m](tgt, ...) end)(utils.root, "set-reset") allowed_globals = opts.allowedGlobals if (opts.indent == nil) then opts.indent = " " + else end if opts.requireAsInclude then scope.specials.require = require_include + else end utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts for _, val in parser.parser(strm, opts.filename, opts) do @@ -2716,6 +3053,10 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload for i = 1, #vals do local exprs = compile1(vals[i], scope, chunk, {nval = (((i < #vals) and 0) or nil), tail = (i == #vals)}) keep_side_effects(exprs, chunk, nil, vals[i]) + if (i == #vals) then + utils.hook("chunk", vals[i], scope) + else + end end allowed_globals = old_globals utils.root.reset() @@ -2729,18 +3070,20 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload local old_globals = allowed_globals local chunk = {} local scope = (opts0.scope or make_scope(scopes.global)) - local _0_ = utils.root - _0_["set-reset"](_0_) + do end (function(tgt, m, ...) return tgt[m](tgt, ...) end)(utils.root, "set-reset") allowed_globals = opts0.allowedGlobals if (opts0.indent == nil) then opts0.indent = " " + else end if opts0.requireAsInclude then scope.specials.require = require_include + else end utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts0 local exprs = compile1(ast, scope, chunk, {tail = true}) keep_side_effects(exprs, chunk, nil, ast) + utils.hook("chunk", ast, scope) allowed_globals = old_globals utils.root.reset() return flatten(chunk, opts0) @@ -2751,24 +3094,25 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload elseif (info.what == "C") then return " [C]: in ?" else - local remap = fennel_sourcemap[info.source] + local remap = sourcemap[info.source] if (remap and remap[info.currentline]) then - if remap[info.currentline][1] then - info.short_src = fennel_sourcemap[("@" .. remap[info.currentline][1])].short_src + if ((remap[info.currentline][1] or "unknown") ~= "unknown") then + info.short_src = sourcemap[("@" .. remap[info.currentline][1])].short_src else info.short_src = remap.short_src end info.currentline = (remap[info.currentline][2] or -1) + else end if (info.what == "Lua") then - local function _1_() + local function _344_() if info.name then return ("'" .. info.name .. "'") else return "?" end end - return string.format(" %s:%d: in function %s", info.short_src, info.currentline, _1_()) + return string.format(" %s:%d: in function %s", info.short_src, info.currentline, _344_()) elseif (info.short_src == "(tail call)") then return " (tail call)" else @@ -2776,28 +3120,29 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload end end end - local function traceback(msg, start) - local msg0 = tostring((msg or "")) - if ((msg0:find("^Compile error") or msg0:find("^Parse error")) and not utils["debug-on?"]("trace")) then - return msg0 + local function traceback(_3fmsg, _3fstart) + local msg = tostring((_3fmsg or "")) + if ((msg:find("^Compile error") or msg:find("^Parse error")) and not utils["debug-on?"]("trace")) then + return msg else local lines = {} - if (msg0:find("^Compile error") or msg0:find("^Parse error")) then - table.insert(lines, msg0) + if (msg:find(":%d+: Compile error") or msg:find(":%d+: Parse error")) then + table.insert(lines, msg) else - local newmsg = msg0:gsub("^[^:]*:%d+:%s+", "runtime error: ") + local newmsg = msg:gsub("^[^:]*:%d+:%s+", "runtime error: ") table.insert(lines, newmsg) end table.insert(lines, "stack traceback:") - local done_3f, level = false, (start or 2) + local done_3f, level = false, (_3fstart or 2) while not done_3f do do - local _1_0 = debug.getinfo(level, "Sln") - if (_1_0 == nil) then + local _348_ = debug.getinfo(level, "Sln") + if (_348_ == nil) then done_3f = true - elseif (nil ~= _1_0) then - local info = _1_0 + elseif (nil ~= _348_) then + local info = _348_ table.insert(lines, traceback_frame(info)) + else end end level = (level + 1) @@ -2806,14 +3151,14 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload end end local function entry_transform(fk, fv) - local function _0_(k, v) + local function _351_(k, v) if (type(k) == "number") then return k, fv(v) else return fk(k), fv(v) end end - return _0_ + return _351_ end local function mixed_concat(t, joiner) local seen = {} @@ -2827,6 +3172,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload if not seen[k] then ret = (ret .. s .. "[" .. k .. "]" .. "=" .. v) s = joiner + else end end return ret @@ -2839,30 +3185,30 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload assert_compile(not runtime_3f, "quoted ... may only be used at compile time", form) return "_VARARG" elseif utils["sym?"](form) then - local filename = nil + local filename if form.filename then filename = string.format("%q", form.filename) else filename = "nil" end - local symstr = utils.deref(form) + local symstr = tostring(form) assert_compile(not runtime_3f, "symbols may only be used at compile time", form) if (symstr:find("#$") or symstr:find("#[:.]")) then return string.format("sym('%s', {filename=%s, line=%s})", autogensym(symstr, scope), filename, (form.line or "nil")) else return string.format("sym('%s', {quoted=true, filename=%s, line=%s})", symstr, filename, (form.line or "nil")) end - elseif (utils["list?"](form) and utils["sym?"](form[1]) and (utils.deref(form[1]) == "unquote")) then + elseif (utils["list?"](form) and utils["sym?"](form[1]) and (tostring(form[1]) == "unquote")) then local payload = form[2] local res = unpack(compile1(payload, scope, parent)) return res[1] elseif utils["list?"](form) then - local mapped = nil - local function _0_() + local mapped + local function _356_() return nil end - mapped = utils.kvmap(form, entry_transform(_0_, q)) - local filename = nil + mapped = utils.kvmap(form, entry_transform(_356_, q)) + local filename if form.filename then filename = string.format("%q", form.filename) else @@ -2873,50 +3219,47 @@ package.preload["conjure-macroexpand.aniseed.fennel.compiler"] = package.preload elseif utils["sequence?"](form) then local mapped = utils.kvmap(form, entry_transform(q, q)) local source = getmetatable(form) - local filename = nil + local filename if source.filename then filename = string.format("%q", source.filename) else filename = "nil" end - local _1_ + local _359_ if source then - _1_ = source.line + _359_ = source.line else - _1_ = "nil" + _359_ = "nil" end - return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _1_, "(getmetatable(sequence()))['sequence']") + return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _359_, "(getmetatable(sequence()))['sequence']") elseif (type(form) == "table") then local mapped = utils.kvmap(form, entry_transform(q, q)) local source = getmetatable(form) - local filename = nil + local filename if source.filename then filename = string.format("%q", source.filename) else filename = "nil" end - local function _1_() + local function _362_() if source then return source.line else return "nil" end end - return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _1_()) + return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _362_()) elseif (type(form) == "string") then return serialize_string(form) else return tostring(form) end end - return {["apply-manglings"] = apply_manglings, ["compile-stream"] = compile_stream, ["compile-string"] = compile_string, ["declare-local"] = declare_local, ["do-quote"] = do_quote, ["global-mangling"] = global_mangling, ["global-unmangling"] = global_unmangling, ["keep-side-effects"] = keep_side_effects, ["make-scope"] = make_scope, ["require-include"] = require_include, ["symbol-to-expression"] = symbol_to_expression, assert = assert_compile, autogensym = autogensym, compile = compile, compile1 = compile1, destructure = destructure, emit = emit, gensym = gensym, macroexpand = macroexpand_2a, metadata = make_metadata(), scopes = scopes, traceback = traceback} + return {compile = compile, compile1 = compile1, ["compile-stream"] = compile_stream, ["compile-string"] = compile_string, emit = emit, destructure = destructure, ["require-include"] = require_include, autogensym = autogensym, gensym = gensym, ["do-quote"] = do_quote, ["global-mangling"] = global_mangling, ["global-unmangling"] = global_unmangling, ["apply-manglings"] = apply_manglings, macroexpand = macroexpand_2a, ["declare-local"] = declare_local, ["make-scope"] = make_scope, ["keep-side-effects"] = keep_side_effects, ["symbol-to-expression"] = symbol_to_expression, assert = assert_compile, scopes = scopes, traceback = traceback, metadata = make_metadata(), sourcemap = sourcemap} end package.preload["conjure-macroexpand.aniseed.fennel.friend"] = package.preload["conjure-macroexpand.aniseed.fennel.friend"] or function(...) - local function ast_source(ast) - local m = getmetatable(ast) - return ((m and m.line and m) or (("table" == type(ast)) and ast) or {}) - end - local suggestions = {["$ and $... in hashfn are mutually exclusive"] = {"modifying the hashfn so it only contains $... or $, $1, $2, $3, etc"}, ["can't start multisym segment with a digit"] = {"removing the digit", "adding a non-digit before the digit"}, ["cannot call literal value"] = {"checking for typos", "checking for a missing function name"}, ["could not compile value of type "] = {"debugging the macro you're calling to return a list or table"}, ["could not read number (.*)"] = {"removing the non-digit character", "beginning the identifier with a non-digit if it is not meant to be a number"}, ["expected a function.* to call"] = {"removing the empty parentheses", "using square brackets if you want an empty table"}, ["expected binding and iterator"] = {"making sure you haven't omitted a local name or iterator"}, ["expected binding table"] = {"placing a table here in square brackets containing identifiers to bind"}, ["expected body expression"] = {"putting some code in the body of this form after the bindings"}, ["expected each macro to be function"] = {"ensuring that the value for each key in your macros table contains a function", "avoid defining nested macro tables"}, ["expected even number of name/value bindings"] = {"finding where the identifier or value is missing"}, ["expected even number of values in table literal"] = {"removing a key", "adding a value"}, ["expected local"] = {"looking for a typo", "looking for a local which is used out of its scope"}, ["expected macros to be table"] = {"ensuring your macro definitions return a table"}, ["expected parameters"] = {"adding function parameters as a list of identifiers in brackets"}, ["expected rest argument before last parameter"] = {"moving & to right before the final identifier when destructuring"}, ["expected symbol for function parameter: (.*)"] = {"changing %s to an identifier instead of a literal value"}, ["expected var (.*)"] = {"declaring %s using var instead of let/local", "introducing a new local instead of changing the value of %s"}, ["expected vararg as last parameter"] = {"moving the \"...\" to the end of the parameter list"}, ["expected whitespace before opening delimiter"] = {"adding whitespace"}, ["global (.*) conflicts with local"] = {"renaming local %s"}, ["illegal character: (.)"] = {"deleting or replacing %s", "avoiding reserved characters like \", \\, ', ~, ;, @, `, and comma"}, ["local (.*) was overshadowed by a special form or macro"] = {"renaming local %s"}, ["macro not found in macro module"] = {"checking the keys of the imported macro module's returned table"}, ["macro tried to bind (.*) without gensym"] = {"changing to %s# when introducing identifiers inside macros"}, ["malformed multisym"] = {"ensuring each period or colon is not followed by another period or colon"}, ["may only be used at compile time"] = {"moving this to inside a macro if you need to manipulate symbols/lists", "using square brackets instead of parens to construct a table"}, ["method must be last component"] = {"using a period instead of a colon for field access", "removing segments after the colon", "making the method call, then looking up the field on the result"}, ["mismatched closing delimiter (.), expected (.)"] = {"replacing %s with %s", "deleting %s", "adding matching opening delimiter earlier"}, ["multisym method calls may only be in call position"] = {"using a period instead of a colon to reference a table's fields", "putting parens around this"}, ["unable to bind (.*)"] = {"replacing the %s with an identifier"}, ["unexpected closing delimiter (.)"] = {"deleting %s", "adding matching opening delimiter earlier"}, ["unexpected multi symbol (.*)"] = {"removing periods or colons from %s"}, ["unexpected vararg"] = {"putting \"...\" at the end of the fn parameters if the vararg was intended"}, ["unknown global in strict mode: (.*)"] = {"looking to see if there's a typo", "using the _G table instead, eg. _G.%s if you really want a global", "moving this code to somewhere that %s is in scope", "binding %s as a local in the scope of this code"}, ["unused local (.*)"] = {"fixing a typo so %s is used", "renaming the local to _%s"}, ["use of global (.*) is aliased by a local"] = {"renaming local %s", "refer to the global using _G.%s instead of directly"}} + local utils = require("conjure-macroexpand.aniseed.fennel.utils") + local suggestions = {["unexpected multi symbol (.*)"] = {"removing periods or colons from %s"}, ["use of global (.*) is aliased by a local"] = {"renaming local %s", "refer to the global using _G.%s instead of directly"}, ["local (.*) was overshadowed by a special form or macro"] = {"renaming local %s"}, ["global (.*) conflicts with local"] = {"renaming local %s"}, ["expected var (.*)"] = {"declaring %s using var instead of let/local", "introducing a new local instead of changing the value of %s"}, ["expected macros to be table"] = {"ensuring your macro definitions return a table"}, ["expected each macro to be function"] = {"ensuring that the value for each key in your macros table contains a function", "avoid defining nested macro tables"}, ["macro not found in macro module"] = {"checking the keys of the imported macro module's returned table"}, ["macro tried to bind (.*) without gensym"] = {"changing to %s# when introducing identifiers inside macros"}, ["unknown identifier in strict mode: (.*)"] = {"looking to see if there's a typo", "using the _G table instead, eg. _G.%s if you really want a global", "moving this code to somewhere that %s is in scope", "binding %s as a local in the scope of this code"}, ["expected a function.* to call"] = {"removing the empty parentheses", "using square brackets if you want an empty table"}, ["cannot call literal value"] = {"checking for typos", "checking for a missing function name"}, ["unexpected vararg"] = {"putting \"...\" at the end of the fn parameters if the vararg was intended"}, ["multisym method calls may only be in call position"] = {"using a period instead of a colon to reference a table's fields", "putting parens around this"}, ["unused local (.*)"] = {"renaming the local to _%s if it is meant to be unused", "fixing a typo so %s is used", "disabling the linter which checks for unused locals"}, ["expected parameters"] = {"adding function parameters as a list of identifiers in brackets"}, ["unable to bind (.*)"] = {"replacing the %s with an identifier"}, ["expected rest argument before last parameter"] = {"moving & to right before the final identifier when destructuring"}, ["expected vararg as last parameter"] = {"moving the \"...\" to the end of the parameter list"}, ["expected symbol for function parameter: (.*)"] = {"changing %s to an identifier instead of a literal value"}, ["could not compile value of type "] = {"debugging the macro you're calling to return a list or table"}, ["expected local"] = {"looking for a typo", "looking for a local which is used out of its scope"}, ["expected body expression"] = {"putting some code in the body of this form after the bindings"}, ["expected binding and iterator"] = {"making sure you haven't omitted a local name or iterator"}, ["expected binding sequence"] = {"placing a table here in square brackets containing identifiers to bind"}, ["expected even number of name/value bindings"] = {"finding where the identifier or value is missing"}, ["may only be used at compile time"] = {"moving this to inside a macro if you need to manipulate symbols/lists", "using square brackets instead of parens to construct a table"}, ["unexpected closing delimiter (.)"] = {"deleting %s", "adding matching opening delimiter earlier"}, ["mismatched closing delimiter (.), expected (.)"] = {"replacing %s with %s", "deleting %s", "adding matching opening delimiter earlier"}, ["expected even number of values in table literal"] = {"removing a key", "adding a value"}, ["expected whitespace before opening delimiter"] = {"adding whitespace"}, ["invalid character: (.)"] = {"deleting or replacing %s", "avoiding reserved characters like \", \\, ', ~, ;, @, `, and comma"}, ["could not read number (.*)"] = {"removing the non-digit character", "beginning the identifier with a non-digit if it is not meant to be a number"}, ["can't start multisym segment with a digit"] = {"removing the digit", "adding a non-digit before the digit"}, ["malformed multisym"] = {"ensuring each period or colon is not followed by another period or colon"}, ["method must be last component"] = {"using a period instead of a colon for field access", "removing segments after the colon", "making the method call, then looking up the field on the result"}, ["$ and $... in hashfn are mutually exclusive"] = {"modifying the hashfn so it only contains $... or $, $1, $2, $3, etc"}, ["tried to reference a macro at runtime"] = {"renaming the macro so as not to conflict with locals"}, ["tried to reference a special form at runtime"] = {"wrapping the special in a function if you need it to be first class"}, ["expected even number of pattern/body pairs"] = {"checking that every pattern has a body to go with it", "adding _ before the final body"}, ["unexpected arguments"] = {"removing an argument", "checking for typos"}, ["unexpected iterator clause"] = {"removing an argument", "checking for typos"}} local unpack = (table.unpack or _G.unpack) local function suggest(msg) local suggestion = nil @@ -2932,6 +3275,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.friend"] = package.preload[" else suggestion = sug(matches) end + else end end return suggestion @@ -2939,7 +3283,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.friend"] = package.preload[" local function read_line_from_file(filename, line) local bytes = 0 local f = assert(io.open(filename)) - local _ = nil + local _ for _0 = 1, (line - 1) do bytes = (bytes + 1 + #f:read()) end @@ -2953,9 +3297,11 @@ package.preload["conjure-macroexpand.aniseed.fennel.friend"] = package.preload[" local current_line = (_3fcurrent_line or 1) local bytes = ((_3fbytes or 0) + #this_line + #newline) if (target_line == current_line) then - return this_line, bytes + return this_line, (bytes - #this_line - 1) elseif this_line then return read_line_from_string(matcher, target_line, (current_line + 1), bytes) + else + return nil end end local function read_line(filename, line, source) @@ -2965,43 +3311,48 @@ package.preload["conjure-macroexpand.aniseed.fennel.friend"] = package.preload[" return read_line_from_file(filename, line) end end - local function friendly_msg(msg, _0_0, source) - local _1_ = _0_0 - local byteend = _1_["byteend"] - local bytestart = _1_["bytestart"] - local filename = _1_["filename"] - local line = _1_["line"] + local function friendly_msg(msg, _156_, source) + local _arg_157_ = _156_ + local filename = _arg_157_["filename"] + local line = _arg_157_["line"] + local bytestart = _arg_157_["bytestart"] + local byteend = _arg_157_["byteend"] local ok, codeline, bol = pcall(read_line, filename, line, source) local suggestions0 = suggest(msg) local out = {msg, ""} if (ok and codeline) then table.insert(out, codeline) + else end if (ok and codeline and bytestart and byteend) then table.insert(out, (string.rep(" ", (bytestart - bol - 1)) .. "^" .. string.rep("^", math.min((byteend - bytestart), ((bol + #codeline) - bytestart))))) + else end if (ok and codeline and bytestart and not byteend) then table.insert(out, (string.rep("-", (bytestart - bol - 1)) .. "^")) table.insert(out, "") + else end if suggestions0 then for _, suggestion in ipairs(suggestions0) do table.insert(out, ("* Try %s."):format(suggestion)) end + else end return table.concat(out, "\n") end local function assert_compile(condition, msg, ast, source) if not condition then - local _1_ = ast_source(ast) - local filename = _1_["filename"] - local line = _1_["line"] - error(friendly_msg(("Compile error in %s:%s\n %s"):format((filename or "unknown"), (line or "?"), msg), ast_source(ast), source), 0) + local _let_162_ = utils["ast-source"](ast) + local filename = _let_162_["filename"] + local line = _let_162_["line"] + error(friendly_msg(("Compile error in %s:%s\n %s"):format((filename or "unknown"), (line or "?"), msg), utils["ast-source"](ast), source), 0) + else end return condition end local function parse_error(msg, filename, line, bytestart, source) - return error(friendly_msg(("Parse error in %s:%s\n %s"):format(filename, line, msg), {bytestart = bytestart, filename = filename, line = line}, source), 0) + return error(friendly_msg(("Parse error in %s:%s\n %s"):format(filename, line, msg), {filename = filename, line = line, bytestart = bytestart}, source), 0) end return {["assert-compile"] = assert_compile, ["parse-error"] = parse_error} end @@ -3011,54 +3362,57 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" local unpack = (table.unpack or _G.unpack) local function granulate(getchunk) local c, index, done_3f = "", 1, false - local function _0_(parser_state) + local function _164_(parser_state) if not done_3f then if (index <= #c) then local b = c:byte(index) index = (index + 1) return b else - local _1_0, _2_0, _3_0 = getchunk(parser_state) - local _4_ - do - local char = _1_0 - _4_ = ((nil ~= _1_0) and (char ~= "")) + local _165_ = getchunk(parser_state) + local function _166_() + local char = _165_ + return (char ~= "") end - if _4_ then - local char = _1_0 + if ((nil ~= _165_) and _166_()) then + local char = _165_ c = char index = 2 return c:byte() - else - local _ = _1_0 + elseif true then + local _ = _165_ done_3f = true return nil + else + return nil end end + else + return nil end end - local function _1_() + local function _170_() c = "" return nil end - return _0_, _1_ + return _164_, _170_ end local function string_stream(str) local str0 = str:gsub("^#!", ";;") local index = 1 - local function _0_() + local function _171_() local r = str0:byte(index) index = (index + 1) return r end - return _0_ + return _171_ end - local delims = {[123] = 125, [125] = true, [40] = 41, [41] = true, [91] = 93, [93] = true} + local delims = {[40] = 41, [41] = true, [91] = 93, [93] = true, [123] = 125, [125] = true} local function whitespace_3f(b) return ((b == 32) or ((b >= 9) and (b <= 13))) end local function sym_char_3f(b) - local b0 = nil + local b0 if ("number" == type(b)) then b0 = b else @@ -3067,7 +3421,11 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" return ((b0 > 32) and not delims[b0] and (b0 ~= 127) and (b0 ~= 34) and (b0 ~= 39) and (b0 ~= 126) and (b0 ~= 59) and (b0 ~= 44) and (b0 ~= 64) and (b0 ~= 96)) end local prefixes = {[35] = "hashfn", [39] = "quote", [44] = "unquote", [96] = "quote"} - local function parser(getbyte, filename, options) + local function parser_fn(getbyte, filename, _173_) + local _arg_174_ = _173_ + local source = _arg_174_["source"] + local unfriendly = _arg_174_["unfriendly"] + local comments = _arg_174_["comments"] local stack = {} local line = 1 local byteindex = 0 @@ -3075,6 +3433,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" local function ungetb(ub) if (ub == 10) then line = (line - 1) + else end byteindex = (byteindex - 1) lastb = ub @@ -3090,56 +3449,59 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" byteindex = (byteindex + 1) if (r == 10) then line = (line + 1) + else end return r end - assert(((nil == filename) or ("string" == type(filename))), "expected filename as second argument to parser") local function parse_error(msg, byteindex_override) - local _0_ = (options or utils.root.options or {}) - local source = _0_["source"] - local unfriendly = _0_["unfriendly"] - utils.root.reset() - if unfriendly then - return error(string.format("Parse error in %s:%s: %s", (filename or "unknown"), (line or "?"), msg), 0) + if (nil == utils.hook("parse-error", msg, filename, (line or "?"), (byteindex_override or byteindex), source, utils.root.reset)) then + utils.root.reset() + if (unfriendly or not friend or not _G.io or not _G.io.read) then + return error(string.format("%s:%s: Parse error: %s", filename, (line or "?"), msg), 0) + else + return friend["parse-error"](msg, filename, (line or "?"), (byteindex_override or byteindex), source) + end else - return friend["parse-error"](msg, (filename or "unknown"), (line or "?"), (byteindex_override or byteindex), source) + return nil end end local function parse_stream() local whitespace_since_dispatch, done_3f, retval = true local function dispatch(v) - local _0_0 = stack[#stack] - if (_0_0 == nil) then + local _180_ = stack[#stack] + if (_180_ == nil) then retval, done_3f, whitespace_since_dispatch = v, true, false return nil - elseif ((type(_0_0) == "table") and (nil ~= _0_0.prefix)) then - local prefix = _0_0.prefix - local source = nil + elseif ((_G.type(_180_) == "table") and (nil ~= (_180_).prefix)) then + local prefix = (_180_).prefix + local source0 do - local _1_0 = table.remove(stack) - _1_0["byteend"] = byteindex - source = _1_0 + local _181_ = table.remove(stack) + do end (_181_)["byteend"] = byteindex + source0 = _181_ end - local list = utils.list(utils.sym(prefix, source), v) - for k, v0 in pairs(source) do + local list = utils.list(utils.sym(prefix, source0), v) + for k, v0 in pairs(source0) do list[k] = v0 end return dispatch(list) - elseif (nil ~= _0_0) then - local top = _0_0 + elseif (nil ~= _180_) then + local top = _180_ whitespace_since_dispatch = false return table.insert(top, v) + else + return nil end end local function badend() local accum = utils.map(stack, "closer") - local _0_ + local _183_ if (#stack == 1) then - _0_ = "" + _183_ = "" else - _0_ = "s" + _183_ = "s" end - return parse_error(string.format("expected closing delimiter%s %s", _0_, string.char(unpack(accum)))) + return parse_error(string.format("expected closing delimiter%s %s", _183_, string.char(unpack(accum)))) end local function skip_whitespace(b) if (b and whitespace_3f(b)) then @@ -3153,14 +3515,14 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" end local function parse_comment(b, contents) if (b and (10 ~= b)) then - local function _1_() - local _0_0 = contents - table.insert(_0_0, string.char(b)) - return _0_0 + local function _187_() + local _186_ = contents + table.insert(_186_, string.char(b)) + return _186_ end - return parse_comment(getb(), _1_()) - elseif (options and options.comments) then - return dispatch(utils.comment(table.concat(contents), {filename = filename, line = (line - 1)})) + return parse_comment(getb(), _187_()) + elseif comments then + return dispatch(utils.comment(table.concat(contents), {line = (line - 1), filename = filename})) else return b end @@ -3168,6 +3530,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" local function open_table(b) if not whitespace_since_dispatch then parse_error(("expected whitespace before opening delimiter " .. string.char(b))) + else end return table.insert(stack, {bytestart = byteindex, closer = delims[b], filename = filename, line = line}) end @@ -3181,14 +3544,16 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" end return dispatch(val) end - local function add_comment_at(comments, index, node) - local _0_0 = comments[index] - if (nil ~= _0_0) then - local existing = _0_0 + local function add_comment_at(comments0, index, node) + local _190_ = (comments0)[index] + if (nil ~= _190_) then + local existing = _190_ return table.insert(existing, node) + elseif true then + local _ = _190_ + comments0[index] = {node} + return nil else - local _ = _0_0 - comments[index] = {node} return nil end end @@ -3200,44 +3565,47 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" end end local function extract_comments(tbl) - local comments = {keys = {}, last = {}, values = {}} + local comments0 = {keys = {}, values = {}, last = {}} while utils["comment?"](tbl[#tbl]) do - table.insert(comments.last, 1, table.remove(tbl)) + table.insert(comments0.last, 1, table.remove(tbl)) end local last_key_3f = false for i, node in ipairs(tbl) do if not utils["comment?"](node) then last_key_3f = not last_key_3f elseif last_key_3f then - add_comment_at(comments.values, next_noncomment(tbl, i), node) + add_comment_at(comments0.values, next_noncomment(tbl, i), node) else - add_comment_at(comments.keys, next_noncomment(tbl, i), node) + add_comment_at(comments0.keys, next_noncomment(tbl, i), node) end end for i = #tbl, 1, -1 do if utils["comment?"](tbl[i]) then table.remove(tbl, i) + else end end - return comments + return comments0 end local function close_curly_table(tbl) - local comments = extract_comments(tbl) + local comments0 = extract_comments(tbl) local keys = {} local val = {} if ((#tbl % 2) ~= 0) then byteindex = (byteindex - 1) parse_error("expected even number of values in table literal") + else end setmetatable(val, tbl) for i = 1, #tbl, 2 do if ((tostring(tbl[i]) == ":") and utils["sym?"](tbl[(i + 1)]) and utils["sym?"](tbl[i])) then tbl[i] = tostring(tbl[(i + 1)]) + else end val[tbl[i]] = tbl[(i + 1)] table.insert(keys, tbl[i]) end - tbl.comments = comments + tbl.comments = comments0 tbl.keys = keys return dispatch(val) end @@ -3245,9 +3613,11 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" local top = table.remove(stack) if (top == nil) then parse_error(("unexpected closing delimiter " .. string.char(b))) + else end if (top.closer and (top.closer ~= b)) then parse_error(("mismatched closing delimiter " .. string.char(b) .. ", expected " .. string.char(top.closer))) + else end top.byteend = byteindex if (b == 41) then @@ -3260,16 +3630,21 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" end local function parse_string_loop(chars, b, state) table.insert(chars, b) - local state0 = nil + local state0 do - local _0_0 = {state, b} - if ((type(_0_0) == "table") and (_0_0[1] == "base") and (_0_0[2] == 92)) then + local _200_ = {state, b} + if ((_G.type(_200_) == "table") and ((_200_)[1] == "base") and ((_200_)[2] == 92)) then state0 = "backslash" - elseif ((type(_0_0) == "table") and (_0_0[1] == "base") and (_0_0[2] == 34)) then + elseif ((_G.type(_200_) == "table") and ((_200_)[1] == "base") and ((_200_)[2] == 34)) then state0 = "done" - else - local _ = _0_0 + elseif ((_G.type(_200_) == "table") and ((_200_)[1] == "backslash") and ((_200_)[2] == 10)) then + table.remove(chars, (#chars - 1)) state0 = "base" + elseif true then + local _ = _200_ + state0 = "base" + else + state0 = nil end end if (b and (state0 ~= "done")) then @@ -3279,34 +3654,39 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" end end local function escape_char(c) - return ({nil, nil, nil, nil, nil, nil, "\\a", "\\b", "\\t", "\\n", "\\v", "\\f", "\\r"})[c:byte()] + return ({[7] = "\\a", [8] = "\\b", [9] = "\\t", [10] = "\\n", [11] = "\\v", [12] = "\\f", [13] = "\\r"})[c:byte()] end local function parse_string() table.insert(stack, {closer = 34}) local chars = {34} if not parse_string_loop(chars, getb(), "base") then badend() + else end table.remove(stack) local raw = string.char(unpack(chars)) local formatted = raw:gsub("[\7-\13]", escape_char) - local _1_0 = (rawget(_G, "loadstring") or load)(("return " .. formatted)) - if (nil ~= _1_0) then - local load_fn = _1_0 + local _204_ = (rawget(_G, "loadstring") or load)(("return " .. formatted)) + if (nil ~= _204_) then + local load_fn = _204_ return dispatch(load_fn()) - elseif (_1_0 == nil) then + elseif (_204_ == nil) then return parse_error(("Invalid string: " .. raw)) + else + return nil end end local function parse_prefix(b) - table.insert(stack, {bytestart = byteindex, filename = filename, line = line, prefix = prefixes[b]}) + table.insert(stack, {prefix = prefixes[b], filename = filename, line = line, bytestart = byteindex}) local nextb = getb() if (whitespace_3f(nextb) or (true == delims[nextb])) then if (b ~= 35) then parse_error("invalid whitespace after quoting prefix") + else end table.remove(stack) dispatch(utils.sym("#")) + else end return ungetb(nextb) end @@ -3317,6 +3697,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" else if b then ungetb(b) + else end return chars end @@ -3327,24 +3708,28 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" dispatch((tonumber(number_with_stripped_underscores) or parse_error(("could not read number \"" .. rawstr .. "\"")))) return true else - local _0_0 = tonumber(number_with_stripped_underscores) - if (nil ~= _0_0) then - local x = _0_0 + local _210_ = tonumber(number_with_stripped_underscores) + if (nil ~= _210_) then + local x = _210_ dispatch(x) return true - else - local _ = _0_0 + elseif true then + local _ = _210_ return false + else + return nil end end end local function check_malformed_sym(rawstr) if (rawstr:match("^~") and (rawstr ~= "~=")) then - return parse_error("illegal character: ~") + return parse_error("invalid character: ~") elseif rawstr:match("%.[0-9]") then return parse_error(("can't start multisym segment with a digit: " .. rawstr), (((byteindex - #rawstr) + rawstr:find("%.[0-9]")) + 1)) elseif (rawstr:match("[%.:][%.:]") and (rawstr ~= "..") and (rawstr ~= "$...")) then return parse_error(("malformed multisym: " .. rawstr), ((byteindex - #rawstr) + 1 + rawstr:find("[%.:][%.:]"))) + elseif ((rawstr ~= ":") and rawstr:match(":$")) then + return parse_error(("malformed multisym: " .. rawstr), ((byteindex - #rawstr) + 1 + rawstr:find(":$"))) elseif rawstr:match(":.+[%.:]") then return parse_error(("method must be last component of multisym: " .. rawstr), ((byteindex - #rawstr) + rawstr:find(":.+[%.:]"))) else @@ -3354,16 +3739,19 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" local function parse_sym(b) local bytestart = byteindex local rawstr = string.char(unpack(parse_sym_loop({b}, getb()))) + local source0 = {byteend = byteindex, bytestart = bytestart, filename = filename, line = line} if (rawstr == "true") then return dispatch(true) elseif (rawstr == "false") then return dispatch(false) elseif (rawstr == "...") then - return dispatch(utils.varg()) + return dispatch(utils.varg(source0)) elseif rawstr:match("^:.+$") then return dispatch(rawstr:sub(2)) elseif not parse_number(rawstr) then - return dispatch(utils.sym(check_malformed_sym(rawstr), {byteend = byteindex, bytestart = bytestart, filename = filename, line = line})) + return dispatch(utils.sym(check_malformed_sym(rawstr), source0)) + else + return nil end end local function parse_loop(b) @@ -3380,8 +3768,9 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" parse_prefix(b) elseif (sym_char_3f(b) or (b == string.byte("~"))) then parse_sym(b) + elseif not utils.hook("illegal-char", b, getb, ungetb, dispatch) then + parse_error(("invalid character: " .. string.char(b))) else - parse_error(("illegal character: " .. string.char(b))) end if not b then return nil @@ -3393,37 +3782,659 @@ package.preload["conjure-macroexpand.aniseed.fennel.parser"] = package.preload[" end return parse_loop(skip_whitespace(getb())) end - local function _0_() - stack = {} + local function _217_() + stack, line, byteindex, lastb = {}, 1, 0, nil return nil end - return parse_stream, _0_ + return parse_stream, _217_ end - return {["string-stream"] = string_stream, ["sym-char?"] = sym_char_3f, granulate = granulate, parser = parser} + local function parser(stream_or_string, _3ffilename, _3foptions) + local filename = (_3ffilename or "unknown") + local options = (_3foptions or utils.root.options or {}) + assert(("string" == type(filename)), "expected filename as second argument to parser") + if ("string" == type(stream_or_string)) then + return parser_fn(string_stream(stream_or_string), filename, options) + else + return parser_fn(stream_or_string, filename, options) + end + end + return {granulate = granulate, parser = parser, ["string-stream"] = string_stream, ["sym-char?"] = sym_char_3f} +end +local utils +package.preload["conjure-macroexpand.aniseed.fennel.view"] = package.preload["conjure-macroexpand.aniseed.fennel.view"] or function(...) + local type_order = {number = 1, boolean = 2, string = 3, table = 4, ["function"] = 5, userdata = 6, thread = 7} + local lua_pairs = pairs + local lua_ipairs = ipairs + local function pairs(t) + local _1_ = getmetatable(t) + if ((_G.type(_1_) == "table") and (nil ~= (_1_).__pairs)) then + local p = (_1_).__pairs + return p(t) + elseif true then + local _ = _1_ + return lua_pairs(t) + else + return nil + end + end + local function ipairs(t) + local _3_ = getmetatable(t) + if ((_G.type(_3_) == "table") and (nil ~= (_3_).__ipairs)) then + local i = (_3_).__ipairs + return i(t) + elseif true then + local _ = _3_ + return lua_ipairs(t) + else + return nil + end + end + local function length_2a(t) + local _5_ = getmetatable(t) + if ((_G.type(_5_) == "table") and (nil ~= (_5_).__len)) then + local l = (_5_).__len + return l(t) + elseif true then + local _ = _5_ + return #t + else + return nil + end + end + local function sort_keys(_7_, _9_) + local _arg_8_ = _7_ + local a = _arg_8_[1] + local _arg_10_ = _9_ + local b = _arg_10_[1] + local ta = type(a) + local tb = type(b) + if ((ta == tb) and ((ta == "string") or (ta == "number"))) then + return (a < b) + else + local dta = type_order[ta] + local dtb = type_order[tb] + if (dta and dtb) then + return (dta < dtb) + elseif dta then + return true + elseif dtb then + return false + else + return (ta < tb) + end + end + end + local function max_index_gap(kv) + local gap = 0 + if (length_2a(kv) > 0) then + local i = 0 + for _, _13_ in ipairs(kv) do + local _each_14_ = _13_ + local k = _each_14_[1] + if ((k - i) > gap) then + gap = (k - i) + else + end + i = k + end + else + end + return gap + end + local function fill_gaps(kv) + local missing_indexes = {} + local i = 0 + for _, _17_ in ipairs(kv) do + local _each_18_ = _17_ + local j = _each_18_[1] + i = (i + 1) + while (i < j) do + table.insert(missing_indexes, i) + i = (i + 1) + end + end + for _, k in ipairs(missing_indexes) do + table.insert(kv, k, {k}) + end + return nil + end + local function table_kv_pairs(t, options) + local assoc_3f = false + local kv = {} + local insert = table.insert + for k, v in pairs(t) do + if ((type(k) ~= "number") or (k < 1)) then + assoc_3f = true + else + end + insert(kv, {k, v}) + end + table.sort(kv, sort_keys) + if not assoc_3f then + if (max_index_gap(kv) > options["max-sparse-gap"]) then + assoc_3f = true + else + fill_gaps(kv) + end + else + end + if (length_2a(kv) == 0) then + return kv, "empty" + else + local function _22_() + if assoc_3f then + return "table" + else + return "seq" + end + end + return kv, _22_() + end + end + local function count_table_appearances(t, appearances) + if (type(t) == "table") then + if not appearances[t] then + appearances[t] = 1 + for k, v in pairs(t) do + count_table_appearances(k, appearances) + count_table_appearances(v, appearances) + end + else + appearances[t] = ((appearances[t] or 0) + 1) + end + else + end + return appearances + end + local function save_table(t, seen) + local seen0 = (seen or {len = 0}) + local id = (seen0.len + 1) + if not (seen0)[t] then + seen0[t] = id + seen0.len = id + else + end + return seen0 + end + local function detect_cycle(t, seen, _3fk) + if ("table" == type(t)) then + seen[t] = true + local _27_, _28_ = next(t, _3fk) + if ((nil ~= _27_) and (nil ~= _28_)) then + local k = _27_ + local v = _28_ + return (seen[k] or detect_cycle(k, seen) or seen[v] or detect_cycle(v, seen) or detect_cycle(t, seen, k)) + else + return nil + end + else + return nil + end + end + local function visible_cycle_3f(t, options) + return (options["detect-cycles?"] and detect_cycle(t, {}) and save_table(t, options.seen) and (1 < (options.appearances[t] or 0))) + end + local function table_indent(indent, id) + local opener_length + if id then + opener_length = (length_2a(tostring(id)) + 2) + else + opener_length = 1 + end + return (indent + opener_length) + end + local pp = nil + local function concat_table_lines(elements, options, multiline_3f, indent, table_type, prefix) + local indent_str = ("\n" .. string.rep(" ", indent)) + local open + local function _32_() + if ("seq" == table_type) then + return "[" + else + return "{" + end + end + open = ((prefix or "") .. _32_()) + local close + if ("seq" == table_type) then + close = "]" + else + close = "}" + end + local oneline = (open .. table.concat(elements, " ") .. close) + if (not options["one-line?"] and (multiline_3f or ((indent + length_2a(oneline)) > options["line-length"]))) then + return (open .. table.concat(elements, indent_str) .. close) + else + return oneline + end + end + local function utf8_len(x) + local n = 0 + for _ in string.gmatch(x, "[%z\1-\127\192-\247]") do + n = (n + 1) + end + return n + end + local function pp_associative(t, kv, options, indent) + local multiline_3f = false + local id = options.seen[t] + if (options.level >= options.depth) then + return "{...}" + elseif (id and options["detect-cycles?"]) then + return ("@" .. id .. "{...}") + else + local visible_cycle_3f0 = visible_cycle_3f(t, options) + local id0 = (visible_cycle_3f0 and options.seen[t]) + local indent0 = table_indent(indent, id0) + local slength + if options["utf8?"] then + slength = utf8_len + else + local function _35_(_241) + return #_241 + end + slength = _35_ + end + local prefix + if visible_cycle_3f0 then + prefix = ("@" .. id0) + else + prefix = "" + end + local items + do + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto + for _, _38_ in pairs(kv) do + local _each_39_ = _38_ + local k = _each_39_[1] + local v = _each_39_[2] + local val_16_auto + do + local k0 = pp(k, options, (indent0 + 1), true) + local v0 = pp(v, options, (indent0 + slength(k0) + 1)) + multiline_3f = (multiline_3f or k0:find("\n") or v0:find("\n")) + val_16_auto = (k0 .. " " .. v0) + end + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end + end + items = tbl_14_auto + end + return concat_table_lines(items, options, multiline_3f, indent0, "table", prefix) + end + end + local function pp_sequence(t, kv, options, indent) + local multiline_3f = false + local id = options.seen[t] + if (options.level >= options.depth) then + return "[...]" + elseif (id and options["detect-cycles?"]) then + return ("@" .. id .. "[...]") + else + local visible_cycle_3f0 = visible_cycle_3f(t, options) + local id0 = (visible_cycle_3f0 and options.seen[t]) + local indent0 = table_indent(indent, id0) + local prefix + if visible_cycle_3f0 then + prefix = ("@" .. id0) + else + prefix = "" + end + local items + do + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto + for _, _43_ in pairs(kv) do + local _each_44_ = _43_ + local _0 = _each_44_[1] + local v = _each_44_[2] + local val_16_auto + do + local v0 = pp(v, options, indent0) + multiline_3f = (multiline_3f or v0:find("\n")) + val_16_auto = v0 + end + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end + end + items = tbl_14_auto + end + return concat_table_lines(items, options, multiline_3f, indent0, "seq", prefix) + end + end + local function concat_lines(lines, options, indent, force_multi_line_3f) + if (length_2a(lines) == 0) then + if options["empty-as-sequence?"] then + return "[]" + else + return "{}" + end + else + local oneline + local _48_ + do + local tbl_14_auto = {} + local i_15_auto = #tbl_14_auto + for _, line in ipairs(lines) do + local val_16_auto = line:gsub("^%s+", "") + if (nil ~= val_16_auto) then + i_15_auto = (i_15_auto + 1) + do end (tbl_14_auto)[i_15_auto] = val_16_auto + else + end + end + _48_ = tbl_14_auto + end + oneline = table.concat(_48_, " ") + if (not options["one-line?"] and (force_multi_line_3f or oneline:find("\n") or ((indent + length_2a(oneline)) > options["line-length"]))) then + return table.concat(lines, ("\n" .. string.rep(" ", indent))) + else + return oneline + end + end + end + local function pp_metamethod(t, metamethod, options, indent) + if (options.level >= options.depth) then + if options["empty-as-sequence?"] then + return "[...]" + else + return "{...}" + end + else + local _ + local function _53_(_241) + return visible_cycle_3f(_241, options) + end + options["visible-cycle?"] = _53_ + _ = nil + local lines, force_multi_line_3f = metamethod(t, pp, options, indent) + options["visible-cycle?"] = nil + local _54_ = type(lines) + if (_54_ == "string") then + return lines + elseif (_54_ == "table") then + return concat_lines(lines, options, indent, force_multi_line_3f) + elseif true then + local _0 = _54_ + return error("__fennelview metamethod must return a table of lines") + else + return nil + end + end + end + local function pp_table(x, options, indent) + options.level = (options.level + 1) + local x0 + do + local _57_ + if options["metamethod?"] then + local _58_ = x + if (nil ~= _58_) then + local _59_ = getmetatable(_58_) + if (nil ~= _59_) then + _57_ = (_59_).__fennelview + else + _57_ = _59_ + end + else + _57_ = _58_ + end + else + _57_ = nil + end + if (nil ~= _57_) then + local metamethod = _57_ + x0 = pp_metamethod(x, metamethod, options, indent) + elseif true then + local _ = _57_ + local _63_, _64_ = table_kv_pairs(x, options) + if (true and (_64_ == "empty")) then + local _0 = _63_ + if options["empty-as-sequence?"] then + x0 = "[]" + else + x0 = "{}" + end + elseif ((nil ~= _63_) and (_64_ == "table")) then + local kv = _63_ + x0 = pp_associative(x, kv, options, indent) + elseif ((nil ~= _63_) and (_64_ == "seq")) then + local kv = _63_ + x0 = pp_sequence(x, kv, options, indent) + else + x0 = nil + end + else + x0 = nil + end + end + options.level = (options.level - 1) + return x0 + end + local function number__3estring(n) + local _68_ = string.gsub(tostring(n), ",", ".") + return _68_ + end + local function colon_string_3f(s) + return s:find("^[-%w?^_!$%&*+./@|<=>]+$") + end + local utf8_inits = {{["min-byte"] = 0, ["max-byte"] = 127, ["min-code"] = 0, ["max-code"] = 127, len = 1}, {["min-byte"] = 192, ["max-byte"] = 223, ["min-code"] = 128, ["max-code"] = 2047, len = 2}, {["min-byte"] = 224, ["max-byte"] = 239, ["min-code"] = 2048, ["max-code"] = 65535, len = 3}, {["min-byte"] = 240, ["max-byte"] = 247, ["min-code"] = 65536, ["max-code"] = 1114111, len = 4}} + local function utf8_escape(str) + local function validate_utf8(str0, index) + local inits = utf8_inits + local byte = string.byte(str0, index) + local init + do + local ret = nil + for _, init0 in ipairs(inits) do + if ret then break end + ret = (byte and (function(_69_,_70_,_71_) return (_69_ >= _70_) and (_70_ >= _71_) end)(init0["max-byte"],byte,init0["min-byte"]) and init0) + end + init = ret + end + local code + local function _72_() + local code0 + if init then + code0 = (byte - init["min-byte"]) + else + code0 = nil + end + for i = (index + 1), (index + init.len + -1) do + local byte0 = string.byte(str0, i) + code0 = (byte0 and code0 and (function(_74_,_75_,_76_) return (_74_ >= _75_) and (_75_ >= _76_) end)(191,byte0,128) and ((code0 * 64) + (byte0 - 128))) + end + return code0 + end + code = (init and _72_()) + if (code and (function(_77_,_78_,_79_) return (_77_ >= _78_) and (_78_ >= _79_) end)(init["max-code"],code,init["min-code"]) and not (function(_80_,_81_,_82_) return (_80_ >= _81_) and (_81_ >= _82_) end)(57343,code,55296)) then + return init.len + else + return nil + end + end + local index = 1 + local output = {} + while (index <= #str) do + local nexti = (string.find(str, "[\128-\255]", index) or (#str + 1)) + local len = validate_utf8(str, nexti) + table.insert(output, string.sub(str, index, (nexti + (len or 0) + -1))) + if (not len and (nexti <= #str)) then + table.insert(output, string.format("\\%03d", string.byte(str, nexti))) + else + end + if len then + index = (nexti + len) + else + index = (nexti + 1) + end + end + return table.concat(output) + end + local function pp_string(str, options, indent) + local escs + local _86_ + if (options["escape-newlines?"] and (length_2a(str) < (options["line-length"] - indent))) then + _86_ = "\\n" + else + _86_ = "\n" + end + local function _88_(_241, _242) + return ("\\%03d"):format(_242:byte()) + end + escs = setmetatable({["\7"] = "\\a", ["\8"] = "\\b", ["\12"] = "\\f", ["\11"] = "\\v", ["\13"] = "\\r", ["\9"] = "\\t", ["\\"] = "\\\\", ["\""] = "\\\"", ["\n"] = _86_}, {__index = _88_}) + local str0 = ("\"" .. str:gsub("[%c\\\"]", escs) .. "\"") + if options["utf8?"] then + return utf8_escape(str0) + else + return str0 + end + end + local function make_options(t, options) + local defaults = {["line-length"] = 80, ["one-line?"] = false, depth = 128, ["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["metamethod?"] = true, ["prefer-colon?"] = false, ["escape-newlines?"] = false, ["utf8?"] = true, ["max-sparse-gap"] = 10} + local overrides = {level = 0, appearances = count_table_appearances(t, {}), seen = {len = 0}} + for k, v in pairs((options or {})) do + defaults[k] = v + end + for k, v in pairs(overrides) do + defaults[k] = v + end + return defaults + end + local function _90_(x, options, indent, colon_3f) + local indent0 = (indent or 0) + local options0 = (options or make_options(x)) + local x0 + if options0.preprocess then + x0 = options0.preprocess(x, options0) + else + x0 = x + end + local tv = type(x0) + local function _93_() + local _92_ = getmetatable(x0) + if (nil ~= _92_) then + return (_92_).__fennelview + else + return _92_ + end + end + if ((tv == "table") or ((tv == "userdata") and _93_())) then + return pp_table(x0, options0, indent0) + elseif (tv == "number") then + return number__3estring(x0) + else + local function _95_() + if (colon_3f ~= nil) then + return colon_3f + elseif ("function" == type(options0["prefer-colon?"])) then + return options0["prefer-colon?"](x0) + else + return options0["prefer-colon?"] + end + end + if ((tv == "string") and colon_string_3f(x0) and _95_()) then + return (":" .. x0) + elseif (tv == "string") then + return pp_string(x0, options0, indent0) + elseif ((tv == "boolean") or (tv == "nil")) then + return tostring(x0) + else + return ("#<" .. tostring(x0) .. ">") + end + end + end + pp = _90_ + local function view(x, _3foptions) + return pp(x, make_options(x, _3foptions), 0) + end + return view end -local utils = nil package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["conjure-macroexpand.aniseed.fennel.utils"] or function(...) + local view = require("conjure-macroexpand.aniseed.fennel.view") + local version = "1.1.0" + local function luajit_vm_3f() + return ((nil ~= jit) and (type(jit) == "table") and (nil ~= jit.on) and (nil ~= jit.off) and (type(jit.version_num) == "number")) + end + local function luajit_vm_version() + local jit_os + if (jit.os == "OSX") then + jit_os = "macOS" + else + jit_os = jit.os + end + return (jit.version .. " " .. jit_os .. "/" .. jit.arch) + end + local function fengari_vm_3f() + return ((nil ~= fengari) and (type(fengari) == "table") and (nil ~= fengari.VERSION) and (type(fengari.VERSION_NUM) == "number")) + end + local function fengari_vm_version() + return (fengari.RELEASE .. " (" .. _VERSION .. ")") + end + local function lua_vm_version() + if luajit_vm_3f() then + return luajit_vm_version() + elseif fengari_vm_3f() then + return fengari_vm_version() + else + return ("PUC " .. _VERSION) + end + end + local function runtime_version() + return ("Fennel " .. version .. " on " .. lua_vm_version()) + end + local function warn(message) + if (_G.io and _G.io.stderr) then + return (_G.io.stderr):write(("--WARNING: %s\n"):format(tostring(message))) + else + return nil + end + end local function stablepairs(t) local keys = {} + local used_keys = {} local succ = {} - for k in pairs(t) do - table.insert(keys, k) + if (getmetatable(t) and getmetatable(t).keys) then + for _, k in ipairs(getmetatable(t).keys) do + if used_keys[k] then + for i = #keys, 1, -1 do + if (keys[i] == k) then + table.remove(keys, i) + else + end + end + else + end + used_keys[k] = true + table.insert(keys, k) + end + else + for k in pairs(t) do + table.insert(keys, k) + end + local function _102_(_241, _242) + return (tostring(_241) < tostring(_242)) + end + table.sort(keys, _102_) end - local function _0_(_241, _242) - return (tostring(_241) < tostring(_242)) - end - table.sort(keys, _0_) for i, k in ipairs(keys) do succ[k] = keys[(i + 1)] end local function stablenext(tbl, idx) - local key = nil + local key if (idx == nil) then key = keys[1] else key = succ[idx] end - local value = nil + local value if (key == nil) then value = nil else @@ -3433,66 +4444,76 @@ package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["c end return stablenext, t, nil end - local function map(t, f, out) - local out0 = (out or {}) - local f0 = nil + local function map(t, f, _3fout) + local out = (_3fout or {}) + local f0 if (type(f) == "function") then f0 = f else - local function _0_(_241) - return _241[f] + local function _106_(_241) + return (_241)[f] end - f0 = _0_ + f0 = _106_ end for _, x in ipairs(t) do - local _1_0 = f0(x) - if (nil ~= _1_0) then - local v = _1_0 - table.insert(out0, v) + local _108_ = f0(x) + if (nil ~= _108_) then + local v = _108_ + table.insert(out, v) + else end end - return out0 + return out end - local function kvmap(t, f, out) - local out0 = (out or {}) - local f0 = nil + local function kvmap(t, f, _3fout) + local out = (_3fout or {}) + local f0 if (type(f) == "function") then f0 = f else - local function _0_(_241) - return _241[f] + local function _110_(_241) + return (_241)[f] end - f0 = _0_ + f0 = _110_ end for k, x in stablepairs(t) do - local _1_0, _2_0 = f0(k, x) - if ((nil ~= _1_0) and (nil ~= _2_0)) then - local key = _1_0 - local value = _2_0 - out0[key] = value - elseif (nil ~= _1_0) then - local value = _1_0 - table.insert(out0, value) + local _112_, _113_ = f0(k, x) + if ((nil ~= _112_) and (nil ~= _113_)) then + local key = _112_ + local value = _113_ + out[key] = value + elseif (nil ~= _112_) then + local value = _112_ + table.insert(out, value) + else end end - return out0 + return out end - local function copy(from, to) - local to0 = (to or {}) + local function copy(from, _3fto) + local tbl_11_auto = (_3fto or {}) for k, v in pairs((from or {})) do - to0[k] = v + local _115_, _116_ = k, v + if ((nil ~= _115_) and (nil ~= _116_)) then + local k_12_auto = _115_ + local v_13_auto = _116_ + tbl_11_auto[k_12_auto] = v_13_auto + else + end end - return to0 + return tbl_11_auto end - local function member_3f(x, tbl, n) - local _0_0 = tbl[(n or 1)] - if (_0_0 == x) then + local function member_3f(x, tbl, _3fn) + local _118_ = tbl[(_3fn or 1)] + if (_118_ == x) then return true - elseif (_0_0 == nil) then + elseif (_118_ == nil) then return nil + elseif true then + local _ = _118_ + return member_3f(x, tbl, ((_3fn or 1) + 1)) else - local _ = _0_0 - return member_3f(x, tbl, ((n or 1) + 1)) + return nil end end local function allpairs(tbl) @@ -3507,10 +4528,17 @@ package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["c seen[next_state] = true return next_state, value else - local meta = getmetatable(t) - if (meta and meta.__index) then - t = meta.__index - return allpairs_next(t) + local _120_ = getmetatable(t) + if ((_G.type(_120_) == "table") and true) then + local __index = (_120_).__index + if ("table" == type(__index)) then + t = __index + return allpairs_next(t) + else + return nil + end + else + return nil end end end @@ -3520,17 +4548,18 @@ package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["c return self[1] end local nil_sym = nil - local function list__3estring(self, tostring2) + local function list__3estring(self, _3ftostring2) local safe, max = {}, 0 for k in pairs(self) do if ((type(k) == "number") and (k > max)) then max = k + else end end for i = 1, max do safe[i] = (((self[i] == nil) and nil_sym) or self[i]) end - return ("(" .. table.concat(map(safe, (tostring2 or tostring)), " ", 1, max) .. ")") + return ("(" .. table.concat(map(safe, (_3ftostring2 or view)), " ", 1, max) .. ")") end local function comment_view(c) return c, true @@ -3541,17 +4570,21 @@ package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["c local function sym_3c(a, b) return (a[1] < tostring(b)) end - local symbol_mt = {"SYMBOL", __eq = sym_3d, __fennelview = deref, __lt = sym_3c, __tostring = deref} - local expr_mt = {"EXPR", __tostring = deref} - local list_mt = {"LIST", __fennelview = list__3estring, __tostring = list__3estring} - local comment_mt = {"COMMENT", __eq = sym_3d, __fennelview = comment_view, __lt = sym_3c, __tostring = deref} + local symbol_mt = {__fennelview = deref, __tostring = deref, __eq = sym_3d, __lt = sym_3c, "SYMBOL"} + local expr_mt + local function _125_(x) + return tostring(deref(x)) + end + expr_mt = {__tostring = _125_, "EXPR"} + local list_mt = {__fennelview = list__3estring, __tostring = list__3estring, "LIST"} + local comment_mt = {__fennelview = comment_view, __tostring = deref, __eq = sym_3d, __lt = sym_3c, "COMMENT"} local sequence_marker = {"SEQUENCE"} - local vararg = setmetatable({"..."}, {"VARARG", __fennelview = deref, __tostring = deref}) - local getenv = nil - local function _0_() + local varg_mt = {__fennelview = deref, __tostring = deref, "VARARG"} + local getenv + local function _126_() return nil end - getenv = ((os and os.getenv) or _0_) + getenv = ((os and os.getenv) or _126_) local function debug_on_3f(flag) local level = (getenv("FENNEL_DEBUG") or "") return ((level == "all") or level:find(flag)) @@ -3559,36 +4592,68 @@ package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["c local function list(...) return setmetatable({...}, list_mt) end - local function sym(str, _3fsource, _3fscope) - local s = {str, ["?scope"] = _3fscope} - for k, v in pairs((_3fsource or {})) do - if (type(k) == "string") then - s[k] = v + local function sym(str, _3fsource) + local _127_ + do + local tbl_11_auto = {str} + for k, v in pairs((_3fsource or {})) do + local _128_, _129_ = nil, nil + if (type(k) == "string") then + _128_, _129_ = k, v + else + _128_, _129_ = nil + end + if ((nil ~= _128_) and (nil ~= _129_)) then + local k_12_auto = _128_ + local v_13_auto = _129_ + tbl_11_auto[k_12_auto] = v_13_auto + else + end end + _127_ = tbl_11_auto end - return setmetatable(s, symbol_mt) + return setmetatable(_127_, symbol_mt) end nil_sym = sym("nil") local function sequence(...) return setmetatable({...}, {sequence = sequence_marker}) end local function expr(strcode, etype) - return setmetatable({strcode, type = etype}, expr_mt) + return setmetatable({type = etype, strcode}, expr_mt) end local function comment_2a(contents, _3fsource) - local _1_ = (_3fsource or {}) - local filename = _1_["filename"] - local line = _1_["line"] - return setmetatable({contents, filename = filename, line = line}, comment_mt) + local _let_132_ = (_3fsource or {}) + local filename = _let_132_["filename"] + local line = _let_132_["line"] + return setmetatable({filename = filename, line = line, contents}, comment_mt) end - local function varg() - return vararg + local function varg(_3fsource) + local _133_ + do + local tbl_11_auto = {"..."} + for k, v in pairs((_3fsource or {})) do + local _134_, _135_ = nil, nil + if (type(k) == "string") then + _134_, _135_ = k, v + else + _134_, _135_ = nil + end + if ((nil ~= _134_) and (nil ~= _135_)) then + local k_12_auto = _134_ + local v_13_auto = _135_ + tbl_11_auto[k_12_auto] = v_13_auto + else + end + end + _133_ = tbl_11_auto + end + return setmetatable(_133_, varg_mt) end local function expr_3f(x) return ((type(x) == "table") and (getmetatable(x) == expr_mt) and x) end local function varg_3f(x) - return ((x == vararg) and x) + return ((type(x) == "table") and (getmetatable(x) == varg_mt) and x) end local function list_3f(x) return ((type(x) == "table") and (getmetatable(x) == list_mt) and x) @@ -3604,7 +4669,10 @@ package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["c return ((type(x) == "table") and (getmetatable(x) == comment_mt) and x) end local function table_3f(x) - return ((type(x) == "table") and (x ~= vararg) and (getmetatable(x) ~= list_mt) and (getmetatable(x) ~= symbol_mt) and not comment_3f(x) and x) + return ((type(x) == "table") and not varg_3f(x) and (getmetatable(x) ~= list_mt) and (getmetatable(x) ~= symbol_mt) and not comment_3f(x) and x) + end + local function string_3f(x) + return (type(x) == "string") end local function multi_sym_3f(str) if sym_3f(str) then @@ -3617,6 +4685,7 @@ package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["c local last_char = part:sub(( - 1)) if (last_char == ":") then parts["multi-sym-method-call"] = true + else end if ((last_char == ":") or (last_char == ".")) then parts[(#parts + 1)] = part:sub(1, ( - 2)) @@ -3630,16 +4699,27 @@ package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["c local function quoted_3f(symbol) return symbol.quoted end - local function walk_tree(root, f, custom_iterator) + local function ast_source(ast) + if table_3f(ast) then + return (getmetatable(ast) or {}) + elseif ("table" == type(ast)) then + return ast + else + return {} + end + end + local function walk_tree(root, f, _3fcustom_iterator) local function walk(iterfn, parent, idx, node) if f(idx, node, parent) then for k, v in iterfn(node) do walk(iterfn, node, k, v) end return nil + else + return nil end end - walk((custom_iterator or pairs), nil, nil, root) + walk((_3fcustom_iterator or pairs), nil, nil, root) return root end local lua_keywords = {"and", "break", "do", "else", "elseif", "end", "false", "for", "function", "if", "in", "local", "nil", "not", "or", "repeat", "return", "then", "true", "until", "while", "goto"} @@ -3656,35 +4736,53 @@ package.preload["conjure-macroexpand.aniseed.fennel.utils"] = package.preload["c end return subopts end - local root = nil - local function _1_() + local root + local function _143_() end - root = {chunk = nil, options = nil, reset = _1_, scope = nil} - root["set-reset"] = function(_2_0) - local _3_ = _2_0 - local chunk = _3_["chunk"] - local options = _3_["options"] - local reset = _3_["reset"] - local scope = _3_["scope"] + root = {chunk = nil, scope = nil, options = nil, reset = _143_} + root["set-reset"] = function(_144_) + local _arg_145_ = _144_ + local chunk = _arg_145_["chunk"] + local scope = _arg_145_["scope"] + local options = _arg_145_["options"] + local reset = _arg_145_["reset"] root.reset = function() root.chunk, root.scope, root.options, root.reset = chunk, scope, options, reset return nil end return root.reset end - local function hook(event, ...) - if (root.options and root.options.plugins) then - for _, plugin in ipairs(root.options.plugins) do - local _3_0 = plugin[event] - if (nil ~= _3_0) then - local f = _3_0 - f(...) - end - end + local warned = {} + local function check_plugin_version(_146_) + local _arg_147_ = _146_ + local name = _arg_147_["name"] + local versions = _arg_147_["versions"] + local plugin = _arg_147_ + if (not member_3f(version:gsub("-dev", ""), (versions or {})) and not warned[plugin]) then + warned[plugin] = true + return warn(string.format("plugin %s does not support Fennel version %s", (name or "unknown"), version)) + else return nil end end - return {["comment?"] = comment_3f, ["debug-on?"] = debug_on_3f, ["expr?"] = expr_3f, ["list?"] = list_3f, ["lua-keywords"] = lua_keywords, ["member?"] = member_3f, ["multi-sym?"] = multi_sym_3f, ["propagate-options"] = propagate_options, ["quoted?"] = quoted_3f, ["sequence?"] = sequence_3f, ["sym?"] = sym_3f, ["table?"] = table_3f, ["valid-lua-identifier?"] = valid_lua_identifier_3f, ["varg?"] = varg_3f, ["walk-tree"] = walk_tree, allpairs = allpairs, comment = comment_2a, copy = copy, deref = deref, expr = expr, hook = hook, kvmap = kvmap, list = list, map = map, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), root = root, sequence = sequence, stablepairs = stablepairs, sym = sym, varg = varg} + local function hook(event, ...) + local result = nil + if (root.options and root.options.plugins) then + for _, plugin in ipairs(root.options.plugins) do + if result then break end + check_plugin_version(plugin) + local _149_ = plugin[event] + if (nil ~= _149_) then + local f = _149_ + result = f(...) + else + end + end + else + end + return result + end + return {warn = warn, allpairs = allpairs, stablepairs = stablepairs, copy = copy, kvmap = kvmap, map = map, ["walk-tree"] = walk_tree, ["member?"] = member_3f, list = list, sequence = sequence, sym = sym, varg = varg, expr = expr, comment = comment_2a, ["comment?"] = comment_3f, ["expr?"] = expr_3f, ["list?"] = list_3f, ["multi-sym?"] = multi_sym_3f, ["sequence?"] = sequence_3f, ["sym?"] = sym_3f, ["table?"] = table_3f, ["varg?"] = varg_3f, ["quoted?"] = quoted_3f, ["string?"] = string_3f, ["valid-lua-identifier?"] = valid_lua_identifier_3f, ["lua-keywords"] = lua_keywords, hook = hook, ["propagate-options"] = propagate_options, root = root, ["debug-on?"] = debug_on_3f, ["ast-source"] = ast_source, version = version, ["runtime-version"] = runtime_version, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), ["macro-path"] = table.concat({"./?.fnl", "./?/init-macros.fnl", "./?/init.fnl", getenv("FENNEL_MACRO_PATH")}, ";")} end utils = require("conjure-macroexpand.aniseed.fennel.utils") local parser = require("conjure-macroexpand.aniseed.fennel.parser") @@ -3692,11 +4790,13 @@ local compiler = require("conjure-macroexpand.aniseed.fennel.compiler") local specials = require("conjure-macroexpand.aniseed.fennel.specials") local repl = require("conjure-macroexpand.aniseed.fennel.repl") local view = require("conjure-macroexpand.aniseed.fennel.view") -local function eval_env(env) +local function eval_env(env, opts) if (env == "_COMPILER") then - local env0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {}) - local mt = getmetatable(env0) - mt.__index = _G + local env0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {}, opts) + if (opts.allowedGlobals == nil) then + opts.allowedGlobals = specials["current-global-names"](env0) + else + end return specials["wrap-env"](env0) else return (env and specials["wrap-env"](env)) @@ -3704,30 +4804,33 @@ local function eval_env(env) end local function eval_opts(options, str) local opts = utils.copy(options) - if ((opts.allowedGlobals == nil) and not getmetatable(opts.env)) then + if (opts.allowedGlobals == nil) then opts.allowedGlobals = specials["current-global-names"](opts.env) + else end if (not opts.filename and not opts.source) then opts.source = str + else end if (opts.env == "_COMPILER") then opts.scope = compiler["make-scope"](compiler.scopes.compiler) + else end return opts end local function eval(str, options, ...) local opts = eval_opts(options, str) - local env = eval_env(opts.env) + local env = eval_env(opts.env, opts) local lua_source = compiler["compile-string"](str, opts) - local loader = nil - local function _0_(...) + local loader + local function _678_(...) if opts.filename then return ("@" .. opts.filename) else return str end end - loader = specials["load-code"](lua_source, env, _0_(...)) + loader = specials["load-code"](lua_source, env, _678_(...)) opts.filename = nil return loader(...) end @@ -3740,42 +4843,44 @@ local function dofile_2a(filename, options, ...) return eval(source, opts, ...) end local function syntax() - local body_3f = {"when", "with-open", "collect", "icollect", "lambda", "\206\187", "macro", "match"} - local binding_3f = {"collect", "icollect", "each", "for", "let", "with-open"} + local body_3f = {"when", "with-open", "collect", "icollect", "lambda", "\206\187", "macro", "match", "accumulate"} + local binding_3f = {"collect", "icollect", "each", "for", "let", "with-open", "accumulate"} + local define_3f = {"fn", "lambda", "\206\187", "var", "local", "macro", "macros", "global"} local out = {} for k, v in pairs(compiler.scopes.global.specials) do local metadata = (compiler.metadata[v] or {}) - out[k] = {["binding-form?"] = utils["member?"](binding_3f, k), ["body-form?"] = metadata["fnl/body-form?"], ["special?"] = true} + do end (out)[k] = {["special?"] = true, ["body-form?"] = metadata["fnl/body-form?"], ["binding-form?"] = utils["member?"](k, binding_3f), ["define?"] = utils["member?"](k, define_3f)} end for k, v in pairs(compiler.scopes.global.macros) do - out[k] = {["binding-form?"] = utils["member?"](binding_3f, k), ["body-form?"] = utils["member?"](body_3f, k), ["macro?"] = true} + out[k] = {["macro?"] = true, ["body-form?"] = utils["member?"](k, body_3f), ["binding-form?"] = utils["member?"](k, binding_3f), ["define?"] = utils["member?"](k, define_3f)} end for k, v in pairs(_G) do - local _0_0 = type(v) - if (_0_0 == "function") then - out[k] = {["global?"] = true} - elseif (_0_0 == "table") then + local _679_ = type(v) + if (_679_ == "function") then + out[k] = {["global?"] = true, ["function?"] = true} + elseif (_679_ == "table") then for k2, v2 in pairs(v) do - if ("function" == type(v2)) then - out[(k .. "." .. k2)] = {["function?"] = true} + if (("function" == type(v2)) and (k ~= "_G")) then + out[(k .. "." .. k2)] = {["function?"] = true, ["global?"] = true} + else end end + out[k] = {["global?"] = true} + else end end return out end -local mod = {["comment?"] = utils["comment?"], ["compile-stream"] = compiler["compile-stream"], ["compile-string"] = compiler["compile-string"], ["list?"] = utils["list?"], ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["make-searcher"] = specials["make-searcher"], ["search-module"] = specials["search-module"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["sym?"] = utils["sym?"], comment = utils.comment, compile = compiler.compile, compile1 = compiler.compile1, compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], doc = specials.doc, dofile = dofile_2a, eval = eval, gensym = compiler.gensym, granulate = parser.granulate, list = utils.list, loadCode = specials["load-code"], macroLoaded = specials["macro-loaded"], makeSearcher = specials["make-searcher"], make_searcher = specials["make-searcher"], mangle = compiler["global-mangling"], metadata = compiler.metadata, parser = parser.parser, path = utils.path, repl = repl, scope = compiler["make-scope"], searchModule = specials["search-module"], searcher = specials["make-searcher"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, syntax = syntax, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.9.3-dev", view = view} +local mod = {list = utils.list, ["list?"] = utils["list?"], sym = utils.sym, ["sym?"] = utils["sym?"], sequence = utils.sequence, ["sequence?"] = utils["sequence?"], comment = utils.comment, ["comment?"] = utils["comment?"], varg = utils.varg, ["varg?"] = utils["varg?"], ["sym-char?"] = parser["sym-char?"], parser = parser.parser, compile = compiler.compile, ["compile-string"] = compiler["compile-string"], ["compile-stream"] = compiler["compile-stream"], eval = eval, repl = repl, view = view, dofile = dofile_2a, ["load-code"] = specials["load-code"], doc = specials.doc, metadata = compiler.metadata, traceback = compiler.traceback, version = utils.version, ["runtime-version"] = utils["runtime-version"], path = utils.path, ["macro-path"] = utils["macro-path"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["search-module"] = specials["search-module"], ["make-searcher"] = specials["make-searcher"], searcher = specials["make-searcher"](), syntax = syntax, gensym = compiler.gensym, scope = compiler["make-scope"], mangle = compiler["global-mangling"], unmangle = compiler["global-unmangling"], compile1 = compiler.compile1, ["string-stream"] = parser["string-stream"], granulate = parser.granulate, loadCode = specials["load-code"], make_searcher = specials["make-searcher"], makeSearcher = specials["make-searcher"], searchModule = specials["search-module"], macroPath = utils["macro-path"], macroSearchers = specials["macro-searchers"], macroLoaded = specials["macro-loaded"], compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], stringStream = parser["string-stream"], runtimeVersion = utils["runtime-version"]} utils["fennel-module"] = mod do - local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other - ;; modules that are loaded by the old bootstrap compiler, this runs in the - ;; compiler scope of the version of the compiler being defined. + local builtin_macros = [===[;; These macros are awkward because their definition cannot rely on the any + ;; built-in macros, only special forms. (no when, no icollect, etc) - ;; The code for these macros is somewhat idiosyncratic because it cannot use any - ;; macros which have not yet been defined. - - ;; TODO: some of these macros modify their arguments; we should stop doing that, - ;; but in a way that preserves file/line metadata. + (fn copy [t] + (let [out []] + (each [_ v (ipairs t)] (table.insert out v)) + (setmetatable out (getmetatable t)))) (fn ->* [val ...] "Thread-first macro. @@ -3783,7 +4888,7 @@ do The value of the second form is spliced into the first arg of the third, etc." (var x val) (each [_ e (ipairs [...])] - (let [elt (if (list? e) e (list e))] + (let [elt (copy (if (list? e) e (list e)))] (table.insert elt 2 x) (set x elt))) x) @@ -3793,40 +4898,38 @@ do Same as ->, except splices the value into the last position of each form rather than the first." (var x val) - (each [_ e (pairs [...])] - (let [elt (if (list? e) e (list e))] + (each [_ e (ipairs [...])] + (let [elt (copy (if (list? e) e (list e)))] (table.insert elt x) (set x elt))) x) - (fn -?>* [val ...] + (fn -?>* [val ?e ...] "Nil-safe thread-first macro. Same as -> except will short-circuit with nil when it encounters a nil value." - (if (= 0 (select "#" ...)) + (if (= nil ?e) val - (let [els [...] - e (table.remove els 1) + (let [e (copy ?e) el (if (list? e) e (list e)) tmp (gensym)] (table.insert el 2 tmp) `(let [,tmp ,val] - (if ,tmp - (-?> ,el ,(unpack els)) + (if (not= nil ,tmp) + (-?> ,el ,...) ,tmp))))) - (fn -?>>* [val ...] + (fn -?>>* [val ?e ...] "Nil-safe thread-last macro. Same as ->> except will short-circuit with nil when it encounters a nil value." - (if (= 0 (select "#" ...)) + (if (= nil ?e) val - (let [els [...] - e (table.remove els 1) + (let [e (copy ?e) el (if (list? e) e (list e)) tmp (gensym)] (table.insert el tmp) `(let [,tmp ,val] - (if ,tmp - (-?>> ,el ,(unpack els)) + (if (not= ,tmp nil) + (-?>> ,el ,...) ,tmp))))) (fn ?dot [tbl ...] @@ -3837,18 +4940,19 @@ do lookups `(do (var ,head ,tbl) ,head)] (each [_ k (ipairs [...])] ;; Kinda gnarly to reassign in place like this, but it emits the best lua. - ;; With this impl, it emits a flat, concise, and readable set of if blocks. + ;; With this impl, it emits a flat, concise, and readable set of ifs (table.insert lookups (# lookups) `(if (not= nil ,head) (set ,head (. ,head ,k))))) lookups)) (fn doto* [val ...] - "Evaluates val and splices it into the first argument of subsequent forms." + "Evaluate val and splice it into the first argument of subsequent forms." (let [name (gensym) form `(let [,name ,val])] - (each [_ elt (pairs [...])] - (table.insert elt 2 name) - (table.insert form elt)) + (each [_ elt (ipairs [...])] + (let [elt (copy (if (list? elt) elt (list elt)))] + (table.insert elt 2 name) + (table.insert form elt))) (table.insert form name) form)) @@ -3875,64 +4979,144 @@ do (table.insert closer 4 `(: ,(. closable-bindings i) :close))) `(let ,closable-bindings ,closer - (close-handlers# (xpcall ,bodyfn ,traceback))))) + (close-handlers# (_G.xpcall ,bodyfn ,traceback))))) - (fn collect* [iter-tbl key-value-expr ...] - "Returns a table made by running an iterator and evaluating an expression - that returns key-value pairs to be inserted sequentially into the table. - This can be thought of as a \"table comprehension\". The provided key-value - expression must return either 2 values, or nil. + (fn extract-into [iter-tbl] + (var (into iter-out found?) (values [] (copy iter-tbl))) + (for [i (length iter-tbl) 2 -1] + (if (= :into (. iter-tbl i)) + (do (assert (not found?) "expected only one :into clause") + (set found? true) + (set into (. iter-tbl (+ i 1))) + (table.remove iter-out i) + (table.remove iter-out i)))) + (assert (or (not found?) (sym? into) (table? into) (list? into)) + "expected table, function call, or symbol in :into clause") + (values into iter-out)) + + (fn collect* [iter-tbl key-expr value-expr ...] + "Return a table made by running an iterator and evaluating an expression that + returns key-value pairs to be inserted sequentially into the table. This can + be thought of as a table comprehension. The body should provide two expressions + (used as key and value) or nil, which causes it to be omitted. For example, (collect [k v (pairs {:apple \"red\" :orange \"orange\"})] (values v k)) returns - {:red \"apple\" :orange \"orange\"}" + {:red \"apple\" :orange \"orange\"} + + Supports an :into clause after the iterator to put results in an existing table. + Supports early termination with an :until clause." (assert (and (sequence? iter-tbl) (>= (length iter-tbl) 2)) "expected iterator binding table") - (assert (not= nil key-value-expr) "expected key-value expression") + (assert (not= nil key-expr) "expected key and value expression") (assert (= nil ...) - "expected exactly one body expression. Wrap multiple expressions with do") - `(let [tbl# {}] - (each ,iter-tbl - (match ,key-value-expr - (k# v#) (tset tbl# k# v#))) - tbl#)) + "expected 1 or 2 body expressions; wrap multiple expressions with do") + (let [kv-expr (if (= nil value-expr) key-expr `(values ,key-expr ,value-expr)) + (into iter) (extract-into iter-tbl)] + `(let [tbl# ,into] + (each ,iter + (match ,kv-expr + (k# v#) (tset tbl# k# v#))) + tbl#))) (fn icollect* [iter-tbl value-expr ...] - "Returns a sequential table made by running an iterator and evaluating an + "Return a sequential table made by running an iterator and evaluating an expression that returns values to be inserted sequentially into the table. - This can be thought of as a \"list comprehension\". + This can be thought of as a table comprehension. If the body evaluates to nil + that element is omitted. For example, - (icollect [_ v (ipairs [1 2 3 4 5])] (when (> v 2) (* v v))) + (icollect [_ v (ipairs [1 2 3 4 5])] + (when (not= v 3) + (* v v))) returns - [9 16 25]" + [1 4 16 25] + + Supports an :into clause after the iterator to put results in an existing table. + Supports early termination with an :until clause." (assert (and (sequence? iter-tbl) (>= (length iter-tbl) 2)) "expected iterator binding table") (assert (not= nil value-expr) "expected table value expression") + (assert (= nil ...) + "expected exactly one body expression. Wrap multiple expressions in do") + (let [(into iter) (extract-into iter-tbl)] + `(let [tbl# ,into] + ;; believe it or not, using a var here has a pretty good performance + ;; boost: https://p.hagelb.org/icollect-performance.html + (var i# (length tbl#)) + (each ,iter + (let [val# ,value-expr] + (when (not= nil val#) + (set i# (+ i# 1)) + (tset tbl# i# val#)))) + tbl#))) + + (fn accumulate* [iter-tbl body ...] + "Accumulation macro. + + It takes a binding table and an expression as its arguments. In the binding + table, the first form starts out bound to the second value, which is an initial + accumulator. The rest are an iterator binding table in the format `each` takes. + + It runs through the iterator in each step of which the given expression is + evaluated, and the accumulator is set to the value of the expression. It + eventually returns the final value of the accumulator. + + For example, + (accumulate [total 0 + _ n (pairs {:apple 2 :orange 3})] + (+ total n)) + returns 5" + (assert (and (sequence? iter-tbl) (>= (length iter-tbl) 4)) + "expected initial value and iterator binding table") + (assert (not= nil body) "expected body expression") (assert (= nil ...) "expected exactly one body expression. Wrap multiple expressions with do") - `(let [tbl# []] - (each ,iter-tbl - (tset tbl# (+ (length tbl#) 1) ,value-expr)) - tbl#)) + (let [accum-var (. iter-tbl 1) + accum-init (. iter-tbl 2)] + `(do (var ,accum-var ,accum-init) + (each ,[(unpack iter-tbl 3)] + (set ,accum-var ,body)) + ,(if (list? accum-var) + (list (sym :values) (unpack accum-var)) + accum-var)))) + + (fn double-eval-safe? [x type] + (or (= :number type) (= :string type) (= :boolean type) + (and (sym? x) (not (multi-sym? x))))) (fn partial* [f ...] - "Returns a function with all arguments partially applied to f." + "Return a function with all arguments partially applied to f." (assert f "expected a function to partially apply") - (let [body (list f ...)] - (table.insert body _VARARG) - `(fn [,_VARARG] - ,body))) + (let [bindings [] + args []] + (each [_ arg (ipairs [...])] + (if (double-eval-safe? arg (type arg)) + (table.insert args arg) + (let [name (gensym)] + (table.insert bindings name) + (table.insert bindings arg) + (table.insert args name)))) + (let [body (list f (unpack args))] + (table.insert body _VARARG) + ;; only use the extra let if we need double-eval protection + (if (= 0 (length bindings)) + `(fn [,_VARARG] ,body) + `(let ,bindings + (fn [,_VARARG] ,body)))))) (fn pick-args* [n f] - "Creates a function of arity n that applies its arguments to f. + "Create a function of arity n that applies its arguments to f. For example, (pick-args 2 func) expands to (fn [_0_ _1_] (func _0_ _1_))" + (if (and _G.io _G.io.stderr) + (_G.io.stderr:write + "-- WARNING: pick-args is deprecated and will be removed in the future.\n")) (assert (and (= (type n) :number) (= n (math.floor n)) (>= n 0)) (.. "Expected n to be an integer literal >= 0, got " (tostring n))) (let [bindings []] @@ -3942,7 +5126,7 @@ do (,f ,(unpack bindings))))) (fn pick-values* [n ...] - "Like the `values` special, but emits exactly n values. + "Evaluate to exactly n values. For example, (pick-values 2 ...) @@ -3960,9 +5144,9 @@ do (values ,(unpack let-syms)))))) (fn lambda* [...] - "Function literal with arity checking. - Will throw an exception if a declared argument is passed in as nil, unless - that argument name begins with ?." + "Function literal with nil-checked arguments. + Like `fn`, but will throw an exception if a declared argument is passed in as + nil, unless that argument's name begins with a question mark." (let [args [...] has-internal-name? (sym? (. args 1)) arglist (if has-internal-name? (. args 2) (. args 1)) @@ -3978,13 +5162,13 @@ do (check! a)) (let [as (tostring a)] (and (not (as:match "^?")) (not= as "&") (not= as "_") - (not= as "..."))) + (not= as "...") (not= as "&as"))) (table.insert args arity-check-position - `(assert (not= nil ,a) - (string.format "Missing argument %s on %s:%s" - ,(tostring a) - ,(or a.filename :unknown) - ,(or a.line "?")))))) + `(_G.assert (not= nil ,a) + ,(: "Missing argument %s on %s:%s" :format + (tostring a) + (or a.filename :unknown) + (or a.line "?")))))) (assert (= :table (type arglist)) "expected arg list") (each [_ a (ipairs arglist)] @@ -4006,7 +5190,7 @@ do `(,handle ,(view (macroexpand form _SCOPE))))) (fn import-macros* [binding1 module-name1 ...] - "Binds a table of macros from each macro module according to a binding form. + "Bind a table of macros from each macro module according to a binding form. Each binding form can be either a symbol or a k/v destructuring table. Example: (import-macros mymacros :my-macros ; bind to symbol @@ -4014,26 +5198,23 @@ do (assert (and binding1 module-name1 (= 0 (% (select "#" ...) 2))) "expected even number of binding/modulename pairs") (for [i 1 (select "#" binding1 module-name1 ...) 2] + ;; delegate the actual loading of the macros to the require-macros + ;; special which already knows how to set up the compiler env and stuff. + ;; this is weird because require-macros is deprecated but it works. (let [(binding modname) (select i binding1 module-name1 ...) - ;; generate a subscope of current scope, use require-macros - ;; to bring in macro module. after that, we just copy the - ;; macros from subscope to scope. scope (get-scope) - subscope (fennel.scope scope)] - (_SPECIALS.require-macros `(require-macros ,modname) subscope {} ast) + macros* (_SPECIALS.require-macros `(import-macros ,modname) + scope {} binding1)] (if (sym? binding) ;; bind whole table of macros to table bound to symbol - (do - (tset scope.macros (. binding 1) {}) - (each [k v (pairs subscope.macros)] - (tset (. scope.macros (. binding 1)) k v))) + (tset scope.macros (. binding 1) macros*) ;; 1-level table destructuring for importing individual macros (table? binding) (each [macro-name [import-key] (pairs binding)] - (assert (= :function (type (. subscope.macros macro-name))) + (assert (= :function (type (. macros* macro-name))) (.. "macro " macro-name " not found in module " (tostring modname))) - (tset scope.macros import-key (. subscope.macros macro-name)))))) + (tset scope.macros import-key (. macros* macro-name)))))) nil) ;;; Pattern matching @@ -4050,16 +5231,20 @@ do (values condition bindings))) (fn match-table [val pattern unifications match-pattern] - (let [condition `(and (= (type ,val) :table)) + (let [condition `(and (= (_G.type ,val) :table)) bindings []] (each [k pat (pairs pattern)] (if (= pat `&) - (do + (let [rest-pat (. pattern (+ k 1)) + rest-val `(select ,k ((or table.unpack _G.unpack) ,val)) + subcondition (match-table `(pick-values 1 ,rest-val) + rest-pat unifications match-pattern)] + (if (not (sym? rest-pat)) + (table.insert condition subcondition)) (assert (= nil (. pattern (+ k 2))) "expected & rest argument before last parameter") - (table.insert bindings (. pattern (+ k 1))) - (table.insert bindings - [`(select ,k ((or table.unpack _G.unpack) ,val))])) + (table.insert bindings rest-pat) + (table.insert bindings [rest-val])) (= k `&as) (do (table.insert bindings pat) @@ -4082,7 +5267,7 @@ do (values condition bindings))) (fn match-pattern [vals pattern unifications] - "Takes the AST of values and a single pattern and returns a condition + "Take the AST of values and a single pattern and returns a condition to determine if it matches as well as a list of bindings to introduce for the duration of the body if it does match." ;; we have to assume we're matching against multiple values here until we @@ -4212,18 +5397,50 @@ do pattern body (where pattern guard guards*) body (where (or pattern patterns*) guard guards*) body)" + (assert (= 0 (math.fmod (select :# ...) 2)) + "expected even number of pattern/body pairs") (let [conds-bodies (partition-2 [...]) - else-branch (if (not= 0 (% (select "#" ...) 2)) - (select (select "#" ...) ...)) match-body []] (each [_ [cond body] (ipairs conds-bodies)] (each [_ cond (ipairs (transform-cond cond))] (table.insert match-body cond) (table.insert match-body body))) - (if else-branch - (table.insert match-body else-branch)) (match* val (unpack match-body)))) + (fn match-try-step [expr else pattern body ...] + (if (= nil pattern body) + expr + ;; unlike regular match, we can't know how many values the value + ;; might evaluate to, so we have to capture them all in ... via IIFE + ;; to avoid double-evaluation. + `((fn [...] + (match ... + ,pattern ,(match-try-step body else ...) + ,(unpack else))) + ,expr))) + + (fn match-try* [expr pattern body ...] + "Perform chained pattern matching for a sequence of steps which might fail. + + The values from the initial expression are matched against the first pattern. + If they match, the first body is evaluated and its values are matched against + the second pattern, etc. + + If there is a (catch pat1 body1 pat2 body2 ...) form at the end, any mismatch + from the steps will be tried against these patterns in sequence as a fallback + just like a normal match. If there is no catch, the mismatched values will be + returned as the value of the entire expression." + (let [clauses [pattern body ...] + last (. clauses (length clauses)) + catch (if (= `catch (and (= :table (type last)) (. last 1))) + (let [[_ & e] (table.remove clauses)] e) ; remove `catch sym + [`_# `...])] + (assert (= 0 (math.fmod (length clauses) 2)) + "expected every pattern to have a body") + (assert (= 0 (math.fmod (length catch) 2)) + "expected every catch pattern to have a body") + (match-try-step expr catch (unpack clauses)))) + {:-> ->* :->> ->>* :-?> -?>* @@ -4234,6 +5451,7 @@ do :with-open with-open* :collect collect* :icollect icollect* + :accumulate accumulate* :partial partial* :lambda lambda* :pick-args pick-args* @@ -4241,23 +5459,24 @@ do :macro macro* :macrodebug macrodebug* :import-macros import-macros* - :match match-where} + :match match-where + :match-try match-try*} ]===] local module_name = "conjure-macroexpand.aniseed.fennel.macros" - local _ = nil - local function _0_() + local _ + local function _682_() return mod end - package.preload[module_name] = _0_ + package.preload[module_name] = _682_ _ = nil - local env = nil + local env do - local _1_0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {}) - _1_0["utils"] = utils - _1_0["fennel"] = mod - env = _1_0 + local _683_ = specials["make-compiler-env"](nil, compiler.scopes.compiler, {}) + do end (_683_)["utils"] = utils + _683_["fennel"] = mod + env = _683_ end - local built_ins = eval(builtin_macros, {allowedGlobals = false, env = env, filename = "src/fennel/macros.fnl", moduleName = module_name, scope = compiler.scopes.compiler, useMetadata = true}) + local built_ins = eval(builtin_macros, {env = env, scope = compiler.scopes.compiler, allowedGlobals = false, useMetadata = true, filename = "src/fennel/macros.fnl", moduleName = module_name}) for k, v in pairs(built_ins) do compiler.scopes.global.macros[k] = v end diff --git a/lua/conjure-macroexpand/aniseed/deps/fennelview.lua b/lua/conjure-macroexpand/aniseed/deps/fennelview.lua deleted file mode 100644 index 9935951..0000000 --- a/lua/conjure-macroexpand/aniseed/deps/fennelview.lua +++ /dev/null @@ -1,382 +0,0 @@ -local type_order = {["function"] = 5, boolean = 2, number = 1, string = 3, table = 4, thread = 7, userdata = 6} -local function sort_keys(_0_0, _1_0) - local _1_ = _0_0 - local a = _1_[1] - local _2_ = _1_0 - local b = _2_[1] - local ta = type(a) - local tb = type(b) - if ((ta == tb) and ((ta == "string") or (ta == "number"))) then - return (a < b) - else - local dta = type_order[ta] - local dtb = type_order[tb] - if (dta and dtb) then - return (dta < dtb) - elseif dta then - return true - elseif dtb then - return false - else - return (ta < tb) - end - end -end -local function table_kv_pairs(t) - local assoc_3f = false - local i = 1 - local kv = {} - local insert = table.insert - for k, v in pairs(t) do - if ((type(k) ~= "number") or (k ~= i)) then - assoc_3f = true - end - i = (i + 1) - insert(kv, {k, v}) - end - table.sort(kv, sort_keys) - if (#kv == 0) then - return kv, "empty" - else - local function _2_() - if assoc_3f then - return "table" - else - return "seq" - end - end - return kv, _2_() - end -end -local function count_table_appearances(t, appearances) - if (type(t) == "table") then - if not appearances[t] then - appearances[t] = 1 - for k, v in pairs(t) do - count_table_appearances(k, appearances) - count_table_appearances(v, appearances) - end - else - appearances[t] = ((appearances[t] or 0) + 1) - end - end - return appearances -end -local function save_table(t, seen) - local seen0 = (seen or {len = 0}) - local id = (seen0.len + 1) - if not seen0[t] then - seen0[t] = id - seen0.len = id - end - return seen0 -end -local function detect_cycle(t, seen, _3fk) - if ("table" == type(t)) then - seen[t] = true - local _2_0, _3_0 = next(t, _3fk) - if ((nil ~= _2_0) and (nil ~= _3_0)) then - local k = _2_0 - local v = _3_0 - return (seen[k] or detect_cycle(k, seen) or seen[v] or detect_cycle(v, seen) or detect_cycle(t, seen, k)) - end - end -end -local function visible_cycle_3f(t, options) - return (options["detect-cycles?"] and detect_cycle(t, {}) and save_table(t, options.seen) and (1 < (options.appearances[t] or 0))) -end -local function table_indent(t, indent, id) - local opener_length = nil - if id then - opener_length = (#tostring(id) + 2) - else - opener_length = 1 - end - return (indent + opener_length) -end -local pp = nil -local function concat_table_lines(elements, options, multiline_3f, indent, table_type, prefix) - local indent_str = ("\n" .. string.rep(" ", indent)) - local open = nil - local function _2_() - if ("seq" == table_type) then - return "[" - else - return "{" - end - end - open = ((prefix or "") .. _2_()) - local close = nil - if ("seq" == table_type) then - close = "]" - else - close = "}" - end - local oneline = (open .. table.concat(elements, " ") .. close) - if (not options["one-line?"] and (multiline_3f or ((indent + #oneline) > options["line-length"]))) then - return (open .. table.concat(elements, indent_str) .. close) - else - return oneline - end -end -local function pp_associative(t, kv, options, indent, key_3f) - local multiline_3f = false - local id = options.seen[t] - if (options.level >= options.depth) then - return "{...}" - elseif (id and options["detect-cycles?"]) then - return ("@" .. id .. "{...}") - else - local visible_cycle_3f0 = visible_cycle_3f(t, options) - local id0 = (visible_cycle_3f0 and options.seen[t]) - local indent0 = table_indent(t, indent, id0) - local slength = nil - local function _3_() - local _2_0 = rawget(_G, "utf8") - if _2_0 then - return _2_0.len - else - return _2_0 - end - end - local function _4_(_241) - return #_241 - end - slength = ((options["utf8?"] and _3_()) or _4_) - local prefix = nil - if visible_cycle_3f0 then - prefix = ("@" .. id0) - else - prefix = "" - end - local items = nil - do - local tbl_0_ = {} - for _, _6_0 in pairs(kv) do - local _7_ = _6_0 - local k = _7_[1] - local v = _7_[2] - local _8_ - do - local k0 = pp(k, options, (indent0 + 1), true) - local v0 = pp(v, options, (indent0 + slength(k0) + 1)) - multiline_3f = (multiline_3f or k0:find("\n") or v0:find("\n")) - _8_ = (k0 .. " " .. v0) - end - tbl_0_[(#tbl_0_ + 1)] = _8_ - end - items = tbl_0_ - end - return concat_table_lines(items, options, multiline_3f, indent0, "table", prefix) - end -end -local function pp_sequence(t, kv, options, indent) - local multiline_3f = false - local id = options.seen[t] - if (options.level >= options.depth) then - return "[...]" - elseif (id and options["detect-cycles?"]) then - return ("@" .. id .. "[...]") - else - local visible_cycle_3f0 = visible_cycle_3f(t, options) - local id0 = (visible_cycle_3f0 and options.seen[t]) - local indent0 = table_indent(t, indent, id0) - local prefix = nil - if visible_cycle_3f0 then - prefix = ("@" .. id0) - else - prefix = "" - end - local items = nil - do - local tbl_0_ = {} - for _, _3_0 in pairs(kv) do - local _4_ = _3_0 - local _0 = _4_[1] - local v = _4_[2] - local _5_ - do - local v0 = pp(v, options, indent0) - multiline_3f = (multiline_3f or v0:find("\n")) - _5_ = v0 - end - tbl_0_[(#tbl_0_ + 1)] = _5_ - end - items = tbl_0_ - end - return concat_table_lines(items, options, multiline_3f, indent0, "seq", prefix) - end -end -local function concat_lines(lines, options, indent, force_multi_line_3f) - if (#lines == 0) then - if options["empty-as-sequence?"] then - return "[]" - else - return "{}" - end - else - local oneline = nil - local _2_ - do - local tbl_0_ = {} - for _, line in ipairs(lines) do - tbl_0_[(#tbl_0_ + 1)] = line:gsub("^%s+", "") - end - _2_ = tbl_0_ - end - oneline = table.concat(_2_, " ") - if (not options["one-line?"] and (force_multi_line_3f or oneline:find("\n") or ((indent + #oneline) > options["line-length"]))) then - return table.concat(lines, ("\n" .. string.rep(" ", indent))) - else - return oneline - end - end -end -local function pp_metamethod(t, metamethod, options, indent) - if (options.level >= options.depth) then - if options["empty-as-sequence?"] then - return "[...]" - else - return "{...}" - end - else - local _ = nil - local function _2_(_241) - return visible_cycle_3f(_241, options) - end - options["visible-cycle?"] = _2_ - _ = nil - local lines, force_multi_line_3f = metamethod(t, pp, options, indent) - options["visible-cycle?"] = nil - local _3_0 = type(lines) - if (_3_0 == "string") then - return lines - elseif (_3_0 == "table") then - return concat_lines(lines, options, indent, force_multi_line_3f) - else - local _0 = _3_0 - return error("__fennelview metamethod must return a table of lines") - end - end -end -local function pp_table(x, options, indent) - options.level = (options.level + 1) - local x0 = nil - do - local _2_0 = nil - if options["metamethod?"] then - local _3_0 = x - if _3_0 then - local _4_0 = getmetatable(_3_0) - if _4_0 then - _2_0 = _4_0.__fennelview - else - _2_0 = _4_0 - end - else - _2_0 = _3_0 - end - else - _2_0 = nil - end - if (nil ~= _2_0) then - local metamethod = _2_0 - x0 = pp_metamethod(x, metamethod, options, indent) - else - local _ = _2_0 - local _4_0, _5_0 = table_kv_pairs(x) - if (true and (_5_0 == "empty")) then - local _0 = _4_0 - if options["empty-as-sequence?"] then - x0 = "[]" - else - x0 = "{}" - end - elseif ((nil ~= _4_0) and (_5_0 == "table")) then - local kv = _4_0 - x0 = pp_associative(x, kv, options, indent) - elseif ((nil ~= _4_0) and (_5_0 == "seq")) then - local kv = _4_0 - x0 = pp_sequence(x, kv, options, indent) - else - x0 = nil - end - end - end - options.level = (options.level - 1) - return x0 -end -local function number__3estring(n) - local _2_0 = string.gsub(tostring(n), ",", ".") - return _2_0 -end -local function colon_string_3f(s) - return s:find("^[-%w?^_!$%&*+./@|<=>]+$") -end -local function pp_string(str, options, indent) - local escs = nil - local _2_ - if (options["escape-newlines?"] and (#str < (options["line-length"] - indent))) then - _2_ = "\\n" - else - _2_ = "\n" - end - local function _4_(_241, _242) - return ("\\%03d"):format(_242:byte()) - end - escs = setmetatable({["\""] = "\\\"", ["\11"] = "\\v", ["\12"] = "\\f", ["\13"] = "\\r", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\\"] = "\\\\", ["\n"] = _2_}, {__index = _4_}) - return ("\"" .. str:gsub("[%c\\\"]", escs) .. "\"") -end -local function make_options(t, options) - local defaults = {["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["escape-newlines?"] = false, ["line-length"] = 80, ["metamethod?"] = true, ["one-line?"] = false, ["prefer-colon?"] = false, ["utf8?"] = true, depth = 128} - local overrides = {appearances = count_table_appearances(t, {}), level = 0, seen = {len = 0}} - for k, v in pairs((options or {})) do - defaults[k] = v - end - for k, v in pairs(overrides) do - defaults[k] = v - end - return defaults -end -local function _2_(x, options, indent, colon_3f) - local indent0 = (indent or 0) - local options0 = (options or make_options(x)) - local tv = type(x) - local function _4_() - local _3_0 = getmetatable(x) - if _3_0 then - return _3_0.__fennelview - else - return _3_0 - end - end - if ((tv == "table") or ((tv == "userdata") and _4_())) then - return pp_table(x, options0, indent0) - elseif (tv == "number") then - return number__3estring(x) - else - local function _5_() - if (colon_3f ~= nil) then - return colon_3f - elseif ("function" == type(options0["prefer-colon?"])) then - return options0["prefer-colon?"](x) - else - return options0["prefer-colon?"] - end - end - if ((tv == "string") and colon_string_3f(x) and _5_()) then - return (":" .. x) - elseif (tv == "string") then - return pp_string(x, options0, indent0) - elseif ((tv == "boolean") or (tv == "nil")) then - return tostring(x) - else - return ("#<" .. tostring(x) .. ">") - end - end -end -pp = _2_ -local function view(x, options) - return pp(x, make_options(x, options), 0) -end -return view diff --git a/lua/conjure-macroexpand/aniseed/deps/fun.lua b/lua/conjure-macroexpand/aniseed/deps/fun.lua new file mode 100644 index 0000000..efd1440 --- /dev/null +++ b/lua/conjure-macroexpand/aniseed/deps/fun.lua @@ -0,0 +1,1058 @@ +--- +--- Lua Fun - a high-performance functional programming library for LuaJIT +--- +--- Copyright (c) 2013-2017 Roman Tsisyk +--- +--- Distributed under the MIT/X11 License. See COPYING.md for more details. +--- + +local exports = {} +local methods = {} + +-- compatibility with Lua 5.1/5.2 +local unpack = rawget(table, "unpack") or unpack + +-------------------------------------------------------------------------------- +-- Tools +-------------------------------------------------------------------------------- + +local return_if_not_empty = function(state_x, ...) + if state_x == nil then + return nil + end + return ... +end + +local call_if_not_empty = function(fun, state_x, ...) + if state_x == nil then + return nil + end + return state_x, fun(...) +end + +local function deepcopy(orig) -- used by cycle() + local orig_type = type(orig) + local copy + if orig_type == 'table' then + copy = {} + for orig_key, orig_value in next, orig, nil do + copy[deepcopy(orig_key)] = deepcopy(orig_value) + end + else + copy = orig + end + return copy +end + +local iterator_mt = { + -- usually called by for-in loop + __call = function(self, param, state) + return self.gen(param, state) + end; + __tostring = function(self) + return '' + end; + -- add all exported methods + __index = methods; +} + +local wrap = function(gen, param, state) + return setmetatable({ + gen = gen, + param = param, + state = state + }, iterator_mt), param, state +end +exports.wrap = wrap + +local unwrap = function(self) + return self.gen, self.param, self.state +end +methods.unwrap = unwrap + +-------------------------------------------------------------------------------- +-- Basic Functions +-------------------------------------------------------------------------------- + +local nil_gen = function(_param, _state) + return nil +end + +local string_gen = function(param, state) + local state = state + 1 + if state > #param then + return nil + end + local r = string.sub(param, state, state) + return state, r +end + +local ipairs_gen = ipairs({}) -- get the generating function from ipairs + +local pairs_gen = pairs({ a = 0 }) -- get the generating function from pairs +local map_gen = function(tab, key) + local value + local key, value = pairs_gen(tab, key) + return key, key, value +end + +local rawiter = function(obj, param, state) + assert(obj ~= nil, "invalid iterator") + if type(obj) == "table" then + local mt = getmetatable(obj); + if mt ~= nil then + if mt == iterator_mt then + return obj.gen, obj.param, obj.state + elseif mt.__ipairs ~= nil then + return mt.__ipairs(obj) + elseif mt.__pairs ~= nil then + return mt.__pairs(obj) + end + end + if #obj > 0 then + -- array + return ipairs(obj) + else + -- hash + return map_gen, obj, nil + end + elseif (type(obj) == "function") then + return obj, param, state + elseif (type(obj) == "string") then + if #obj == 0 then + return nil_gen, nil, nil + end + return string_gen, obj, 0 + end + error(string.format('object %s of type "%s" is not iterable', + obj, type(obj))) +end + +local iter = function(obj, param, state) + return wrap(rawiter(obj, param, state)) +end +exports.iter = iter + +local method0 = function(fun) + return function(self) + return fun(self.gen, self.param, self.state) + end +end + +local method1 = function(fun) + return function(self, arg1) + return fun(arg1, self.gen, self.param, self.state) + end +end + +local method2 = function(fun) + return function(self, arg1, arg2) + return fun(arg1, arg2, self.gen, self.param, self.state) + end +end + +local export0 = function(fun) + return function(gen, param, state) + return fun(rawiter(gen, param, state)) + end +end + +local export1 = function(fun) + return function(arg1, gen, param, state) + return fun(arg1, rawiter(gen, param, state)) + end +end + +local export2 = function(fun) + return function(arg1, arg2, gen, param, state) + return fun(arg1, arg2, rawiter(gen, param, state)) + end +end + +local each = function(fun, gen, param, state) + repeat + state = call_if_not_empty(fun, gen(param, state)) + until state == nil +end +methods.each = method1(each) +exports.each = export1(each) +methods.for_each = methods.each +exports.for_each = exports.each +methods.foreach = methods.each +exports.foreach = exports.each + +-------------------------------------------------------------------------------- +-- Generators +-------------------------------------------------------------------------------- + +local range_gen = function(param, state) + local stop, step = param[1], param[2] + local state = state + step + if state > stop then + return nil + end + return state, state +end + +local range_rev_gen = function(param, state) + local stop, step = param[1], param[2] + local state = state + step + if state < stop then + return nil + end + return state, state +end + +local range = function(start, stop, step) + if step == nil then + if stop == nil then + if start == 0 then + return nil_gen, nil, nil + end + stop = start + start = stop > 0 and 1 or -1 + end + step = start <= stop and 1 or -1 + end + + assert(type(start) == "number", "start must be a number") + assert(type(stop) == "number", "stop must be a number") + assert(type(step) == "number", "step must be a number") + assert(step ~= 0, "step must not be zero") + + if (step > 0) then + return wrap(range_gen, {stop, step}, start - step) + elseif (step < 0) then + return wrap(range_rev_gen, {stop, step}, start - step) + end +end +exports.range = range + +local duplicate_table_gen = function(param_x, state_x) + return state_x + 1, unpack(param_x) +end + +local duplicate_fun_gen = function(param_x, state_x) + return state_x + 1, param_x(state_x) +end + +local duplicate_gen = function(param_x, state_x) + return state_x + 1, param_x +end + +local duplicate = function(...) + if select('#', ...) <= 1 then + return wrap(duplicate_gen, select(1, ...), 0) + else + return wrap(duplicate_table_gen, {...}, 0) + end +end +exports.duplicate = duplicate +exports.replicate = duplicate +exports.xrepeat = duplicate + +local tabulate = function(fun) + assert(type(fun) == "function") + return wrap(duplicate_fun_gen, fun, 0) +end +exports.tabulate = tabulate + +local zeros = function() + return wrap(duplicate_gen, 0, 0) +end +exports.zeros = zeros + +local ones = function() + return wrap(duplicate_gen, 1, 0) +end +exports.ones = ones + +local rands_gen = function(param_x, _state_x) + return 0, math.random(param_x[1], param_x[2]) +end + +local rands_nil_gen = function(_param_x, _state_x) + return 0, math.random() +end + +local rands = function(n, m) + if n == nil and m == nil then + return wrap(rands_nil_gen, 0, 0) + end + assert(type(n) == "number", "invalid first arg to rands") + if m == nil then + m = n + n = 0 + else + assert(type(m) == "number", "invalid second arg to rands") + end + assert(n < m, "empty interval") + return wrap(rands_gen, {n, m - 1}, 0) +end +exports.rands = rands + +-------------------------------------------------------------------------------- +-- Slicing +-------------------------------------------------------------------------------- + +local nth = function(n, gen_x, param_x, state_x) + assert(n > 0, "invalid first argument to nth") + -- An optimization for arrays and strings + if gen_x == ipairs_gen then + return param_x[n] + elseif gen_x == string_gen then + if n <= #param_x then + return string.sub(param_x, n, n) + else + return nil + end + end + for i=1,n-1,1 do + state_x = gen_x(param_x, state_x) + if state_x == nil then + return nil + end + end + return return_if_not_empty(gen_x(param_x, state_x)) +end +methods.nth = method1(nth) +exports.nth = export1(nth) + +local head_call = function(state, ...) + if state == nil then + error("head: iterator is empty") + end + return ... +end + +local head = function(gen, param, state) + return head_call(gen(param, state)) +end +methods.head = method0(head) +exports.head = export0(head) +exports.car = exports.head +methods.car = methods.head + +local tail = function(gen, param, state) + state = gen(param, state) + if state == nil then + return wrap(nil_gen, nil, nil) + end + return wrap(gen, param, state) +end +methods.tail = method0(tail) +exports.tail = export0(tail) +exports.cdr = exports.tail +methods.cdr = methods.tail + +local take_n_gen_x = function(i, state_x, ...) + if state_x == nil then + return nil + end + return {i, state_x}, ... +end + +local take_n_gen = function(param, state) + local n, gen_x, param_x = param[1], param[2], param[3] + local i, state_x = state[1], state[2] + if i >= n then + return nil + end + return take_n_gen_x(i + 1, gen_x(param_x, state_x)) +end + +local take_n = function(n, gen, param, state) + assert(n >= 0, "invalid first argument to take_n") + return wrap(take_n_gen, {n, gen, param}, {0, state}) +end +methods.take_n = method1(take_n) +exports.take_n = export1(take_n) + +local take_while_gen_x = function(fun, state_x, ...) + if state_x == nil or not fun(...) then + return nil + end + return state_x, ... +end + +local take_while_gen = function(param, state_x) + local fun, gen_x, param_x = param[1], param[2], param[3] + return take_while_gen_x(fun, gen_x(param_x, state_x)) +end + +local take_while = function(fun, gen, param, state) + assert(type(fun) == "function", "invalid first argument to take_while") + return wrap(take_while_gen, {fun, gen, param}, state) +end +methods.take_while = method1(take_while) +exports.take_while = export1(take_while) + +local take = function(n_or_fun, gen, param, state) + if type(n_or_fun) == "number" then + return take_n(n_or_fun, gen, param, state) + else + return take_while(n_or_fun, gen, param, state) + end +end +methods.take = method1(take) +exports.take = export1(take) + +local drop_n = function(n, gen, param, state) + assert(n >= 0, "invalid first argument to drop_n") + local i + for i=1,n,1 do + state = gen(param, state) + if state == nil then + return wrap(nil_gen, nil, nil) + end + end + return wrap(gen, param, state) +end +methods.drop_n = method1(drop_n) +exports.drop_n = export1(drop_n) + +local drop_while_x = function(fun, state_x, ...) + if state_x == nil or not fun(...) then + return state_x, false + end + return state_x, true, ... +end + +local drop_while = function(fun, gen_x, param_x, state_x) + assert(type(fun) == "function", "invalid first argument to drop_while") + local cont, state_x_prev + repeat + state_x_prev = deepcopy(state_x) + state_x, cont = drop_while_x(fun, gen_x(param_x, state_x)) + until not cont + if state_x == nil then + return wrap(nil_gen, nil, nil) + end + return wrap(gen_x, param_x, state_x_prev) +end +methods.drop_while = method1(drop_while) +exports.drop_while = export1(drop_while) + +local drop = function(n_or_fun, gen_x, param_x, state_x) + if type(n_or_fun) == "number" then + return drop_n(n_or_fun, gen_x, param_x, state_x) + else + return drop_while(n_or_fun, gen_x, param_x, state_x) + end +end +methods.drop = method1(drop) +exports.drop = export1(drop) + +local split = function(n_or_fun, gen_x, param_x, state_x) + return take(n_or_fun, gen_x, param_x, state_x), + drop(n_or_fun, gen_x, param_x, state_x) +end +methods.split = method1(split) +exports.split = export1(split) +methods.split_at = methods.split +exports.split_at = exports.split +methods.span = methods.split +exports.span = exports.split + +-------------------------------------------------------------------------------- +-- Indexing +-------------------------------------------------------------------------------- + +local index = function(x, gen, param, state) + local i = 1 + for _k, r in gen, param, state do + if r == x then + return i + end + i = i + 1 + end + return nil +end +methods.index = method1(index) +exports.index = export1(index) +methods.index_of = methods.index +exports.index_of = exports.index +methods.elem_index = methods.index +exports.elem_index = exports.index + +local indexes_gen = function(param, state) + local x, gen_x, param_x = param[1], param[2], param[3] + local i, state_x = state[1], state[2] + local r + while true do + state_x, r = gen_x(param_x, state_x) + if state_x == nil then + return nil + end + i = i + 1 + if r == x then + return {i, state_x}, i + end + end +end + +local indexes = function(x, gen, param, state) + return wrap(indexes_gen, {x, gen, param}, {0, state}) +end +methods.indexes = method1(indexes) +exports.indexes = export1(indexes) +methods.elem_indexes = methods.indexes +exports.elem_indexes = exports.indexes +methods.indices = methods.indexes +exports.indices = exports.indexes +methods.elem_indices = methods.indexes +exports.elem_indices = exports.indexes + +-------------------------------------------------------------------------------- +-- Filtering +-------------------------------------------------------------------------------- + +local filter1_gen = function(fun, gen_x, param_x, state_x, a) + while true do + if state_x == nil or fun(a) then break; end + state_x, a = gen_x(param_x, state_x) + end + return state_x, a +end + +-- call each other +local filterm_gen +local filterm_gen_shrink = function(fun, gen_x, param_x, state_x) + return filterm_gen(fun, gen_x, param_x, gen_x(param_x, state_x)) +end + +filterm_gen = function(fun, gen_x, param_x, state_x, ...) + if state_x == nil then + return nil + end + if fun(...) then + return state_x, ... + end + return filterm_gen_shrink(fun, gen_x, param_x, state_x) +end + +local filter_detect = function(fun, gen_x, param_x, state_x, ...) + if select('#', ...) < 2 then + return filter1_gen(fun, gen_x, param_x, state_x, ...) + else + return filterm_gen(fun, gen_x, param_x, state_x, ...) + end +end + +local filter_gen = function(param, state_x) + local fun, gen_x, param_x = param[1], param[2], param[3] + return filter_detect(fun, gen_x, param_x, gen_x(param_x, state_x)) +end + +local filter = function(fun, gen, param, state) + return wrap(filter_gen, {fun, gen, param}, state) +end +methods.filter = method1(filter) +exports.filter = export1(filter) +methods.remove_if = methods.filter +exports.remove_if = exports.filter + +local grep = function(fun_or_regexp, gen, param, state) + local fun = fun_or_regexp + if type(fun_or_regexp) == "string" then + fun = function(x) return string.find(x, fun_or_regexp) ~= nil end + end + return filter(fun, gen, param, state) +end +methods.grep = method1(grep) +exports.grep = export1(grep) + +local partition = function(fun, gen, param, state) + local neg_fun = function(...) + return not fun(...) + end + return filter(fun, gen, param, state), + filter(neg_fun, gen, param, state) +end +methods.partition = method1(partition) +exports.partition = export1(partition) + +-------------------------------------------------------------------------------- +-- Reducing +-------------------------------------------------------------------------------- + +local foldl_call = function(fun, start, state, ...) + if state == nil then + return nil, start + end + return state, fun(start, ...) +end + +local foldl = function(fun, start, gen_x, param_x, state_x) + while true do + state_x, start = foldl_call(fun, start, gen_x(param_x, state_x)) + if state_x == nil then + break; + end + end + return start +end +methods.foldl = method2(foldl) +exports.foldl = export2(foldl) +methods.reduce = methods.foldl +exports.reduce = exports.foldl + +local length = function(gen, param, state) + if gen == ipairs_gen or gen == string_gen then + return #param + end + local len = 0 + repeat + state = gen(param, state) + len = len + 1 + until state == nil + return len - 1 +end +methods.length = method0(length) +exports.length = export0(length) + +local is_null = function(gen, param, state) + return gen(param, deepcopy(state)) == nil +end +methods.is_null = method0(is_null) +exports.is_null = export0(is_null) + +local is_prefix_of = function(iter_x, iter_y) + local gen_x, param_x, state_x = iter(iter_x) + local gen_y, param_y, state_y = iter(iter_y) + + local r_x, r_y + for i=1,10,1 do + state_x, r_x = gen_x(param_x, state_x) + state_y, r_y = gen_y(param_y, state_y) + if state_x == nil then + return true + end + if state_y == nil or r_x ~= r_y then + return false + end + end +end +methods.is_prefix_of = is_prefix_of +exports.is_prefix_of = is_prefix_of + +local all = function(fun, gen_x, param_x, state_x) + local r + repeat + state_x, r = call_if_not_empty(fun, gen_x(param_x, state_x)) + until state_x == nil or not r + return state_x == nil +end +methods.all = method1(all) +exports.all = export1(all) +methods.every = methods.all +exports.every = exports.all + +local any = function(fun, gen_x, param_x, state_x) + local r + repeat + state_x, r = call_if_not_empty(fun, gen_x(param_x, state_x)) + until state_x == nil or r + return not not r +end +methods.any = method1(any) +exports.any = export1(any) +methods.some = methods.any +exports.some = exports.any + +local sum = function(gen, param, state) + local s = 0 + local r = 0 + repeat + s = s + r + state, r = gen(param, state) + until state == nil + return s +end +methods.sum = method0(sum) +exports.sum = export0(sum) + +local product = function(gen, param, state) + local p = 1 + local r = 1 + repeat + p = p * r + state, r = gen(param, state) + until state == nil + return p +end +methods.product = method0(product) +exports.product = export0(product) + +local min_cmp = function(m, n) + if n < m then return n else return m end +end + +local max_cmp = function(m, n) + if n > m then return n else return m end +end + +local min = function(gen, param, state) + local state, m = gen(param, state) + if state == nil then + error("min: iterator is empty") + end + + local cmp + if type(m) == "number" then + -- An optimization: use math.min for numbers + cmp = math.min + else + cmp = min_cmp + end + + for _, r in gen, param, state do + m = cmp(m, r) + end + return m +end +methods.min = method0(min) +exports.min = export0(min) +methods.minimum = methods.min +exports.minimum = exports.min + +local min_by = function(cmp, gen_x, param_x, state_x) + local state_x, m = gen_x(param_x, state_x) + if state_x == nil then + error("min: iterator is empty") + end + + for _, r in gen_x, param_x, state_x do + m = cmp(m, r) + end + return m +end +methods.min_by = method1(min_by) +exports.min_by = export1(min_by) +methods.minimum_by = methods.min_by +exports.minimum_by = exports.min_by + +local max = function(gen_x, param_x, state_x) + local state_x, m = gen_x(param_x, state_x) + if state_x == nil then + error("max: iterator is empty") + end + + local cmp + if type(m) == "number" then + -- An optimization: use math.max for numbers + cmp = math.max + else + cmp = max_cmp + end + + for _, r in gen_x, param_x, state_x do + m = cmp(m, r) + end + return m +end +methods.max = method0(max) +exports.max = export0(max) +methods.maximum = methods.max +exports.maximum = exports.max + +local max_by = function(cmp, gen_x, param_x, state_x) + local state_x, m = gen_x(param_x, state_x) + if state_x == nil then + error("max: iterator is empty") + end + + for _, r in gen_x, param_x, state_x do + m = cmp(m, r) + end + return m +end +methods.max_by = method1(max_by) +exports.max_by = export1(max_by) +methods.maximum_by = methods.max_by +exports.maximum_by = exports.max_by + +local totable = function(gen_x, param_x, state_x) + local tab, key, val = {} + while true do + state_x, val = gen_x(param_x, state_x) + if state_x == nil then + break + end + table.insert(tab, val) + end + return tab +end +methods.totable = method0(totable) +exports.totable = export0(totable) + +local tomap = function(gen_x, param_x, state_x) + local tab, key, val = {} + while true do + state_x, key, val = gen_x(param_x, state_x) + if state_x == nil then + break + end + tab[key] = val + end + return tab +end +methods.tomap = method0(tomap) +exports.tomap = export0(tomap) + +-------------------------------------------------------------------------------- +-- Transformations +-------------------------------------------------------------------------------- + +local map_gen = function(param, state) + local gen_x, param_x, fun = param[1], param[2], param[3] + return call_if_not_empty(fun, gen_x(param_x, state)) +end + +local map = function(fun, gen, param, state) + return wrap(map_gen, {gen, param, fun}, state) +end +methods.map = method1(map) +exports.map = export1(map) + +local enumerate_gen_call = function(state, i, state_x, ...) + if state_x == nil then + return nil + end + return {i + 1, state_x}, i, ... +end + +local enumerate_gen = function(param, state) + local gen_x, param_x = param[1], param[2] + local i, state_x = state[1], state[2] + return enumerate_gen_call(state, i, gen_x(param_x, state_x)) +end + +local enumerate = function(gen, param, state) + return wrap(enumerate_gen, {gen, param}, {1, state}) +end +methods.enumerate = method0(enumerate) +exports.enumerate = export0(enumerate) + +local intersperse_call = function(i, state_x, ...) + if state_x == nil then + return nil + end + return {i + 1, state_x}, ... +end + +local intersperse_gen = function(param, state) + local x, gen_x, param_x = param[1], param[2], param[3] + local i, state_x = state[1], state[2] + if i % 2 == 1 then + return {i + 1, state_x}, x + else + return intersperse_call(i, gen_x(param_x, state_x)) + end +end + +-- TODO: interperse must not add x to the tail +local intersperse = function(x, gen, param, state) + return wrap(intersperse_gen, {x, gen, param}, {0, state}) +end +methods.intersperse = method1(intersperse) +exports.intersperse = export1(intersperse) + +-------------------------------------------------------------------------------- +-- Compositions +-------------------------------------------------------------------------------- + +local function zip_gen_r(param, state, state_new, ...) + if #state_new == #param / 2 then + return state_new, ... + end + + local i = #state_new + 1 + local gen_x, param_x = param[2 * i - 1], param[2 * i] + local state_x, r = gen_x(param_x, state[i]) + if state_x == nil then + return nil + end + table.insert(state_new, state_x) + return zip_gen_r(param, state, state_new, r, ...) +end + +local zip_gen = function(param, state) + return zip_gen_r(param, state, {}) +end + +-- A special hack for zip/chain to skip last two state, if a wrapped iterator +-- has been passed +local numargs = function(...) + local n = select('#', ...) + if n >= 3 then + -- Fix last argument + local it = select(n - 2, ...) + if type(it) == 'table' and getmetatable(it) == iterator_mt and + it.param == select(n - 1, ...) and it.state == select(n, ...) then + return n - 2 + end + end + return n +end + +local zip = function(...) + local n = numargs(...) + if n == 0 then + return wrap(nil_gen, nil, nil) + end + local param = { [2 * n] = 0 } + local state = { [n] = 0 } + + local i, gen_x, param_x, state_x + for i=1,n,1 do + local it = select(n - i + 1, ...) + gen_x, param_x, state_x = rawiter(it) + param[2 * i - 1] = gen_x + param[2 * i] = param_x + state[i] = state_x + end + + return wrap(zip_gen, param, state) +end +methods.zip = zip +exports.zip = zip + +local cycle_gen_call = function(param, state_x, ...) + if state_x == nil then + local gen_x, param_x, state_x0 = param[1], param[2], param[3] + return gen_x(param_x, deepcopy(state_x0)) + end + return state_x, ... +end + +local cycle_gen = function(param, state_x) + local gen_x, param_x, state_x0 = param[1], param[2], param[3] + return cycle_gen_call(param, gen_x(param_x, state_x)) +end + +local cycle = function(gen, param, state) + return wrap(cycle_gen, {gen, param, state}, deepcopy(state)) +end +methods.cycle = method0(cycle) +exports.cycle = export0(cycle) + +-- call each other +local chain_gen_r1 +local chain_gen_r2 = function(param, state, state_x, ...) + if state_x == nil then + local i = state[1] + i = i + 1 + if param[3 * i - 1] == nil then + return nil + end + local state_x = param[3 * i] + return chain_gen_r1(param, {i, state_x}) + end + return {state[1], state_x}, ... +end + +chain_gen_r1 = function(param, state) + local i, state_x = state[1], state[2] + local gen_x, param_x = param[3 * i - 2], param[3 * i - 1] + return chain_gen_r2(param, state, gen_x(param_x, state[2])) +end + +local chain = function(...) + local n = numargs(...) + if n == 0 then + return wrap(nil_gen, nil, nil) + end + + local param = { [3 * n] = 0 } + local i, gen_x, param_x, state_x + for i=1,n,1 do + local elem = select(i, ...) + gen_x, param_x, state_x = iter(elem) + param[3 * i - 2] = gen_x + param[3 * i - 1] = param_x + param[3 * i] = state_x + end + + return wrap(chain_gen_r1, param, {1, param[3]}) +end +methods.chain = chain +exports.chain = chain + +-------------------------------------------------------------------------------- +-- Operators +-------------------------------------------------------------------------------- + +local operator = { + ---------------------------------------------------------------------------- + -- Comparison operators + ---------------------------------------------------------------------------- + lt = function(a, b) return a < b end, + le = function(a, b) return a <= b end, + eq = function(a, b) return a == b end, + ne = function(a, b) return a ~= b end, + ge = function(a, b) return a >= b end, + gt = function(a, b) return a > b end, + + ---------------------------------------------------------------------------- + -- Arithmetic operators + ---------------------------------------------------------------------------- + add = function(a, b) return a + b end, + div = function(a, b) return a / b end, + floordiv = function(a, b) return math.floor(a/b) end, + intdiv = function(a, b) + local q = a / b + if a >= 0 then return math.floor(q) else return math.ceil(q) end + end, + mod = function(a, b) return a % b end, + mul = function(a, b) return a * b end, + neq = function(a) return -a end, + unm = function(a) return -a end, -- an alias + pow = function(a, b) return a ^ b end, + sub = function(a, b) return a - b end, + truediv = function(a, b) return a / b end, + + ---------------------------------------------------------------------------- + -- String operators + ---------------------------------------------------------------------------- + concat = function(a, b) return a..b end, + len = function(a) return #a end, + length = function(a) return #a end, -- an alias + + ---------------------------------------------------------------------------- + -- Logical operators + ---------------------------------------------------------------------------- + land = function(a, b) return a and b end, + lor = function(a, b) return a or b end, + lnot = function(a) return not a end, + truth = function(a) return not not a end, +} +exports.operator = operator +methods.operator = operator +exports.op = operator +methods.op = operator + +-------------------------------------------------------------------------------- +-- module definitions +-------------------------------------------------------------------------------- + +-- a special syntax sugar to export all functions to the global table +setmetatable(exports, { + __call = function(t, override) + for k, v in pairs(t) do + if rawget(_G, k) ~= nil then + local msg = 'function ' .. k .. ' already exists in global scope.' + if override then + rawset(_G, k, v) + print('WARNING: ' .. msg .. ' Overwritten.') + else + print('NOTICE: ' .. msg .. ' Skipped.') + end + else + rawset(_G, k, v) + end + end + end, +}) + +return exports diff --git a/lua/conjure-macroexpand/aniseed/env.lua b/lua/conjure-macroexpand/aniseed/env.lua index ffa3a46..2e0bec2 100644 --- a/lua/conjure-macroexpand/aniseed/env.lua +++ b/lua/conjure-macroexpand/aniseed/env.lua @@ -1,108 +1,63 @@ local _2afile_2a = "fnl/aniseed/env.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.env" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {autoload("conjure-macroexpand.aniseed.compile"), autoload("conjure-macroexpand.aniseed.fennel"), autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim")} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {autoload = {compile = "conjure-macroexpand.aniseed.compile", fennel = "conjure-macroexpand.aniseed.fennel", fs = "conjure-macroexpand.aniseed.fs", nvim = "conjure-macroexpand.aniseed.nvim"}} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local compile = _local_0_[1] -local fennel = _local_0_[2] -local fs = _local_0_[3] -local nvim = _local_0_[4] -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.env" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end -local config_dir +local _2amodule_2a do - local v_0_ = nvim.fn.stdpath("config") - local t_0_ = (_0_)["aniseed/locals"] - t_0_["config-dir"] = v_0_ - config_dir = v_0_ + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] end -local quiet_require +local _2amodule_locals_2a do - local v_0_ - local function quiet_require0(m) - local ok_3f, err = nil, nil - local function _3_() - return require(m) - end - ok_3f, err = pcall(_3_) - if (not ok_3f and not err:find(("module '" .. m .. "' not found"))) then - return nvim.ex.echoerr(err) + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local compile, fennel, fs, nvim = autoload("conjure-macroexpand.aniseed.compile"), autoload("conjure-macroexpand.aniseed.fennel"), autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim") +do end (_2amodule_locals_2a)["compile"] = compile +_2amodule_locals_2a["fennel"] = fennel +_2amodule_locals_2a["fs"] = fs +_2amodule_locals_2a["nvim"] = nvim +local config_dir = nvim.fn.stdpath("config") +do end (_2amodule_locals_2a)["config-dir"] = config_dir +local function quiet_require(m) + local ok_3f, err = nil, nil + local function _1_() + return require(m) + end + ok_3f, err = pcall(_1_) + if (not ok_3f and not err:find(("module '" .. m .. "' not found"))) then + return nvim.ex.echoerr(err) + else + return nil + end +end +_2amodule_locals_2a["quiet-require"] = quiet_require +local function init(opts) + local opts0 + if ("table" == type(opts)) then + opts0 = opts + else + opts0 = {} + end + local glob_expr = "**/*.fnl" + local fnl_dir = nvim.fn.expand((opts0.input or (config_dir .. fs["path-sep"] .. "fnl"))) + local lua_dir = nvim.fn.expand((opts0.output or (config_dir .. fs["path-sep"] .. "lua"))) + if opts0.output then + package.path = (package.path .. ";" .. lua_dir .. fs["path-sep"] .. "?.lua") + else + end + local function _5_(path) + if fs["macro-file-path?"](path) then + return path + else + return string.gsub(path, ".fnl$", ".lua") end end - v_0_ = quiet_require0 - local t_0_ = (_0_)["aniseed/locals"] - t_0_["quiet-require"] = v_0_ - quiet_require = v_0_ -end -local init -do - local v_0_ - do - local v_0_0 - local function init0(opts) - local opts0 - if ("table" == type(opts)) then - opts0 = opts - else - opts0 = {} - end - local glob_expr = "**/*.fnl" - local fnl_dir = (opts0.input or (config_dir .. fs["path-sep"] .. "fnl")) - local lua_dir = (opts0.output or (config_dir .. fs["path-sep"] .. "lua")) - package.path = (package.path .. ";" .. lua_dir .. fs["path-sep"] .. "?.lua") - local function _4_(path) - if fs["macro-file-path?"](path) then - return path - else - return string.gsub(path, ".fnl$", ".lua") - end - end - if (((false ~= opts0.compile) or os.getenv("ANISEED_ENV_COMPILE")) and fs["glob-dir-newer?"](fnl_dir, lua_dir, glob_expr, _4_)) then - fennel["add-path"]((fnl_dir .. fs["path-sep"] .. "?.fnl")) - compile.glob(glob_expr, fnl_dir, lua_dir, opts0) - end - return quiet_require((opts0.module or "init")) - end - v_0_0 = init0 - _0_["init"] = v_0_0 - v_0_ = v_0_0 + if (((false ~= opts0.compile) or os.getenv("ANISEED_ENV_COMPILE")) and fs["glob-dir-newer?"](fnl_dir, lua_dir, glob_expr, _5_)) then + fennel["add-path"]((fnl_dir .. fs["path-sep"] .. "?.fnl")) + compile.glob(glob_expr, fnl_dir, lua_dir, opts0) + else end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["init"] = v_0_ - init = v_0_ + return quiet_require((opts0.module or "init")) end -return nil +_2amodule_2a["init"] = init +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/eval.lua b/lua/conjure-macroexpand/aniseed/eval.lua index 9de3cdd..c975008 100644 --- a/lua/conjure-macroexpand/aniseed/eval.lua +++ b/lua/conjure-macroexpand/aniseed/eval.lua @@ -1,67 +1,72 @@ local _2afile_2a = "fnl/aniseed/eval.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.eval" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.compile"), autoload("conjure-macroexpand.aniseed.fennel"), autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim")} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {autoload = {a = "conjure-macroexpand.aniseed.core", compile = "conjure-macroexpand.aniseed.compile", fennel = "conjure-macroexpand.aniseed.fennel", fs = "conjure-macroexpand.aniseed.fs", nvim = "conjure-macroexpand.aniseed.nvim"}} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local a = _local_0_[1] -local compile = _local_0_[2] -local fennel = _local_0_[3] -local fs = _local_0_[4] -local nvim = _local_0_[5] -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.eval" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end -local str +local _2amodule_2a do - local v_0_ - do - local v_0_0 - local function str0(code, opts) - local fnl = fennel.impl() - local function _3_() - return fnl.eval(compile["macros-prefix"](code, opts), a.merge({["compiler-env"] = _G}, opts)) - end - return xpcall(_3_, fnl.traceback) - end - v_0_0 = str0 - _0_["str"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["str"] = v_0_ - str = v_0_ + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] end -return nil +local _2amodule_locals_2a +do + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local a, compile, fennel, fs, nvim = autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.compile"), autoload("conjure-macroexpand.aniseed.fennel"), autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim") +do end (_2amodule_locals_2a)["a"] = a +_2amodule_locals_2a["compile"] = compile +_2amodule_locals_2a["fennel"] = fennel +_2amodule_locals_2a["fs"] = fs +_2amodule_locals_2a["nvim"] = nvim +local function str(code, opts) + local fnl = fennel.impl() + local function _1_() + return fnl.eval(compile["wrap-macros"](code, opts), a.merge({compilerEnv = _G}, opts)) + end + return xpcall(_1_, fnl.traceback) +end +_2amodule_2a["str"] = str +local function clean_values(vals) + local function _2_(val) + if a["table?"](val) then + return (compile["delete-marker"] ~= a.first(val)) + else + return true + end + end + return a.filter(_2_, vals) +end +_2amodule_locals_2a["clean-values"] = clean_values +local function clean_error(err) + return string.gsub(string.gsub(err, "^%b[string .-%b]:%d+: ", ""), "^Compile error in .-:%d+\n%s+", "") +end +_2amodule_2a["clean-error"] = clean_error +local function repl(opts) + local eval_values = nil + local fnl = fennel.impl() + local opts0 = (opts or {}) + local co + local function _4_() + local function _5_(_241) + eval_values = clean_values(_241) + return nil + end + local function _6_(_241, _242) + return (opts0["error-handler"] or nvim.err_writeln)(clean_error(_242)) + end + return fnl.repl(a.merge({compilerEnv = _G, pp = a.identity, readChunk = coroutine.yield, onValues = _5_, onError = _6_}, opts0)) + end + co = coroutine.create(_4_) + coroutine.resume(co) + coroutine.resume(co, compile["wrap-macros"](nil, opts0)) + eval_values = nil + local function _7_(code) + ANISEED_STATIC_MODULES = false + coroutine.resume(co, code) + local prev_eval_values = eval_values + eval_values = nil + return prev_eval_values + end + return _7_ +end +_2amodule_2a["repl"] = repl +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/fennel.lua b/lua/conjure-macroexpand/aniseed/fennel.lua index bcd88ca..855b801 100644 --- a/lua/conjure-macroexpand/aniseed/fennel.lua +++ b/lua/conjure-macroexpand/aniseed/fennel.lua @@ -1,112 +1,55 @@ local _2afile_2a = "fnl/aniseed/fennel.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.fennel" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim")} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {autoload = {fs = "conjure-macroexpand.aniseed.fs", nvim = "conjure-macroexpand.aniseed.nvim"}} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local fs = _local_0_[1] -local nvim = _local_0_[2] -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.fennel" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end -local sync_rtp +local _2amodule_2a do - local v_0_ - do - local v_0_0 - local function sync_rtp0(compiler) - local sep = fs["path-sep"] - local fnl_suffix = (sep .. "fnl" .. sep .. "?.fnl") - local rtp = nvim.o.runtimepath - local fnl_path = (rtp:gsub(",", (fnl_suffix .. ";")) .. fnl_suffix) - local lua_path = fnl_path:gsub((sep .. "fnl" .. sep), (sep .. "lua" .. sep)) - do end (compiler)["path"] = (fnl_path .. ";" .. lua_path) - return nil - end - v_0_0 = sync_rtp0 - _0_["sync-rtp"] = v_0_0 - v_0_ = v_0_0 + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] +end +local _2amodule_locals_2a +do + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local a, fs, nvim, str = autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim"), autoload("conjure-macroexpand.aniseed.string") +do end (_2amodule_locals_2a)["a"] = a +_2amodule_locals_2a["fs"] = fs +_2amodule_locals_2a["nvim"] = nvim +_2amodule_locals_2a["str"] = str +local function sync_rtp(compiler) + local fnl_suffix = (fs["path-sep"] .. "fnl" .. fs["path-sep"] .. "?.fnl") + local lua_suffix = (fs["path-sep"] .. "lua" .. fs["path-sep"] .. "?.fnl") + local rtps = nvim.list_runtime_paths() + local fnl_paths + local function _1_(_241) + return (_241 .. fnl_suffix) end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["sync-rtp"] = v_0_ - sync_rtp = v_0_ -end -local state -do - local v_0_ = {["compiler-loaded?"] = false} - local t_0_ = (_0_)["aniseed/locals"] - t_0_["state"] = v_0_ - state = v_0_ -end -local impl -do - local v_0_ - do - local v_0_0 - local function impl0() - local compiler = require("conjure-macroexpand.aniseed.deps.fennel") - if not state["compiler-loaded?"] then - state["compiler-loaded?"] = true - sync_rtp(compiler) - end - return compiler - end - v_0_0 = impl0 - _0_["impl"] = v_0_0 - v_0_ = v_0_0 + fnl_paths = a.map(_1_, rtps) + local lua_paths + local function _2_(_241) + return (_241 .. lua_suffix) end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["impl"] = v_0_ - impl = v_0_ + lua_paths = a.map(_2_, rtps) + do end (compiler)["macro-path"] = str.join(";", a.concat(fnl_paths, lua_paths)) + return nil end -local add_path -do - local v_0_ - do - local v_0_0 - local function add_path0(path) - local fnl = impl() - do end (fnl)["path"] = (fnl.path .. ";" .. path) - return nil - end - v_0_0 = add_path0 - _0_["add-path"] = v_0_0 - v_0_ = v_0_0 +_2amodule_2a["sync-rtp"] = sync_rtp +local state = {["compiler-loaded?"] = false} +_2amodule_locals_2a["state"] = state +local function impl() + local compiler = require("conjure-macroexpand.aniseed.deps.fennel") + if not state["compiler-loaded?"] then + state["compiler-loaded?"] = true + sync_rtp(compiler) + else end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["add-path"] = v_0_ - add_path = v_0_ + return compiler end -return nil +_2amodule_2a["impl"] = impl +local function add_path(path) + local fnl = impl() + do end (fnl)["macro-path"] = (fnl["macro-path"] .. ";" .. path) + return nil +end +_2amodule_2a["add-path"] = add_path +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/fs.lua b/lua/conjure-macroexpand/aniseed/fs.lua index a9bca3f..5470cca 100644 --- a/lua/conjure-macroexpand/aniseed/fs.lua +++ b/lua/conjure-macroexpand/aniseed/fs.lua @@ -1,154 +1,58 @@ local _2afile_2a = "fnl/aniseed/fs.fnl" -local _0_ +local _2amodule_name_2a = "conjure-macroexpand.aniseed.fs" +local _2amodule_2a do - local name_0_ = "conjure-macroexpand.aniseed.fs" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] +end +local _2amodule_locals_2a +do + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local a, nvim = autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.nvim") +do end (_2amodule_locals_2a)["a"] = a +_2amodule_locals_2a["nvim"] = nvim +local function basename(path) + return nvim.fn.fnamemodify(path, ":h") +end +_2amodule_2a["basename"] = basename +local function mkdirp(dir) + return nvim.fn.mkdir(dir, "p") +end +_2amodule_2a["mkdirp"] = mkdirp +local function relglob(dir, expr) + local dir_len = a.inc(string.len(dir)) + local function _1_(_241) + return string.sub(_241, dir_len) + end + return a.map(_1_, nvim.fn.globpath(dir, expr, true, true)) +end +_2amodule_2a["relglob"] = relglob +local function glob_dir_newer_3f(a_dir, b_dir, expr, b_dir_path_fn) + local newer_3f = false + for _, path in ipairs(relglob(a_dir, expr)) do + if (nvim.fn.getftime((a_dir .. path)) > nvim.fn.getftime((b_dir .. b_dir_path_fn(path)))) then + newer_3f = true else - module_0_ = {} end end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ + return newer_3f end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) +_2amodule_2a["glob-dir-newer?"] = glob_dir_newer_3f +local function macro_file_path_3f(path) + return a["string?"](string.match(path, "macros?.fnl$")) end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.nvim")} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {autoload = {a = "conjure-macroexpand.aniseed.core", nvim = "conjure-macroexpand.aniseed.nvim"}} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local a = _local_0_[1] -local nvim = _local_0_[2] -local _2amodule_2a = _0_ -local _2amodule_name_2a = "conjure-macroexpand.aniseed.fs" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end +_2amodule_2a["macro-file-path?"] = macro_file_path_3f local path_sep do - local v_0_ - do - local v_0_0 - do - local os = string.lower(jit.os) - if (("linux" == os) or ("osx" == os) or ("bsd" == os)) then - v_0_0 = "/" - else - v_0_0 = "\\" - end - end - _0_["path-sep"] = v_0_0 - v_0_ = v_0_0 + local os = string.lower(jit.os) + if (("linux" == os) or ("osx" == os) or ("bsd" == os)) then + path_sep = "/" + else + path_sep = "\\" end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["path-sep"] = v_0_ - path_sep = v_0_ end -local basename -do - local v_0_ - do - local v_0_0 - local function basename0(path) - return nvim.fn.fnamemodify(path, ":h") - end - v_0_0 = basename0 - _0_["basename"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["basename"] = v_0_ - basename = v_0_ -end -local mkdirp -do - local v_0_ - do - local v_0_0 - local function mkdirp0(dir) - return nvim.fn.mkdir(dir, "p") - end - v_0_0 = mkdirp0 - _0_["mkdirp"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["mkdirp"] = v_0_ - mkdirp = v_0_ -end -local relglob -do - local v_0_ - do - local v_0_0 - local function relglob0(dir, expr) - local dir_len = a.inc(string.len(dir)) - local function _3_(_241) - return string.sub(_241, dir_len) - end - return a.map(_3_, nvim.fn.globpath(dir, expr, true, true)) - end - v_0_0 = relglob0 - _0_["relglob"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["relglob"] = v_0_ - relglob = v_0_ -end -local glob_dir_newer_3f -do - local v_0_ - do - local v_0_0 - local function glob_dir_newer_3f0(a_dir, b_dir, expr, b_dir_path_fn) - local newer_3f = false - for _, path in ipairs(relglob(a_dir, expr)) do - if (nvim.fn.getftime((a_dir .. path)) > nvim.fn.getftime((b_dir .. b_dir_path_fn(path)))) then - newer_3f = true - end - end - return newer_3f - end - v_0_0 = glob_dir_newer_3f0 - _0_["glob-dir-newer?"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["glob-dir-newer?"] = v_0_ - glob_dir_newer_3f = v_0_ -end -local macro_file_path_3f -do - local v_0_ - do - local v_0_0 - local function macro_file_path_3f0(path) - return string.match(path, "macros.fnl$") - end - v_0_0 = macro_file_path_3f0 - _0_["macro-file-path?"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["macro-file-path?"] = v_0_ - macro_file_path_3f = v_0_ -end -return nil +_2amodule_2a["path-sep"] = path_sep +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/macros.fnl b/lua/conjure-macroexpand/aniseed/macros.fnl index 1e5032e..3e098fb 100644 --- a/lua/conjure-macroexpand/aniseed/macros.fnl +++ b/lua/conjure-macroexpand/aniseed/macros.fnl @@ -3,7 +3,16 @@ ;; Automatically loaded through require-macros for all Aniseed based evaluations. -(local module-sym (gensym)) +(fn nil? [x] + (= :nil (type x))) + +(fn seq? [x] + (not (nil? (. x 1)))) + +(fn str [x] + (if (= :string (type x)) + x + (tostring x))) (fn sorted-each [f x] (let [acc []] @@ -12,122 +21,186 @@ (table.sort acc (fn [a b] - (< (. a 1) (. b 1)))) + (< (str (. a 1)) (str (. b 1))))) (each [_ [k v] (ipairs acc)] (f k v)))) -(fn module [name new-local-fns initial-mod] - `(-> [(local ,module-sym - (let [name# ,(tostring name) - module# (let [x# (. package.loaded name#)] - (if (= :table (type x#)) - x# - ,(or initial-mod {})))] - (tset module# :aniseed/module name#) - (tset module# :aniseed/locals (or (. module# :aniseed/locals) {})) - (tset module# :aniseed/local-fns (or (. module# :aniseed/local-fns) {})) - (tset package.loaded name# module#) - module#)) +(fn contains? [t target] + (var seen? false) + (each [k v (pairs t)] + (when (= k target) + (set seen? true))) + seen?) - ,module-sym +(fn ensure-sym [x] + (if (= :string (type x)) + (sym x) + x)) - ;; Meta! Autoload the autoload function, so it's only loaded when used. - (local ,(sym :autoload) - (fn [...] ((. (require :aniseed.autoload) :autoload) ...))) +;; This marker can be used by a post-processor to delete a useless byproduct line. +(local delete-marker :ANISEED_DELETE_ME) - ,(let [aliases [] - vals [] - effects [] - pkg (let [x (. package.loaded (tostring name))] - (when (= :table (type x)) - x)) - locals (-?> pkg (. :aniseed/locals)) - local-fns (or (and (not new-local-fns) - (?. pkg :aniseed/local-fns)) - {})] +;; We store all locals under this for later splatting. +(local locals-key :aniseed/locals) - (when new-local-fns - (each [action binds (pairs new-local-fns)] - (let [action-str (tostring action) - current (or (. local-fns action-str) {})] - (tset local-fns action-str current) - (each [alias module (pairs binds)] - (if (= :number (type alias)) - (tset current (tostring module) true) - (tset current (tostring alias) (tostring module))))))) +;; Various symbols we want to use multiple times. +;; Avoids the compiler complaining that we're introducing locals without gensym. +(local mod-name-sym (sym :*module-name*)) +(local mod-sym (sym :*module*)) +(local mod-locals-sym (sym :*module-locals*)) +(local autoload-sym (sym :autoload)) - (sorted-each - (fn [action binds] - (sorted-each - (fn [alias-or-val val] - (if (= true val) +;; Upserts the existence of the module for subsequent def forms and expands the +;; bound function calls into the current context. +;; +;; On subsequent interactive calls it will expand the existing module into your +;; current context. This should be used by Conjure as you enter a buffer. +;; +;; (module foo +;; {require {nvim aniseed.nvim}} +;; {:some-optional-base :table-of-things +;; :to-base :the-module-off-of}) +;; +;; (module foo) ;; expands foo into your current context +(fn module [mod-name mod-fns mod-base] + (let [;; So we can check for existing values and know if we're in an interactive eval. + ;; If the module doesn't exist we're compiling and can skip interactive tooling. + existing-mod (. package.loaded (tostring mod-name)) - ;; {require-macros [bar]} - (table.insert effects `(,(sym action) ,alias-or-val)) + ;; Determine if we're in an interactive eval or not. - ;; {require {foo bar}} - (do - (table.insert aliases (sym alias-or-val)) - (table.insert vals `(,(sym action) ,val))))) + ;; We don't count userdata / other types as an existing module since we + ;; can't really work with anything other than a table. If it's not a + ;; table it's probably not a module Aniseed can work with in general + ;; since it's assumed all Aniseed modules are table based. - binds)) - local-fns) + ;; We can also completely disable the interactive mode which is used by + ;; `aniseed.env` but can also be enabled by others. Sadly this works + ;; through global variables but still! + interactive? (and (table? existing-mod) + (not _G.ANISEED_STATIC_MODULES)) - (when locals - (sorted-each - (fn [alias val] - (table.insert aliases (sym alias)) - (table.insert vals `(. ,module-sym :aniseed/locals ,alias))) - locals)) + ;; The final result table that gets returned from the macro. + ;; This is the best way I've found to introduce many (local ...) forms from one macro. + result `[,delete-marker - `[,effects - (local ,aliases - (let [(ok?# val#) - (pcall - (fn [] ,vals))] - (if ok?# - (do - (tset ,module-sym :aniseed/local-fns ,local-fns) - val#) - (print val#)))) - (local ,(sym "*module*") ,module-sym) - (local ,(sym "*module-name*") ,(tostring name))])] - (. 2))) + ;; We can't refer to things like (local (foo bar) (10 foo)). + ;; So we need to define them in an earlier local. + (local ,mod-name-sym ,(tostring mod-name)) + + ;; Only expose the module table if it doesn't exist yet. + (local ,mod-sym ,(if interactive? + `(. package.loaded ,mod-name-sym) + `(do + (tset package.loaded ,mod-name-sym ,(or mod-base {})) + (. package.loaded ,mod-name-sym)))) + + ;; As we def values we insert them into locals. + ;; This table is then expanded in subsequent interactive evals. + (local ,mod-locals-sym ,(if interactive? + `(. ,mod-sym ,locals-key) + `(do + (tset ,mod-sym ,locals-key {}) + (. ,mod-sym ,locals-key))))] + + ;; Bindings that are returned from the macro. + ;; (=> :some-symbol :some-value) + keys [] + vals [] + => (fn [k v] + (table.insert keys k) + (table.insert vals v))] + + ;; For each function / value pair... + (when mod-fns + (sorted-each + (fn [mod-fn args] + (if (seq? args) + ;; If it's sequential, we execute the fn for side effects. + (each [_ arg (ipairs args)] + (=> (sym :_) `(,mod-fn ,(tostring arg)))) + + ;; Otherwise we need to bind the execution to a name. + (sorted-each + (fn [bind arg] + (=> (ensure-sym bind) `(,mod-fn ,(tostring arg)))) + args))) + mod-fns) + + ;; Only require autoload if it's used. + (when (contains? mod-fns autoload-sym) + (table.insert result `(local ,autoload-sym (. (require "conjure-macroexpand.aniseed.autoload") :autoload))))) + + ;; When we have some keys insert the key/vals pairs locals. + ;; If this is empty we end up generating invalid Lua. + (when (seq? keys) + (table.insert result `(local ,(list (unpack keys)) (values ,(unpack vals)))) + + ;; We also bind these exposed locals into *module-locals* for future splatting. + (each [_ k (ipairs keys)] + (if (sym? k) + ;; Normal symbols can just be assigned into module-locals. + (table.insert result `(tset ,mod-locals-sym ,(tostring k) ,k)) + + ;; Tables mean we're using Fennel destructure syntax. + ;; So we need to unpack the assignments so they can be used later in interactive evals. + (sorted-each + (fn [k v] + (table.insert + result + `(tset ,mod-locals-sym ,(tostring k) ,v))) + k)))) + + ;; Now we can expand any existing locals into the current scope. + ;; Since this will only happen in interactive evals we can generate messy code. + (when interactive? + ;; Expand exported values into the current scope, except aniseed/locals. + (sorted-each + (fn [k v] + (when (not= k locals-key) + (table.insert result `(local ,(sym k) (. ,mod-sym ,k))))) + existing-mod) + + ;; Expand locals into the current scope. + (when (. existing-mod locals-key) + (sorted-each + (fn [k v] + (table.insert result `(local ,(sym k) (. ,mod-locals-sym ,k)))) + (. existing-mod locals-key)))) + + result)) (fn def- [name value] - `(local ,name - (let [v# ,value - t# (. ,module-sym :aniseed/locals)] - (tset t# ,(tostring name) v#) - v#))) + `[,delete-marker + (local ,name ,value) + (tset ,mod-locals-sym ,(tostring name) ,name)]) (fn def [name value] - `(def- ,name - (do - (let [v# ,value] - (tset ,module-sym ,(tostring name) v#) - v#)))) + `[,delete-marker + (local ,name ,value) + (tset ,mod-sym ,(tostring name) ,name)]) (fn defn- [name ...] - `(def- ,name (fn ,name ,...))) + `[,delete-marker + (fn ,name ,...) + (tset ,mod-locals-sym ,(tostring name) ,name)]) (fn defn [name ...] - `(def ,name (fn ,name ,...))) + `[,delete-marker + (fn ,name ,...) + (tset ,mod-sym ,(tostring name) ,name)]) (fn defonce- [name value] - `(def- ,name - (or (. ,module-sym :aniseed/locals ,(tostring name)) - ,value))) + `(def- ,name (or (. ,mod-sym ,(tostring name)) ,value))) (fn defonce [name value] - `(def ,name - (or (. ,module-sym ,(tostring name)) - ,value))) + `(def ,name (or (. ,mod-sym ,(tostring name)) ,value))) (fn deftest [name ...] - `(let [tests# (or (. ,module-sym :aniseed/tests) {})] + `(let [tests# (or (. ,mod-sym :aniseed/tests + ) {})] (tset tests# ,(tostring name) (fn [,(sym :t)] ,...)) - (tset ,module-sym :aniseed/tests tests#))) + (tset ,mod-sym :aniseed/tests tests#))) (fn time [...] `(let [start# (vim.loop.hrtime) @@ -136,9 +209,90 @@ (print (.. "Elapsed time: " (/ (- end# start#) 1000000) " msecs")) result#)) +;; Checks surrounding scope for *module* and, if found, makes sure *module* is +;; inserted after `last-expr` (and therefore *module* is returned) +(fn wrap-last-expr [last-expr] + (if (in-scope? mod-sym) + `(do ,last-expr ,mod-sym) + last-expr)) + +;; Used by aniseed.compile to wrap the entire body of a file, replacing the +;; last expression with another wrapper; `wrap-last-expr` which handles the +;; module's return value. +;; +;; i.e. +;; (wrap-module-body +;; (module foo) +;; (def x 1) +;; (vim.cmd "...")) ; vim.cmd returns a string which becomes the returned value +;; ; for the entire file once compiled +;; --> expands to: +;; (do +;; (module foo) +;; (def x 1) +;; (wrap-last-expr (vim.cmd "..."))) +;; --> expands to: +;; (do +;; (module foo) +;; (def x 1) +;; (do +;; (vim.cmd "...") +;; *module*)) +(fn wrap-module-body [...] + (let [body# [...] + last-expr# (table.remove body#)] + (table.insert body# `(wrap-last-expr ,last-expr#)) + `(do ,(unpack body#)))) + +(fn conditional-let [branch bindings ...] + (assert (= 2 (length bindings)) "expected a single binding pair") + + (let [[bind-expr value-expr] bindings] + (if + ;; Simple symbols + ;; [foo bar] + (sym? bind-expr) + `(let [,bind-expr ,value-expr] + (,branch ,bind-expr ,...)) + + ;; List / values destructure + ;; [(a b) c] + (list? bind-expr) + (do + ;; Even if the user isn't using the first slot, we will. + ;; [(_ val) (pcall #:foo)] + ;; => [(bindGENSYM12345 val) (pcall #:foo)] + (when (= '_ (. bind-expr 1)) + (tset bind-expr 1 (gensym "bind"))) + + `(let [,bind-expr ,value-expr] + (,branch ,(. bind-expr 1) ,...))) + + ;; Sequential and associative table destructure + ;; [[a b] c] + ;; [{: a : b} c] + (table? bind-expr) + `(let [value# ,value-expr + ,bind-expr (or value# {})] + (,branch value# ,...)) + + ;; We should never get here, but just in case. + (assert (.. "unknown bind-expr type: " (type bind-expr)))))) + +(fn if-let [bindings ...] + (assert (<= (length [...]) 2) (.. "if-let does not support more than two branches")) + (conditional-let 'if bindings ...)) + +(fn when-let [bindings ...] + (conditional-let 'when bindings ...)) + {:module module :def- def- :def def :defn- defn- :defn defn :defonce- defonce- :defonce defonce + :if-let if-let + :when-let when-let + :wrap-last-expr wrap-last-expr + :wrap-module-body wrap-module-body :deftest deftest :time time} diff --git a/lua/conjure-macroexpand/aniseed/nvim.lua b/lua/conjure-macroexpand/aniseed/nvim.lua index 78264ea..06d81a4 100644 --- a/lua/conjure-macroexpand/aniseed/nvim.lua +++ b/lua/conjure-macroexpand/aniseed/nvim.lua @@ -1,41 +1,12 @@ local _2afile_2a = "fnl/aniseed/nvim.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.nvim" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = require("conjure-macroexpand.aniseed.deps.nvim") - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.nvim" -return ({nil, _0_, nil, {{}, nil, nil, nil}})[2] +local _2amodule_2a +do + package.loaded[_2amodule_name_2a] = require("conjure-macroexpand.aniseed.deps.nvim") + _2amodule_2a = package.loaded[_2amodule_name_2a] +end +local _2amodule_locals_2a +do + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end diff --git a/lua/conjure-macroexpand/aniseed/nvim/util.lua b/lua/conjure-macroexpand/aniseed/nvim/util.lua index a9f7244..df98ac5 100644 --- a/lua/conjure-macroexpand/aniseed/nvim/util.lua +++ b/lua/conjure-macroexpand/aniseed/nvim/util.lua @@ -1,122 +1,63 @@ local _2afile_2a = "fnl/aniseed/nvim/util.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.nvim.util" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {autoload("conjure-macroexpand.aniseed.nvim")} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {autoload = {nvim = "conjure-macroexpand.aniseed.nvim"}} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local nvim = _local_0_[1] -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.nvim.util" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end -local normal +local _2amodule_2a do - local v_0_ - do - local v_0_0 - local function normal0(keys) - return nvim.ex.silent(("exe \"normal! " .. keys .. "\"")) - end - v_0_0 = normal0 - _0_["normal"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["normal"] = v_0_ - normal = v_0_ + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] end -local fn_bridge +local _2amodule_locals_2a do - local v_0_ - do - local v_0_0 - local function fn_bridge0(viml_name, mod, lua_name, opts) - local _let_0_ = (opts or {}) - local range = _let_0_["range"] - local _return = _let_0_["return"] - local _3_ - if range then - _3_ = " range" - else - _3_ = "" - end - local _5_ - if (_return ~= false) then - _5_ = "return" - else - _5_ = "call" - end - local _7_ - if range then - _7_ = "\" . a:firstline . \", \" . a:lastline . \", " - else - _7_ = "" - end - return nvim.ex.function_((viml_name .. "(...)" .. _3_ .. "\n " .. _5_ .. " luaeval(\"require('" .. mod .. "')['" .. lua_name .. "'](" .. _7_ .. "unpack(_A))\", a:000)\n endfunction")) - end - v_0_0 = fn_bridge0 - _0_["fn-bridge"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["fn-bridge"] = v_0_ - fn_bridge = v_0_ + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] end -local with_out_str -do - local v_0_ - do - local v_0_0 - local function with_out_str0(f) - nvim.ex.redir("=> g:aniseed_nvim_util_out_str") - do - local ok_3f, err = pcall(f) - nvim.ex.redir("END") - nvim.ex.echon("") - nvim.ex.redraw() - if not ok_3f then - error(err) - end - end - return string.gsub(nvim.g.aniseed_nvim_util_out_str, "^(\n?)(.*)$", "%2%1") - end - v_0_0 = with_out_str0 - _0_["with-out-str"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["with-out-str"] = v_0_ - with_out_str = v_0_ +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local nvim = autoload("conjure-macroexpand.aniseed.nvim") +do end (_2amodule_locals_2a)["nvim"] = nvim +local function normal(keys) + return nvim.ex.silent(("exe \"normal! " .. keys .. "\"")) end -return nil +_2amodule_2a["normal"] = normal +local function fn_bridge(viml_name, mod, lua_name, opts) + local _let_1_ = (opts or {}) + local range = _let_1_["range"] + local _return = _let_1_["return"] + local function _2_() + if range then + return " range" + else + return "" + end + end + local function _3_() + if (_return ~= false) then + return "return" + else + return "call" + end + end + local function _4_() + if range then + return "\" . a:firstline . \", \" . a:lastline . \", " + else + return "" + end + end + return nvim.ex.function_((viml_name .. "(...)" .. _2_() .. "\n " .. _3_() .. " luaeval(\"require('" .. mod .. "')['" .. lua_name .. "'](" .. _4_() .. "unpack(_A))\", a:000)\n endfunction")) +end +_2amodule_2a["fn-bridge"] = fn_bridge +local function with_out_str(f) + nvim.ex.redir("=> g:aniseed_nvim_util_out_str") + do + local ok_3f, err = pcall(f) + nvim.ex.redir("END") + nvim.ex.echon("") + nvim.ex.redraw() + if not ok_3f then + error(err) + else + end + end + return string.gsub(nvim.g.aniseed_nvim_util_out_str, "^(\n?)(.*)$", "%2%1") +end +_2amodule_2a["with-out-str"] = with_out_str +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/setup.lua b/lua/conjure-macroexpand/aniseed/setup.lua new file mode 100644 index 0000000..f062d48 --- /dev/null +++ b/lua/conjure-macroexpand/aniseed/setup.lua @@ -0,0 +1,61 @@ +local _2afile_2a = "fnl/aniseed/setup.fnl" +local _2amodule_name_2a = "conjure-macroexpand.aniseed.setup" +local _2amodule_2a +do + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] +end +local _2amodule_locals_2a +do + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local a, env, eval, nvim = autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.env"), autoload("conjure-macroexpand.aniseed.eval"), autoload("conjure-macroexpand.aniseed.nvim") +do end (_2amodule_locals_2a)["a"] = a +_2amodule_locals_2a["env"] = env +_2amodule_locals_2a["eval"] = eval +_2amodule_locals_2a["nvim"] = nvim +local function init() + if (1 == nvim.fn.has("nvim-0.7")) then + local function _1_(cmd) + local ok_3f, res = eval.str(cmd.args, {}) + if ok_3f then + return nvim.echo(res) + else + return nvim.err_writeln(res) + end + end + nvim.create_user_command("AniseedEval", _1_, {nargs = 1}) + local function _3_(cmd) + local code + local function _4_() + if ("" == cmd.args) then + return nvim.buf_get_name(nvim.get_current_buf()) + else + return cmd.args + end + end + code = a.slurp(_4_()) + if code then + local ok_3f, res = eval.str(code, {}) + if ok_3f then + return nvim.echo(res) + else + return nvim.err_writeln(res) + end + else + return nvim.err_writeln(("File '" .. (cmd.args or "nil") .. "' not found")) + end + end + nvim.create_user_command("AniseedEvalFile", _3_, {nargs = "?", complete = "file"}) + else + end + if nvim.g["aniseed#env"] then + return env.init(nvim.g["aniseed#env"]) + else + return nil + end +end +_2amodule_2a["init"] = init +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/string.lua b/lua/conjure-macroexpand/aniseed/string.lua index d8b4e91..1996330 100644 --- a/lua/conjure-macroexpand/aniseed/string.lua +++ b/lua/conjure-macroexpand/aniseed/string.lua @@ -1,182 +1,84 @@ local _2afile_2a = "fnl/aniseed/string.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.string" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {autoload("conjure-macroexpand.aniseed.core")} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {autoload = {a = "conjure-macroexpand.aniseed.core"}} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local a = _local_0_[1] -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.string" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end -local join +local _2amodule_2a do - local v_0_ - do - local v_0_0 - local function join0(...) - local args = {...} - local function _3_(...) - if (2 == a.count(args)) then - return args - else - return {"", a.first(args)} - end + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] +end +local _2amodule_locals_2a +do + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local a = autoload("conjure-macroexpand.aniseed.core") +do end (_2amodule_locals_2a)["a"] = a +local function join(...) + local args = {...} + local function _2_(...) + if (2 == a.count(args)) then + return args + else + return {"", a.first(args)} + end + end + local _let_1_ = _2_(...) + local sep = _let_1_[1] + local xs = _let_1_[2] + local len = a.count(xs) + local result = {} + if (len > 0) then + for i = 1, len do + local x = xs[i] + local _3_ + if ("string" == type(x)) then + _3_ = x + elseif (nil == x) then + _3_ = x + else + _3_ = a["pr-str"](x) end - local _let_0_ = _3_(...) - local sep = _let_0_[1] - local xs = _let_0_[2] - local len = a.count(xs) - local result = {} - if (len > 0) then - for i = 1, len do - local x = xs[i] - local _4_ - if ("string" == type(x)) then - _4_ = x - elseif (nil == x) then - _4_ = x - else - _4_ = a["pr-str"](x) - end - if _4_ then - table.insert(result, _4_) - else - end - end + if (_3_ ~= nil) then + table.insert(result, _3_) + else end - return table.concat(result, sep) end - v_0_0 = join0 - _0_["join"] = v_0_0 - v_0_ = v_0_0 + else end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["join"] = v_0_ - join = v_0_ + return table.concat(result, sep) end -local split -do - local v_0_ - do - local v_0_0 - local function split0(s, pat) - local done_3f = false - local acc = {} - local index = 1 - while not done_3f do - local start, _end = string.find(s, pat, index) - if ("nil" == type(start)) then - table.insert(acc, string.sub(s, index)) - done_3f = true - else - table.insert(acc, string.sub(s, index, (start - 1))) - index = (_end + 1) - end - end - return acc +_2amodule_2a["join"] = join +local function split(s, pat) + local done_3f = false + local acc = {} + local index = 1 + while not done_3f do + local start, _end = string.find(s, pat, index) + if ("nil" == type(start)) then + table.insert(acc, string.sub(s, index)) + done_3f = true + else + table.insert(acc, string.sub(s, index, (start - 1))) + index = (_end + 1) end - v_0_0 = split0 - _0_["split"] = v_0_0 - v_0_ = v_0_0 end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["split"] = v_0_ - split = v_0_ + return acc end -local blank_3f -do - local v_0_ - do - local v_0_0 - local function blank_3f0(s) - return (a["empty?"](s) or not string.find(s, "[^%s]")) - end - v_0_0 = blank_3f0 - _0_["blank?"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["blank?"] = v_0_ - blank_3f = v_0_ +_2amodule_2a["split"] = split +local function blank_3f(s) + return (a["empty?"](s) or not string.find(s, "[^%s]")) end -local triml -do - local v_0_ - do - local v_0_0 - local function triml0(s) - return string.gsub(s, "^%s*(.-)", "%1") - end - v_0_0 = triml0 - _0_["triml"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["triml"] = v_0_ - triml = v_0_ +_2amodule_2a["blank?"] = blank_3f +local function triml(s) + return string.gsub(s, "^%s*(.-)", "%1") end -local trimr -do - local v_0_ - do - local v_0_0 - local function trimr0(s) - return string.gsub(s, "(.-)%s*$", "%1") - end - v_0_0 = trimr0 - _0_["trimr"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["trimr"] = v_0_ - trimr = v_0_ +_2amodule_2a["triml"] = triml +local function trimr(s) + return string.gsub(s, "(.-)%s*$", "%1") end -local trim -do - local v_0_ - do - local v_0_0 - local function trim0(s) - return string.gsub(s, "^%s*(.-)%s*$", "%1") - end - v_0_0 = trim0 - _0_["trim"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["trim"] = v_0_ - trim = v_0_ +_2amodule_2a["trimr"] = trimr +local function trim(s) + return string.gsub(s, "^%s*(.-)%s*$", "%1") end -return nil +_2amodule_2a["trim"] = trim +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/test.lua b/lua/conjure-macroexpand/aniseed/test.lua index 2f916b6..5ad7aad 100644 --- a/lua/conjure-macroexpand/aniseed/test.lua +++ b/lua/conjure-macroexpand/aniseed/test.lua @@ -1,235 +1,153 @@ local _2afile_2a = "fnl/aniseed/test.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.test" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim"), autoload("conjure-macroexpand.aniseed.string")} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {autoload = {a = "conjure-macroexpand.aniseed.core", fs = "conjure-macroexpand.aniseed.fs", nvim = "conjure-macroexpand.aniseed.nvim", str = "conjure-macroexpand.aniseed.string"}} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local a = _local_0_[1] -local fs = _local_0_[2] -local nvim = _local_0_[3] -local str = _local_0_[4] -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.test" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end -local ok_3f +local _2amodule_2a do - local v_0_ - do - local v_0_0 - local function ok_3f0(_3_) - local _arg_0_ = _3_ - local tests = _arg_0_["tests"] - local tests_passed = _arg_0_["tests-passed"] - return (tests == tests_passed) - end - v_0_0 = ok_3f0 - _0_["ok?"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["ok?"] = v_0_ - ok_3f = v_0_ + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] end -local display_results +local _2amodule_locals_2a do - local v_0_ - do - local v_0_0 - local function display_results0(results, prefix) - do - local _let_0_ = results - local assertions = _let_0_["assertions"] - local assertions_passed = _let_0_["assertions-passed"] - local tests = _let_0_["tests"] - local tests_passed = _let_0_["tests-passed"] - local _3_ - if ok_3f(results) then - _3_ = "OK" - else - _3_ = "FAILED" - end - a.println((prefix .. " " .. _3_ .. " " .. tests_passed .. "/" .. tests .. " tests and " .. assertions_passed .. "/" .. assertions .. " assertions passed")) - end - return results - end - v_0_0 = display_results0 - _0_["display-results"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["display-results"] = v_0_ - display_results = v_0_ + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] end -local run -do - local v_0_ - do - local v_0_0 - local function run0(mod_name) - local mod = package.loaded[mod_name] - local tests = (a["table?"](mod) and mod["aniseed/tests"]) - if a["table?"](tests) then - local results = {["assertions-passed"] = 0, ["tests-passed"] = 0, assertions = 0, tests = #tests} - for label, f in pairs(tests) do - local test_failed = false - a.update(results, "tests", a.inc) - do - local prefix = ("[" .. mod_name .. "/" .. label .. "]") - local fail - local function _3_(desc, ...) - test_failed = true - local function _4_(...) - if desc then - return (" (" .. desc .. ")") - else - return "" - end - end - return a.println((str.join({prefix, " ", ...}) .. _4_(...))) - end - fail = _3_ - local begin - local function _4_() - return a.update(results, "assertions", a.inc) - end - begin = _4_ - local pass - local function _5_() - return a.update(results, "assertions-passed", a.inc) - end - pass = _5_ - local t - local function _6_(e, r, desc) - begin() - if (e == r) then - return pass() - else - return fail(desc, "Expected '", a["pr-str"](e), "' but received '", a["pr-str"](r), "'") - end - end - local function _7_(r, desc) - begin() - if r then - return pass() - else - return fail(desc, "Expected truthy result but received '", a["pr-str"](r), "'") - end - end - local function _8_(e, r, desc) - begin() - local se = a["pr-str"](e) - local sr = a["pr-str"](r) - if (se == sr) then - return pass() - else - return fail(desc, "Expected (with pr) '", se, "' but received '", sr, "'") - end - end - t = {["="] = _6_, ["ok?"] = _7_, ["pr="] = _8_} - local _9_, _10_ = nil, nil - local function _11_() - return f(t) - end - _9_, _10_ = pcall(_11_) - if ((_9_ == false) and (nil ~= _10_)) then - local err = _10_ - fail("Exception: ", err) - end - end - if not test_failed then - a.update(results, "tests-passed", a.inc) - end - end - return display_results(results, ("[" .. mod_name .. "]")) - end - end - v_0_0 = run0 - _0_["run"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["run"] = v_0_ - run = v_0_ +local autoload = (require("conjure-macroexpand.aniseed.autoload")).autoload +local a, fs, nvim, str = autoload("conjure-macroexpand.aniseed.core"), autoload("conjure-macroexpand.aniseed.fs"), autoload("conjure-macroexpand.aniseed.nvim"), autoload("conjure-macroexpand.aniseed.string") +do end (_2amodule_locals_2a)["a"] = a +_2amodule_locals_2a["fs"] = fs +_2amodule_locals_2a["nvim"] = nvim +_2amodule_locals_2a["str"] = str +local function ok_3f(_1_) + local _arg_2_ = _1_ + local tests = _arg_2_["tests"] + local tests_passed = _arg_2_["tests-passed"] + return (tests == tests_passed) end -local run_all -do - local v_0_ +_2amodule_2a["ok?"] = ok_3f +local function display_results(results, prefix) do - local v_0_0 - local function run_all0() - local function _3_(totals, results) - for k, v in pairs(results) do - totals[k] = (v + totals[k]) - end - return totals - end - return display_results(a.reduce(_3_, {["assertions-passed"] = 0, ["tests-passed"] = 0, assertions = 0, tests = 0}, a.filter(a["table?"], a.map(run, a.keys(package.loaded)))), "[total]") - end - v_0_0 = run_all0 - _0_["run-all"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["run-all"] = v_0_ - run_all = v_0_ -end -local suite -do - local v_0_ - do - local v_0_0 - local function suite0() - do - local sep = fs["path-sep"] - local function _3_(path) - return require(string.gsub(string.match(path, ("^test" .. sep .. "fnl" .. sep .. "(.-).fnl$")), sep, ".")) - end - a["run!"](_3_, nvim.fn.globpath(("test" .. sep .. "fnl"), "**/*-test.fnl", false, true)) - end - if ok_3f(run_all()) then - return nvim.ex.q() + local _let_3_ = results + local tests = _let_3_["tests"] + local tests_passed = _let_3_["tests-passed"] + local assertions = _let_3_["assertions"] + local assertions_passed = _let_3_["assertions-passed"] + local function _4_() + if ok_3f(results) then + return "OK" else - return nvim.ex.cq() + return "FAILED" end end - v_0_0 = suite0 - _0_["suite"] = v_0_0 - v_0_ = v_0_0 + a.println((prefix .. " " .. _4_() .. " " .. tests_passed .. "/" .. tests .. " tests and " .. assertions_passed .. "/" .. assertions .. " assertions passed")) end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["suite"] = v_0_ - suite = v_0_ + return results end -return nil +_2amodule_2a["display-results"] = display_results +local function run(mod_name) + local mod = _G.package.loaded[mod_name] + local tests = (a["table?"](mod) and mod["aniseed/tests"]) + if a["table?"](tests) then + local results = {tests = #tests, ["tests-passed"] = 0, assertions = 0, ["assertions-passed"] = 0} + for label, f in pairs(tests) do + local test_failed = false + a.update(results, "tests", a.inc) + do + local prefix = ("[" .. mod_name .. "/" .. label .. "]") + local fail + local function _5_(desc, ...) + test_failed = true + local function _6_(...) + if desc then + return (" (" .. desc .. ")") + else + return "" + end + end + return a.println((str.join({prefix, " ", ...}) .. _6_(...))) + end + fail = _5_ + local begin + local function _7_() + return a.update(results, "assertions", a.inc) + end + begin = _7_ + local pass + local function _8_() + return a.update(results, "assertions-passed", a.inc) + end + pass = _8_ + local t + local function _9_(e, r, desc) + begin() + if (e == r) then + return pass() + else + return fail(desc, "Expected '", a["pr-str"](e), "' but received '", a["pr-str"](r), "'") + end + end + local function _11_(e, r, desc) + begin() + local se = a["pr-str"](e) + local sr = a["pr-str"](r) + if (se == sr) then + return pass() + else + return fail(desc, "Expected (with pr) '", se, "' but received '", sr, "'") + end + end + local function _13_(r, desc) + begin() + if r then + return pass() + else + return fail(desc, "Expected truthy result but received '", a["pr-str"](r), "'") + end + end + t = {["="] = _9_, ["pr="] = _11_, ["ok?"] = _13_} + local _15_, _16_ = nil, nil + local function _17_() + return f(t) + end + _15_, _16_ = pcall(_17_) + if ((_15_ == false) and (nil ~= _16_)) then + local err = _16_ + fail("Exception: ", err) + else + end + end + if not test_failed then + a.update(results, "tests-passed", a.inc) + else + end + end + return display_results(results, ("[" .. mod_name .. "]")) + else + return nil + end +end +_2amodule_2a["run"] = run +local function run_all() + local function _21_(totals, results) + for k, v in pairs(results) do + totals[k] = (v + totals[k]) + end + return totals + end + return display_results(a.reduce(_21_, {tests = 0, ["tests-passed"] = 0, assertions = 0, ["assertions-passed"] = 0}, a.filter(a["table?"], a.map(run, a.keys(_G.package.loaded)))), "[total]") +end +_2amodule_2a["run-all"] = run_all +local function suite() + do + local sep = fs["path-sep"] + local function _22_(path) + return require(string.gsub(string.match(path, ("^test" .. sep .. "fnl" .. sep .. "(.-).fnl$")), sep, ".")) + end + a["run!"](_22_, nvim.fn.globpath(("test" .. sep .. "fnl"), "**/*-test.fnl", false, true)) + end + if ok_3f(run_all()) then + return nvim.ex.q() + else + return nvim.ex.cq() + end +end +_2amodule_2a["suite"] = suite +return _2amodule_2a diff --git a/lua/conjure-macroexpand/aniseed/view.lua b/lua/conjure-macroexpand/aniseed/view.lua index c674ed0..80fe450 100644 --- a/lua/conjure-macroexpand/aniseed/view.lua +++ b/lua/conjure-macroexpand/aniseed/view.lua @@ -1,58 +1,19 @@ local _2afile_2a = "fnl/aniseed/view.fnl" -local _0_ -do - local name_0_ = "conjure-macroexpand.aniseed.view" - local module_0_ - do - local x_0_ = package.loaded[name_0_] - if ("table" == type(x_0_)) then - module_0_ = x_0_ - else - module_0_ = {} - end - end - module_0_["aniseed/module"] = name_0_ - module_0_["aniseed/locals"] = ((module_0_)["aniseed/locals"] or {}) - do end (module_0_)["aniseed/local-fns"] = ((module_0_)["aniseed/local-fns"] or {}) - do end (package.loaded)[name_0_] = module_0_ - _0_ = module_0_ -end -local autoload -local function _1_(...) - return (require("conjure-macroexpand.aniseed.autoload")).autoload(...) -end -autoload = _1_ -local function _2_(...) - local ok_3f_0_, val_0_ = nil, nil - local function _2_() - return {} - end - ok_3f_0_, val_0_ = pcall(_2_) - if ok_3f_0_ then - _0_["aniseed/local-fns"] = {} - return val_0_ - else - return print(val_0_) - end -end -local _local_0_ = _2_(...) -local _2amodule_2a = _0_ local _2amodule_name_2a = "conjure-macroexpand.aniseed.view" -do local _ = ({nil, _0_, nil, {{}, nil, nil, nil}})[2] end -local serialise +local _2amodule_2a do - local v_0_ - do - local v_0_0 - local function _3_(...) - return require("conjure-macroexpand.aniseed.deps.fennelview")(...) - end - v_0_0 = _3_ - _0_["serialise"] = v_0_0 - v_0_ = v_0_0 - end - local t_0_ = (_0_)["aniseed/locals"] - t_0_["serialise"] = v_0_ - serialise = v_0_ + package.loaded[_2amodule_name_2a] = {} + _2amodule_2a = package.loaded[_2amodule_name_2a] end -return nil +local _2amodule_locals_2a +do + _2amodule_2a["aniseed/locals"] = {} + _2amodule_locals_2a = (_2amodule_2a)["aniseed/locals"] +end +local fnl = require("conjure-macroexpand.aniseed.fennel") +do end (_2amodule_locals_2a)["fnl"] = fnl +local function serialise(...) + return fnl.impl().view(...) +end +_2amodule_2a["serialise"] = serialise +return _2amodule_2a