garden/fennel.lua

6140 lines
229 KiB
Lua
Raw Normal View History

2023-12-08 18:47:06 +00:00
-- SPDX-License-Identifier: MIT
-- SPDX-FileCopyrightText: Calvin Rose and contributors
2023-12-01 01:10:16 +00:00
package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
local utils = require("fennel.utils")
local parser = require("fennel.parser")
local compiler = require("fennel.compiler")
local specials = require("fennel.specials")
local view = require("fennel.view")
local unpack = (table.unpack or _G.unpack)
2023-12-08 18:47:06 +00:00
local depth = 0
local function prompt_for(top_3f)
if top_3f then
return (string.rep(">", (depth + 1)) .. " ")
else
return (string.rep(".", (depth + 1)) .. " ")
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
end
local function default_read_chunk(parser_state)
io.write(prompt_for((0 == parser_state["stack-size"])))
2023-12-01 01:10:16 +00:00
io.flush()
local input = io.read()
return (input and (input .. "\n"))
end
local function default_on_values(xs)
io.write(table.concat(xs, "\9"))
return io.write("\n")
end
local function default_on_error(errtype, err, lua_source)
2023-12-08 18:47:06 +00:00
local function _612_()
local _611_0 = errtype
if (_611_0 == "Lua Compile") then
2023-12-01 01:10:16 +00:00
return ("Bad code generated - likely a bug with the compiler:\n" .. "--- Generated Lua Start ---\n" .. lua_source .. "--- Generated Lua End ---\n")
2023-12-08 18:47:06 +00:00
elseif (_611_0 == "Runtime") then
2023-12-01 01:10:16 +00:00
return (compiler.traceback(tostring(err), 4) .. "\n")
else
2023-12-08 18:47:06 +00:00
local _ = _611_0
2023-12-01 01:10:16 +00:00
return ("%s error: %s\n"):format(errtype, tostring(err))
end
end
2023-12-08 18:47:06 +00:00
return io.write(_612_())
2023-12-01 01:10:16 +00:00
end
local function splice_save_locals(env, lua_source, scope)
local saves = nil
do
local tbl_17_ = {}
local i_18_ = #tbl_17_
for name in pairs(env.___replLocals___) do
2023-12-08 18:47:06 +00:00
local val_19_ = ("local %s = ___replLocals___[%q]"):format((scope.manglings[name] or name), name)
2023-12-01 01:10:16 +00:00
if (nil ~= val_19_) then
i_18_ = (i_18_ + 1)
tbl_17_[i_18_] = val_19_
end
end
saves = tbl_17_
end
local binds = nil
do
local tbl_17_ = {}
local i_18_ = #tbl_17_
for raw, name in pairs(scope.manglings) do
local val_19_ = nil
if not scope.gensyms[name] then
2023-12-08 18:47:06 +00:00
val_19_ = ("___replLocals___[%q] = %s"):format(raw, name)
2023-12-01 01:10:16 +00:00
else
val_19_ = nil
end
if (nil ~= val_19_) then
i_18_ = (i_18_ + 1)
tbl_17_[i_18_] = val_19_
end
end
binds = tbl_17_
end
local gap = nil
if lua_source:find("\n") then
gap = "\n"
else
gap = " "
end
2023-12-08 18:47:06 +00:00
local function _618_()
2023-12-01 01:10:16 +00:00
if next(saves) then
return (table.concat(saves, " ") .. gap)
else
return ""
end
end
2023-12-08 18:47:06 +00:00
local function _621_()
local _619_0, _620_0 = lua_source:match("^(.*)[\n ](return .*)$")
if ((nil ~= _619_0) and (nil ~= _620_0)) then
local body = _619_0
local _return = _620_0
2023-12-01 01:10:16 +00:00
return (body .. gap .. table.concat(binds, " ") .. gap .. _return)
else
2023-12-08 18:47:06 +00:00
local _ = _619_0
2023-12-01 01:10:16 +00:00
return lua_source
end
end
2023-12-08 18:47:06 +00:00
return (_618_() .. _621_())
2023-12-01 01:10:16 +00:00
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_17_ = matches
local i_18_ = #tbl_17_
2023-12-08 18:47:06 +00:00
local function _623_()
2023-12-01 01:10:16 +00:00
if scope_first_3f then
return scope.manglings
else
return tbl
end
end
2023-12-08 18:47:06 +00:00
for k, is_mangled in utils.allpairs(_623_()) do
2023-12-01 01:10:16 +00:00
if (max_items <= #matches) then break end
local val_19_ = nil
do
local lookup_k = nil
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_19_ = (prefix .. k)
else
val_19_ = nil
end
end
if (nil ~= val_19_) then
i_18_ = (i_18_ + 1)
tbl_17_[i_18_] = val_19_
end
end
return tbl_17_
end
local function descend(input, tbl, prefix, add_matches, method_3f)
local splitter = nil
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
end
end
local function add_matches(input, tbl, prefix)
local prefix0 = nil
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()
2023-12-08 18:47:06 +00:00
local _632_
2023-12-01 01:10:16 +00:00
do
local tbl_17_ = {}
local i_18_ = #tbl_17_
for name, f in pairs(commands) do
local val_19_ = (" ,%s - %s"):format(name, ((compiler.metadata):get(f, "fnl/docstring") or "undocumented"))
if (nil ~= val_19_) then
i_18_ = (i_18_ + 1)
tbl_17_[i_18_] = val_19_
end
end
2023-12-08 18:47:06 +00:00
_632_ = tbl_17_
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
return table.concat(_632_, "\n")
2023-12-01 01:10:16 +00:00
end
commands.help = function(_, _0, on_values)
2023-12-08 18:47:06 +00:00
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 ,return FORM - Evaluate FORM and return its value to the REPL's caller.\n ,exit - Leave the repl.\n\nUse ,doc something to see descriptions for individual macros and special forms.\nValues from previous inputs are kept in *1, *2, and *3.\n\nFor more information about the language, see https://fennel-lang.org/reference")})
2023-12-01 01:10:16 +00:00
end
do end (compiler.metadata):set(commands.help, "fnl/docstring", "Show this message.")
local function reload(module_name, env, on_values, on_error)
2023-12-08 18:47:06 +00:00
local _634_0, _635_0 = pcall(specials["load-code"]("return require(...)", env), module_name)
if ((_634_0 == true) and (nil ~= _635_0)) then
local old = _635_0
2023-12-01 01:10:16 +00:00
local _ = nil
package.loaded[module_name] = nil
_ = nil
local ok, new = pcall(require, module_name)
local new0 = nil
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
old[k] = nil
end
end
package.loaded[module_name] = old
end
return on_values({"ok"})
2023-12-08 18:47:06 +00:00
elseif ((_634_0 == false) and (nil ~= _635_0)) then
local msg = _635_0
2023-12-01 01:10:16 +00:00
if msg:match("loop or previous error loading module") then
package.loaded[module_name] = nil
return reload(module_name, env, on_values, on_error)
elseif specials["macro-loaded"][module_name] then
specials["macro-loaded"][module_name] = nil
return nil
else
2023-12-08 18:47:06 +00:00
local function _640_()
local _639_0 = msg:gsub("\n.*", "")
return _639_0
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
return on_error("Runtime", _640_())
2023-12-01 01:10:16 +00:00
end
end
end
local function run_command(read, on_error, f)
2023-12-08 18:47:06 +00:00
local _643_0, _644_0, _645_0 = pcall(read)
if ((_643_0 == true) and (_644_0 == true) and (nil ~= _645_0)) then
local val = _645_0
local _646_0, _647_0 = pcall(f, val)
if ((_646_0 == false) and (nil ~= _647_0)) then
local msg = _647_0
2023-12-01 01:10:16 +00:00
return on_error("Runtime", msg)
end
2023-12-08 18:47:06 +00:00
elseif (_643_0 == false) then
2023-12-01 01:10:16 +00:00
return on_error("Parse", "Couldn't parse input.")
end
end
commands.reload = function(env, read, on_values, on_error)
2023-12-08 18:47:06 +00:00
local function _650_(_241)
2023-12-01 01:10:16 +00:00
return reload(tostring(_241), env, on_values, on_error)
end
2023-12-08 18:47:06 +00:00
return run_command(read, on_error, _650_)
2023-12-01 01:10:16 +00:00
end
do end (compiler.metadata):set(commands.reload, "fnl/docstring", "Reload the specified module.")
commands.reset = function(env, _, on_values)
env.___replLocals___ = {}
return on_values({"ok"})
end
do end (compiler.metadata):set(commands.reset, "fnl/docstring", "Erase all repl-local scope.")
commands.complete = function(env, read, on_values, on_error, scope, chars)
2023-12-08 18:47:06 +00:00
local function _651_()
2023-12-01 01:10:16 +00:00
return on_values(completer(env, scope, table.concat(chars):gsub(",complete +", ""):sub(1, -2)))
end
2023-12-08 18:47:06 +00:00
return run_command(read, on_error, _651_)
2023-12-01 01:10:16 +00:00
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
2023-12-08 18:47:06 +00:00
local _652_0 = type(subtbl)
if (_652_0 == "function") then
2023-12-01 01:10:16 +00:00
if ((prefix .. name)):match(pattern) then
table.insert(names, (prefix .. name))
end
2023-12-08 18:47:06 +00:00
elseif (_652_0 == "table") then
2023-12-01 01:10:16 +00:00
if not seen[subtbl] then
2023-12-08 18:47:06 +00:00
local _654_
2023-12-01 01:10:16 +00:00
do
seen[subtbl] = true
2023-12-08 18:47:06 +00:00
_654_ = seen
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
apropos_2a(pattern, subtbl, (prefix .. name:gsub("%.", "/") .. "."), _654_, names)
2023-12-01 01:10:16 +00:00
end
end
end
end
return names
end
local function apropos(pattern)
local names = apropos_2a(pattern, package.loaded, "", {}, {})
local tbl_17_ = {}
local i_18_ = #tbl_17_
for _, name in ipairs(names) do
local val_19_ = name:gsub("^_G%.", "")
if (nil ~= val_19_) then
i_18_ = (i_18_ + 1)
tbl_17_[i_18_] = val_19_
end
end
return tbl_17_
end
commands.apropos = function(_env, read, on_values, on_error, _scope)
2023-12-08 18:47:06 +00:00
local function _659_(_241)
2023-12-01 01:10:16 +00:00
return on_values(apropos(tostring(_241)))
end
2023-12-08 18:47:06 +00:00
return run_command(read, on_error, _659_)
2023-12-01 01:10:16 +00:00
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 = nil
do
local tbl_17_ = {}
local i_18_ = #tbl_17_
for p in path:gmatch("[^%.]+") do
local val_19_ = p
if (nil ~= val_19_) then
i_18_ = (i_18_ + 1)
tbl_17_[i_18_] = val_19_
end
end
paths = tbl_17_
end
local tgt = package.loaded
for _, path0 in ipairs(paths) do
if (nil == tgt) then break end
2023-12-08 18:47:06 +00:00
local _662_
2023-12-01 01:10:16 +00:00
do
2023-12-08 18:47:06 +00:00
local _661_0 = path0:gsub("%/", ".")
_662_ = _661_0
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
tgt = tgt[_662_]
2023-12-01 01:10:16 +00:00
end
return tgt
end
local function apropos_doc(pattern)
local tbl_17_ = {}
local i_18_ = #tbl_17_
for _, path in ipairs(apropos(".*")) do
local val_19_ = nil
do
local tgt = apropos_follow_path(path)
if ("function" == type(tgt)) then
2023-12-08 18:47:06 +00:00
local _663_0 = (compiler.metadata):get(tgt, "fnl/docstring")
if (nil ~= _663_0) then
local docstr = _663_0
2023-12-01 01:10:16 +00:00
val_19_ = (docstr:match(pattern) and path)
else
val_19_ = nil
end
else
val_19_ = nil
end
end
if (nil ~= val_19_) then
i_18_ = (i_18_ + 1)
tbl_17_[i_18_] = val_19_
end
end
return tbl_17_
end
commands["apropos-doc"] = function(_env, read, on_values, on_error, _scope)
2023-12-08 18:47:06 +00:00
local function _667_(_241)
2023-12-01 01:10:16 +00:00
return on_values(apropos_doc(tostring(_241)))
end
2023-12-08 18:47:06 +00:00
return run_command(read, on_error, _667_)
2023-12-01 01:10:16 +00:00
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
2023-12-08 18:47:06 +00:00
on_values({specials.doc(tgt, path)})
on_values({})
2023-12-01 01:10:16 +00:00
end
end
return nil
end
commands["apropos-show-docs"] = function(_env, read, on_values, on_error)
2023-12-08 18:47:06 +00:00
local function _669_(_241)
2023-12-01 01:10:16 +00:00
return apropos_show_docs(on_values, tostring(_241))
end
2023-12-08 18:47:06 +00:00
return run_command(read, on_error, _669_)
2023-12-01 01:10:16 +00:00
end
do end (compiler.metadata):set(commands["apropos-show-docs"], "fnl/docstring", "Print all documentations matching a pattern in function name")
2023-12-08 18:47:06 +00:00
local function resolve(identifier, _670_0, scope)
local _671_ = _670_0
local env = _671_
local ___replLocals___ = _671_["___replLocals___"]
2023-12-01 01:10:16 +00:00
local e = nil
2023-12-08 18:47:06 +00:00
local function _672_(_241, _242)
2023-12-01 01:10:16 +00:00
return (___replLocals___[scope.unmanglings[_242]] or env[_242])
end
2023-12-08 18:47:06 +00:00
e = setmetatable({}, {__index = _672_})
local function _673_(...)
local _674_0, _675_0 = ...
if ((_674_0 == true) and (nil ~= _675_0)) then
local code = _675_0
local function _676_(...)
local _677_0, _678_0 = ...
if ((_677_0 == true) and (nil ~= _678_0)) then
local val = _678_0
2023-12-01 01:10:16 +00:00
return val
else
2023-12-08 18:47:06 +00:00
local _ = _677_0
2023-12-01 01:10:16 +00:00
return nil
end
end
2023-12-08 18:47:06 +00:00
return _676_(pcall(specials["load-code"](code, e)))
2023-12-01 01:10:16 +00:00
else
2023-12-08 18:47:06 +00:00
local _ = _674_0
2023-12-01 01:10:16 +00:00
return nil
end
end
2023-12-08 18:47:06 +00:00
return _673_(pcall(compiler["compile-string"], tostring(identifier), {scope = scope}))
2023-12-01 01:10:16 +00:00
end
commands.find = function(env, read, on_values, on_error, scope)
2023-12-08 18:47:06 +00:00
local function _681_(_241)
local _682_0 = nil
2023-12-01 01:10:16 +00:00
do
2023-12-08 18:47:06 +00:00
local _683_0 = utils["sym?"](_241)
if (nil ~= _683_0) then
local _684_0 = resolve(_683_0, env, scope)
if (nil ~= _684_0) then
_682_0 = debug.getinfo(_684_0)
2023-12-01 01:10:16 +00:00
else
2023-12-08 18:47:06 +00:00
_682_0 = _684_0
2023-12-01 01:10:16 +00:00
end
else
2023-12-08 18:47:06 +00:00
_682_0 = _683_0
2023-12-01 01:10:16 +00:00
end
end
2023-12-08 18:47:06 +00:00
if ((_G.type(_682_0) == "table") and (nil ~= _682_0.linedefined) and (nil ~= _682_0.short_src) and (nil ~= _682_0.source) and (_682_0.what == "Lua")) then
local line = _682_0.linedefined
local src = _682_0.short_src
local source = _682_0.source
2023-12-01 01:10:16 +00:00
local fnlsrc = nil
do
2023-12-08 18:47:06 +00:00
local _687_0 = compiler.sourcemap
if (nil ~= _687_0) then
_687_0 = _687_0[source]
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
if (nil ~= _687_0) then
_687_0 = _687_0[line]
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
if (nil ~= _687_0) then
_687_0 = _687_0[2]
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
fnlsrc = _687_0
2023-12-01 01:10:16 +00:00
end
return on_values({string.format("%s:%s", src, (fnlsrc or line))})
2023-12-08 18:47:06 +00:00
elseif (_682_0 == nil) then
2023-12-01 01:10:16 +00:00
return on_error("Repl", "Unknown value")
else
2023-12-08 18:47:06 +00:00
local _ = _682_0
2023-12-01 01:10:16 +00:00
return on_error("Repl", "No source info")
end
end
2023-12-08 18:47:06 +00:00
return run_command(read, on_error, _681_)
2023-12-01 01:10:16 +00:00
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)
2023-12-08 18:47:06 +00:00
local function _692_(_241)
2023-12-01 01:10:16 +00:00
local name = tostring(_241)
local path = (utils["multi-sym?"](name) or {name})
local ok_3f, target = nil, nil
2023-12-08 18:47:06 +00:00
local function _693_()
2023-12-01 01:10:16 +00:00
return (utils["get-in"](scope.specials, path) or utils["get-in"](scope.macros, path) or resolve(name, env, scope))
end
2023-12-08 18:47:06 +00:00
ok_3f, target = pcall(_693_)
2023-12-01 01:10:16 +00:00
if ok_3f then
return on_values({specials.doc(target, name)})
else
return on_error("Repl", ("Could not find " .. name .. " for docs."))
end
end
2023-12-08 18:47:06 +00:00
return run_command(read, on_error, _692_)
2023-12-01 01:10:16 +00:00
end
do end (compiler.metadata):set(commands.doc, "fnl/docstring", "Print the docstring and arglist for a function, macro, or special form.")
commands.compile = function(env, read, on_values, on_error, scope)
2023-12-08 18:47:06 +00:00
local function _695_(_241)
2023-12-01 01:10:16 +00:00
local allowedGlobals = specials["current-global-names"](env)
local ok_3f, result = pcall(compiler.compile, _241, {allowedGlobals = allowedGlobals, env = env, scope = scope})
if ok_3f then
return on_values({result})
else
return on_error("Repl", ("Error compiling expression: " .. result))
end
end
2023-12-08 18:47:06 +00:00
return run_command(read, on_error, _695_)
2023-12-01 01:10:16 +00:00
end
do end (compiler.metadata):set(commands.compile, "fnl/docstring", "compiles the expression into lua and prints the result.")
local function load_plugin_commands(plugins)
2023-12-08 18:47:06 +00:00
for i = #(plugins or {}), 1, -1 do
for name, f in pairs(plugins[i]) do
local _697_0 = name:match("^repl%-command%-(.*)")
if (nil ~= _697_0) then
local cmd_name = _697_0
commands[cmd_name] = f
2023-12-01 01:10:16 +00:00
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
2023-12-08 18:47:06 +00:00
local _699_0 = commands[command_name]
if (nil ~= _699_0) then
local command = _699_0
2023-12-01 01:10:16 +00:00
command(env, read, on_values, on_error, scope, chars)
else
2023-12-08 18:47:06 +00:00
local _ = _699_0
if ((command_name ~= "exit") and (command_name ~= "return")) then
2023-12-01 01:10:16 +00:00
on_values({"Unknown command", command_name})
end
end
end
if ("exit" ~= command_name) then
2023-12-08 18:47:06 +00:00
return loop((command_name == "return"))
2023-12-01 01:10:16 +00:00
end
end
local function try_readline_21(opts, ok, readline)
if ok then
if readline.set_readline_name then
readline.set_readline_name("fennel")
end
readline.set_options({histfile = "", keeplines = 1000})
opts.readChunk = function(parser_state)
local prompt = nil
if (0 < parser_state["stack-size"]) then
prompt = ".. "
else
prompt = ">> "
end
local str = readline.readline(prompt)
if str then
return (str .. "\n")
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
end
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
2023-12-08 18:47:06 +00:00
local _708_ = utils.copy(_3foptions)
local opts = _708_
local _3ffennelrc = _708_["fennelrc"]
2023-12-01 01:10:16 +00:00
local _ = nil
opts.fennelrc = nil
_ = nil
local readline = (should_use_readline_3f(opts) and try_readline_21(opts, pcall(require, "readline")))
local _0 = nil
if _3ffennelrc then
_0 = _3ffennelrc()
else
_0 = nil
end
local env = specials["wrap-env"]((opts.env or rawget(_G, "_ENV") or _G))
local callbacks = {env = env, onError = (opts.onError or default_on_error), onValues = (opts.onValues or default_on_values), pp = (opts.pp or view), readChunk = (opts.readChunk or default_read_chunk)}
local save_locals_3f = (opts.saveLocals ~= false)
local byte_stream, clear_stream = nil, nil
2023-12-08 18:47:06 +00:00
local function _710_(_241)
2023-12-01 01:10:16 +00:00
return callbacks.readChunk(_241)
end
2023-12-08 18:47:06 +00:00
byte_stream, clear_stream = parser.granulate(_710_)
2023-12-01 01:10:16 +00:00
local chars = {}
local read, reset = nil, nil
2023-12-08 18:47:06 +00:00
local function _711_(parser_state)
2023-12-01 01:10:16 +00:00
local b = byte_stream(parser_state)
if b then
table.insert(chars, string.char(b))
end
return b
end
2023-12-08 18:47:06 +00:00
read, reset = parser.parser(_711_)
depth = (depth + 1)
if opts.message then
callbacks.onValues({opts.message})
end
2023-12-01 01:10:16 +00:00
env.___repl___ = callbacks
opts.env, opts.scope = env, compiler["make-scope"]()
opts.useMetadata = (opts.useMetadata ~= false)
if (opts.allowedGlobals == nil) then
opts.allowedGlobals = specials["current-global-names"](env)
end
2023-12-08 18:47:06 +00:00
if opts.init then
opts.init(opts, depth)
end
2023-12-01 01:10:16 +00:00
if opts.registerCompleter then
2023-12-08 18:47:06 +00:00
local function _717_()
local _716_0 = opts.scope
local function _718_(...)
return completer(env, _716_0, ...)
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
return _718_
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
opts.registerCompleter(_717_())
2023-12-01 01:10:16 +00:00
end
load_plugin_commands(opts.plugins)
if save_locals_3f then
local function newindex(t, k, v)
if opts.scope.manglings[k] then
return rawset(t, k, v)
end
end
env.___replLocals___ = setmetatable({}, {__newindex = newindex})
end
local function print_values(...)
local vals = {...}
local out = {}
local pp = callbacks.pp
env._, env.__ = vals[1], vals
for i = 1, select("#", ...) do
table.insert(out, pp(vals[i]))
end
return callbacks.onValues(out)
end
2023-12-08 18:47:06 +00:00
local function save_value(...)
env.___replLocals___["*3"] = env.___replLocals___["*2"]
env.___replLocals___["*2"] = env.___replLocals___["*1"]
env.___replLocals___["*1"] = ...
return ...
end
opts.scope.manglings["*1"], opts.scope.unmanglings._1 = "_1", "*1"
opts.scope.manglings["*2"], opts.scope.unmanglings._2 = "_2", "*2"
opts.scope.manglings["*3"], opts.scope.unmanglings._3 = "_3", "*3"
local function loop(exit_next_3f)
2023-12-01 01:10:16 +00:00
for k in pairs(chars) do
chars[k] = nil
end
reset()
2023-12-08 18:47:06 +00:00
local ok, parser_not_eof_3f, form = pcall(read)
2023-12-01 01:10:16 +00:00
local src_string = table.concat(chars)
local readline_not_eof_3f = (not readline or (src_string ~= "(null)"))
local not_eof_3f = (readline_not_eof_3f and parser_not_eof_3f)
if not ok then
callbacks.onError("Parse", not_eof_3f)
clear_stream()
return loop()
elseif command_3f(src_string) then
return run_command_loop(src_string, read, loop, env, callbacks.onValues, callbacks.onError, opts.scope, chars)
else
if not_eof_3f then
2023-12-08 18:47:06 +00:00
local function _722_(...)
local _723_0, _724_0 = ...
if ((_723_0 == true) and (nil ~= _724_0)) then
local src = _724_0
local function _725_(...)
local _726_0, _727_0 = ...
if ((_726_0 == true) and (nil ~= _727_0)) then
local chunk = _727_0
local function _728_()
return print_values(save_value(chunk()))
end
local function _729_(...)
return callbacks.onError("Runtime", ...)
end
return xpcall(_728_, _729_)
elseif ((_726_0 == false) and (nil ~= _727_0)) then
local msg = _727_0
clear_stream()
return callbacks.onError("Compile", msg)
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
end
local function _732_(...)
local src0 = nil
if save_locals_3f then
src0 = splice_save_locals(env, src, opts.scope)
else
src0 = src
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
return pcall(specials["load-code"], src0, env)
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
return _725_(_732_(...))
elseif ((_723_0 == false) and (nil ~= _724_0)) then
local msg = _724_0
clear_stream()
return callbacks.onError("Compile", msg)
2023-12-01 01:10:16 +00:00
end
end
2023-12-08 18:47:06 +00:00
local function _734_()
opts["source"] = src_string
return opts
end
_722_(pcall(compiler.compile, form, _734_()))
2023-12-01 01:10:16 +00:00
utils.root.options = old_root_options
2023-12-08 18:47:06 +00:00
if exit_next_3f then
return env.___replLocals___["*1"]
else
return loop()
end
2023-12-01 01:10:16 +00:00
end
end
end
2023-12-08 18:47:06 +00:00
local value = loop()
depth = (depth - 1)
2023-12-01 01:10:16 +00:00
if readline then
2023-12-08 18:47:06 +00:00
readline.save_history()
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
if opts.exit then
opts.exit(opts, depth)
end
return value
2023-12-01 01:10:16 +00:00
end
return repl
end
package.preload["fennel.specials"] = package.preload["fennel.specials"] or function(...)
local utils = require("fennel.utils")
local view = require("fennel.view")
local parser = require("fennel.parser")
local compiler = require("fennel.compiler")
local unpack = (table.unpack or _G.unpack)
local SPECIALS = compiler.scopes.global.specials
local function wrap_env(env)
2023-12-08 18:47:06 +00:00
local function _417_(_, key)
2023-12-01 01:10:16 +00:00
if utils["string?"](key) then
return env[compiler["global-unmangling"](key)]
else
return env[key]
end
end
2023-12-08 18:47:06 +00:00
local function _419_(_, key, value)
2023-12-01 01:10:16 +00:00
if utils["string?"](key) then
env[compiler["global-unmangling"](key)] = value
return nil
else
env[key] = value
return nil
end
end
2023-12-08 18:47:06 +00:00
local function _421_()
2023-12-01 01:10:16 +00:00
local function putenv(k, v)
2023-12-08 18:47:06 +00:00
local _422_
2023-12-01 01:10:16 +00:00
if utils["string?"](k) then
2023-12-08 18:47:06 +00:00
_422_ = compiler["global-unmangling"](k)
2023-12-01 01:10:16 +00:00
else
2023-12-08 18:47:06 +00:00
_422_ = k
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
return _422_, v
2023-12-01 01:10:16 +00:00
end
return next, utils.kvmap(env, putenv), nil
end
2023-12-08 18:47:06 +00:00
return setmetatable({}, {__index = _417_, __newindex = _419_, __pairs = _421_})
2023-12-01 01:10:16 +00:00
end
local function current_global_names(_3fenv)
local mt = nil
do
2023-12-08 18:47:06 +00:00
local _424_0 = getmetatable(_3fenv)
if ((_G.type(_424_0) == "table") and (nil ~= _424_0.__pairs)) then
local mtpairs = _424_0.__pairs
2023-12-01 01:10:16 +00:00
local tbl_14_ = {}
for k, v in mtpairs(_3fenv) do
local k_15_, v_16_ = k, v
if ((k_15_ ~= nil) and (v_16_ ~= nil)) then
tbl_14_[k_15_] = v_16_
end
end
mt = tbl_14_
2023-12-08 18:47:06 +00:00
elseif (_424_0 == nil) then
2023-12-01 01:10:16 +00:00
mt = (_3fenv or _G)
else
mt = nil
end
end
return (mt and utils.kvmap(mt, compiler["global-unmangling"]))
end
local function load_code(code, _3fenv, _3ffilename)
local env = (_3fenv or rawget(_G, "_ENV") or _G)
2023-12-08 18:47:06 +00:00
local _427_0, _428_0 = rawget(_G, "setfenv"), rawget(_G, "loadstring")
if ((nil ~= _427_0) and (nil ~= _428_0)) then
local setfenv = _427_0
local loadstring = _428_0
2023-12-01 01:10:16 +00:00
local f = assert(loadstring(code, _3ffilename))
setfenv(f, env)
return f
else
2023-12-08 18:47:06 +00:00
local _ = _427_0
2023-12-01 01:10:16 +00:00
return assert(load(code, _3ffilename, "t", env))
end
end
local function doc_2a(tgt, name)
if not tgt then
return (name .. " not found")
else
local docstring = (((compiler.metadata):get(tgt, "fnl/docstring") or "#<undocumented>")):gsub("\n$", ""):gsub("\n", "\n ")
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 {"#<unknown-arguments>"}), " ")
2023-12-08 18:47:06 +00:00
local _430_
2023-12-01 01:10:16 +00:00
if (0 < #arglist) then
2023-12-08 18:47:06 +00:00
_430_ = " "
2023-12-01 01:10:16 +00:00
else
2023-12-08 18:47:06 +00:00
_430_ = ""
2023-12-01 01:10:16 +00:00
end
2023-12-08 18:47:06 +00:00
return string.format("(%s%s%s)\n %s", name, _430_, arglist, docstring)
2023-12-01 01:10:16 +00:00
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}
return nil
end
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 = start, len do
compiler.compile1(ast[i], sub_scope, parent, {nval = 0})
end
return nil
end
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)
2023-12-08 18:47:06 +00:00
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_scope, chunk, subopts)
if (i ~= len) then
compiler["keep-side-effects"](subexprs, parent, nil, ast[i])
2023-12-01 01:10:16 +00:00
end
end
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
compiler.emit(parent, "do", ast)
return compile_body(opts.target, opts.tail)
elseif opts.nval then
local syms = {}
for i = 1, opts.nval do
local s = ((_3fpre_syms and _3fpre_syms[i]) or compiler.gensym(scope))
syms[i] = s
retexprs[i] = utils.expr(s, "sym")
end
local outer_target = table.concat(syms