~technomancy/fennel-lang.org

33ea511106ec2746ff75b6af4193fe897a03ae53 — Phil Hagelberg 7 days ago 221fd38 main
Update antifennel to latest version.
1 files changed, 1371 insertions(+), 925 deletions(-)

M antifennel.lua
M antifennel.lua => antifennel.lua +1371 -925
@@ 8,42 8,42 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
  local function any_3f(tbl, pred)
    local _276_
    do
      local tbl_13_auto = {}
      local i_14_auto = #tbl_13_auto
      local tbl_15_auto = {}
      local i_16_auto = #tbl_15_auto
      for _, v in pairs(tbl) do
        local val_15_auto
        local val_17_auto
        if pred(v) then
          val_15_auto = true
          val_17_auto = true
        else
          val_15_auto = nil
          val_17_auto = nil
        end
        if (nil ~= val_15_auto) then
          i_14_auto = (i_14_auto + 1)
          do end (tbl_13_auto)[i_14_auto] = val_15_auto
        if (nil ~= val_17_auto) then
          i_16_auto = (i_16_auto + 1)
          do end (tbl_15_auto)[i_16_auto] = val_17_auto
        else
        end
      end
      _276_ = tbl_13_auto
      _276_ = tbl_15_auto
    end
    return (0 ~= #_276_)
  end
  local function strip_comments(t)
    local tbl_13_auto = {}
    local i_14_auto = #tbl_13_auto
    local tbl_15_auto = {}
    local i_16_auto = #tbl_15_auto
    for _, x in ipairs(t) do
      local val_15_auto
      local val_17_auto
      if not fennel["comment?"](x) then
        val_15_auto = x
        val_17_auto = x
      else
        val_15_auto = nil
        val_17_auto = nil
      end
      if (nil ~= val_15_auto) then
        i_14_auto = (i_14_auto + 1)
        do end (tbl_13_auto)[i_14_auto] = val_15_auto
      if (nil ~= val_17_auto) then
        i_16_auto = (i_16_auto + 1)
        do end (tbl_15_auto)[i_16_auto] = val_17_auto
      else
      end
    end
    return tbl_13_auto
    return tbl_15_auto
  end
  local function view_fn_args(t, view, inspector, indent, start_indent, out, callee)
    if fennel["sym?"](t[2]) then


@@ 294,19 294,18 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
    end
  end
  local slength
  local _313_
  do
  local function _313_(...)
    local _312_ = rawget(_G, "utf8")
    if _312_ then
      _313_ = (_312_).len
    if (nil ~= _312_) then
      return (_312_).len
    else
      _313_ = _312_
      return _312_
    end
  end
  local function _315_(_241)
    return #_241
  end
  slength = (_313_ or _315_)
  slength = (_313_(...) or _315_)
  local function maybe_attach_comment(x, indent, c)
    if c then
      return (tostring(c) .. "\n" .. string.rep(" ", indent) .. x)


@@ 379,36 378,35 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
    local mt = getmetatable(t)
    local keys
    local function _331_()
      local tbl_13_auto = {}
      local i_14_auto = #tbl_13_auto
      local tbl_15_auto = {}
      local i_16_auto = #tbl_15_auto
      for k in pairs(t) do
        local val_15_auto = k
        if (nil ~= val_15_auto) then
          i_14_auto = (i_14_auto + 1)
          do end (tbl_13_auto)[i_14_auto] = val_15_auto
        local val_17_auto = k
        if (nil ~= val_17_auto) then
          i_16_auto = (i_16_auto + 1)
          do end (tbl_15_auto)[i_16_auto] = val_17_auto
        else
        end
      end
      return tbl_13_auto
      return tbl_15_auto
    end
    keys = (mt.keys or _331_())
    local pair_strs
    do
      local tbl_13_auto = {}
      local i_14_auto = #tbl_13_auto
      local tbl_15_auto = {}
      local i_16_auto = #tbl_15_auto
      for _, k in ipairs(keys) do
        local val_15_auto = view_pair(t, view, inspector, indent0, mt, k)
        if (nil ~= val_15_auto) then
          i_14_auto = (i_14_auto + 1)
          do end (tbl_13_auto)[i_14_auto] = val_15_auto
        local val_17_auto = view_pair(t, view, inspector, indent0, mt, k)
        if (nil ~= val_17_auto) then
          i_16_auto = (i_16_auto + 1)
          do end (tbl_15_auto)[i_16_auto] = val_17_auto
        else
        end
      end
      pair_strs = tbl_13_auto
      pair_strs = tbl_15_auto
    end
    local oneline = ("{" .. table.concat(pair_strs, " ") .. "}")
    local _335_
    do
    local function _335_()
      local t_334_ = mt
      if (nil ~= t_334_) then
        t_334_ = (t_334_).comments


@@ 418,9 416,9 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
        t_334_ = (t_334_).last
      else
      end
      _335_ = t_334_
      return t_334_
    end
    if (oneline:match("\n") or _335_ or ((indent0 + #oneline) > inspector["line-length"])) then
    if (oneline:match("\n") or _335_() or ((indent0 + #oneline) > inspector["line-length"])) then
      local function _339_()
        local t_338_ = mt
        if (nil ~= t_338_) then


@@ 1343,7 1341,7 @@ package.preload["lang.id_generator"] = package.preload["lang.id_generator"] or f
    end
    return nil
  end
  return {close_gen_variables = close_gen_variables, genid = genid}
  return {genid = genid, close_gen_variables = close_gen_variables}
end
package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(...)
  local id_generator = require("lang.id_generator")


@@ 1360,10 1358,10 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
  end
  local AST = {}
  local function func_decl(id, body, params, vararg, locald, firstline, lastline)
    return build("FunctionDeclaration", {params = params, locald = locald, line = firstline, vararg = vararg, firstline = firstline, lastline = lastline, body = body, id = id})
    return build("FunctionDeclaration", {line = firstline, firstline = firstline, lastline = lastline, locald = locald, id = id, params = params, body = body, vararg = vararg})
  end
  local function func_expr(body, params, vararg, firstline, lastline)
    return build("FunctionExpression", {params = params, vararg = vararg, firstline = firstline, lastline = lastline, body = body})
    return build("FunctionExpression", {firstline = firstline, body = body, params = params, lastline = lastline, vararg = vararg})
  end
  AST.expr_function = function(ast, args, body, proto)
    return func_expr(body, args, proto.varargs, proto.firstline, proto.lastline)


@@ 1387,7 1385,7 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
    return params
  end
  AST.chunk = function(ast, body, chunkname, firstline, lastline)
    return build("Chunk", {firstline = firstline, chunkname = chunkname, lastline = lastline, body = body})
    return build("Chunk", {body = body, firstline = firstline, lastline = lastline, chunkname = chunkname})
  end
  AST.local_decl = function(ast, vlist, exps, line)
    local ids = {}


@@ 1397,14 1395,14 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
    return build("LocalDeclaration", {names = ids, expressions = exps, line = line})
  end
  AST.assignment_expr = function(ast, vars, exps, line)
    return build("AssignmentExpression", {right = exps, line = line, left = vars})
    return build("AssignmentExpression", {left = vars, right = exps, line = line})
  end
  AST.expr_index = function(ast, v, index, line)
    return build("MemberExpression", {property = index, computed = true, line = line, object = v})
    return build("MemberExpression", {object = v, property = index, computed = true, line = line})
  end
  AST.expr_property = function(ast, v, prop, line)
    local index = ident(ast, prop, line, true)
    return build("MemberExpression", {property = index, computed = false, line = line, object = v})
    return build("MemberExpression", {object = v, property = index, computed = false, line = line})
  end
  AST.literal = function(ast, val)
    return build("Literal", {value = val})


@@ 1425,10 1423,10 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
    end
  end
  AST.expr_table = function(ast, keyvals, line)
    return build("Table", {line = line, keyvals = keyvals})
    return build("Table", {keyvals = keyvals, line = line})
  end
  AST.expr_unop = function(ast, op, v, line)
    return build("UnaryExpression", {line = line, argument = v, operator = op})
    return build("UnaryExpression", {operator = op, line = line, argument = v})
  end
  local function concat_append(ts, node)
    local n = #ts


@@ 1443,7 1441,7 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
    end
  end
  AST.expr_binop = function(ast, op, expa, expb, line)
    local binop_body = ((op ~= "..") and {right = expb, operator = op, line = line, left = expa})
    local binop_body = ((op ~= "..") and {left = expa, operator = op, right = expb, line = line})
    if binop_body then
      if ((op == "and") or (op == "or")) then
        return build("LogicalExpression", binop_body)


@@ 1454,7 1452,7 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
      local terms = {}
      concat_append(terms, expa)
      concat_append(terms, expb)
      return build("ConcatenateExpression", {terms = terms, line = expa.line})
      return build("ConcatenateExpression", {line = expa.line, terms = terms})
    end
  end
  AST.identifier = function(ast, name)


@@ 1462,10 1460,10 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
  end
  AST.expr_method_call = function(ast, v, key, args, line)
    local m = ident(ast, key, nil, true)
    return build("SendExpression", {receiver = v, method = m, arguments = args, line = line})
    return build("SendExpression", {arguments = args, line = line, receiver = v, method = m})
  end
  AST.expr_function_call = function(ast, v, args, line)
    return build("CallExpression", {line = line, arguments = args, callee = v})
    return build("CallExpression", {arguments = args, callee = v, line = line})
  end
  AST.return_stmt = function(ast, exps, line)
    return build("ReturnStatement", {arguments = exps, line = line})


@@ 1480,24 1478,24 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
    return build("ExpressionStatement", {line = line, expression = expr})
  end
  AST.if_stmt = function(ast, tests, cons, else_branch, line)
    return build("IfStatement", {tests = tests, cons = cons, line = line, alternate = else_branch})
    return build("IfStatement", {line = line, alternate = else_branch, tests = tests, cons = cons})
  end
  AST.do_stmt = function(ast, body, line, lastline)
    return build("DoStatement", {lastline = lastline, line = line, body = body})
    return build("DoStatement", {body = body, lastline = lastline, line = line})
  end
  AST.while_stmt = function(ast, test, body, line, lastline)
    return build("WhileStatement", {lastline = lastline, test = test, line = line, body = body})
    return build("WhileStatement", {body = body, lastline = lastline, line = line, test = test})
  end
  AST.repeat_stmt = function(ast, test, body, line, lastline)
    return build("RepeatStatement", {lastline = lastline, test = test, line = line, body = body})
    return build("RepeatStatement", {body = body, lastline = lastline, line = line, test = test})
  end
  AST.for_stmt = function(ast, ___var___, init, last, step, body, line, lastline)
    local for_init = build("ForInit", {value = init, line = line, id = ___var___})
    return build("ForStatement", {line = line, lastline = lastline, last = last, init = for_init, step = step, body = body})
    local for_init = build("ForInit", {id = ___var___, value = init, line = line})
    return build("ForStatement", {step = step, lastline = lastline, last = last, line = line, body = body, init = for_init})
  end
  AST.for_iter_stmt = function(ast, vars, exps, body, line, lastline)
    local names = build("ForNames", {names = vars, line = line})
    return build("ForInStatement", {namelist = names, line = line, lastline = lastline, explist = exps, body = body})
    local names = build("ForNames", {line = line, names = vars})
    return build("ForInStatement", {explist = exps, lastline = lastline, body = body, namelist = names, line = line})
  end
  AST.goto_stmt = function(ast, name, line)
    return build("GotoStatement", {line = line, label = name})


@@ 1549,7 1547,7 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
      end
      return nil
    end
    return {lookup = lookup, declare = declare, scope_exit = scope_exit, scope_enter = scope_enter}
    return {lookup = lookup, scope_enter = scope_enter, scope_exit = scope_exit, declare = declare}
  end
  local function default_mangle(name)
    return name


@@ 1568,7 1566,7 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
  return {New = new_ast}
end
package.preload["lang.operator"] = package.preload["lang.operator"] or function(...)
  local binop = {[">"] = ((3 * 256) + 3), ["<"] = ((3 * 256) + 3), ["^"] = ((10 * 256) + 9), ["/"] = ((7 * 256) + 7), ["=="] = ((3 * 256) + 3), ["or"] = ((1 * 256) + 1), ["%"] = ((7 * 256) + 7), ["and"] = ((2 * 256) + 2), ["<="] = ((3 * 256) + 3), [">="] = ((3 * 256) + 3), ["~="] = ((3 * 256) + 3), ["+"] = ((6 * 256) + 6), ["-"] = ((6 * 256) + 6), ["*"] = ((7 * 256) + 7), [".."] = ((5 * 256) + 4)}
  local binop = {["~="] = ((3 * 256) + 3), ["-"] = ((6 * 256) + 6), ["+"] = ((6 * 256) + 6), ["/"] = ((7 * 256) + 7), ["and"] = ((2 * 256) + 2), ["^"] = ((10 * 256) + 9), ["*"] = ((7 * 256) + 7), ["or"] = ((1 * 256) + 1), ["%"] = ((7 * 256) + 7), [">"] = ((3 * 256) + 3), ["<"] = ((3 * 256) + 3), [">="] = ((3 * 256) + 3), ["<="] = ((3 * 256) + 3), [".."] = ((5 * 256) + 4), ["=="] = ((3 * 256) + 3)}
  local unary_priority = 8
  local ident_priority = 16
  local function is_binop(op)


@@ 1585,7 1583,7 @@ end
package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
  local operator = require("lang.operator")
  local LJ_52 = false
  local End_of_block = {TK_else = true, TK_elseif = true, TK_end = true, TK_until = true, TK_eof = true}
  local End_of_block = {TK_elseif = true, TK_end = true, TK_until = true, TK_eof = true, TK_else = true}
  local function err_syntax(ls, em)
    return ls:error(ls.token, em)
  end


@@ 2155,10 2153,10 @@ package.preload["lang.lexer"] = package.preload["lang.lexer"] or function(...)
  local ASCII_a, ASCII_f, ASCII_z = 97, 102, 122
  local ASCII_A, ASCII_Z = 65, 90
  local END_OF_STREAM = ( - 1)
  local Reserved_keyword = {["and"] = 1, ["break"] = 2, ["do"] = 3, ["else"] = 4, ["elseif"] = 5, ["end"] = 6, ["false"] = 7, ["for"] = 8, ["function"] = 9, ["goto"] = 10, ["if"] = 11, ["in"] = 12, ["local"] = 13, ["nil"] = 14, ["not"] = 15, ["or"] = 16, ["repeat"] = 17, ["return"] = 18, ["then"] = 19, ["true"] = 20, ["until"] = 21, ["while"] = 22}
  local Reserved_keyword = {["nil"] = 14, ["not"] = 15, ["or"] = 16, ["repeat"] = 17, ["return"] = 18, ["then"] = 19, ["true"] = 20, ["until"] = 21, ["while"] = 22, ["and"] = 1, ["break"] = 2, ["do"] = 3, ["else"] = 4, ["elseif"] = 5, ["end"] = 6, ["false"] = 7, ["for"] = 8, ["function"] = 9, ["goto"] = 10, ["if"] = 11, ["in"] = 12, ["local"] = 13}
  local uint64, int64 = ffi.typeof("uint64_t"), ffi.typeof("int64_t")
  local complex = ffi.typeof("complex")
  local Token_symbol = {TK_le = "<=", TK_concat = "..", TK_eq = "==", TK_ne = "~=", TK_eof = "<eof>", TK_ge = ">="}
  local Token_symbol = {TK_ge = ">=", TK_le = "<=", TK_concat = "..", TK_eq = "==", TK_ne = "~=", TK_eof = "<eof>"}
  local function token2str(tok)
    if string.match(tok, "^TK_") then
      return (Token_symbol[tok] or string.sub(tok, 4))


@@ 2422,7 2420,7 @@ package.preload["lang.lexer"] = package.preload["lang.lexer"] or function(...)
      return nil
    end
  end
  local Escapes = {f = "\12", a = "\7", b = "\8", n = "\n", v = "\11", t = "\9", r = "\13"}
  local Escapes = {n = "\n", v = "\11", t = "\9", r = "\13", b = "\8", a = "\7", f = "\12"}
  local function hex_char(c)
    if string.match(c, "^%x") then
      local b = ___band___(strbyte(c), 15)


@@ 2654,7 2652,7 @@ package.preload["lang.lexer"] = package.preload["lang.lexer"] or function(...)
    end
    return nil
  end
  local Lexer = {token2str = token2str, error = lex_error}
  local Lexer = {error = lex_error, token2str = token2str}
  Lexer.next = function(ls)
    ls.lastline = ls.linenumber
    if (ls.tklookahead == "TK_eof") then


@@ 2677,7 2675,7 @@ package.preload["lang.lexer"] = package.preload["lang.lexer"] or function(...)
  local Lexer_class = {__index = Lexer}
  local function lex_setup(read_func, chunkname)
    local header = false
    local ls = {linenumber = 1, tklookahead = "TK_eof", chunkname = chunkname, n = 0, space_buf = "", lastline = 1, read_func = read_func}
    local ls = {space_buf = "", n = 0, read_func = read_func, linenumber = 1, chunkname = chunkname, lastline = 1, tklookahead = "TK_eof"}
    nextchar(ls)
    if ((((ls.current == "\239") and (ls.n >= 2)) and (byte(ls, 0) == "\187")) and (byte(ls, 1) == "\191")) then
      ls.n = (ls.n - 2)


@@ 2718,14 2716,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local view = require("fennel.view")
    local unpack = (table.unpack or _G.unpack)
    local function default_read_chunk(parser_state)
      local function _488_()
      local function _519_()
        if (0 < parser_state["stack-size"]) then
          return ".."
        else
          return ">> "
        end
      end
      io.write(_488_())
      io.write(_519_())
      io.flush()
      local input = io.read()
      return (input and (input .. "\n"))


@@ 2735,22 2733,23 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return io.write("\n")
    end
    local function default_on_error(errtype, err, lua_source)
      local function _490_()
        local _489_ = errtype
        if (_489_ == "Lua Compile") then
      local function _521_()
        local _520_ = errtype
        if (_520_ == "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 (_489_ == "Runtime") then
        elseif (_520_ == "Runtime") then
          return (compiler.traceback(tostring(err), 4) .. "\n")
        else
          local _ = _489_
        elseif true then
          local _ = _520_
          return ("%s error: %s\n"):format(errtype, tostring(err))
        else
          return nil
        end
      end
      return io.write(_490_())
      return io.write(_521_())
    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___ = (rawget(env, "___replLocals___") or {})
      local spliced_source = {}
      local bind = "local %s = ___replLocals___['%s']"
      for line in lua_source:gmatch("([^\n]+)\n?") do


@@ 2761,6 2760,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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


@@ 2777,14 2777,15 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            k0 = k
          end
          if ((#matches < 2000) and (type(k0) == "string") and (input == k0:sub(0, #input)) and (not method_3f or ("function" == type(tbl[k0])))) then
            local function _494_()
            local function _525_()
              if method_3f then
                return (prefix .. ":" .. k0)
              else
                return (prefix .. k0)
              end
            end
            table.insert(matches, _494_())
            table.insert(matches, _525_())
          else
          end
        end
        return nil


@@ 2805,6 2806,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          else
            return add_matches(tail, tbl[raw_head], (prefix .. head))
          end
        else
          return nil
        end
      end
      local function add_matches(input, tbl, prefix)


@@ 2833,24 2836,30 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return input:match("^%s*,")
    end
    local function command_docs()
      local _501_
      local _532_
      do
        local tbl_13_auto = {}
        local tbl_14_auto = {}
        local i_15_auto = #tbl_14_auto
        for name, f in pairs(commands) do
          tbl_13_auto[(#tbl_13_auto + 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
        _501_ = tbl_13_auto
        _532_ = tbl_14_auto
      end
      return table.concat(_501_, "\n")
      return table.concat(_532_, "\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 _502_, _503_ = pcall(specials["load-code"]("return require(...)", env), module_name)
      if ((_502_ == true) and (nil ~= _503_)) then
        local old = _503_
      local _534_, _535_ = pcall(specials["load-code"]("return require(...)", env), module_name)
      if ((_534_ == true) and (nil ~= _535_)) then
        local old = _535_
        local _
        package.loaded[module_name] = nil
        _ = nil


@@ 2869,36 2878,40 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          for k in pairs(old) do
            if (nil == (new0)[k]) then
              old[k] = nil
            else
            end
          end
          package.loaded[module_name] = old
        else
        end
        return on_values({"ok"})
      elseif ((_502_ == false) and (nil ~= _503_)) then
        local msg = _503_
        local function _508_()
          local _507_ = msg:gsub("\n.*", "")
          return _507_
      elseif ((_534_ == false) and (nil ~= _535_)) then
        local msg = _535_
        local function _540_()
          local _539_ = msg:gsub("\n.*", "")
          return _539_
        end
        return on_error("Runtime", _508_())
        return on_error("Runtime", _540_())
      else
        return nil
      end
    end
    local function run_command(read, on_error, f)
      local _510_, _511_, _512_ = pcall(read)
      if ((_510_ == true) and (_511_ == true) and (nil ~= _512_)) then
        local val = _512_
      local _542_, _543_, _544_ = pcall(read)
      if ((_542_ == true) and (_543_ == true) and (nil ~= _544_)) then
        local val = _544_
        return f(val)
      elseif ((_510_ == false) and true and true) then
        local _3fparse_ok = _511_
        local _3ferr = _512_
      elseif (_542_ == 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 function _514_(_241)
      local function _546_(_241)
        return reload(tostring(_241), env, on_values, on_error)
      end
      return run_command(read, on_error, _514_)
      return run_command(read, on_error, _546_)
    end
    do end (compiler.metadata):set(commands.reload, "fnl/docstring", "Reload the specified module.")
    commands.reset = function(env, _, on_values)


@@ 2907,68 2920,84 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    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)
      local function _515_()
      local function _547_()
        return on_values(completer(env, scope, string.char(unpack(chars)):gsub(",complete +", ""):sub(1, -2)))
      end
      return run_command(read, on_error, _515_)
      return run_command(read, on_error, _547_)
    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 _516_ = type(subtbl)
          if (_516_ == "function") then
          local _548_ = type(subtbl)
          if (_548_ == "function") then
            if ((prefix .. name)):match(pattern) then
              table.insert(names, (prefix .. name))
            else
            end
          elseif (_516_ == "table") then
          elseif (_548_ == "table") then
            if not seen[subtbl] then
              local _519_
              local _551_
              do
                local _518_ = seen
                _518_[subtbl] = true
                _519_ = _518_
                local _550_ = seen
                _550_[subtbl] = true
                _551_ = _550_
              end
              apropos_2a(pattern, subtbl, (prefix .. name:gsub("%.", "/") .. "."), _519_, names)
              apropos_2a(pattern, subtbl, (prefix .. name:gsub("%.", "/") .. "."), _551_, names)
            else
            end
          else
          end
        else
        end
      end
      return names
    end
    local function apropos(pattern)
      local names = apropos_2a(pattern, package.loaded, "", {}, {})
      local tbl_13_auto = {}
      local tbl_14_auto = {}
      local i_15_auto = #tbl_14_auto
      for _, name in ipairs(names) do
        tbl_13_auto[(#tbl_13_auto + 1)] = name:gsub("^_G%.", "")
        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_13_auto
      return tbl_14_auto
    end
    commands.apropos = function(_env, read, on_values, on_error, _scope)
      local function _523_(_241)
      local function _556_(_241)
        return on_values(apropos(tostring(_241)))
      end
      return run_command(read, on_error, _523_)
      return run_command(read, on_error, _556_)
    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_13_auto = {}
        local tbl_14_auto = {}
        local i_15_auto = #tbl_14_auto
        for p in path:gmatch("[^%.]+") do
          tbl_13_auto[(#tbl_13_auto + 1)] = p
          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_13_auto
        paths = tbl_14_auto
      end
      local tgt = package.loaded
      for _, path0 in ipairs(paths) do
        if (nil == tgt) then break end
        local _525_
        local _559_
        do
          local _524_ = path0:gsub("%/", ".")
          _525_ = _524_
          local _558_ = path0:gsub("%/", ".")
          _559_ = _558_
        end
        tgt = tgt[_525_]
        tgt = tgt[_559_]
      end
      return tgt
    end


@@ 2977,22 3006,25 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      for _, path in ipairs(apropos(".*")) do
        local tgt = apropos_follow_path(path)
        if ("function" == type(tgt)) then
          local _526_ = (compiler.metadata):get(tgt, "fnl/docstring")
          if (nil ~= _526_) then
            local docstr = _526_
          local _560_ = (compiler.metadata):get(tgt, "fnl/docstring")
          if (nil ~= _560_) then
            local docstr = _560_
            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 _530_(_241)
      local function _564_(_241)
        return on_values(apropos_doc(tostring(_241)))
      end
      return run_command(read, on_error, _530_)
      return run_command(read, on_error, _564_)
    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)


@@ 3001,62 3033,129 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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, scope)
      local function _532_(_241)
    commands["apropos-show-docs"] = function(_env, read, on_values, on_error)
      local function _566_(_241)
        return apropos_show_docs(on_values, tostring(_241))
      end
      return run_command(read, on_error, _532_)
      return run_command(read, on_error, _566_)
    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, _567_, scope)
      local _arg_568_ = _567_
      local ___replLocals___ = _arg_568_["___replLocals___"]
      local env = _arg_568_
      local e
      local function _569_(_241, _242)
        return (___replLocals___[_242] or env[_242])
      end
      e = setmetatable({}, {__index = _569_})
      local code = compiler["compile-string"](tostring(identifier), {scope = scope})
      return specials["load-code"](code, e)()
    end
    commands.find = function(env, read, on_values, on_error, scope)
      local function _570_(_241)
        local _571_
        do
          local _572_ = utils["sym?"](_241)
          if (nil ~= _572_) then
            local _573_ = resolve(_572_, env, scope)
            if (nil ~= _573_) then
              _571_ = debug.getinfo(_573_)
            else
              _571_ = _573_
            end
          else
            _571_ = _572_
          end
        end
        if ((_G.type(_571_) == "table") and (nil ~= (_571_).linedefined) and (nil ~= (_571_).short_src) and (nil ~= (_571_).source) and ((_571_).what == "Lua")) then
          local line = (_571_).linedefined
          local src = (_571_).short_src
          local source = (_571_).source
          local fnlsrc
          do
            local t_576_ = compiler.sourcemap
            if (nil ~= t_576_) then
              t_576_ = (t_576_)[source]
            else
            end
            if (nil ~= t_576_) then
              t_576_ = (t_576_)[line]
            else
            end
            if (nil ~= t_576_) then
              t_576_ = (t_576_)[2]
            else
            end
            fnlsrc = t_576_
          end
          return on_values({string.format("%s:%s", src, (fnlsrc or line))})
        elseif (_571_ == nil) then
          return on_error("Repl", "Unknown value")
        elseif true then
          local _ = _571_
          return on_error("Repl", "No source info")
        else
          return nil
        end
      end
      return run_command(read, on_error, _570_)
    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 _581_(_241)
        local name = tostring(_241)
        local target = (scope.specials[name] or scope.macros[name] or resolve(name, env, scope))
        return on_values({specials.doc(target, name)})
      end
      return run_command(read, on_error, _581_)
    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 _533_ = name:match("^repl%-command%-(.*)")
          if (nil ~= _533_) then
            local cmd_name = _533_
          local _582_ = name:match("^repl%-command%-(.*)")
          if (nil ~= _582_) then
            local cmd_name = _582_
            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, plugins)
    local function run_command_loop(input, read, loop, env, on_values, on_error, scope, chars)
      local command_name = input:match(",([^%s/]+)")
      do
        local _535_ = commands[command_name]
        if (nil ~= _535_) then
          local command = _535_
        local _584_ = commands[command_name]
        if (nil ~= _584_) then
          local command = _584_
          command(env, read, on_values, on_error, scope, chars)
        else
          local _ = _535_
        elseif true then
          local _ = _584_
          if ("exit" ~= command_name) then
            on_values({"Unknown command", command_name})
          else
          end
        else
        end
      end
      if ("exit" ~= command_name) then
        return loop()
      else
        return nil
      end
    end
    local function repl(options)
      local old_root_options = utils.root.options
      local env
      if options.env then
        env = specials["wrap-env"](options.env)
      else
        env = setmetatable({}, {__index = (rawget(_G, "_ENV") or _G)})
      end
      local env = specials["wrap-env"]((options.env or (rawget(_G, "_ENV") or _G)))
      local save_locals_3f = ((options.saveLocals ~= false) and env.debug and env.debug.getlocal)
      local opts = {}
      local _
      for k, v in pairs(options) do
        opts[k] = v
      end
      _ = nil
      local opts = utils.copy(options)
      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)


@@ 3064,29 3163,42 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local byte_stream, clear_stream = parser.granulate(read_chunk)
      local chars = {}
      local read, reset = nil, nil
      local function _540_(parser_state)
      local function _588_(parser_state)
        local c = byte_stream(parser_state)
        table.insert(chars, c)
        return c
      end
      read, reset = parser.parser(_540_)
      read, reset = parser.parser(_588_)
      opts.env, opts.scope = env, compiler["make-scope"]()
      opts.useMetadata = (options.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 _544_()
          local _542_ = env
          local _543_ = opts.scope
          local function _545_(...)
            return completer(_542_, _543_, ...)
        local function _592_()
          local _590_ = env
          local _591_ = opts.scope
          local function _593_(...)
            return completer(_590_, _591_, ...)
          end
          return _545_
          return _593_
        end
        opts.registerCompleter(_544_())
        opts.registerCompleter(_592_())
      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 = {...}
        local out = {}


@@ 3100,9 3212,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        for k in pairs(chars) do
          chars[k] = nil
        end
        reset()
        local ok, parse_ok_3f, x = pcall(read)
        local src_string = string.char(unpack(chars))
        reset()
        if not ok then
          on_error("Parse", parse_ok_3f)
          clear_stream()


@@ 3112,48 3224,52 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        else
          if parse_ok_3f then
            do
              local _547_, _548_ = nil, nil
              local function _550_()
                local _549_ = opts
                _549_["source"] = src_string
                return _549_
              local _597_, _598_ = nil, nil
              local function _600_()
                local _599_ = opts
                _599_["source"] = src_string
                return _599_
              end
              _547_, _548_ = pcall(compiler.compile, x, _550_())
              if ((_547_ == false) and (nil ~= _548_)) then
                local msg = _548_
              _597_, _598_ = pcall(compiler.compile, x, _600_())
              if ((_597_ == false) and (nil ~= _598_)) then
                local msg = _598_
                clear_stream()
                on_error("Compile", msg)
              elseif ((_547_ == true) and (nil ~= _548_)) then
                local src = _548_
              elseif ((_597_ == true) and (nil ~= _598_)) then
                local src = _598_
                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 _552_, _553_ = pcall(specials["load-code"], src0, env)
                if ((_552_ == false) and (nil ~= _553_)) then
                  local msg = _553_
                local _602_, _603_ = pcall(specials["load-code"], src0, env)
                if ((_602_ == false) and (nil ~= _603_)) then
                  local msg = _603_
                  clear_stream()
                  on_error("Lua Compile", msg, src0)
                elseif (true and (nil ~= _553_)) then
                  local _0 = _552_
                  local chunk = _553_
                  local function _554_()
                elseif (true and (nil ~= _603_)) then
                  local _ = _602_
                  local chunk = _603_
                  local function _604_()
                    return print_values(chunk())
                  end
                  local function _555_()
                    local function _556_(...)
                  local function _605_()
                    local function _606_(...)
                      return on_error("Runtime", ...)
                    end
                    return _556_
                    return _606_
                  end
                  xpcall(_554_, _555_())
                  xpcall(_604_, _605_())
                else
                end
              else
              end
            end
            utils.root.options = old_root_options
            return loop()
          else
            return nil
          end
        end
      end


@@ 3169,14 3285,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local unpack = (table.unpack or _G.unpack)
    local SPECIALS = compiler.scopes.global.specials
    local function wrap_env(env)
      local function _315_(_, key)
      local function _345_(_, key)
        if (type(key) == "string") then
          return env[compiler["global-unmangling"](key)]
        else
          return env[key]
        end
      end
      local function _317_(_, key, value)
      local function _347_(_, key, value)
        if (type(key) == "string") then
          env[compiler["global-unmangling"](key)] = value
          return nil


@@ 3185,56 3301,54 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          return nil
        end
      end
      local function _319_()
      local function _349_()
        local function putenv(k, v)
          local _320_
          local _350_
          if (type(k) == "string") then
            _320_ = compiler["global-unmangling"](k)
            _350_ = compiler["global-unmangling"](k)
          else
            _320_ = k
            _350_ = k
          end
          return _320_, v
          return _350_, v
        end
        return next, utils.kvmap(env, putenv), nil
      end
      return setmetatable({}, {__index = _315_, __newindex = _317_, __pairs = _319_})
      return setmetatable({}, {__index = _345_, __newindex = _347_, __pairs = _349_})
    end
    local function current_global_names(env)
    local function current_global_names(_3fenv)
      local mt
      do
        local _322_ = getmetatable(env)
        local function _323_()
          local __pairs = (_322_).__pairs
          return __pairs
        end
        if (((_G.type(_322_) == "table") and true) and _323_()) then
          local __pairs = (_322_).__pairs
          local tbl_10_auto = {}
          for k, v in __pairs(env) do
            local _324_, _325_ = k, v
            if ((nil ~= _324_) and (nil ~= _325_)) then
              local k_11_auto = _324_
              local v_12_auto = _325_
              tbl_10_auto[k_11_auto] = v_12_auto
        local _352_ = getmetatable(_3fenv)
        if ((_G.type(_352_) == "table") and (nil ~= (_352_).__pairs)) then
          local mtpairs = (_352_).__pairs
          local tbl_11_auto = {}
          for k, v in mtpairs(_3fenv) do
            local _353_, _354_ = k, v
            if ((nil ~= _353_) and (nil ~= _354_)) then
              local k_12_auto = _353_
              local v_13_auto = _354_
              tbl_11_auto[k_12_auto] = v_13_auto
            else
            end
          end
          mt = tbl_10_auto
        elseif (_322_ == nil) then
          mt = (env or _G)
          mt = tbl_11_auto
        elseif (_352_ == nil) then
          mt = (_3fenv or _G)
        else
        mt = nil
          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 _357_ = f
        setfenv(_357_, env)
        return _357_
      else
        return assert(load(code, filename, "t", environment0))
        return assert(load(code, _3ffilename, "t", env))
      end
    end
    local function doc_2a(tgt, name)


@@ 3245,13 3359,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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>"}), " ")
          local _329_
          local _359_
          if (#arglist > 0) then
            _329_ = " "
            _359_ = " "
          else
            _329_ = ""
            _359_ = ""
          end
          return string.format("(%s%s%s)\n  %s", name, _329_, arglist, docstring)
          return string.format("(%s%s%s)\n  %s", name, _359_, arglist, docstring)
        else
          return string.format("%s\n  %s", name, docstring)
        end


@@ 3261,36 3375,38 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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


@@ 3299,7 3415,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      elseif opts.nval then
        local syms = {}
        for i = 1, opts.nval do
          local s = ((pre_syms and pre_syms[i]) or compiler.gensym(scope))
          local s = ((_3fpre_syms and (_3fpre_syms)[i]) or compiler.gensym(scope))
          do end (syms)[i] = s
          retexprs[i] = utils.expr(s, "sym")
        end


@@ 3316,7 3432,6 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          fargs = ""
        end
        compiler.emit(parent, string.format("local function %s(%s)", fname, fargs), ast)
        utils.hook("do", ast, scope)
        return compile_body(nil, true, utils.expr((fname .. "(" .. fargs .. ")"), "statement"))
      end
    end


@@ 3331,33 3446,45 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          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 _338_
        local _368_
        do
          local tbl_13_auto = {}
          local tbl_14_auto = {}
          local i_15_auto = #tbl_14_auto
          for _, v in ipairs(x) do
            tbl_13_auto[(#tbl_13_auto + 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
          _338_ = tbl_13_auto
          _368_ = tbl_14_auto
        end
        return ("[" .. table.concat(_338_, " ") .. "]")
        return ("[" .. table.concat(_368_, " ") .. "]")
      elseif utils["table?"](x) then
        local _339_
        local _370_
        do
          local tbl_13_auto = {}
          local tbl_14_auto = {}
          local i_15_auto = #tbl_14_auto
          for k, v in pairs(x) do
            tbl_13_auto[(#tbl_13_auto + 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
          _339_ = tbl_13_auto
          _370_ = tbl_14_auto
        end
        return ("{" .. table.concat(_339_, " ") .. "}")
        return ("{" .. table.concat(_370_, " ") .. "}")
      elseif (key_3f and (type(x) == "string") and x:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")) then
        return (":" .. x)
      elseif (type(x) == "string") then


@@ 3369,28 3496,31 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function set_fn_metadata(arg_list, docstring, parent, fn_name)
      if utils.root.options.useMetadata then
        local args
        local function _341_(_241)
        local function _373_(_241)
          return ("\"%s\""):format(deep_tostring(_241))
        end
        args = utils.map(arg_list, _341_)
        args = utils.map(arg_list, _373_)
        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 _344_
        local _376_
        if not multi then
          _344_ = compiler["declare-local"](fn_name, {}, scope, ast)
          _376_ = compiler["declare-local"](fn_name, {}, scope, ast)
        else
          _344_ = (compiler["symbol-to-expression"](fn_name, scope))[1]
          _376_ = (compiler["symbol-to-expression"](fn_name, scope))[1]
        end
        return _344_, not multi, 3
        return _376_, not multi, 3
      else
        return nil, true, 2
      end


@@ 3399,13 3529,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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 _347_
      local _379_
      if local_3f then
        _347_ = "local function %s(%s)"
        _379_ = "local function %s(%s)"
      else
        _347_ = "%s = function(%s)"
        _379_ = "%s = function(%s)"
      end
      compiler.emit(parent, string.format(_347_, fn_name, table.concat(arg_name_list, ", ")), ast)
      compiler.emit(parent, string.format(_379_, 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)


@@ 3419,9 3549,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    SPECIALS.fn = function(ast, scope, parent)
      local f_scope
      do
        local _349_ = compiler["make-scope"](scope)
        do end (_349_)["vararg"] = false
        f_scope = _349_
        local _381_ = compiler["make-scope"](scope)
        do end (_381_)["vararg"] = false
        f_scope = _381_
      end
      local f_chunk = {}
      local fn_sym = utils["sym?"](ast[2])


@@ 3461,50 3591,39 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    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)
    SPECIALS.lua = function(ast, _, parent)
      compiler.assert(((#ast == 2) or (#ast == 3)), "expected 1 or 2 arguments", ast)
      local _354_
      local _386_
      do
        local _353_ = utils["sym?"](ast[2])
        if _353_ then
          _354_ = tostring(_353_)
        local _385_ = utils["sym?"](ast[2])
        if (nil ~= _385_) then
          _386_ = tostring(_385_)
        else
          _354_ = _353_
          _386_ = _385_
        end
      end
      if ("nil" ~= _354_) then
      if ("nil" ~= _386_) then
        table.insert(parent, {ast = ast, leaf = tostring(ast[2])})
      else
      end
      local _358_
      local _390_
      do
        local _357_ = utils["sym?"](ast[3])
        if _357_ then
          _358_ = tostring(_357_)
        local _389_ = utils["sym?"](ast[3])
        if (nil ~= _389_) then
          _390_ = tostring(_389_)
        else
          _358_ = _357_
          _390_ = _389_
        end
      end
      if ("nil" ~= _358_) then
      if ("nil" ~= _390_) 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 = tostring(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 _let_361_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
        local value = _let_361_[1]
        return ("print(require('%s').doc(%s, '%s'))"):format((utils.root.options.moduleName or "fennel"), tostring(value), tostring(ast[2]))
        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 _let_363_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
      local lhs = _let_363_[1]
      local _let_393_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
      local lhs = _let_393_[1]
      if (len == 2) then
        return tostring(lhs)
      else


@@ 3514,8 3633,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          if ((type(index) == "string") and utils["valid-lua-identifier?"](index)) then
            table.insert(indices, ("." .. index))
          else
            local _let_364_ = compiler.compile1(index, scope, parent, {nval = 1})
            local index0 = _let_364_[1]
            local _let_394_ = compiler.compile1(index, scope, parent, {nval = 1})
            local index0 = _let_394_[1]
            table.insert(indices, ("[" .. tostring(index0) .. "]"))
          end
        end


@@ 3560,21 3679,26 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    doc_special("var", {"name", "val"}, "Introduce new mutable local.")
    local function kv_3f(t)
      local _368_
      local _398_
      do
        local tbl_13_auto = {}
        local tbl_14_auto = {}
        local i_15_auto = #tbl_14_auto
        for k in pairs(t) do
          local _369_
          local val_16_auto
          if not ("number" == type(k)) then
            _369_ = k
            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
          _369_ = nil
          end
          tbl_13_auto[(#tbl_13_auto + 1)] = _369_
        end
        _368_ = tbl_13_auto
        _398_ = tbl_14_auto
      end
      return (_368_)[1]
      return (_398_)[1]
    end
    SPECIALS.let = function(ast, scope, parent, opts)
      local bindings = ast[2]


@@ 3601,22 3725,24 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
    end
    local function disambiguate_3f(rootstr, parent)
      local function _373_()
        local _372_ = get_prev_line(parent)
        if (nil ~= _372_) then
          local prev_line = _372_
      local function _403_()
        local _402_ = get_prev_line(parent)
        if (nil ~= _402_) then
          local prev_line = _402_
          return prev_line:match("%)$")
        else
          return nil
        end
      end
      return (rootstr:match("^{") or _373_())
      return (rootstr:match("^{") or _403_())
    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 keys = {}
      for i = 3, (#ast - 1) do
        local _let_375_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
        local key = _let_375_[1]
        local _let_405_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
        local key = _let_405_[1]
        table.insert(keys, tostring(key))
      end
      local value = (compiler.compile1(ast[#ast], scope, parent, {nval = 1}))[1]


@@ 3660,6 3786,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      if (1 == (#ast % 2)) then
        table.insert(ast, utils.sym("nil"))
      else
      end
      for i = 2, (#ast - 1), 2 do
        local condchunk = {}


@@ 3704,6 3831,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          compiler.emit(last_buffer, next_buffer, ast)
          compiler.emit(last_buffer, "end", ast)
          last_buffer = next_buffer
        else
        end
      end
      if (wrapper == "iife") then


@@ 3731,13 3859,17 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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 _let_384_ = compiler.compile1(condition, scope, chunk, {nval = 1})
        local condition_lua = _let_384_[1]
        local _let_414_ = compiler.compile1(condition, scope, chunk, {nval = 1})
        local condition_lua = _let_414_[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)


@@ 3760,7 3892,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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)


@@ 3806,7 3938,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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)


@@ 3817,10 3949,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    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 _let_388_ = ast
      local _ = _let_388_[1]
      local _0 = _let_388_[2]
      local method_string = _let_388_[3]
      local _let_418_ = ast
      local _ = _let_418_[1]
      local _0 = _let_418_[2]
      local method_string = _let_418_[3]
      local call_string
      if ((target.type == "literal") or (target.type == "varg") or (target.type == "expression")) then
        call_string = "(%s):%s(%s)"


@@ 3842,18 3974,18 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local function method_call(ast, scope, parent)
      compiler.assert((2 < #ast), "expected at least 2 arguments", ast)
      local _let_390_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
      local target = _let_390_[1]
      local _let_420_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
      local target = _let_420_[1]
      local args = {}
      for i = 4, #ast do
        local subexprs
        local _391_
        local _421_
        if (i ~= #ast) then
          _391_ = 1
          _421_ = 1
        else
        _391_ = nil
          _421_ = nil
        end
        subexprs = compiler.compile1(ast[i], scope, parent, {nval = _391_})
        subexprs = compiler.compile1(ast[i], scope, parent, {nval = _421_})
        utils.map(subexprs, tostring, args)
      end
      if ((type(ast[3]) == "string") and utils["valid-lua-identifier?"](ast[3])) then


@@ 3891,10 4023,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      compiler.assert((#ast == 2), "expected one argument", ast)
      local f_scope
      do
        local _396_ = compiler["make-scope"](scope)
        do end (_396_)["vararg"] = false
        _396_["hashfn"] = true
        f_scope = _396_
        local _426_ = compiler["make-scope"](scope)
        do end (_426_)["vararg"] = false
        _426_["hashfn"] = true
        f_scope = _426_
      end
      local f_chunk = {}
      local name = compiler.gensym(scope)


@@ 3918,6 4050,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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
      if f_scope.vararg then


@@ 3936,48 4069,47 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local operands = {}
      local padded_op = (" " .. name .. " ")
      for i = 2, len do
        local subexprs
        local _400_
        if (i < len) then
          _400_ = 1
        local subexprs = compiler.compile1(ast[i], scope, parent)
        if (i == len) then
          utils.map(subexprs, tostring, operands)
        else
        _400_ = nil
          table.insert(operands, tostring(subexprs[1]))
        end
        subexprs = compiler.compile1(ast[i], scope, parent, {nval = _400_})
        utils.map(subexprs, tostring, operands)
      end
      local _402_ = #operands
      if (_402_ == 0) then
        local _404_
      local _431_ = #operands
      if (_431_ == 0) then
        local _433_
        do
          local _403_ = zero_arity
          compiler.assert(_403_, "Expected more than 0 arguments", ast)
          _404_ = _403_
          local _432_ = zero_arity
          compiler.assert(_432_, "Expected more than 0 arguments", ast)
          _433_ = _432_
        end
        return utils.expr(_404_, "literal")
      elseif (_402_ == 1) then
        return utils.expr(_433_, "literal")
      elseif (_431_ == 1) then
        if unary_prefix then
          return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")")
        else
          return operands[1]
        end
      else
        local _ = _402_
      elseif true then
        local _ = _431_
        return ("(" .. table.concat(operands, padded_op) .. ")")
      else
        return nil
      end
    end
    local function define_arithmetic_special(name, zero_arity, unary_prefix, lua_name)
      local _410_
    local function define_arithmetic_special(name, zero_arity, unary_prefix, _3flua_name)
      local _439_
      do
        local _407_ = (lua_name or name)
        local _408_ = zero_arity
        local _409_ = unary_prefix
        local function _411_(...)
          return arithmetic_special(_407_, _408_, _409_, ...)
        local _436_ = (_3flua_name or name)
        local _437_ = zero_arity
        local _438_ = unary_prefix
        local function _440_(...)
          return arithmetic_special(_436_, _437_, _438_, ...)
        end
        _410_ = _411_
        _439_ = _440_
      end
      SPECIALS[name] = _410_
      SPECIALS[name] = _439_
      return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.")
    end
    define_arithmetic_special("+", "0")


@@ 4006,13 4138,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        local prefixed_lib_name = ("bit." .. lib_name)
        for i = 2, len do
          local subexprs
          local _412_
          local _441_
          if (i ~= len) then
            _412_ = 1
            _441_ = 1
          else
          _412_ = nil
            _441_ = nil
          end
          subexprs = compiler.compile1(ast[i], scope, parent, {nval = _412_})
          subexprs = compiler.compile1(ast[i], scope, parent, {nval = _441_})
          utils.map(subexprs, tostring, operands)
        end
        if (#operands == 1) then


@@ 4031,18 4163,18 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
    end
    local function define_bitop_special(name, zero_arity, unary_prefix, native)
      local _422_
      local _451_
      do
        local _418_ = native
        local _419_ = name
        local _420_ = zero_arity
        local _421_ = unary_prefix
        local function _423_(...)
          return bitop_special(_418_, _419_, _420_, _421_, ...)
        local _447_ = native
        local _448_ = name
        local _449_ = zero_arity
        local _450_ = unary_prefix
        local function _452_(...)
          return bitop_special(_447_, _448_, _449_, _450_, ...)
        end
        _422_ = _423_
        _451_ = _452_
      end
      SPECIALS[name] = _422_
      SPECIALS[name] = _451_
      return nil
    end
    define_bitop_special("lshift", nil, "1", "<<")


@@ 4056,15 4188,15 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    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.")
    doc_special("..", {"a", "b", "..."}, "String concatenation operator; works the same as Lua but accepts more arguments.")
    local function native_comparator(op, _424_, scope, parent)
      local _arg_425_ = _424_
      local _ = _arg_425_[1]
      local lhs_ast = _arg_425_[2]
      local rhs_ast = _arg_425_[3]
      local _let_426_ = compiler.compile1(lhs_ast, scope, parent, {nval = 1})
      local lhs = _let_426_[1]
      local _let_427_ = compiler.compile1(rhs_ast, scope, parent, {nval = 1})
      local rhs = _let_427_[1]
    local function native_comparator(op, _453_, scope, parent)
      local _arg_454_ = _453_
      local _ = _arg_454_[1]
      local lhs_ast = _arg_454_[2]
      local rhs_ast = _arg_454_[3]
      local _let_455_ = compiler.compile1(lhs_ast, scope, parent, {nval = 1})
      local lhs = _let_455_[1]
      local _let_456_ = compiler.compile1(rhs_ast, scope, parent, {nval = 1})
      local rhs = _let_456_[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)


@@ 4081,15 4213,15 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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


@@ 4102,11 4234,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    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


@@ 4120,12 4252,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    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)


@@ 4139,16 4272,17 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local safe_require = nil
    local function safe_compiler_env()
      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}
      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}
    end
    local function combined_mt_pairs(env)
      local combined = {}
      local _let_430_ = getmetatable(env)
      local __index = _let_430_["__index"]
      local _let_459_ = getmetatable(env)
      local __index = _let_459_["__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


@@ 4158,180 4292,205 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function make_compiler_env(ast, scope, parent, _3fopts)
      local provided
      do
        local _432_ = (_3fopts or utils.root.options)
        if ((_G.type(_432_) == "table") and ((_432_)["compiler-env"] == "strict")) then
        local _461_ = (_3fopts or utils.root.options)
        if ((_G.type(_461_) == "table") and ((_461_)["compiler-env"] == "strict")) then
          provided = safe_compiler_env()
        elseif ((_G.type(_432_) == "table") and (nil ~= (_432_).compilerEnv)) then
          local compilerEnv = (_432_).compilerEnv
        elseif ((_G.type(_461_) == "table") and (nil ~= (_461_).compilerEnv)) then
          local compilerEnv = (_461_).compilerEnv
          provided = compilerEnv
        elseif ((_G.type(_432_) == "table") and (nil ~= (_432_)["compiler-env"])) then
          local compiler_env = (_432_)["compiler-env"]
        elseif ((_G.type(_461_) == "table") and (nil ~= (_461_)["compiler-env"])) then
          local compiler_env = (_461_)["compiler-env"]
          provided = compiler_env
        else
          local _ = _432_
        elseif true then
          local _ = _461_
          provided = safe_compiler_env(false)
        else
          provided = nil
        end
      end
      local env
      local function _434_(base)
      local function _463_(base)
        return utils.sym(compiler.gensym((compiler.scopes.macro or scope), base))
      end
      local function _435_()
      local function _464_()
        return compiler.scopes.macro
      end
      local function _436_(symbol)
      local function _465_(symbol)
        compiler.assert(compiler.scopes.macro, "must call from macro", ast)
        return compiler.scopes.macro.manglings[tostring(symbol)]
      end
      local function _437_(form)
      local function _466_(form)
        compiler.assert(compiler.scopes.macro, "must call from macro", ast)
        return compiler.macroexpand(form, compiler.scopes.macro)
      end
      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, list = utils.list, ["list?"] = utils["list?"], ["multi-sym?"] = utils["multi-sym?"], sequence = utils.sequence, ["sequence?"] = utils["sequence?"], sym = utils.sym, ["sym?"] = utils["sym?"], ["table?"] = utils["table?"], ["varg?"] = utils["varg?"], view = view, gensym = _434_, ["get-scope"] = _435_, ["in-scope?"] = _436_, macroexpand = _437_}
      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 = _463_, ["get-scope"] = _464_, ["in-scope?"] = _465_, macroexpand = _466_}
      env._G = env
      return setmetatable(env, {__index = provided, __newindex = provided, __pairs = combined_mt_pairs})
    end
    local function _439_(...)
      local tbl_13_auto = {}
    local function _468_(...)
      local tbl_14_auto = {}
      local i_15_auto = #tbl_14_auto
      for c in string.gmatch((package.config or ""), "([^\n]+)") do
        tbl_13_auto[(#tbl_13_auto + 1)] = c
        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
        end
      end
      return tbl_13_auto
      return tbl_14_auto
    end
    local _local_438_ = _439_(...)
    local dirsep = _local_438_[1]
    local pathsep = _local_438_[2]
    local pathmark = _local_438_[3]
    local _local_467_ = _468_(...)
    local dirsep = _local_467_[1]
    local pathsep = _local_467_[2]
    local pathmark = _local_467_[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 _440_ = (io.open(filename) or io.open(filename2))
        if (nil ~= _440_) then
          local file = _440_
        local _470_ = (io.open(filename) or io.open(filename2))
        if (nil ~= _470_) then
          local file = _470_
          file:close()
          return filename
        else
          return nil
        end
      end
      local function find_in_path(start)
        local _442_ = fullpath:match(pattern, start)
        if (nil ~= _442_) then
          local path = _442_
        local _472_ = fullpath:match(pattern, start)
        if (nil ~= _472_) then
          local path = _472_
          return (try_path(path) or find_in_path((start + #path + 1)))
        else
          return nil
        end
      end
      return find_in_path(1)
    end
    local function make_searcher(options)
      local function _444_(module_name)
    local function make_searcher(_3foptions)
      local function _474_(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 _445_ = search_module(module_name)
        if (nil ~= _445_) then
          local filename = _445_
          local _448_
        local _475_ = search_module(module_name)
        if (nil ~= _475_) then
          local filename = _475_
          local _478_
          do
            local _446_ = filename
            local _447_ = opts
            local function _449_(...)
              return utils["fennel-module"].dofile(_446_, _447_, ...)
            local _476_ = filename
            local _477_ = opts
            local function _479_(...)
              return utils["fennel-module"].dofile(_476_, _477_, ...)
            end
            _448_ = _449_
            _478_ = _479_
          end
          return _448_, filename
          return _478_, filename
        else
          return nil
        end
      end
      return _444_
      return _474_
    end
    local function fennel_macro_searcher(module_name)
      local opts
      do
        local _451_ = utils.copy(utils.root.options)
        do end (_451_)["env"] = "_COMPILER"
        _451_["allowedGlobals"] = nil
        opts = _451_
      end
      local _452_ = search_module(module_name, utils["fennel-module"]["macro-path"])
      if (nil ~= _452_) then
        local filename = _452_
        local _455_
        local _481_ = utils.copy(utils.root.options)
        do end (_481_)["env"] = "_COMPILER"
        _481_["requireAsInclude"] = false
        _481_["allowedGlobals"] = nil
        opts = _481_
      end
      local _482_ = search_module(module_name, utils["fennel-module"]["macro-path"])
      if (nil ~= _482_) then
        local filename = _482_
        local _485_
        do
          local _453_ = filename
          local _454_ = opts
          local function _456_(...)
            return utils["fennel-module"].dofile(_453_, _454_, ...)
          local _483_ = filename
          local _484_ = opts
          local function _486_(...)
            return utils["fennel-module"].dofile(_483_, _484_, ...)
          end
          _455_ = _456_
          _485_ = _486_
        end
        return _455_, filename
        return _485_, filename
      else
        return nil
      end
    end
    local function lua_macro_searcher(module_name)
      local _458_ = search_module(module_name, package.path)
      if (nil ~= _458_) then
        local filename = _458_
      local _488_ = search_module(module_name, package.path)
      if (nil ~= _488_) then
        local filename = _488_
        local code
        do
          local f = io.open(filename)
          local function close_handlers_7_auto(ok_8_auto, ...)
          local function close_handlers_8_auto(ok_9_auto, ...)
            f:close()
            if ok_8_auto then
            if ok_9_auto then
              return ...
            else
              return error(..., 0)
            end
          end
          local function _460_()
          local function _490_()
            return assert(f:read("*a"))
          end
          code = close_handlers_7_auto(_G.xpcall(_460_, (package.loaded.fennel or debug).traceback))
          code = close_handlers_8_auto(_G.xpcall(_490_, (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 = {lua_macro_searcher, fennel_macro_searcher}
    local macro_searchers = {fennel_macro_searcher, lua_macro_searcher}
    local function search_macro_module(modname, n)
      local _462_ = macro_searchers[n]
      if (nil ~= _462_) then
        local f = _462_
        local _463_, _464_ = f(modname)
        if ((nil ~= _463_) and true) then
          local loader = _463_
          local _3ffilename = _464_
      local _492_ = macro_searchers[n]
      if (nil ~= _492_) then
        local f = _492_
        local _493_, _494_ = f(modname)
        if ((nil ~= _493_) and true) then
          local loader = _493_
          local _3ffilename = _494_
          return loader, _3ffilename
        else
          local _ = _463_
        elseif true then
          local _ = _493_
          return search_macro_module(modname, (n + 1))
        else
          return nil
        end
      else
        return nil
      end
    end
    local function metadata_only_fennel(modname)
      if ((modname == "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 _468_(modname)
      local function _469_()
    local function _498_(modname)
      local function _499_()
        local loader, filename = search_macro_module(modname, 1)
        compiler.assert(loader, (modname .. " module not found."))
        do end (macro_loaded)[modname] = loader(modname, filename)
        return macro_loaded[modname]
      end
      return (macro_loaded[modname] or metadata_only_fennel(modname) or _469_())
      return (macro_loaded[modname] or metadata_only_fennel(modname) or _499_())
    end
    safe_require = _468_
    safe_require = _498_
    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


@@ 4340,26 4499,31 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return nil
    end
    local function resolve_module_name(_470_, _scope, _parent, opts)
      local _arg_471_ = _470_
      local filename = _arg_471_["filename"]
      local second = _arg_471_[2]
    local function resolve_module_name(_500_, _scope, _parent, opts)
      local _arg_501_ = _500_
      local filename = _arg_501_["filename"]
      local second = _arg_501_[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, real_ast)
      compiler.assert((#ast == 2), "Expected one module name argument", (real_ast or ast))
    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(("string" == type(modname)), "module name must compile to string", (real_ast or ast))
      compiler.assert(("string" == type(modname)), "module name must compile to string", (_3freal_ast or ast))
      if not macro_loaded[modname] then
        local loader, filename = search_macro_module(modname, 1)
        compiler.assert(loader, (modname .. " module not found."), ast)
        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)


@@ 4367,6 4531,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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)


@@ 4388,18 4553,18 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local src
      do
        local f = assert(io.open(path))
        local function close_handlers_7_auto(ok_8_auto, ...)
        local function close_handlers_8_auto(ok_9_auto, ...)
          f:close()
          if ok_8_auto then
          if ok_9_auto then
            return ...
          else
            return error(..., 0)
          end
        end
        local function _476_()
        local function _507_()
          return f:read("*all"):gsub("[\13\n]*$", "")
        end
        src = close_handlers_7_auto(_G.xpcall(_476_, (package.loaded.fennel or debug).traceback))
        src = close_handlers_8_auto(_G.xpcall(_507_, (package.loaded.fennel or debug).traceback))
      end
      local ret = utils.expr(("require(\"" .. mod .. "\")"), "statement")
      local target = ("package.preload[%q]"):format(mod)


@@ 4423,19 4588,23 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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
      do
        local _479_, _480_ = pcall(resolve_module_name, ast, scope, parent, opts)
        if ((_479_ == true) and (nil ~= _480_)) then
          local modname = _480_
        local _510_, _511_ = pcall(resolve_module_name, ast, scope, parent, opts)
        if ((_510_ == true) and (nil ~= _511_)) then
          local modname = _511_
          modexpr = utils.expr(string.format("%q", modname), "literal")
        else
          local _ = _479_
        elseif true then
          local _ = _510_
          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


@@ 4451,13 4620,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        utils.root.options["module-name"] = mod
        _ = nil
        local res
        local function _484_()
          local _483_ = search_module(mod)
          if (nil ~= _483_) then
            local fennel_path = _483_
        local function _515_()
          local _514_ = search_module(mod)
          if (nil ~= _514_) then
            local fennel_path = _514_
            return include_path(ast, opts, fennel_path, mod, true)
          else
            local _0 = _483_
          elseif true then
            local _0 = _514_
            local lua_path = search_module(mod, package.path)
            if lua_path then
              return include_path(ast, opts, lua_path, mod, false)


@@ 4466,9 4635,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            else
              return compiler.assert(false, ("module not found " .. mod), ast)
            end
          else
            return nil
          end
        end
        res = ((utils["member?"](mod, (utils.root.options.skipInclude or {})) and utils.expr("nil --[[SKIPPED INCLUDE]]--", "literal")) or include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _484_())
        res = ((utils["member?"](mod, (utils.root.options.skipInclude or {})) and utils.expr("nil --[[SKIPPED INCLUDE]]--", "literal")) or include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _515_())
        utils.root.options["module-name"] = oldmod
        return res
      end


@@ 4502,15 4673,15 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local friend = require("fennel.friend")
    local unpack = (table.unpack or _G.unpack)
    local scopes = {}
    local function make_scope(parent)
      local parent0 = (parent or scopes.global)
      local _182_
      if parent0 then
        _182_ = ((parent0.depth or 0) + 1)
    local function make_scope(_3fparent)
      local parent = (_3fparent or scopes.global)
      local _203_
      if parent then
        _203_ = ((parent.depth or 0) + 1)
      else
        _182_ = 0
        _203_ = 0
      end
      return {includes = setmetatable({}, {__index = (parent0 and parent0.includes)}), macros = setmetatable({}, {__index = (parent0 and parent0.macros)}), manglings = setmetatable({}, {__index = (parent0 and parent0.manglings)}), 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)}), gensyms = setmetatable({}, {__index = (parent0 and parent0.gensyms)}), autogensyms = setmetatable({}, {__index = (parent0 and parent0.autogensyms)}), vararg = (parent0 and parent0.vararg), depth = _182_, hashfn = (parent0 and parent0.hashfn), parent = parent0}
      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 = _203_, hashfn = (parent and parent.hashfn), refedglobals = {}, parent = parent}
    end
    local function assert_msg(ast, msg)
      local ast_tbl


@@ 4527,15 4698,19 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local function assert_compile(condition, msg, ast)
      if not condition then
        local _let_185_ = (utils.root.options or {})
        local source = _let_185_["source"]
        local unfriendly = _let_185_["unfriendly"]
        utils.root.reset()
        if (unfriendly or not friend or not _G.io or not _G.io.read) then
          error(assert_msg(ast, msg), 0)
        local _let_206_ = (utils.root.options or {})
        local source = _let_206_["source"]
        local unfriendly = _let_206_["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


@@ 4545,34 4720,36 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    scopes.macro = scopes.global
    local serialize_subst = {["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "n", ["\11"] = "\\v", ["\12"] = "\\f"}
    local function serialize_string(str)
      local function _188_(_241)
      local function _210_(_241)
        return ("\\" .. _241:byte())
      end
      return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _188_)
      return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _210_)
    end
    local function global_mangling(str)
      if utils["valid-lua-identifier?"](str) then
        return str
      else
        local function _189_(_241)
        local function _211_(_241)
          return string.format("_%02x", _241:byte())
        end
        return ("__fnl_global__" .. str:gsub("[^%w]", _189_))
        return ("__fnl_global__" .. str:gsub("[^%w]", _211_))
      end
    end
    local function global_unmangling(identifier)
      local _191_ = string.match(identifier, "^__fnl_global__(.*)$")
      if (nil ~= _191_) then
        local rest = _191_
        local _192_
        local function _193_(_241)
      local _213_ = string.match(identifier, "^__fnl_global__(.*)$")
      if (nil ~= _213_) then
        local rest = _213_
        local _214_
        local function _215_(_241)
          return string.char(tonumber(_241:sub(2), 16))
        end
        _192_ = string.gsub(rest, "_[%da-f][%da-f]", _193_)
        return _192_
      else
        local _ = _191_
        _214_ = string.gsub(rest, "_[%da-f][%da-f]", _215_)
        return _214_
      elseif true then
        local _ = _213_
        return identifier
      else
        return nil
      end
    end
    local allowed_globals = nil


@@ 4586,7 4763,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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
      if ((utils["lua-keywords"])[str] or str:match("^%d")) then


@@ 4595,14 4772,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        raw = str
      end
      local mangling
      local function _197_(_241)
      local function _219_(_241)
        return string.format("_%02x", _241:byte())
      end
      mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _197_)
      mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _219_)
      local unique = unique_mangling(mangling, mangling, scope, 0)
      do end (scope.unmanglings)[unique] = str
      do
        local manglings = (temp_manglings or scope.manglings)
        local manglings = (_3ftemp_manglings or scope.manglings)
        do end (manglings)[str] = unique
      end
      return unique


@@ 4633,29 4810,31 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      utils.root.scope["gensym-append"] = ((utils.root.scope["gensym-append"] or 0) + 1)
      return ("_" .. utils.root.scope["gensym-append"] .. "_")
    end
    local function gensym(scope, base, _3fsuffix)
      local mangling = ((base or "") .. next_append() .. (_3fsuffix or ""))
    local function gensym(scope, _3fbase, _3fsuffix)
      local mangling = ((_3fbase or "") .. next_append() .. (_3fsuffix or ""))
      while scope.unmanglings[mangling] do
        mangling = ((base or "") .. next_append() .. (_3fsuffix or ""))
        mangling = ((_3fbase or "") .. next_append() .. (_3fsuffix or ""))
      end
      scope.unmanglings[mangling] = (base or true)
      scope.unmanglings[mangling] = (_3fbase or true)
      do end (scope.gensyms)[mangling] = true
      return mangling
    end
    local function autogensym(base, scope)
      local _200_ = utils["multi-sym?"](base)
      if (nil ~= _200_) then
        local parts = _200_
      local _222_ = utils["multi-sym?"](base)
      if (nil ~= _222_) then
        local parts = _222_
        parts[1] = autogensym(parts[1], scope)
        return table.concat(parts, ((parts["multi-sym-method-call"] and ":") or "."))
      else
        local _ = _200_
        local function _201_()
      elseif true then
        local _ = _222_
        local function _223_()
          local mangling = gensym(scope, base:sub(1, ( - 2)), "auto")
          do end (scope.autogensyms)[base] = mangling
          return mangling
        end
        return (scope.autogensyms[base] or _201_())
        return (scope.autogensyms[base] or _223_())
      else
        return nil
      end
    end
    local function check_binding_valid(symbol, scope, ast)


@@ 4664,12 4843,12 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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 = tostring(symbol)
      assert_compile(not utils["multi-sym?"](name), ("unexpected multi symbol " .. name), ast)
      do end (scope.symmeta)[name] = meta
      return local_mangling(name, scope, ast, temp_manglings)
      return local_mangling(name, scope, ast, _3ftemp_manglings)
    end
    local function hashfn_arg_name(name, multi_sym_parts, scope)
      if not scope.hashfn then


@@ 4679,12 4858,15 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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)


@@ 4693,19 4875,21 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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 scope.macros[parts[1]], "tried to reference a macro at runtime", symbol)
      assert_compile((not reference_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) then
        utils.root.scope.refedglobals[parts[1]] = true
      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)


@@ 4725,10 4909,6 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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


@@ 4737,11 4917,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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


@@ 4752,6 4934,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      for i = 1, last do
        if (out[i] == nil) then
          out[i] = ""
        else
        end
      end
      return table.concat(out, "\n")


@@ 4762,22 4945,23 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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
        do
          local _214_ = tab
          if (_214_ == true) then
          local _236_ = tab
          if (_236_ == true) then
            tab0 = "  "
          elseif (_214_ == false) then
          elseif (_236_ == false) then
            tab0 = ""
          elseif (_214_ == tab) then
          elseif (_236_ == tab) then
            tab0 = tab
          elseif (_214_ == nil) then
          elseif (_236_ == nil) then
            tab0 = ""
          else
          tab0 = nil
            tab0 = nil
          end
        end
        local function parter(c)


@@ 4788,12 4972,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            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


@@ 4816,27 5002,31 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          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 _223_(self, tgt, key)
      local function _245_(self, tgt, key)
        if self[tgt] then
          return self[tgt][key]
        else
          return nil
        end
      end
      local function _225_(self, tgt, key, value)
      local function _247_(self, tgt, key, value)
        self[tgt] = (self[tgt] or {})
        do end (self[tgt])[key] = value
        return tgt
      end
      local function _226_(self, tgt, ...)
      local function _248_(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


@@ 4844,7 5034,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        return tgt
      end
      return setmetatable({}, {__index = {get = _223_, set = _225_, setall = _226_}, __mode = "k"})
      return setmetatable({}, {__index = {get = _245_, set = _247_, setall = _248_}, __mode = "k"})
    end
    local function exprs1(exprs)
      return table.concat(utils.map(exprs, tostring), ", ")


@@ 4864,6 5054,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            disambiguated = code
          end
          emit(chunk, disambiguated, ast)
        else
        end
      end
      return nil


@@ 4883,28 5074,32 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
              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 _234_()
        local function _256_()
          if (result == "") then
            return "nil"
          else
            return result
          end
        end
        emit(parent, string.format("%s = %s", opts.target, _234_()), ast)
        emit(parent, string.format("%s = %s", opts.target, _256_()), ast)
      else
      end
      if (opts.tail or opts.target) then
        return {returned = true}
      else
        local _236_ = exprs
        _236_["returned"] = true
        return _236_
        local _258_ = exprs
        _258_["returned"] = true
        return _258_
      end
    end
    local function find_macro(ast, scope, multi_sym_parts)


@@ 4924,36 5119,60 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return macro_2a
      end
    end
    local function macroexpand_2a(ast, scope, once)
      local _240_
    local function propagate_trace_info(_262_, _index, node)
      local _arg_263_ = _262_
      local filename = _arg_263_["filename"]
      local line = _arg_263_["line"]
      local bytestart = _arg_263_["bytestart"]
      local byteend = _arg_263_["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
      end
      return ("table" == type(node))
    end
    local function macroexpand_2a(ast, scope, _3fonce)
      local _265_
      if utils["list?"](ast) then
        _240_ = find_macro(ast, scope, utils["multi-sym?"](ast[1]))
        _265_ = find_macro(ast, scope, utils["multi-sym?"](ast[1]))
      else
      _240_ = nil
        _265_ = nil
      end
      if (_240_ == false) then
      if (_265_ == false) then
        return ast
      elseif (nil ~= _240_) then
        local macro_2a = _240_
      elseif (nil ~= _265_) then
        local macro_2a = _265_
        local old_scope = scopes.macro
        local _
        scopes.macro = scope
        _ = nil
        local ok, transformed = nil, nil
        local function _242_()
        local function _267_()
          return macro_2a(unpack(ast, 2))
        end
        ok, transformed = xpcall(_242_, debug.traceback)
        ok, transformed = xpcall(_267_, debug.traceback)
        local function _269_()
          local _268_ = ast
          local function _270_(...)
            return propagate_trace_info(_268_, ...)
          end
          return _270_
        end
        utils["walk-tree"](transformed, _269_())
        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 _ = _240_
      elseif true then
        local _ = _265_
        return ast
      else
        return nil
      end
    end
    local function compile_special(ast, scope, parent, opts, special)


@@ 4984,13 5203,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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
        local _248_
        local _276_
        if (i ~= len) then
          _248_ = 1
          _276_ = 1
        else
        _248_ = nil
          _276_ = nil
        end
        subexprs = compile1(ast[i], scope, parent, {nval = _248_})
        subexprs = compile1(ast[i], scope, parent, {nval = _276_})
        table.insert(fargs, (subexprs[1] or utils.expr("nil", "literal")))
        if (i == len) then
          for j = 2, #subexprs do


@@ 5043,23 5262,23 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return handle_compile_opts({e}, parent, opts, ast)
    end
    local function serialize_number(n)
      local _254_ = string.gsub(tostring(n), ",", ".")
      return _254_
      local _282_ = string.gsub(tostring(n), ",", ".")
      return _282_
    end
    local function compile_scalar(ast, _scope, parent, opts)
      local serialize
      do
        local _255_ = type(ast)
        if (_255_ == "nil") then
        local _283_ = type(ast)
        if (_283_ == "nil") then
          serialize = tostring
        elseif (_255_ == "boolean") then
        elseif (_283_ == "boolean") then
          serialize = tostring
        elseif (_255_ == "string") then
        elseif (_283_ == "string") then
          serialize = serialize_string
        elseif (_255_ == "number") then
        elseif (_283_ == "number") then
          serialize = serialize_number
        else
        serialize = nil
          serialize = nil
        end
      end
      return handle_compile_opts({utils.expr(serialize(ast), "literal")}, parent, opts)


@@ 5071,31 5290,39 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          if ((type(k) == "string") and utils["valid-lua-identifier?"](k)) then
            return {k, k}
          else
            local _let_257_ = compile1(k, scope, parent, {nval = 1})
            local compiled = _let_257_[1]
            local _let_285_ = compile1(k, scope, parent, {nval = 1})
            local compiled = _let_285_[1]
            local kstr = ("[" .. tostring(compiled) .. "]")
            return {kstr, k}
          end
        else
          return nil
        end
      end
      do
        local keys
        do
          local tbl_13_auto = {}
          local tbl_14_auto = {}
          local i_15_auto = #tbl_14_auto
          for k, v in utils.stablepairs(ast) do
            tbl_13_auto[(#tbl_13_auto + 1)] = write_other_values(k, v)
            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
          keys = tbl_13_auto
        end
        local function _262_(_260_)
          local _arg_261_ = _260_
          local k1 = _arg_261_[1]
          local k2 = _arg_261_[2]
          local _let_263_ = compile1(ast[k2], scope, parent, {nval = 1})
          local v = _let_263_[1]
          keys = tbl_14_auto
        end
        local function _291_(_289_)
          local _arg_290_ = _289_
          local k1 = _arg_290_[1]
          local k2 = _arg_290_[2]
          local _let_292_ = compile1(ast[k2], scope, parent, {nval = 1})
          local v = _let_292_[1]
          return string.format("%s = %s", k1, tostring(v))
        end
        utils.map(keys, _262_, buffer)
        utils.map(keys, _291_, buffer)
      end
      for i = 1, #ast do
        local nval = ((i ~= #ast) and 1)


@@ 5103,31 5330,31 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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 _let_265_ = opts0
      local isvar = _let_265_["isvar"]
      local declaration = _let_265_["declaration"]
      local forceglobal = _let_265_["forceglobal"]
      local forceset = _let_265_["forceset"]
      local symtype = _let_265_["symtype"]
      local _let_294_ = opts0
      local isvar = _let_294_["isvar"]
      local declaration = _let_294_["declaration"]
      local forceglobal = _let_294_["forceglobal"]
      local forceset = _let_294_["forceset"]
      local symtype = _let_294_["symtype"]
      local symtype0 = ("_" .. (symtype or "dst"))
      local setter
      if declaration then


@@ 5149,6 5376,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            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)


@@ 5156,21 5384,23 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            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
        local function _271_(_241)
        local function _300_(_241)
          if scope.manglings[_241] then
            return _241
          else
            return "nil"
          end
        end
        inits = utils.map(lvalues, _271_)
        inits = utils.map(lvalues, _300_)
        local init = table.concat(inits, ", ")
        local lvalue = table.concat(lvalues, ", ")
        local plen, plast = #parent, parent[#parent]


@@ 5179,6 5409,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          for pi = plen, #parent do
            if (parent[pi] == plast) then
              plen = pi
            else
            end
          end
          if ((#parent == (plen + 1)) and parent[#parent].leaf) then


@@ 5188,6 5419,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          else
            table.insert(parent, (plen + 1), {ast = ast, leaf = ("local " .. lvalue .. " = " .. init)})
          end
        else
        end
        return ret
      end


@@ 5202,33 5434,35 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        if declaration then
          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
        do
          local _278_
          local _307_
          if top_3f then
            _278_ = exprs1(compile1(from, scope, parent))
            _307_ = exprs1(compile1(from, scope, parent))
          else
            _278_ = exprs1(rightexprs)
            _307_ = exprs1(rightexprs)
          end
          if (_278_ == "") then
          if (_307_ == "") then
            right = "nil"
          elseif (nil ~= _278_) then
            local right0 = _278_
          elseif (nil ~= _307_) then
            local right0 = _307_
            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 (tostring(v) == "&")) then
              local unpack_str = "{(table.unpack or unpack)(%s, %s)}"
              local formatted = string.format(unpack_str, s, k)
              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)


@@ 5248,6 5482,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
              local subexpr = utils.expr(string.format("%s[%s]", s, key), "expression")
              destructure1(v, {subexpr}, left)
            end
          else
          end
        end
        return nil


@@ 5269,8 5504,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          for _, sym in ipairs(left) do
            if utils["sym?"](sym) then
              scope.symmeta[tostring(sym)] = {var = isvar}
            else
            end
          end
        else
        end
        for _, pair in utils.stablepairs(tables) do
          destructure1(pair[1], {pair[2]}, left)


@@ 5289,6 5526,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        if top_3f then
          return {returned = true}
        else
          return nil
        end
      end
      local ret = destructure1(to, nil, ast, true)


@@ 5313,9 5552,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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


@@ 5324,6 5565,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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()


@@ 5341,13 5586,16 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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)


@@ 5358,24 5606,25 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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
            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 _295_()
          local function _325_()
            if info.name then
              return ("'" .. info.name .. "'")
            else
              return "?"
            end
          end
          return string.format("  %s:%d: in function %s", info.short_src, info.currentline, _295_())
          return string.format("  %s:%d: in function %s", info.short_src, info.currentline, _325_())
        elseif (info.short_src == "(tail call)") then
          return "  (tail call)"
        else


@@ 5399,12 5648,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        local done_3f, level = false, (start or 2)
        while not done_3f do
          do
            local _299_ = debug.getinfo(level, "Sln")
            if (_299_ == nil) then
            local _329_ = debug.getinfo(level, "Sln")
            if (_329_ == nil) then
              done_3f = true
            elseif (nil ~= _299_) then
              local info = _299_
            elseif (nil ~= _329_) then
              local info = _329_
              table.insert(lines, traceback_frame(info))
            else
            end
          end
          level = (level + 1)


@@ 5413,14 5663,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
    end
    local function entry_transform(fk, fv)
      local function _302_(k, v)
      local function _332_(k, v)
        if (type(k) == "number") then
          return k, fv(v)
        else
          return fk(k), fv(v)
        end
      end
      return _302_
      return _332_
    end
    local function mixed_concat(t, joiner)
      local seen = {}


@@ 5434,6 5684,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        if not seen[k] then
          ret = (ret .. s .. "[" .. k .. "]" .. "=" .. v)
          s = joiner
        else
        end
      end
      return ret


@@ 5465,10 5716,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return res[1]
      elseif utils["list?"](form) then
        local mapped
        local function _307_()
        local function _337_()
          return nil
        end
        mapped = utils.kvmap(form, entry_transform(_307_, q))
        mapped = utils.kvmap(form, entry_transform(_337_, q))
        local filename
        if form.filename then
          filename = string.format("%q", form.filename)


@@ 5486,13 5737,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        else
          filename = "nil"
        end
        local _310_
        local _340_
        if source then
          _310_ = source.line
          _340_ = source.line
        else
          _310_ = "nil"
          _340_ = "nil"
        end
        return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _310_, "(getmetatable(sequence()))['sequence']")
        return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _340_, "(getmetatable(sequence()))['sequence']")
      elseif (type(form) == "table") then
        local mapped = utils.kvmap(form, entry_transform(q, q))
        local source = getmetatable(form)


@@ 5502,27 5753,24 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        else
          filename = "nil"
        end
        local function _313_()
        local function _343_()
          if source then
            return source.line
          else
            return "nil"
          end
        end
        return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _313_())
        return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _343_())
      elseif (type(form) == "string") then
        return serialize_string(form)
      else
        return tostring(form)
      end
    end
    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()}
    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["fennel.friend"] = package.preload["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 utils = require("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"}, ["illegal 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"}, ["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)


@@ 5539,6 5787,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          else
            suggestion = sug(matches)
          end
        else
        end
      end
      return suggestion


@@ 5563,6 5812,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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)


@@ 5572,38 5823,43 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return read_line_from_file(filename, line)
      end
    end
    local function friendly_msg(msg, _122_, source)
      local _arg_123_ = _122_
      local filename = _arg_123_["filename"]
      local line = _arg_123_["line"]
      local bytestart = _arg_123_["bytestart"]
      local byteend = _arg_123_["byteend"]
    local function friendly_msg(msg, _142_, source)
      local _arg_143_ = _142_
      local filename = _arg_143_["filename"]
      local line = _arg_143_["line"]
      local bytestart = _arg_143_["bytestart"]
      local byteend = _arg_143_["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 _let_128_ = ast_source(ast)
        local filename = _let_128_["filename"]
        local line = _let_128_["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_148_ = utils["ast-source"](ast)
        local filename = _let_148_["filename"]
        local line = _let_148_["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


@@ 5618,46 5874,50 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local unpack = (table.unpack or _G.unpack)
    local function granulate(getchunk)
      local c, index, done_3f = "", 1, false
      local function _130_(parser_state)
      local function _150_(parser_state)
        if not done_3f then
          if (index <= #c) then
            local b = c:byte(index)
            index = (index + 1)
            return b
          else
            local _131_ = getchunk(parser_state)
            local function _132_()
              local char = _131_
            local _151_ = getchunk(parser_state)
            local function _152_()
              local char = _151_
              return (char ~= "")
            end
            if ((nil ~= _131_) and _132_()) then
              local char = _131_
            if ((nil ~= _151_) and _152_()) then
              local char = _151_
              c = char
              index = 2
              return c:byte()
            else
              local _ = _131_
            elseif true then
              local _ = _151_
              done_3f = true
              return nil
            else
              return nil
            end
          end
        else
          return nil
        end
      end
      local function _136_()
      local function _156_()
        c = ""
        return nil
      end
      return _130_, _136_
      return _150_, _156_
    end
    local function string_stream(str)
      local str0 = str:gsub("^#!", ";;")
      local index = 1
      local function _137_()
      local function _157_()
        local r = str0:byte(index)
        index = (index + 1)
        return r
      end
      return _137_
      return _157_
    end
    local delims = {[40] = 41, [41] = true, [91] = 93, [93] = true, [123] = 125, [125] = true}
    local function whitespace_3f(b)


@@ 5673,7 5933,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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(getbyte, _3ffilename, _3foptions)
      local stack = {}
      local line = 1
      local byteindex = 0


@@ 5681,6 5941,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local function ungetb(ub)
        if (ub == 10) then
          line = (line - 1)
        else
        end
        byteindex = (byteindex - 1)
        lastb = ub


@@ 5696,56 5957,63 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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")
      assert(((nil == _3ffilename) or ("string" == type(_3ffilename))), "expected filename as second argument to parser")
      local function parse_error(msg, byteindex_override)
        local _let_142_ = (options or utils.root.options or {})
        local source = _let_142_["source"]
        local unfriendly = _let_142_["unfriendly"]
        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 or "unknown"), (line or "?"), msg), 0)
        local _let_162_ = (_3foptions or utils.root.options or {})
        local source = _let_162_["source"]
        local unfriendly = _let_162_["unfriendly"]
        if (nil == utils.hook("parse-error", msg, (_3ffilename or "unknown"), (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", (_3ffilename or "unknown"), (line or "?"), msg), 0)
          else
            return friend["parse-error"](msg, (_3ffilename or "unknown"), (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 _144_ = stack[#stack]
          if (_144_ == nil) then
          local _165_ = stack[#stack]
          if (_165_ == nil) then
            retval, done_3f, whitespace_since_dispatch = v, true, false
            return nil
          elseif ((_G.type(_144_) == "table") and (nil ~= (_144_).prefix)) then
            local prefix = (_144_).prefix
          elseif ((_G.type(_165_) == "table") and (nil ~= (_165_).prefix)) then
            local prefix = (_165_).prefix
            local source
            do
              local _145_ = table.remove(stack)
              do end (_145_)["byteend"] = byteindex
              source = _145_
              local _166_ = table.remove(stack)
              do end (_166_)["byteend"] = byteindex
              source = _166_
            end
            local list = utils.list(utils.sym(prefix, source), v)
            for k, v0 in pairs(source) do
              list[k] = v0
            end
            return dispatch(list)
          elseif (nil ~= _144_) then
            local top = _144_
          elseif (nil ~= _165_) then
            local top = _165_
            whitespace_since_dispatch = false
            return table.insert(top, v)
          else
            return nil
          end
        end
        local function badend()
          local accum = utils.map(stack, "closer")
          local _147_
          local _168_
          if (#stack == 1) then
            _147_ = ""
            _168_ = ""
          else
            _147_ = "s"
            _168_ = "s"
          end
          return parse_error(string.format("expected closing delimiter%s %s", _147_, string.char(unpack(accum))))
          return parse_error(string.format("expected closing delimiter%s %s", _168_, string.char(unpack(accum))))
        end
        local function skip_whitespace(b)
          if (b and whitespace_3f(b)) then


@@ 5759,14 6027,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        local function parse_comment(b, contents)
          if (b and (10 ~= b)) then
            local function _151_()
              local _150_ = contents
              table.insert(_150_, string.char(b))
              return _150_
            local function _172_()
              local _171_ = contents
              table.insert(_171_, string.char(b))
              return _171_
            end
            return parse_comment(getb(), _151_())
          elseif (options and options.comments) then
            return dispatch(utils.comment(table.concat(contents), {line = (line - 1), filename = filename}))
            return parse_comment(getb(), _172_())
          elseif (_3foptions and _3foptions.comments) then
            return dispatch(utils.comment(table.concat(contents), {line = (line - 1), filename = _3ffilename}))
          else
            return b
          end


@@ 5774,8 6042,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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})
          return table.insert(stack, {bytestart = byteindex, closer = delims[b], filename = _3ffilename, line = line})
        end
        local function close_list(list)
          return dispatch(setmetatable(list, getmetatable(utils.list())))


@@ 5788,14 6057,16 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          return dispatch(val)
        end
        local function add_comment_at(comments, index, node)
          local _154_ = comments[index]
          if (nil ~= _154_) then
            local existing = _154_
          local _175_ = comments[index]
          if (nil ~= _175_) then
            local existing = _175_
            return table.insert(existing, node)
          else
            local _ = _154_
          elseif true then
            local _ = _175_
            comments[index] = {node}
            return nil
          else
            return nil
          end
        end
        local function next_noncomment(tbl, i)


@@ 5823,6 6094,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          for i = #tbl, 1, -1 do
            if utils["comment?"](tbl[i]) then
              table.remove(tbl, i)
            else
            end
          end
          return comments


@@ 5834,11 6106,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          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])


@@ 5851,9 6125,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          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


@@ 5868,14 6144,19 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          table.insert(chars, b)
          local state0
          do
            local _164_ = {state, b}
            if ((_G.type(_164_) == "table") and ((_164_)[1] == "base") and ((_164_)[2] == 92)) then
            local _185_ = {state, b}
            if ((_G.type(_185_) == "table") and ((_185_)[1] == "base") and ((_185_)[2] == 92)) then
              state0 = "backslash"
            elseif ((_G.type(_164_) == "table") and ((_164_)[1] == "base") and ((_164_)[2] == 34)) then
            elseif ((_G.type(_185_) == "table") and ((_185_)[1] == "base") and ((_185_)[2] == 34)) then
              state0 = "done"
            else
              local _ = _164_
            elseif ((_G.type(_185_) == "table") and ((_185_)[1] == "backslash") and ((_185_)[2] == 10)) then
              table.remove(chars, (#chars - 1))
              state0 = "base"
            elseif true then
              local _ = _185_
              state0 = "base"
            else
              state0 = nil
            end
          end
          if (b and (state0 ~= "done")) then


@@ 5892,27 6173,32 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          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 _168_ = (rawget(_G, "loadstring") or load)(("return " .. formatted))
          if (nil ~= _168_) then
            local load_fn = _168_
          local _189_ = (rawget(_G, "loadstring") or load)(("return " .. formatted))
          if (nil ~= _189_) then
            local load_fn = _189_
            return dispatch(load_fn())
          elseif (_168_ == nil) then
          elseif (_189_ == nil) then
            return parse_error(("Invalid string: " .. raw))
          else
            return nil
          end
        end
        local function parse_prefix(b)
          table.insert(stack, {prefix = prefixes[b], filename = filename, line = line, bytestart = byteindex})
          table.insert(stack, {prefix = prefixes[b], filename = _3ffilename, 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


@@ 5923,6 6209,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          else
            if b then
              ungetb(b)
            else
            end
            return chars
          end


@@ 5933,14 6220,16 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            dispatch((tonumber(number_with_stripped_underscores) or parse_error(("could not read number \"" .. rawstr .. "\""))))
            return true
          else
            local _174_ = tonumber(number_with_stripped_underscores)
            if (nil ~= _174_) then
              local x = _174_
            local _195_ = tonumber(number_with_stripped_underscores)
            if (nil ~= _195_) then
              local x = _195_
              dispatch(x)
              return true
            else
              local _ = _174_
            elseif true then
              local _ = _195_
              return false
            else
              return nil
            end
          end
        end


@@ 5971,7 6260,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          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), {byteend = byteindex, bytestart = bytestart, filename = _3ffilename, line = line}))
          else
            return nil
          end
        end
        local function parse_loop(b)


@@ 5990,6 6281,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            parse_sym(b)
          elseif not utils.hook("illegal-char", b, getb, ungetb, dispatch) then
            parse_error(("illegal character: " .. string.char(b)))
          else
          end
          if not b then
            return nil


@@ 6001,11 6293,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        return parse_loop(skip_whitespace(getb()))
      end
      local function _181_()
        stack, line, byteindex = {}, 1, 0
      local function _202_()
        stack, line, byteindex, lastb = {}, 1, 0, nil
        return nil
      end
      return parse_stream, _181_
      return parse_stream, _202_
    end
    return {granulate = granulate, parser = parser, ["string-stream"] = string_stream, ["sym-char?"] = sym_char_3f}
  end


@@ 6019,9 6311,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if ((_G.type(_1_) == "table") and (nil ~= (_1_).__pairs)) then
        local p = (_1_).__pairs
        return p(t)
      else
      elseif true then
        local _ = _1_
        return lua_pairs(t)
      else
        return nil
      end
    end
    local function ipairs(t)


@@ 6029,9 6323,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if ((_G.type(_3_) == "table") and (nil ~= (_3_).__ipairs)) then
        local i = (_3_).__ipairs
        return i(t)
      else
      elseif true then
        local _ = _3_
        return lua_ipairs(t)
      else
        return nil
      end
    end
    local function length_2a(t)


@@ 6039,9 6335,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if ((_G.type(_5_) == "table") and (nil ~= (_5_).__len)) then
        local l = (_5_).__len
        return l(t)
      else
      elseif true then
        local _ = _5_
        return #t
      else
        return nil
      end
    end
    local function sort_keys(_7_, _9_)


@@ 6076,9 6374,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          local k = _each_14_[1]
          if ((k - i) > gap) then
            gap = (k - i)
          else
          end
          i = k
        end
      else
      end
      return gap
    end


@@ 6106,17 6406,18 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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
        local gap = max_index_gap(kv)
        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"


@@ 6142,6 6443,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        else
          appearances[t] = ((appearances[t] or 0) + 1)
        end
      else
      end
      return appearances
    end


@@ 6151,6 6453,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if not (seen0)[t] then
        seen0[t] = id
        seen0.len = id
      else
      end
      return seen0
    end


@@ 6162,7 6465,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          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)


@@ 6181,13 6488,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function concat_table_lines(elements, options, multiline_3f, indent, table_type, prefix)
      local indent_str = ("\n" .. string.rep(" ", indent))
      local open
      local _32_
      if ("seq" == table_type) then
        _32_ = "["
      else
        _32_ = "{"
      local function _32_()
        if ("seq" == table_type) then
          return "["
        else
          return "{"
        end
      end
      open = ((prefix or "") .. _32_)
      open = ((prefix or "") .. _32_())
      local close
      if ("seq" == table_type) then
        close = "]"


@@ 6201,6 6509,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        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]


@@ 6213,18 6528,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        local id0 = (visible_cycle_3f0 and options.seen[t])
        local indent0 = table_indent(indent, id0)
        local slength
        local function _37_()
          local _36_ = rawget(_G, "utf8")
          if _36_ then
            return (_36_).len
          else
            return _36_
        if options["utf8?"] then
          slength = utf8_len
        else
          local function _35_(_241)
            return #_241
          end
          slength = _35_
        end
        local function _39_(_241)
          return length_2a(_241)
        end
        slength = ((options["utf8?"] and _37_()) or _39_)
        local prefix
        if visible_cycle_3f0 then
          prefix = ("@" .. id0)


@@ 6233,21 6544,26 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        local items
        do
          local tbl_13_auto = {}
          for _, _41_ in pairs(kv) do
            local _each_42_ = _41_
            local k = _each_42_[1]
            local v = _each_42_[2]
            local _43_
          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"))
              _43_ = (k0 .. " " .. v0)
              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
            tbl_13_auto[(#tbl_13_auto + 1)] = _43_
          end
          items = tbl_13_auto
          items = tbl_14_auto
        end
        return concat_table_lines(items, options, multiline_3f, indent0, "table", prefix)
      end


@@ 6271,20 6587,25 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        local items
        do
          local tbl_13_auto = {}
          for _, _46_ in pairs(kv) do
            local _each_47_ = _46_
            local _0 = _each_47_[1]
            local v = _each_47_[2]
            local _48_
          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"))
              _48_ = v0
              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
            tbl_13_auto[(#tbl_13_auto + 1)] = _48_
          end
          items = tbl_13_auto
          items = tbl_14_auto
        end
        return concat_table_lines(items, options, multiline_3f, indent0, "seq", prefix)
      end


@@ 6298,15 6619,21 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
      else
        local oneline
        local _51_
        local _48_
        do
          local tbl_13_auto = {}
          local tbl_14_auto = {}
          local i_15_auto = #tbl_14_auto
          for _, line in ipairs(lines) do
            tbl_13_auto[(#tbl_13_auto + 1)] = line:gsub("^%s+", "")
            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
          _51_ = tbl_13_auto
          _48_ = tbl_14_auto
        end
        oneline = table.concat(_51_, " ")
        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


@@ 6323,21 6650,23 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
      else
        local _
        local function _55_(_241)
        local function _53_(_241)
          return visible_cycle_3f(_241, options)
        end
        options["visible-cycle?"] = _55_
        options["visible-cycle?"] = _53_
        _ = nil
        local lines, force_multi_line_3f = metamethod(t, pp, options, indent)
        options["visible-cycle?"] = nil
        local _56_ = type(lines)
        if (_56_ == "string") then
        local _54_ = type(lines)
        if (_54_ == "string") then
          return lines
        elseif (_56_ == "table") then
        elseif (_54_ == "table") then
          return concat_lines(lines, options, indent, force_multi_line_3f)
        else
          local _0 = _56_
        elseif true then
          local _0 = _54_
          return error("__fennelview metamethod must return a table of lines")
        else
          return nil
        end
      end
    end


@@ 6345,69 6674,129 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      options.level = (options.level + 1)
      local x0
      do
        local _59_
        local _57_
        if options["metamethod?"] then
          local _60_ = x
          if _60_ then
            local _61_ = getmetatable(_60_)
            if _61_ then
              _59_ = (_61_).__fennelview
          local _58_ = x
          if (nil ~= _58_) then
            local _59_ = getmetatable(_58_)
            if (nil ~= _59_) then
              _57_ = (_59_).__fennelview
            else
              _59_ = _61_
              _57_ = _59_
            end
          else
            _59_ = _60_
            _57_ = _58_
          end
        else
        _59_ = nil
          _57_ = nil
        end
        if (nil ~= _59_) then
          local metamethod = _59_
        if (nil ~= _57_) then
          local metamethod = _57_
          x0 = pp_metamethod(x, metamethod, options, indent)
        else
          local _ = _59_
          local _65_, _66_ = table_kv_pairs(x, options)
          if (true and (_66_ == "empty")) then
            local _0 = _65_
        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 ~= _65_) and (_66_ == "table")) then
            local kv = _65_
          elseif ((nil ~= _63_) and (_64_ == "table")) then
            local kv = _63_
            x0 = pp_associative(x, kv, options, indent)
          elseif ((nil ~= _65_) and (_66_ == "seq")) then
            local kv = _65_
          elseif ((nil ~= _63_) and (_64_ == "seq")) then
            local kv = _63_
            x0 = pp_sequence(x, kv, options, indent)
          else
          x0 = nil
            x0 = nil
          end
        else
          x0 = nil
        end
      end
      options.level = (options.level - 1)
      return x0
    end
    local function number__3estring(n)
      local _70_ = string.gsub(tostring(n), ",", ".")
      return _70_
      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 _71_
      local _86_
      if (options["escape-newlines?"] and (length_2a(str) < (options["line-length"] - indent))) then
        _71_ = "\\n"
        _86_ = "\\n"
      else
        _71_ = "\n"
        _86_ = "\n"
      end
      local function _73_(_241, _242)
      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"] = _71_}, {__index = _73_})
      return ("\"" .. str:gsub("[%c\\\"]", escs) .. "\"")
      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}


@@ 6420,7 6809,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return defaults
    end
    local function _74_(x, options, indent, colon_3f)
    local function _90_(x, options, indent, colon_3f)
      local indent0 = (indent or 0)
      local options0 = (options or make_options(x))
      local x0


@@ 6430,20 6819,20 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        x0 = x
      end
      local tv = type(x0)
      local function _77_()
        local _76_ = getmetatable(x0)
        if _76_ then
          return (_76_).__fennelview
      local function _93_()
        local _92_ = getmetatable(x0)
        if (nil ~= _92_) then
          return (_92_).__fennelview
        else
          return _76_
          return _92_
        end
      end
      if ((tv == "table") or ((tv == "userdata") and _77_())) then
      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 _79_()
        local function _95_()
          if (colon_3f ~= nil) then
            return colon_3f
          elseif ("function" == type(options0["prefer-colon?"])) then


@@ 6452,7 6841,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            return options0["prefer-colon?"]
          end
        end
        if ((tv == "string") and colon_string_3f(x0) and _79_()) then
        if ((tv == "string") and colon_string_3f(x0) and _95_()) then
          return (":" .. x0)
        elseif (tv == "string") then
          return pp_string(x0, options0, indent0)


@@ 6463,17 6852,20 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
      end
    end
    pp = _74_
    local function view(x, options)
      return pp(x, make_options(x, options), 0)
    pp = _90_
    local function view(x, _3foptions)
      return pp(x, make_options(x, _3foptions), 0)
    end
    return view
  end
  package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(...)
    local view = require("fennel.view")
    local version = "1.0.0"
    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)


@@ 6486,8 6878,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            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)


@@ 6496,10 6890,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        for k in pairs(t) do
          table.insert(keys, k)
        end
        local function _84_(_241, _242)
        local function _100_(_241, _242)
          return (tostring(_241) < tostring(_242))
        end
        table.sort(keys, _84_)
        table.sort(keys, _100_)
      end
      for i, k in ipairs(keys) do
        succ[k] = keys[(i + 1)]


@@ 6521,66 6915,70 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return stablenext, t, nil
    end
    local function map(t, f, out)
      local out0 = (out or {})
    local function map(t, f, _3fout)
      local out = (_3fout or {})
      local f0
      if (type(f) == "function") then
        f0 = f
      else
        local function _88_(_241)
        local function _104_(_241)
          return (_241)[f]
        end
        f0 = _88_
        f0 = _104_
      end
      for _, x in ipairs(t) do
        local _90_ = f0(x)
        if (nil ~= _90_) then
          local v = _90_
          table.insert(out0, v)
        local _106_ = f0(x)
        if (nil ~= _106_) then
          local v = _106_
          table.insert(out, v)
        else
        end
      end
      return out0
      return out
    end
    local function kvmap(t, f, out)
      local out0 = (out or {})
    local function kvmap(t, f, _3fout)
      local out = (_3fout or {})
      local f0
      if (type(f) == "function") then
        f0 = f
      else
        local function _92_(_241)
        local function _108_(_241)
          return (_241)[f]
        end
        f0 = _92_
        f0 = _108_
      end
      for k, x in stablepairs(t) do
        local _94_, _95_ = f0(k, x)
        if ((nil ~= _94_) and (nil ~= _95_)) then
          local key = _94_
          local value = _95_
          out0[key] = value
        elseif (nil ~= _94_) then
          local value = _94_
          table.insert(out0, value)
        local _110_, _111_ = f0(k, x)
        if ((nil ~= _110_) and (nil ~= _111_)) then
          local key = _110_
          local value = _111_
          out[key] = value
        elseif (nil ~= _110_) then
          local value = _110_
          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 to = (_3fto or {})
      for k, v in pairs((from or {})) do
        to0[k] = v
        to[k] = v
      end
      return to0
      return to
    end
    local function member_3f(x, tbl, n)
      local _97_ = tbl[(n or 1)]
      if (_97_ == x) then
    local function member_3f(x, tbl, _3fn)
      local _113_ = tbl[(_3fn or 1)]
      if (_113_ == x) then
        return true
      elseif (_97_ == nil) then
      elseif (_113_ == nil) then
        return nil
      elseif true then
        local _ = _113_
        return member_3f(x, tbl, ((_3fn or 1) + 1))
      else
        local _ = _97_
        return member_3f(x, tbl, ((n or 1) + 1))
        return nil
      end
    end
    local function allpairs(tbl)


@@ 6595,13 6993,17 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          seen[next_state] = true
          return next_state, value
        else
          local _99_ = getmetatable(t)
          if ((_G.type(_99_) == "table") and true) then
            local __index = (_99_).__index
          local _115_ = getmetatable(t)
          if ((_G.type(_115_) == "table") and true) then
            local __index = (_115_).__index
            if ("table" == type(__index)) then
              t = __index
              return allpairs_next(t)
            else
              return nil
            end
          else
            return nil
          end
        end
      end


@@ 6611,17 7013,18 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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 view)), " ", 1, max) .. ")")
      return ("(" .. table.concat(map(safe, (_3ftostring2 or view)), " ", 1, max) .. ")")
    end
    local function comment_view(c)
      return c, true


@@ 6632,21 7035,21 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function sym_3c(a, b)
      return (a[1] < tostring(b))
    end
    local symbol_mt = {"SYMBOL", __fennelview = deref, __tostring = deref, __eq = sym_3d, __lt = sym_3c}
    local symbol_mt = {__fennelview = deref, __tostring = deref, __eq = sym_3d, __lt = sym_3c, "SYMBOL"}
    local expr_mt
    local function _104_(x)
    local function _120_(x)
      return tostring(deref(x))
    end
    expr_mt = {"EXPR", __tostring = _104_}
    local list_mt = {"LIST", __fennelview = list__3estring, __tostring = list__3estring}
    local comment_mt = {"COMMENT", __fennelview = comment_view, __tostring = deref, __eq = sym_3d, __lt = sym_3c}
    expr_mt = {__tostring = _120_, "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 vararg = setmetatable({"..."}, {__fennelview = deref, __tostring = deref, "VARARG"})
    local getenv
    local function _105_()
    local function _121_()
      return nil
    end
    getenv = ((os and os.getenv) or _105_)
    getenv = ((os and os.getenv) or _121_)
    local function debug_on_3f(flag)
      local level = (getenv("FENNEL_DEBUG") or "")
      return ((level == "all") or level:find(flag))


@@ 6655,10 7058,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return setmetatable({...}, list_mt)
    end
    local function sym(str, _3fsource, _3fscope)
      local s = {str, ["?scope"] = _3fscope}
      local s = {["?scope"] = _3fscope, str}
      for k, v in pairs((_3fsource or {})) do
        if (type(k) == "string") then
          s[k] = v
        else
        end
      end
      return setmetatable(s, symbol_mt)


@@ 6668,13 7072,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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 _let_107_ = (_3fsource or {})
      local filename = _let_107_["filename"]
      local line = _let_107_["line"]
      return setmetatable({contents, filename = filename, line = line}, comment_mt)
      local _let_123_ = (_3fsource or {})
      local filename = _let_123_["filename"]
      local line = _let_123_["line"]
      return setmetatable({filename = filename, line = line, contents}, comment_mt)
    end
    local function varg()
      return vararg


@@ 6712,6 7116,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          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))


@@ 6725,16 7130,27 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    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"}


@@ 6752,36 7168,52 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return subopts
    end
    local root
    local function _112_()
    end
    root = {chunk = nil, scope = nil, options = nil, reset = _112_}
    root["set-reset"] = function(_113_)
      local _arg_114_ = _113_
      local chunk = _arg_114_["chunk"]
      local scope = _arg_114_["scope"]
      local options = _arg_114_["options"]
      local reset = _arg_114_["reset"]
    local function _129_()
    end
    root = {chunk = nil, scope = nil, options = nil, reset = _129_}
    root["set-reset"] = function(_130_)
      local _arg_131_ = _130_
      local chunk = _arg_131_["chunk"]
      local scope = _arg_131_["scope"]
      local options = _arg_131_["options"]
      local reset = _arg_131_["reset"]
      root.reset = function()
        root.chunk, root.scope, root.options, root.reset = chunk, scope, options, reset
        return nil
      end
      return root.reset
    end
    local warned = {}
    local function check_plugin_version(_132_)
      local _arg_133_ = _132_
      local name = _arg_133_["name"]
      local versions = _arg_133_["versions"]
      local plugin = _arg_133_
      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
    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
          local _115_ = plugin[event]
          if (nil ~= _115_) then
            local f = _115_
          check_plugin_version(plugin)
          local _135_ = plugin[event]
          if (nil ~= _135_) then
            local f = _135_
            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, ["valid-lua-identifier?"] = valid_lua_identifier_3f, ["lua-keywords"] = lua_keywords, hook = hook, ["propagate-options"] = propagate_options, root = root, ["debug-on?"] = debug_on_3f, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), ["macro-path"] = table.concat({"./?.fnl", "./?/init-macros.fnl", "./?/init.fnl", getenv("FENNEL_MACRO_PATH")}, ";")}
    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, ["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, 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("fennel.utils")
  local parser = require("fennel.parser")


@@ 6794,6 7226,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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


@@ 6804,12 7237,15 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local opts = utils.copy(options)
    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


@@ 6818,14 7254,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local env = eval_env(opts.env, opts)
    local lua_source = compiler["compile-string"](str, opts)
    local loader
    local function _566_(...)
    local function _616_(...)
      if opts.filename then
        return ("@" .. opts.filename)
      else
        return str
      end
    end
    loader = specials["load-code"](lua_source, env, _566_(...))
    loader = specials["load-code"](lua_source, env, _616_(...))
    opts.filename = nil
    return loader(...)
  end


@@ 6850,21 7286,23 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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 _567_ = type(v)
      if (_567_ == "function") then
      local _617_ = type(v)
      if (_617_ == "function") then
        out[k] = {["global?"] = true, ["function?"] = true}
      elseif (_567_ == "table") then
      elseif (_617_ == "table") then
        for k2, v2 in pairs(v) do
          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 = {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, path = utils.path, ["macro-path"] = utils["macro-path"], ["sym-char?"] = parser["sym-char?"], parser = parser.parser, granulate = parser.granulate, ["string-stream"] = parser["string-stream"], compile = compiler.compile, ["compile-string"] = compiler["compile-string"], ["compile-stream"] = compiler["compile-stream"], compile1 = compiler.compile1, traceback = compiler.traceback, mangle = compiler["global-mangling"], unmangle = compiler["global-unmangling"], metadata = compiler.metadata, scope = compiler["make-scope"], gensym = compiler.gensym, ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["search-module"] = specials["search-module"], ["make-searcher"] = specials["make-searcher"], makeSearcher = specials["make-searcher"], searcher = specials["make-searcher"](), doc = specials.doc, view = view, eval = eval, dofile = dofile_2a, version = "1.0.0-dev", repl = repl, syntax = syntax, loadCode = specials["load-code"], make_searcher = specials["make-searcher"], searchModule = specials["search-module"], macroLoaded = specials["macro-loaded"], compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], stringStream = parser["string-stream"]}
  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, path = utils.path, ["macro-path"] = utils["macro-path"], ["sym-char?"] = parser["sym-char?"], parser = parser.parser, granulate = parser.granulate, ["string-stream"] = parser["string-stream"], compile = compiler.compile, ["compile-string"] = compiler["compile-string"], ["compile-stream"] = compiler["compile-stream"], compile1 = compiler.compile1, traceback = compiler.traceback, mangle = compiler["global-mangling"], unmangle = compiler["global-unmangling"], metadata = compiler.metadata, scope = compiler["make-scope"], gensym = compiler.gensym, ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["search-module"] = specials["search-module"], ["make-searcher"] = specials["make-searcher"], makeSearcher = specials["make-searcher"], searcher = specials["make-searcher"](), doc = specials.doc, view = view, eval = eval, dofile = dofile_2a, version = utils.version, repl = repl, syntax = syntax, loadCode = specials["load-code"], make_searcher = specials["make-searcher"], searchModule = specials["search-module"], macroLoaded = specials["macro-loaded"], compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], stringStream = parser["string-stream"]}
  utils["fennel-module"] = mod
  do
    local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other


@@ 6893,7 7331,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    Same as ->, except splices the value into the last position of each form
    rather than the first."
      (var x val)
      (each [_ e (pairs [...])]
      (each [_ e (ipairs [...])]
        (let [elt (if (list? e) e (list e))]
          (table.insert elt x)
          (set x elt)))


@@ 6910,7 7348,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
                tmp (gensym)]
            (table.insert el 2 tmp)
            `(let [,tmp ,val]
               (if ,tmp
               (if (not= nil ,tmp)
                   (-?> ,el ,(unpack els))
                   ,tmp)))))
    


@@ 6925,7 7363,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
                tmp (gensym)]
            (table.insert el tmp)
            `(let [,tmp ,val]
               (if ,tmp
               (if (not= ,tmp nil)
                   (-?>> ,el ,(unpack els))
                   ,tmp)))))
    


@@ 6946,9 7384,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      "Evaluates val and splices 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 (if (list? elt) elt (list elt))]
            (table.insert elt 2 name)
            (table.insert form elt)))
        (table.insert form name)
        form))
    


@@ 6991,15 7430,16 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
              "expected table, function call, or symbol in :into clause")
      (or into []))
    
    (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 collect* [iter-tbl key-expr 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 body should provide two
    expressions (used as key and value) or nil, which causes it to be omitted from
    the resulting table.
    
    For example,
      (collect [k v (pairs {:apple \"red\" :orange \"orange\"})]
        (values v k))
        v k)
    returns
      {:red \"apple\" :orange \"orange\"}
    


@@ 7007,24 7447,26 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    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# ,(into-val iter-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))]
        `(let [tbl# ,(into-val iter-tbl)]
           (each ,iter-tbl
             (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
    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 \"list comprehension\". If the body returns nil
    that element is omitted from the resulting table.
    
    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."


@@ 7184,23 7626,23 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      (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
              (tset scope.macros (. binding 1) (. macro-loaded modname))
              (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


@@ 7221,12 7663,16 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            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)


@@ 7415,17 7861,17 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    ]===]
    local module_name = "fennel.macros"
    local _
    local function _570_()
    local function _620_()
      return mod
    end
    package.preload[module_name] = _570_
    package.preload[module_name] = _620_
    _ = nil
    local env
    do
      local _571_ = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
      do end (_571_)["utils"] = utils
      _571_["fennel"] = mod
      env = _571_
      local _621_ = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
      do end (_621_)["utils"] = utils
      _621_["fennel"] = mod
      env = _621_
    end
    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