~technomancy/fennel-lang.org

bc6e92ee20960b04eb48db01869e454d1b6106f3 — Phil Hagelberg 2 days ago f05b8ea main
Latest antifennel
1 files changed, 1400 insertions(+), 768 deletions(-)

M antifennel.lua
M antifennel.lua => antifennel.lua +1400 -768
@@ 6,34 6,34 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
    return #line:match("[^\n]*$")
  end
  local function any_3f(tbl, pred)
    local _0_
    local _276_
    do
      local tbl_0_ = {}
      local tbl_12_auto = {}
      for _, v in pairs(tbl) do
        local _1_
        local _277_
        if pred(v) then
          _1_ = true
          _277_ = true
        else
        _1_ = nil
        _277_ = nil
        end
        tbl_0_[(#tbl_0_ + 1)] = _1_
        tbl_12_auto[(#tbl_12_auto + 1)] = _277_
      end
      _0_ = tbl_0_
      _276_ = tbl_12_auto
    end
    return (0 ~= #_0_)
    return (0 ~= #_276_)
  end
  local function strip_comments(t)
    local tbl_0_ = {}
    local tbl_12_auto = {}
    for _, x in ipairs(t) do
      local _0_
      local _279_
      if not fennel["comment?"](x) then
        _0_ = x
        _279_ = x
      else
      _0_ = nil
      _279_ = nil
      end
      tbl_0_[(#tbl_0_ + 1)] = _0_
      tbl_12_auto[(#tbl_12_auto + 1)] = _279_
    end
    return tbl_0_
    return tbl_12_auto
  end
  local function view_fn_args(t, view, inspector, indent, start_indent, out, callee)
    if fennel["sym?"](t[2]) then


@@ 106,13 106,13 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
    else
      table.insert(out, " ")
    end
    local indent = nil
    local indent
    if force_initial_newline[callee] then
      indent = start_indent
    else
      indent = (start_indent + #callee)
    end
    local second = nil
    local second
    if (init_bindings[callee] and ("unquote" ~= tostring(t[2][1]))) then
      second = view_binding(t[2], view, inspector, (indent + 1), ("let" == callee), "[", "]")
    else


@@ 140,7 140,7 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
  end
  local function view_body(t, view, inspector, start_indent, out, callee)
    local start_index = view_init_body(t, view, inspector, start_indent, out, callee)
    local indent = nil
    local indent
    if one_element_per_line_forms[callee] then
      indent = (start_indent + #callee)
    else


@@ 193,14 193,13 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
    return table.insert(out, (" " .. view_binding({select(2, unpack(t))}, view, inspector, indent, true, "", "")))
  end
  local function if_pair(view, a, b, c)
    local function _0_()
      if fennel["comment?"](c) then
        return (" " .. view(c))
      else
        return ""
      end
    local _298_
    if fennel["comment?"](c) then
      _298_ = (" " .. view(c))
    else
      _298_ = ""
    end
    return (view(a) .. " " .. view(b) .. _0_())
    return (view(a) .. " " .. view(b) .. _298_)
  end
  local function pairwise_if_3f(t, indent, i, view)
    if (#strip_comments(t) < 5) then


@@ 212,21 211,21 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
    elseif (80 < (indent + 1 + #if_pair(view, select(i, unpack(t))))) then
      return false
    else
      local _0_
      local _300_
      if fennel.comment(t[(i + 2)]) then
        _0_ = (i + 3)
        _300_ = (i + 3)
      else
        _0_ = (i + 2)
        _300_ = (i + 2)
      end
      return pairwise_if_3f(t, indent, _0_, view)
      return pairwise_if_3f(t, indent, _300_, view)
    end
  end
  local function originally_different_lines_3f(_0_0, line)
    local _arg_0_ = _0_0
    local _ = _arg_0_[1]
    local first = _arg_0_[2]
    local second = _arg_0_[3]
    return (("table" == type(first)) and ("table" == type(second)) and (function(_1_,_2_,_3_) return (_1_ ~= _2_) or (_2_ ~= _3_) end)(line,(first.line or line),(second.line or line)))
  local function originally_different_lines_3f(_303_, line)
    local _arg_304_ = _303_
    local _ = _arg_304_[1]
    local first = _arg_304_[2]
    local second = _arg_304_[3]
    return (("table" == type(first)) and ("table" == type(second)) and (function(_305_,_306_,_307_) return (_305_ ~= _306_) or (_306_ ~= _307_) end)(line,(first.line or line),(second.line or line)))
  end
  local function view_maybe_body(t, view, inspector, indent, start_indent, out, callee)
    if pairwise_if_3f(t, indent, 2, view) then


@@ 256,7 255,7 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
      local callee = view(t[1], inspector, (start_indent + 1))
      local callee0 = (renames[callee] or callee)
      local out = {"(", callee0}
      local indent = nil
      local indent
      if body_specials[callee0] then
        indent = (start_indent + 2)
      else


@@ 274,20 273,19 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
      return table.concat(out)
    end
  end
  local slength = nil
  local _2_
  do
    local _1_0 = rawget(_G, "utf8")
    if _1_0 then
      _2_ = (_1_0).len
  local slength
  local function _314_(...)
    local _313_ = rawget(_G, "utf8")
    if _313_ then
      return (_313_).len
    else
      _2_ = _1_0
      return _313_
    end
  end
  local function _3_(_241)
  local function _316_(_241)
    return #_241
  end
  slength = (_2_ or _3_)
  slength = (_314_(...) or _316_)
  local function maybe_attach_comment(x, indent, c)
    if c then
      return (tostring(c) .. "\n" .. string.rep(" ", indent) .. x)


@@ 300,49 298,51 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
  end
  local function view_pair(t, view, inspector, indent, mt, key)
    local val = t[key]
    local k = nil
    local k
    if shorthand_pair_3f(key, val) then
      k = ":"
    else
      k = view(key, inspector, (indent + 1), true)
    end
    local v = view(val, inspector, (indent + slength(k) + 1))
    local function _5_()
      local res_0_ = mt.comments
      local function _6_()
        local res_0_0 = (res_0_).keys
        local function _7_()
          local res_0_1 = (res_0_0)[key]
          return (res_0_1 and res_0_1)
        end
        return (res_0_0 and _7_())
    local function _320_()
      local t_319_ = mt
      if (nil ~= t_319_) then
        t_319_ = (t_319_).comments
      end
      if (nil ~= t_319_) then
        t_319_ = (t_319_).keys
      end
      return (res_0_ and _6_())
      if (nil ~= t_319_) then
        t_319_ = (t_319_)[key]
      end
      return t_319_
    end
    local function _6_()
      local res_0_ = mt.comments
      local function _7_()
        local res_0_0 = (res_0_).values
        local function _8_()
          local res_0_1 = (res_0_0)[val]
          return (res_0_1 and res_0_1)
        end
        return (res_0_0 and _8_())
    local function _325_()
      local t_324_ = mt
      if (nil ~= t_324_) then
        t_324_ = (t_324_).comments
      end
      if (nil ~= t_324_) then
        t_324_ = (t_324_).values
      end
      return (res_0_ and _7_())
      if (nil ~= t_324_) then
        t_324_ = (t_324_)[val]
      end
      return t_324_
    end
    return (maybe_attach_comment(k, indent, _5_()) .. " " .. maybe_attach_comment(v, indent, _6_()))
    return (maybe_attach_comment(k, indent, _320_()) .. " " .. maybe_attach_comment(v, indent, _325_()))
  end
  local function view_multiline_kv(pair_strs, indent, last_comment)
    if last_comment then
      local _5_
      local _330_
      do
        local _4_0 = pair_strs
        table.insert(_4_0, tostring(last_comment))
        table.insert(_4_0, "}")
        _5_ = _4_0
        local _329_ = pair_strs
        table.insert(_329_, tostring(last_comment))
        table.insert(_329_, "}")
        _330_ = _329_
      end
      return ("{" .. table.concat(_5_, ("\n" .. string.rep(" ", indent))))
      return ("{" .. table.concat(_330_, ("\n" .. string.rep(" ", indent))))
    else
      return ("{" .. table.concat(pair_strs, ("\n" .. string.rep(" ", indent))) .. "}")
    end


@@ 350,43 350,46 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
  local function view_kv(t, view, inspector, indent)
    local indent0 = (indent + 1)
    local mt = getmetatable(t)
    local keys = nil
    local function _4_()
      local tbl_0_ = {}
    local keys
    local function _332_()
      local tbl_12_auto = {}
      for k in pairs(t) do
        tbl_0_[(#tbl_0_ + 1)] = k
        tbl_12_auto[(#tbl_12_auto + 1)] = k
      end
      return tbl_0_
      return tbl_12_auto
    end
    keys = (mt.keys or _4_())
    local pair_strs = nil
    keys = (mt.keys or _332_())
    local pair_strs
    do
      local tbl_0_ = {}
      local tbl_12_auto = {}
      for _, k in ipairs(keys) do
        tbl_0_[(#tbl_0_ + 1)] = view_pair(t, view, inspector, indent0, mt, k)
        tbl_12_auto[(#tbl_12_auto + 1)] = view_pair(t, view, inspector, indent0, mt, k)
      end
      pair_strs = tbl_0_
      pair_strs = tbl_12_auto
    end
    local oneline = ("{" .. table.concat(pair_strs, " ") .. "}")
    local _5_
    do
      local res_0_ = mt.comments
      local function _6_()
        local res_0_0 = (res_0_).last
        return (res_0_0 and res_0_0)
    local function _334_()
      local t_333_ = mt
      if (nil ~= t_333_) then
        t_333_ = (t_333_).comments
      end
      if (nil ~= t_333_) then
        t_333_ = (t_333_).last
      end
      _5_ = (res_0_ and _6_())
      return t_333_
    end
    if (oneline:match("\n") or _5_ or ((indent0 + #oneline) > inspector["line-length"])) then
      local function _6_()
        local res_0_ = mt.comments
        local function _7_()
          local res_0_0 = (res_0_).last
          return (res_0_0 and res_0_0)
    if (oneline:match("\n") or _334_() or ((indent0 + #oneline) > inspector["line-length"])) then
      local function _338_()
        local t_337_ = mt
        if (nil ~= t_337_) then
          t_337_ = (t_337_).comments
        end
        return (res_0_ and _7_())
        if (nil ~= t_337_) then
          t_337_ = (t_337_).last
        end
        return t_337_
      end
      return view_multiline_kv(pair_strs, indent0, _6_())
      return view_multiline_kv(pair_strs, indent0, _338_())
    else
      return oneline
    end


@@ 406,12 409,12 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
  local function set_fennelview_metamethod(idx, form, parent)
    if (("table" == type(form)) and not fennel["sym?"](form) and not fennel["comment?"](form) and (fennel.varg() ~= form)) then
      if (not fennel["list?"](form) and not fennel["sequence?"](form)) then
        local _4_0 = getmetatable(form)
        if (nil ~= _4_0) then
          local mt = _4_0
        local _343_ = getmetatable(form)
        if (nil ~= _343_) then
          local mt = _343_
          mt["__fennelview"] = view_kv
        else
          local _ = _4_0
          local _ = _343_
          setmetatable(form, {__fennelview = view_kv})
        end
      end


@@ 422,10 425,10 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
    return (s:find("^[-%w?^_!$%&*+./@|<=>]+$") and not s:find("^[-?^_!$%&*+./@|<=>%\\]+$"))
  end
  local function fnlfmt(ast)
    local _let_0_ = getmetatable(fennel.list())
    local list_mt = _let_0_
    local __fennelview = _let_0_["__fennelview"]
    local _ = nil
    local _let_347_ = getmetatable(fennel.list())
    local list_mt = _let_347_
    local __fennelview = _let_347_["__fennelview"]
    local _
    list_mt.__fennelview = view_list
    _ = nil
    local _0 = walk_tree(ast, set_fennelview_metamethod)


@@ 437,16 440,16 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
  local function space_out_forms_3f(prev_ast, ast)
    return not (prev_ast.line and ast.line and (1 == (ast.line - prev_ast.line)))
  end
  local function format_file(filename, _4_0)
    local _arg_0_ = _4_0
    local no_comments = _arg_0_["no-comments"]
    local f = nil
  local function format_file(filename, _348_)
    local _arg_349_ = _348_
    local no_comments = _arg_349_["no-comments"]
    local f
    do
      local _5_0 = filename
      if (_5_0 == "-") then
      local _350_ = filename
      if (_350_ == "-") then
        f = io.stdin
      else
        local _ = _5_0
        local _ = _350_
        f = assert(io.open(filename, "r"), "File not found.")
      end
    end


@@ 510,17 513,19 @@ package.preload["letter"] = package.preload["letter"] or function(...)
  local function transform_do(node)
    local bindings = {}
    table.insert(node, 2, bindings)
    node[1] = fennel.sym("let")
    do end (node)[1] = fennel.sym("let")
    return locals_to_bindings(node, bindings)
  end
  local function transform_fn(node)
  local function body_start(node)
    local has_name_3f = fennel["sym?"](node[2])
    local do_loc = nil
    if has_name_3f then
      do_loc = 4
      return 4
    else
      do_loc = 3
      return 3
    end
  end
  local function transform_fn(node)
    local do_loc = body_start(node)
    local do_node = fennel.list(fennel.sym("do"))
    move_body(node, do_node, do_loc)
    return table.insert(node, do_loc, do_node)


@@ 529,15 534,19 @@ package.preload["letter"] = package.preload["letter"] or function(...)
    return (("table" == type(node)) and ("do" == tostring(node[1])) and ("table" == type(node[2])) and ("local" == tostring(node[2][1])))
  end
  local function fn_local_node_3f(node)
    return (("table" == type(node)) and ("fn" == tostring(node[1])) and ((("table" == type(node[3])) and ("local" == tostring(node[3][1]))) or (("table" == type(node[4])) and ("local" == tostring(node[4][1])))))
    local function _272_()
      local first_body = node[body_start(node)]
      return (("table" == type(first_body)) and ("local" == tostring(first_body[1])))
    end
    return (("table" == type(node)) and ("fn" == tostring(node[1])) and _272_())
  end
  local function letter(idx, node)
    if do_local_node_3f(node) then
      transform_do(node)
    end
    if fn_local_node_3f(node) then
      transform_fn(node)
    end
    if do_local_node_3f(node) then
      transform_do(node)
    end
    return ("table" == type(node))
  end
  local function reverse_ipairs(t)


@@ 556,12 565,12 @@ package.preload["letter"] = package.preload["letter"] or function(...)
  return compile
end
package.preload["anticompiler"] = package.preload["anticompiler"] or function(...)
  local _local_0_ = require("fennel")
  local list = _local_0_["list"]
  local sequence = _local_0_["sequence"]
  local sym = _local_0_["sym"]
  local sym_3f = _local_0_["sym?"]
  local view = _local_0_["view"]
  local _local_116_ = require("fennel")
  local list = _local_116_["list"]
  local sequence = _local_116_["sequence"]
  local sym = _local_116_["sym"]
  local sym_3f = _local_116_["sym?"]
  local view = _local_116_["view"]
  local unpack = (table.unpack or _G.unpack)
  local function map(tbl, f, with_last_3f)
    local len = #tbl


@@ 583,91 592,112 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
    end
    return nil
  end
  local function _function(compile, scope, _0_0)
    local _arg_0_ = _0_0
    local body = _arg_0_["body"]
    local params = _arg_0_["params"]
    local vararg = _arg_0_["vararg"]
    local params0 = nil
    local function _1_(...)
      return compile(scope, ...)
    end
    params0 = map(params, _1_)
    local subscope = nil
  local function _function(compile, scope, _117_)
    local _arg_118_ = _117_
    local body = _arg_118_["body"]
    local params = _arg_118_["params"]
    local vararg = _arg_118_["vararg"]
    local params0
    local function _120_()
      local _119_ = scope
      local function _121_(...)
        return compile(_119_, ...)
      end
      return _121_
    end
    params0 = map(params, _120_())
    local subscope
    do
      local _2_0 = make_scope(scope)
      add_to_scope(_2_0, "param", params0)
      subscope = _2_0
      local _122_ = make_scope(scope)
      add_to_scope(_122_, "param", params0)
      subscope = _122_
    end
    local function _3_(...)
      return compile(subscope, ...)
    local _124_
    do
      local _123_ = subscope
      local function _125_(...)
        return compile(_123_, ...)
      end
      _124_ = _125_
    end
    return list(sym("fn"), sequence(unpack(params0)), unpack(map(body, _3_, true)))
    return list(sym("fn"), sequence(unpack(params0)), unpack(map(body, _124_, true)))
  end
  local function declare_function(compile, scope, ast)
    if (ast.locald or ("MemberExpression" == ast.id.kind)) then
      local _1_0 = _function(compile, scope, ast)
      table.insert(_1_0, 2, compile(scope, ast.id))
      return _1_0
      local _126_ = _function(compile, scope, ast)
      table.insert(_126_, 2, compile(scope, ast.id))
      return _126_
    else
      return list(sym("set-forcibly!"), compile(scope, ast.id), _function(compile, scope, ast))
    end
  end
  local function local_declaration(compile, scope, _1_0)
    local _arg_0_ = _1_0
    local expressions = _arg_0_["expressions"]
    local names = _arg_0_["names"]
    if ((function(_2_,_3_,_4_) return (_2_ == _3_) and (_3_ == _4_) end)(#expressions,#names,1) and ("FunctionExpression" == expressions[1].kind)) then
  local function local_declaration(compile, scope, _128_)
    local _arg_129_ = _128_
    local expressions = _arg_129_["expressions"]
    local names = _arg_129_["names"]
    if ((function(_130_,_131_,_132_) return (_130_ == _131_) and (_131_ == _132_) end)(#expressions,#names,1) and ("FunctionExpression" == expressions[1].kind)) then
      add_to_scope(scope, "function", {names[1].name})
      local function _6_()
        local _5_0 = expressions[1]
        _5_0["id"] = names[1]
        _5_0["locald"] = true
        return _5_0
      local function _134_()
        local _133_ = expressions[1]
        _133_["id"] = names[1]
        _133_["locald"] = true
        return _133_
      end
      return declare_function(compile, scope, _6_())
      return declare_function(compile, scope, _134_())
    else
      local local_sym = sym("local")
      local function _5_(_241)
      local function _135_(_241)
        return _241.name
      end
      add_to_scope(scope, "local", map(names, _5_), local_sym)
      local _6_
      add_to_scope(scope, "local", map(names, _135_), local_sym)
      local _136_
      if (1 == #names) then
        _6_ = sym(names[1].name)
        _136_ = sym(names[1].name)
      else
        local function _7_(...)
          return compile(scope, ...)
        local function _138_()
          local _137_ = scope
          local function _139_(...)
            return compile(_137_, ...)
          end
          return _139_
        end
        _6_ = list(unpack(map(names, _7_)))
        _136_ = list(unpack(map(names, _138_())))
      end
      local function _8_()
      local function _144_()
        if (1 == #expressions) then
          return compile(scope, expressions[1])
        elseif (0 == #expressions) then
          return sym("nil")
        else
          local function _8_(...)
            return compile(scope, ...)
          local function _142_()
            local _141_ = scope
            local function _143_(...)
              return compile(_141_, ...)
            end
            return _143_
          end
          return list(sym("values"), unpack(map(expressions, _8_)))
          return list(sym("values"), unpack(map(expressions, _142_())))
        end
      end
      return list(local_sym, _6_, _8_())
      return list(local_sym, _136_, _144_())
    end
  end
  local function vals(compile, scope, _2_0)
    local _arg_0_ = _2_0
    local arguments = _arg_0_["arguments"]
  local function vals(compile, scope, _146_)
    local _arg_147_ = _146_
    local arguments = _arg_147_["arguments"]
    if (1 == #arguments) then
      return compile(scope, arguments[1])
    elseif (0 == #arguments) then
      return sym("nil")
    else
      local function _3_(...)
        return compile(scope, ...)
      local function _149_()
        local _148_ = scope
        local function _150_(...)
          return compile(_148_, ...)
        end
        return _150_
      end
      return list(sym("values"), unpack(map(arguments, _3_)))
      return list(sym("values"), unpack(map(arguments, _149_())))
    end
  end
  local function any_complex_expressions_3f(args, i)


@@ 690,54 720,66 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
    end
    return list(sym("let"), bindings, list(sym("lua"), ("return " .. table.concat(binding_names, ", "))))
  end
  local function early_return(compile, scope, _3_0)
    local _arg_0_ = _3_0
    local arguments = _arg_0_["arguments"]
    local args = nil
    local function _4_(...)
      return compile(scope, ...)
  local function early_return(compile, scope, _153_)
    local _arg_154_ = _153_
    local arguments = _arg_154_["arguments"]
    local args
    local function _156_()
      local _155_ = scope
      local function _157_(...)
        return compile(_155_, ...)
      end
      return _157_
    end
    args = map(arguments, _4_)
    args = map(arguments, _156_())
    if any_complex_expressions_3f(arguments, 1) then
      return early_return_complex(compile, scope, args)
    else
      return list(sym("lua"), ("return " .. table.concat(map(args, view), ", ")))
    end
  end
  local function binary(compile, scope, _4_0, ast)
    local _arg_0_ = _4_0
    local left = _arg_0_["left"]
    local operator = _arg_0_["operator"]
    local right = _arg_0_["right"]
  local function binary(compile, scope, _159_, ast)
    local _arg_160_ = _159_
    local left = _arg_160_["left"]
    local operator = _arg_160_["operator"]
    local right = _arg_160_["right"]
    local operators = {["#"] = "length", ["=="] = "=", ["~"] = "bnot", ["~="] = "not="}
    return list(sym((operators[operator] or operator)), compile(scope, left), compile(scope, right))
  end
  local function unary(compile, scope, _5_0, ast)
    local _arg_0_ = _5_0
    local argument = _arg_0_["argument"]
    local operator = _arg_0_["operator"]
  local function unary(compile, scope, _161_, ast)
    local _arg_162_ = _161_
    local argument = _arg_162_["argument"]
    local operator = _arg_162_["operator"]
    return list(sym(operator), compile(scope, argument))
  end
  local function call(compile, scope, _6_0)
    local _arg_0_ = _6_0
    local arguments = _arg_0_["arguments"]
    local callee = _arg_0_["callee"]
    local function _7_(...)
      return compile(scope, ...)
  local function call(compile, scope, _163_)
    local _arg_164_ = _163_
    local arguments = _arg_164_["arguments"]
    local callee = _arg_164_["callee"]
    local function _166_()
      local _165_ = scope
      local function _167_(...)
        return compile(_165_, ...)
      end
      return _167_
    end
    return list(compile(scope, callee), unpack(map(arguments, _7_)))
    return list(compile(scope, callee), unpack(map(arguments, _166_())))
  end
  local function send(compile, scope, _7_0)
    local _arg_0_ = _7_0
    local arguments = _arg_0_["arguments"]
    local method = _arg_0_["method"]
    local receiver = _arg_0_["receiver"]
  local function send(compile, scope, _168_)
    local _arg_169_ = _168_
    local arguments = _arg_169_["arguments"]
    local method = _arg_169_["method"]
    local receiver = _arg_169_["receiver"]
    local target = compile(scope, receiver)
    local args = nil
    local function _8_(...)
      return compile(scope, ...)
    local args
    local function _171_()
      local _170_ = scope
      local function _172_(...)
        return compile(_170_, ...)
      end
      return _172_
    end
    args = map(arguments, _8_)
    args = map(arguments, _171_())
    if sym_3f(target) then
      return list(sym((tostring(target) .. ":" .. method.name)), unpack(args))
    else


@@ 745,34 787,34 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
    end
  end
  local function any_computed_3f(ast)
    local function _8_()
    local function _174_()
      if (ast.object.kind == "MemberExpression") then
        return any_computed_3f(ast.object)
      else
        return true
      end
    end
    return (ast.computed or (ast.object and (ast.object.kind ~= "Identifier") and _8_()))
    return (ast.computed or (ast.object and (ast.object.kind ~= "Identifier") and _174_()))
  end
  local function member(compile, scope, ast)
    if any_computed_3f(ast) then
      local function _8_()
      local function _175_()
        if ast.computed then
          return compile(scope, ast.property)
        else
          return view(compile(scope, ast.property))
        end
      end
      return list(sym("."), compile(scope, ast.object), _8_())
      return list(sym("."), compile(scope, ast.object), _175_())
    else
      return sym((tostring(compile(scope, ast.object)) .. "." .. ast.property.name))
    end
  end
  local function if_2a(compile, scope, _8_0, tail_3f)
    local _arg_0_ = _8_0
    local alternate = _arg_0_["alternate"]
    local cons = _arg_0_["cons"]
    local tests = _arg_0_["tests"]
  local function if_2a(compile, scope, _177_, tail_3f)
    local _arg_178_ = _177_
    local alternate = _arg_178_["alternate"]
    local cons = _arg_178_["cons"]
    local tests = _arg_178_["tests"]
    for _, v in ipairs(cons) do
      if (0 == #v) then
        table.insert(v, sym("nil"))


@@ 780,211 822,265 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
    end
    local subscope = make_scope(scope)
    if (not alternate and (1 == #tests)) then
      local function _9_(...)
        return compile(subscope, ...)
      local _181_
      do
        local _180_ = subscope
        local function _182_(...)
          return compile(_180_, ...)
        end
        _181_ = _182_
      end
      return list(sym("when"), compile(scope, tests[1]), unpack(map(cons[1], _9_, tail_3f)))
      return list(sym("when"), compile(scope, tests[1]), unpack(map(cons[1], _181_, tail_3f)))
    else
      local out = list(sym("if"))
      for i, test in ipairs(tests) do
        table.insert(out, compile(scope, test))
        local c = cons[i]
        local function _9_()
        local function _186_()
          if (1 == #c) then
            return compile(subscope, c[1], tail_3f)
          else
            local function _9_(...)
              return compile(subscope, ...)
            local _184_
            do
              local _183_ = subscope
              local function _185_(...)
                return compile(_183_, ...)
              end
              _184_ = _185_
            end
            return list(sym("do"), unpack(map(c, _9_, tail_3f)))
            return list(sym("do"), unpack(map(c, _184_, tail_3f)))
          end
        end
        table.insert(out, _9_())
        table.insert(out, _186_())
      end
      if alternate then
        local function _9_()
        local function _190_()
          if (1 == #alternate) then
            return compile(subscope, alternate[1], tail_3f)
          else
            local function _9_(...)
              return compile(subscope, ...)
            local _188_
            do
              local _187_ = subscope
              local function _189_(...)
                return compile(_187_, ...)
              end
              _188_ = _189_
            end
            return list(sym("do"), unpack(map(alternate, _9_, tail_3f)))
            return list(sym("do"), unpack(map(alternate, _188_, tail_3f)))
          end
        end
        table.insert(out, _9_())
        table.insert(out, _190_())
      end
      return out
    end
  end
  local function concat(compile, scope, _9_0)
    local _arg_0_ = _9_0
    local terms = _arg_0_["terms"]
    local function _10_(...)
      return compile(scope, ...)
  local function concat(compile, scope, _193_)
    local _arg_194_ = _193_
    local terms = _arg_194_["terms"]
    local function _196_()
      local _195_ = scope
      local function _197_(...)
        return compile(_195_, ...)
      end
      return _197_
    end
    return list(sym(".."), unpack(map(terms, _10_)))
    return list(sym(".."), unpack(map(terms, _196_())))
  end
  local function each_2a(compile, scope, _10_0)
    local _arg_0_ = _10_0
    local body = _arg_0_["body"]
    local explist = _arg_0_["explist"]
    local namelist = _arg_0_["namelist"]
  local function each_2a(compile, scope, _198_)
    local _arg_199_ = _198_
    local body = _arg_199_["body"]
    local explist = _arg_199_["explist"]
    local namelist = _arg_199_["namelist"]
    local subscope = make_scope(scope)
    local binding = nil
    local function _11_(...)
      return compile(scope, ...)
    local binding
    local function _201_()
      local _200_ = scope
      local function _202_(...)
        return compile(_200_, ...)
      end
      return _202_
    end
    binding = map(namelist.names, _11_)
    binding = map(namelist.names, _201_())
    add_to_scope(subscope, "param", binding)
    local function _12_(...)
      return compile(scope, ...)
    local function _204_()
      local _203_ = scope
      local function _205_(...)
        return compile(_203_, ...)
      end
      return _205_
    end
    for _, form in ipairs(map(explist, _12_)) do
    for _, form in ipairs(map(explist, _204_())) do
      table.insert(binding, form)
    end
    local function _12_(...)
      return compile(subscope, ...)
    local function _207_()
      local _206_ = subscope
      local function _208_(...)
        return compile(_206_, ...)
      end
      return _208_
    end
    return list(sym("each"), binding, unpack(map(body, _12_)))
    return list(sym("each"), binding, unpack(map(body, _207_())))
  end
  local function tset_2a(compile, scope, left, right_out, ast)
    if (1 < #left) then
      error(("Unsupported form; tset cannot set multiple values on line " .. (ast.line or "?")))
    end
    local _12_
    local _210_
    if (not left[1].computed and (left[1].property.kind == "Identifier")) then
      _12_ = left[1].property.name
      _210_ = left[1].property.name
    else
      _12_ = compile(scope, left[1].property)
      _210_ = compile(scope, left[1].property)
    end
    return list(sym("tset"), compile(scope, left[1].object), _12_, right_out)
    return list(sym("tset"), compile(scope, left[1].object), _210_, right_out)
  end
  local function varize_local_21(scope, name)
    scope[name].ast[1] = "var"
    return true
  end
  local function setter_for(scope, names)
    local kinds = nil
    local function _11_(_241)
      local _12_0 = (scope[_241] or _241)
      if ((type(_12_0) == "table") and (nil ~= (_12_0).kind)) then
        local kind = (_12_0).kind
    local kinds
    local function _212_(_241)
      local _213_ = (scope[_241] or _241)
      if ((type(_213_) == "table") and (nil ~= (_213_).kind)) then
        local kind = (_213_).kind
        return kind
      else
        local _ = _12_0
        local _ = _213_
        return "global"
      end
    end
    kinds = map(names, _11_)
    local _12_0, _13_0, _14_0 = kinds
    local _15_
    do
      local _ = _12_0
      _15_ = (true and (1 < #kinds))
    kinds = map(names, _212_)
    local _215_ = kinds
    local function _216_()
      local _ = _215_
      return (1 < #kinds)
    end
    if _15_ then
      local _ = _12_0
    if (true and _216_()) then
      local _ = _215_
      return "set-forcibly!"
    elseif ((type(_12_0) == "table") and ((_12_0)[1] == "local")) then
      local function _16_(...)
        return varize_local_21(scope, ...)
    elseif ((type(_215_) == "table") and ((_215_)[1] == "local")) then
      local function _218_()
        local _217_ = scope
        local function _219_(...)
          return varize_local_21(_217_, ...)
        end
        return _219_
      end
      map(names, _16_)
      map(names, _218_())
      return "set"
    elseif ((type(_12_0) == "table") and ((_12_0)[1] == "MemberExpression")) then
    elseif ((type(_215_) == "table") and ((_215_)[1] == "MemberExpression")) then
      return "set"
    elseif ((type(_12_0) == "table") and ((_12_0)[1] == "function")) then
    elseif ((type(_215_) == "table") and ((_215_)[1] == "function")) then
      return "set-forcibly!"
    elseif ((type(_12_0) == "table") and ((_12_0)[1] == "param")) then
    elseif ((type(_215_) == "table") and ((_215_)[1] == "param")) then
      return "set-forcibly!"
    else
      local _ = _12_0
      local _ = _215_
      return "global"
    end
  end
  local function assignment(compile, scope, ast)
    local _let_0_ = ast
    local left = _let_0_["left"]
    local right = _let_0_["right"]
    local right_out = nil
    local _let_221_ = ast
    local left = _let_221_["left"]
    local right = _let_221_["right"]
    local right_out
    if (1 == #right) then
      right_out = compile(scope, right[1])
    elseif (0 == #right) then
      right_out = sym("nil")
    else
      local function _11_(...)
        return compile(scope, ...)
      local function _223_()
        local _222_ = scope
        local function _224_(...)
          return compile(_222_, ...)
        end
        return _224_
      end
      right_out = list(sym("values"), unpack(map(right, _11_)))
      right_out = list(sym("values"), unpack(map(right, _223_())))
    end
    if any_computed_3f(left[1]) then
      return tset_2a(compile, scope, left, right_out, ast)
    else
      local setter = nil
      local function _12_(_241)
      local setter
      local function _226_(_241)
        return (_241.name or _241)
      end
      setter = setter_for(scope, map(left, _12_))
      local _13_
      setter = setter_for(scope, map(left, _226_))
      local _227_
      if (1 == #left) then
        _13_ = compile(scope, left[1])
        _227_ = compile(scope, left[1])
      else
        local function _14_(...)
          return compile(scope, ...)
        local function _229_()
          local _228_ = scope
          local function _230_(...)
            return compile(_228_, ...)
          end
          return _230_
        end
        _13_ = list(unpack(map(left, _14_)))
        _227_ = list(unpack(map(left, _229_())))
      end
      return list(sym(setter), _13_, right_out)
      return list(sym(setter), _227_, right_out)
    end
  end
  local function while_2a(compile, scope, _11_0)
    local _arg_0_ = _11_0
    local body = _arg_0_["body"]
    local test = _arg_0_["test"]
  local function while_2a(compile, scope, _233_)
    local _arg_234_ = _233_
    local body = _arg_234_["body"]
    local test = _arg_234_["test"]
    local subscope = make_scope(scope)
    local function _12_(...)
      return compile(subscope, ...)
    end
    return list(sym("while"), compile(scope, test), unpack(map(body, _12_)))
  end
  local function repeat_2a(compile, scope, _12_0)
    local _arg_0_ = _12_0
    local body = _arg_0_["body"]
    local test = _arg_0_["test"]
    local function _14_()
      local _13_0 = nil
      local function _14_(...)
        return compile(scope, ...)
      end
      _13_0 = map(body, _14_)
      table.insert(_13_0, list(sym("when"), compile(scope, test), list(sym("lua"), "break")))
      return _13_0
    end
    return list(sym("while"), true, unpack(_14_()))
  end
  local function for_2a(compile, scope, _13_0)
    local _arg_0_ = _13_0
    local body = _arg_0_["body"]
    local init = _arg_0_["init"]
    local last = _arg_0_["last"]
    local step = _arg_0_["step"]
    local function _236_()
      local _235_ = subscope
      local function _237_(...)
        return compile(_235_, ...)
      end
      return _237_
    end
    return list(sym("while"), compile(scope, test), unpack(map(body, _236_())))
  end
  local function repeat_2a(compile, scope, _238_)
    local _arg_239_ = _238_
    local body = _arg_239_["body"]
    local test = _arg_239_["test"]
    local function _244_()
      local _240_
      local function _242_()
        local _241_ = scope
        local function _243_(...)
          return compile(_241_, ...)
        end
        return _243_
      end
      _240_ = map(body, _242_())
      table.insert(_240_, list(sym("when"), compile(scope, test), list(sym("lua"), "break")))
      return _240_
    end
    return list(sym("while"), true, unpack(_244_()))
  end
  local function for_2a(compile, scope, _245_)
    local _arg_246_ = _245_
    local body = _arg_246_["body"]
    local init = _arg_246_["init"]
    local last = _arg_246_["last"]
    local step = _arg_246_["step"]
    local i = compile(scope, init.id)
    local subscope = make_scope(scope)
    add_to_scope(subscope, "param", {i})
    local function _14_(...)
      return compile(subscope, ...)
    local function _248_()
      local _247_ = subscope
      local function _249_(...)
        return compile(_247_, ...)
      end
      return _249_
    end
    return list(sym("for"), {i, compile(scope, init.value), compile(scope, last), (step and (step ~= 1) and compile(scope, step))}, unpack(map(body, _14_)))
    return list(sym("for"), {i, compile(scope, init.value), compile(scope, last), (step and (step ~= 1) and compile(scope, step))}, unpack(map(body, _248_())))
  end
  local function table_2a(compile, scope, _14_0)
    local _arg_0_ = _14_0
    local keyvals = _arg_0_["keyvals"]
  local function table_2a(compile, scope, _250_)
    local _arg_251_ = _250_
    local keyvals = _arg_251_["keyvals"]
    local out = {}
    for i, _15_0 in pairs(keyvals) do
      local _each_0_ = _15_0
      local v = _each_0_[1]
      local k = _each_0_[2]
    for i, _252_ in pairs(keyvals) do
      local _each_253_ = _252_
      local v = _each_253_[1]
      local k = _each_253_[2]
      if k then
        out[compile(scope, k)] = compile(scope, v)
      else


@@ 993,14 1089,19 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
    end
    return out
  end
  local function do_2a(compile, scope, _15_0, tail_3f)
    local _arg_0_ = _15_0
    local body = _arg_0_["body"]
  local function do_2a(compile, scope, _255_, tail_3f)
    local _arg_256_ = _255_
    local body = _arg_256_["body"]
    local subscope = make_scope(scope)
    local function _16_(...)
      return compile(subscope, ...)
    local _258_
    do
      local _257_ = subscope
      local function _259_(...)
        return compile(_257_, ...)
      end
      _258_ = _259_
    end
    return list(sym("do"), unpack(map(body, _16_, tail_3f)))
    return list(sym("do"), unpack(map(body, _258_, tail_3f)))
  end
  local function _break(compile, scope, ast)
    return list(sym("lua"), "break")


@@ 1015,75 1116,80 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
    if os.getenv("DEBUG") then
      print(ast.kind)
    end
    local _17_0 = ast.kind
    if (_17_0 == "Chunk") then
    local _262_ = ast.kind
    if (_262_ == "Chunk") then
      local scope0 = make_scope(nil)
      local function _18_(...)
        return compile(scope0, ...)
      local _264_
      do
        local _263_ = scope0
        local function _265_(...)
          return compile(_263_, ...)
        end
        _264_ = _265_
      end
      return map(ast.body, _18_, true)
    elseif (_17_0 == "LocalDeclaration") then
      return map(ast.body, _264_, true)
    elseif (_262_ == "LocalDeclaration") then
      return local_declaration(compile, scope, ast)
    elseif (_17_0 == "FunctionDeclaration") then
    elseif (_262_ == "FunctionDeclaration") then
      return declare_function(compile, scope, ast)
    elseif (_17_0 == "FunctionExpression") then
    elseif (_262_ == "FunctionExpression") then
      return _function(compile, scope, ast)
    elseif (_17_0 == "BinaryExpression") then
    elseif (_262_ == "BinaryExpression") then
      return binary(compile, scope, ast)
    elseif (_17_0 == "ConcatenateExpression") then
    elseif (_262_ == "ConcatenateExpression") then
      return concat(compile, scope, ast)
    elseif (_17_0 == "CallExpression") then
    elseif (_262_ == "CallExpression") then
      return call(compile, scope, ast)
    elseif (_17_0 == "LogicalExpression") then
    elseif (_262_ == "LogicalExpression") then
      return binary(compile, scope, ast)
    elseif (_17_0 == "AssignmentExpression") then
    elseif (_262_ == "AssignmentExpression") then
      return assignment(compile, scope, ast)
    elseif (_17_0 == "SendExpression") then
    elseif (_262_ == "SendExpression") then
      return send(compile, scope, ast)
    elseif (_17_0 == "MemberExpression") then
    elseif (_262_ == "MemberExpression") then
      return member(compile, scope, ast)
    elseif (_17_0 == "UnaryExpression") then
    elseif (_262_ == "UnaryExpression") then
      return unary(compile, scope, ast)
    elseif (_17_0 == "ExpressionValue") then
    elseif (_262_ == "ExpressionValue") then
      return compile(scope, ast.value)
    elseif (_17_0 == "ExpressionStatement") then
    elseif (_262_ == "ExpressionStatement") then
      return compile(scope, ast.expression)
    elseif (_17_0 == "IfStatement") then
    elseif (_262_ == "IfStatement") then
      return if_2a(compile, scope, ast, tail_3f)
    elseif (_17_0 == "DoStatement") then
    elseif (_262_ == "DoStatement") then
      return do_2a(compile, scope, ast, tail_3f)
    elseif (_17_0 == "ForInStatement") then
    elseif (_262_ == "ForInStatement") then
      return each_2a(compile, scope, ast)
    elseif (_17_0 == "WhileStatement") then
    elseif (_262_ == "WhileStatement") then
      return while_2a(compile, scope, ast)
    elseif (_17_0 == "RepeatStatement") then
    elseif (_262_ == "RepeatStatement") then
      return repeat_2a(compile, scope, ast)
    elseif (_17_0 == "ForStatement") then
    elseif (_262_ == "ForStatement") then
      return for_2a(compile, scope, ast)
    elseif (_17_0 == "BreakStatement") then
    elseif (_262_ == "BreakStatement") then
      return _break(compile, scope, ast)
    elseif (_17_0 == "ReturnStatement") then
    elseif (_262_ == "ReturnStatement") then
      if tail_3f then
        return vals(compile, scope, ast)
      else
        return early_return(compile, scope, ast)
      end
    elseif (_17_0 == "Identifier") then
    elseif (_262_ == "Identifier") then
      return sym(ast.name)
    elseif (_17_0 == "Table") then
    elseif (_262_ == "Table") then
      return table_2a(compile, scope, ast)
    elseif (_17_0 == "Literal") then
    elseif (_262_ == "Literal") then
      if (nil == ast.value) then
        return sym("nil")
      else
        return ast.value
      end
    elseif (_17_0 == "Vararg") then
    elseif (_262_ == "Vararg") then
      return sym("...")
    elseif (_17_0 == nil) then
    elseif (_262_ == nil) then
      return sym("nil")
    else
      local _ = _17_0
      local _ = _262_
      return unsupported(ast)
    end
  end


@@ 1340,7 1446,7 @@ package.preload["lang.lua_ast"] = package.preload["lang.lua_ast"] or function(..
    local function declare(self, name)
      local vars = self.current.vars
      local entry = create(name)
      vars[(#vars + 1)] = entry
      do end (vars)[(#vars + 1)] = entry
      return entry
    end
    local function scope_enter(self)


@@ 1460,7 1566,7 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    lex_check(ls, "]")
    return v
  end
  local function _0_(ast, ls)
  local function _64_(ast, ls)
    local line = ls.linenumber
    local kvs = {}
    lex_check(ls, "{")


@@ 1475,7 1581,7 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
        lex_check(ls, "=")
      end
      local val = expr(ast, ls)
      kvs[(#kvs + 1)] = {val, key}
      do end (kvs)[(#kvs + 1)] = {val, key}
      if (not lex_opt(ls, ",") and not lex_opt(ls, ";")) then
        break
      end


@@ 1483,8 1589,8 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    lex_match(ls, "}", "{", line)
    return ast:expr_table(kvs, line)
  end
  expr_table = _0_
  local function _1_(ast, ls)
  expr_table = _64_
  local function _67_(ast, ls)
    local tk, val = ls.token, ls.tokenval
    local e = nil
    if (tk == "TK_number") then


@@ 1517,8 1623,8 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    ls:next()
    return e
  end
  expr_simple = _1_
  local function _2_(ast, ls)
  expr_simple = _67_
  local function _70_(ast, ls)
    local exps = {}
    exps[1] = expr(ast, ls)
    while lex_opt(ls, ",") do


@@ 1530,8 1636,8 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    end
    return exps
  end
  expr_list = _2_
  local function _3_(ast, ls)
  expr_list = _70_
  local function _72_(ast, ls)
    local tk = ls.token
    if (((tk == "TK_not") or (tk == "-")) or (tk == "#")) then
      local line = ls.linenumber


@@ 1542,8 1648,8 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
      return expr_simple(ast, ls)
    end
  end
  expr_unop = _3_
  local function _4_(ast, ls, limit)
  expr_unop = _72_
  local function _74_(ast, ls, limit)
    local v = expr_unop(ast, ls)
    local op = ls.token2str(ls.token)
    while (operator.is_binop(op) and (operator.left_priority(op) > limit)) do


@@ 1555,12 1661,12 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    end
    return v, op
  end
  expr_binop = _4_
  local function _5_(ast, ls)
  expr_binop = _74_
  local function _75_(ast, ls)
    return expr_binop(ast, ls, 0)
  end
  expr = _5_
  local function _6_(ast, ls)
  expr = _75_
  local function _76_(ast, ls)
    local v, vk = nil
    if (ls.token == "(") then
      local line = ls.linenumber


@@ 1593,7 1699,7 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    end
    return v, vk
  end
  expr_primary = _6_
  expr_primary = _76_
  local function parse_return(ast, ls, line)
    ls:next()
    ls.fs.has_return = true


@@ 1657,7 1763,7 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    ast:fscope_end()
    return ast:repeat_stmt(cond, body, line, lastline)
  end
  local function _7_(ast, ls)
  local function _82_(ast, ls)
    local line = ls.linenumber
    local args = nil
    if (ls.token == "(") then


@@ 1683,11 1789,11 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    end
    return args
  end
  parse_args = _7_
  parse_args = _82_
  local function parse_assignment(ast, ls, vlist, ___var___, vk)
    local line = ls.linenumber
    checkcond(ls, ((vk == "var") or (vk == "indexed")), "syntax error")
    vlist[(#vlist + 1)] = ___var___
    do end (vlist)[(#vlist + 1)] = ___var___
    if lex_opt(ls, ",") then
      local n_var, n_vk = expr_primary(ast, ls)
      return parse_assignment(ast, ls, vlist, n_var, n_vk)


@@ 1757,7 1863,7 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
  end
  local function parse_then(ast, ls, tests, line)
    ls:next()
    tests[(#tests + 1)] = expr(ast, ls)
    do end (tests)[(#tests + 1)] = expr(ast, ls)
    lex_check(ls, "TK_then")
    return parse_block(ast, ls, line)
  end


@@ 1855,7 1961,7 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
      local function tk_args()
        if ((ls.token == "TK_name") or (not LJ_52 and (ls.token == "TK_goto"))) then
          local name = lex_str(ls)
          args[(#args + 1)] = name
          do end (args)[(#args + 1)] = name
          if lex_opt(ls, ",") then
            return tk_args()
          end


@@ 1884,7 1990,7 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    local body = {}
    while (not islast and not End_of_block[ls.token]) do
      stmt, islast = parse_stmt(ast, ls)
      body[(#body + 1)] = stmt
      do end (body)[(#body + 1)] = stmt
      lex_opt(ls, ";")
    end
    return body, firstline, ls.linenumber


@@ 1893,7 1999,7 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    local body, firstline, lastline = parse_block_stmts(ast, ls)
    return ast:chunk(body, ls.chunkname, 0, lastline)
  end
  local function _8_(ast, ls, line, needself)
  local function _102_(ast, ls, line, needself)
    local pfs = ls.fs
    ls.fs = new_proto(ls, false)
    ast:fscope_begin()


@@ 1912,15 2018,15 @@ package.preload["lang.parser"] = package.preload["lang.parser"] or function(...)
    ls.fs = pfs
    return params, body, proto
  end
  parse_body = _8_
  local function _9_(ast, ls, firstline)
  parse_body = _102_
  local function _104_(ast, ls, firstline)
    ast:fscope_begin()
    local body = parse_block_stmts(ast, ls)
    body.firstline, body.lastline = firstline, ls.linenumber
    ast:fscope_end()
    return body
  end
  parse_block = _9_
  parse_block = _104_
  local function parse(ast, ls)
    ls:next()
    ls.fs = new_proto(ls, true)


@@ 2456,7 2562,7 @@ package.preload["lang.lexer"] = package.preload["lang.lexer"] or function(...)
  end
  return lex_setup
end
local fennel = nil
local fennel
package.preload["fennel"] = package.preload["fennel"] or function(...)
  package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
    local utils = require("fennel.utils")


@@ 2510,6 2616,77 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return table.concat(spliced_source, "\n")
    end
    local function completer(env, scope, text)
      local matches = {}
      local input_fragment = text:gsub(".*[%s)(]+", "")
      local stop_looking_3f = false
      local function add_partials(input, tbl, prefix, method_3f)
        for k in utils.allpairs(tbl) do
          local k0 = nil
          if ((tbl == env) or (tbl == env.___replLocals___)) then
            k0 = scope.unmanglings[k]
          else
            k0 = k
          end
          if ((#matches < 2000) and (type(k0) == "string") and (input == k0:sub(0, #input)) and (not method_3f or ("function" == type(tbl[k0])))) then
            local function _1_()
              if method_3f then
                return (prefix .. ":" .. k0)
              else
                return (prefix .. k0)
              end
            end
            table.insert(matches, _1_())
          end
        end
        return nil
      end
      local function descend(input, tbl, prefix, add_matches, method_3f)
        local splitter = nil
        if method_3f then
          splitter = "^([^:]+):(.*)"
        else
          splitter = "^([^.]+)%.(.*)"
        end
        local head, tail = input:match(splitter)
        local raw_head = nil
        if ((tbl == env) or (tbl == env.___replLocals___)) then
          raw_head = scope.manglings[head]
        else
          raw_head = head
        end
        if (type(tbl[raw_head]) == "table") then
          stop_looking_3f = true
          if method_3f then
            return add_partials(tail, tbl[raw_head], (prefix .. head), true)
          else
            return add_matches(tail, tbl[raw_head], (prefix .. head))
          end
        end
      end
      local function add_matches(input, tbl, prefix)
        local prefix0 = nil
        if prefix then
          prefix0 = (prefix .. ".")
        else
          prefix0 = ""
        end
        if (not input:find("%.") and input:find(":")) then
          return descend(input, tbl, prefix0, add_matches, true)
        elseif not input:find("%.") then
          return add_partials(input, tbl, prefix0)
        else
          return descend(input, tbl, prefix0, add_matches, false)
        end
      end
      for _, source in ipairs({scope.specials, scope.macros, (env.___replLocals___ or {}), env, env._G}) do
        add_matches(input_fragment, source)
        if stop_looking_3f then
          break
        end
      end
      return matches
    end
    local commands = {}
    local function command_3f(input)
      return input:match("^%s*,")


@@ 2582,6 2759,138 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return on_values({"ok"})
    end
    do end (compiler.metadata):set(commands.reset, "fnl/docstring", "Erase all repl-local scope.")
    commands.complete = function(env, read, on_values, on_error, scope)
      local _0_0, _1_0, _2_0 = pcall(read)
      if ((_0_0 == true) and (_1_0 == true) and (nil ~= _2_0)) then
        local input = _2_0
        return on_values(completer(env, scope, tostring(input)))
      elseif (true and true and true) then
        local _ = _0_0
        local _0 = _1_0
        local _3fmsg = _2_0
        return on_error("Parse", (_3fmsg or "Couldn't parse completion input."))
      end
    end
    do end (compiler.metadata):set(commands.complete, "fnl/docstring", "Print all possible completions for a given input.")
    local function apropos_2a(pattern, module, prefix, seen, names)
      for name, module0 in pairs(module) do
        if (("string" == type(name)) and (package ~= module0)) then
          local _0_0 = type(module0)
          if (_0_0 == "function") then
            if ((prefix .. name)):match(pattern) then
              table.insert(names, (prefix .. name))
            end
          elseif (_0_0 == "table") then
            if not seen[module0] then
              local _2_
              do
                local _1_0 = seen
                _1_0[module0] = true
                _2_ = _1_0
              end
              apropos_2a(pattern, module0, (prefix .. name:gsub("%.", "/") .. "."), _2_, names)
            end
          end
        end
      end
      return names
    end
    local function apropos(pattern)
      local names = apropos_2a(pattern, package.loaded, "", {}, {})
      local tbl_0_ = {}
      for _, name in ipairs(names) do
        tbl_0_[(#tbl_0_ + 1)] = name:gsub("^_G%.", "")
      end
      return tbl_0_
    end
    commands.apropos = function(env, read, on_values, on_error, scope)
      local _0_0, _1_0, _2_0 = pcall(read)
      if ((_0_0 == true) and (_1_0 == true) and (nil ~= _2_0)) then
        local input = _2_0
        return on_values(apropos(tostring(input)))
      elseif (true and true and true) then
        local _ = _0_0
        local _0 = _1_0
        local _3fmsg = _2_0
        return on_error("Parse", (_3fmsg or "Couldn't parse apropos input."))
      end
    end
    do end (compiler.metadata):set(commands.apropos, "fnl/docstring", "Print all functions matching a pattern in all loaded modules.")
    local function apropos_follow_path(path)
      local paths = nil
      do
        local tbl_0_ = {}
        for p in path:gmatch("[^%.]+") do
          tbl_0_[(#tbl_0_ + 1)] = p
        end
        paths = tbl_0_
      end
      local tgt = package.loaded
      for _, path0 in ipairs(paths) do
        local _1_
        do
          local _0_0 = path0:gsub("%/", ".")
          _1_ = _0_0
        end
        tgt = tgt[_1_]
        if (nil == tgt) then
          break
        end
      end
      return tgt
    end
    local function apropos_doc(pattern)
      local names = {}
      for _, path in ipairs(apropos(".*")) do
        local tgt = apropos_follow_path(path)
        if ("function" == type(tgt)) then
          local _0_0 = (compiler.metadata):get(tgt, "fnl/docstring")
          if (nil ~= _0_0) then
            local docstr = _0_0
            if docstr:match(pattern) then
              table.insert(names, path)
            end
          end
        end
      end
      return names
    end
    commands["apropos-doc"] = function(env, read, on_values, on_error, scope)
      local _0_0, _1_0, _2_0 = pcall(read)
      if ((_0_0 == true) and (_1_0 == true) and (nil ~= _2_0)) then
        local input = _2_0
        return on_values(apropos_doc(tostring(input)))
      elseif (true and true and true) then
        local _ = _0_0
        local _0 = _1_0
        local _3fmsg = _2_0
        return on_error("Parse", (_3fmsg or "Couldn't parse apropos-doc input."))
      end
    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(pattern)
      for _, path in ipairs(apropos(pattern)) do
        local tgt = apropos_follow_path(path)
        if (("function" == type(tgt)) and (compiler.metadata):get(tgt, "fnl/docstring")) then
          print(specials.doc(tgt, path))
          print()
        end
      end
      return nil
    end
    commands["apropos-show-docs"] = function(env, read, _, on_error, scope)
      local _0_0, _1_0, _2_0 = pcall(read)
      if ((_0_0 == true) and (_1_0 == true) and (nil ~= _2_0)) then
        local input = _2_0
        return apropos_show_docs(tostring(input))
      elseif (true and true and true) then
        local _0 = _0_0
        local _1 = _1_0
        local _3fmsg = _2_0
        return on_error("Parse", (_3fmsg or "Couldn't parse apropos-show-docs input."))
      end
    end
    do end (compiler.metadata):set(commands["apropos-show-docs"], "fnl/docstring", "Print all documentations matching a pattern in function name")
    local function load_plugin_commands()
      if (utils.root and utils.root.options and utils.root.options.plugins) then
        for _, plugin in ipairs(utils.root.options.plugins) do


@@ 2596,14 2905,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return nil
      end
    end
    local function run_command(input, read, loop, env, on_values, on_error)
    local function run_command(input, read, loop, env, on_values, on_error, scope)
      load_plugin_commands()
      local command_name = input:match(",([^%s/]+)")
      do
        local _0_0 = commands[command_name]
        if (nil ~= _0_0) then
          local command = _0_0
          command(env, read, on_values, on_error)
          command(env, read, on_values, on_error, scope)
        else
          local _ = _0_0
          if ("exit" ~= command_name) then


@@ 2615,52 2924,6 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return loop()
      end
    end
    local function completer(env, scope, text)
      local matches = {}
      local input_fragment = text:gsub(".*[%s)(]+", "")
      local function add_partials(input, tbl, prefix)
        for k in utils.allpairs(tbl) do
          local k0 = nil
          if ((tbl == env) or (tbl == env.___replLocals___)) then
            k0 = scope.unmanglings[k]
          else
            k0 = k
          end
          if ((#matches < 2000) and (type(k0) == "string") and (input == k0:sub(0, #input))) then
            table.insert(matches, (prefix .. k0))
          end
        end
        return nil
      end
      local function add_matches(input, tbl, prefix)
        local prefix0 = nil
        if prefix then
          prefix0 = (prefix .. ".")
        else
          prefix0 = ""
        end
        if not input:find("%.") then
          return add_partials(input, tbl, prefix0)
        else
          local head, tail = input:match("^([^.]+)%.(.*)")
          local raw_head = nil
          if ((tbl == env) or (tbl == env.___replLocals___)) then
            raw_head = scope.manglings[head]
          else
            raw_head = head
          end
          if (type(tbl[raw_head]) == "table") then
            return add_matches(tail, tbl[raw_head], (prefix0 .. head))
          end
        end
      end
      add_matches(input_fragment, (scope.specials or {}))
      add_matches(input_fragment, (scope.macros or {}))
      add_matches(input_fragment, (env.___replLocals___ or {}))
      add_matches(input_fragment, env)
      add_matches(input_fragment, (env._ENV or env._G or {}))
      return matches
    end
    local function repl(options)
      local old_root_options = utils.root.options
      local env = nil


@@ 2722,11 2985,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          reset()
          return loop()
        elseif command_3f(src_string) then
          return run_command(src_string, read, loop, env, on_values, on_error)
          return run_command(src_string, read, loop, env, on_values, on_error, scope)
        else
          if parse_ok_3f then
            do
              local _4_0, _5_0 = pcall(compiler.compile, x, {["assert-compile"] = opts["assert-compile"], ["parse-error"] = opts["parse-error"], correlate = opts.correlate, moduleName = opts.moduleName, scope = scope, source = src_string, useMetadata = opts.useMetadata})
              local _4_0, _5_0 = pcall(compiler.compile, x, {["assert-compile"] = opts["assert-compile"], ["parse-error"] = opts["parse-error"], correlate = opts.correlate, moduleName = opts.moduleName, scope = scope, source = src_string, useBitLib = opts.useBitLib, useMetadata = opts.useMetadata})
              if ((_4_0 == false) and (nil ~= _5_0)) then
                local msg = _5_0
                clear_stream()


@@ 2791,30 3054,73 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
      end
    end
    local function table_kv_pairs(t)
    local function max_index_gap(kv)
      local gap = 0
      if (#kv > 0) then
        local _2_ = kv
        local _3_ = _2_[1]
        local i = _3_[1]
        local rest = {(table.unpack or unpack)(_2_, 2)}
        for _, _4_0 in ipairs(rest) do
          local _5_ = _4_0
          local k = _5_[1]
          if ((k - i) > gap) then
            gap = (k - i)
          end
          i = k
        end
      end
      return gap
    end
    local function fill_gaps(kv)
      do
        local missing_indexes = {}
        local i = 0
        for _, _2_0 in ipairs(kv) do
          local _3_ = _2_0
          local j = _3_[1]
          i = (i + 1)
          while (i < j) do
            table.insert(missing_indexes, i)
            i = (i + 1)
          end
        end
        for _, k in ipairs(missing_indexes) do
          table.insert(kv, k, {k})
        end
      end
      return kv
    end
    local function table_kv_pairs(t, options)
      local assoc_3f = false
      local i = 1
      local kv = {}
      local insert = table.insert
      for k, v in pairs(t) do
        if ((type(k) ~= "number") or (k ~= i)) then
        if (type(k) ~= "number") then
          assoc_3f = true
        end
        i = (i + 1)
        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
      end
      if (#kv == 0) then
        return kv, "empty"
      else
        local function _2_()
        local function _3_()
          if assoc_3f then
            return "table"
          else
            return "seq"
          end
        end
        return kv, _2_()
        return kv, _3_()
      end
    end
    local function count_table_appearances(t, appearances)


@@ 2918,7 3224,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        else
          prefix = ""
        end
        local elements = nil
        local items = nil
        do
          local tbl_0_ = {}
          for _, _6_0 in pairs(kv) do


@@ 2934,9 3240,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            end
            tbl_0_[(#tbl_0_ + 1)] = _8_
          end
          elements = tbl_0_
          items = tbl_0_
        end
        return concat_table_lines(elements, options, multiline_3f, indent0, "table", prefix)
        return concat_table_lines(items, options, multiline_3f, indent0, "table", prefix)
      end
    end
    local function pp_sequence(t, kv, options, indent)


@@ 2956,7 3262,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        else
          prefix = ""
        end
        local elements = nil
        local items = nil
        do
          local tbl_0_ = {}
          for _, _3_0 in pairs(kv) do


@@ 2971,9 3277,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            end
            tbl_0_[(#tbl_0_ + 1)] = _5_
          end
          elements = tbl_0_
          items = tbl_0_
        end
        return concat_table_lines(elements, options, multiline_3f, indent0, "seq", prefix)
        return concat_table_lines(items, options, multiline_3f, indent0, "seq", prefix)
      end
    end
    local function concat_lines(lines, options, indent, force_multi_line_3f)


@@ 3024,7 3330,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          return concat_lines(lines, options, indent, force_multi_line_3f)
        else
          local _0 = _3_0
          return error("Error: __fennelview metamethod must return a table of lines")
          return error("__fennelview metamethod must return a table of lines")
        end
      end
    end


@@ 3053,7 3359,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          x0 = pp_metamethod(x, metamethod, options, indent)
        else
          local _ = _2_0
          local _4_0, _5_0 = table_kv_pairs(x)
          local _4_0, _5_0 = table_kv_pairs(x, options)
          if (true and (_5_0 == "empty")) then
            local _0 = _4_0
            if options["empty-as-sequence?"] then


@@ 3097,7 3403,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return ("\"" .. str:gsub("[%c\\\"]", escs) .. "\"")
    end
    local function make_options(t, options)
      local defaults = {["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["escape-newlines?"] = false, ["line-length"] = 80, ["metamethod?"] = true, ["one-line?"] = false, ["prefer-colon?"] = false, ["utf8?"] = true, depth = 128}
      local defaults = {["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["escape-newlines?"] = false, ["line-length"] = 80, ["max-sparse-gap"] = 10, ["metamethod?"] = true, ["one-line?"] = false, ["prefer-colon?"] = false, ["utf8?"] = true, depth = 128}
      local overrides = {appearances = count_table_appearances(t, {}), level = 0, seen = {len = 0}}
      for k, v in pairs((options or {})) do
        defaults[k] = v


@@ 3189,7 3495,28 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return setmetatable({}, {__index = _0_, __newindex = _1_, __pairs = _2_})
    end
    local function current_global_names(env)
      return utils.kvmap((env or _G), compiler["global-unmangling"])
      local mt = nil
      do
        local _0_0 = getmetatable(env)
        if ((type(_0_0) == "table") and (nil ~= _0_0.__pairs)) then
          local __pairs = _0_0.__pairs
          local tbl_0_ = {}
          for k, v in __pairs(env) do
            local _1_0, _2_0 = k, v
            if ((nil ~= _1_0) and (nil ~= _2_0)) then
              local k_0_ = _1_0
              local v_0_ = _2_0
              tbl_0_[k_0_] = v_0_
            end
          end
          mt = tbl_0_
        elseif (_0_0 == nil) then
          mt = (env or _G)
        else
        mt = nil
        end
      end
      return (mt and utils.kvmap(mt, compiler["global-unmangling"]))
    end
    local function load_code(code, environment, filename)
      local environment0 = (environment or rawget(_G, "_ENV") or _G)


@@ 3221,8 3548,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
      end
    end
    local function doc_special(name, arglist, docstring)
      compiler.metadata[SPECIALS[name]] = {["fnl/arglist"] = arglist, ["fnl/docstring"] = docstring}
    local function doc_special(name, arglist, docstring, body_form_3f)
      compiler.metadata[SPECIALS[name]] = {["fnl/arglist"] = arglist, ["fnl/body-form?"] = body_form_3f, ["fnl/docstring"] = docstring}
      return nil
    end
    local function compile_do(ast, scope, parent, start)


@@ 3284,7 3611,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return compile_body(nil, true, utils.expr((fname .. "(" .. fargs .. ")"), "statement"))
      end
    end
    doc_special("do", {"..."}, "Evaluate multiple forms; return last value.")
    doc_special("do", {"..."}, "Evaluate multiple forms; return last value.", true)
    SPECIALS.values = function(ast, scope, parent)
      local len = #ast
      local exprs = {}


@@ 3333,8 3660,8 @@ 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 = nil
        local function _0_(v)
          return ("\"%s\""):format(deep_tostring(v))
        local function _0_(_241)
          return ("\"%s\""):format(deep_tostring(_241))
        end
        args = utils.map(arg_list, _0_)
        local meta_fields = {"\"fnl/arglist\"", ("{" .. table.concat(args, ", ") .. "}")}


@@ 3356,9 3683,30 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        return _0_, not multi, 3
      else
        return compiler.gensym(scope), true, 2
        return nil, true, 2
      end
    end
    local function compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, local_3f, arg_name_list, arg_list, docstring)
      for i = (index + 1), #ast do
        compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
      end
      local _0_
      if local_3f then
        _0_ = "local function %s(%s)"
      else
        _0_ = "%s = function(%s)"
      end
      compiler.emit(parent, string.format(_0_, 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)
      utils.hook("fn", ast, f_scope)
      return utils.expr(fn_name, "sym")
    end
    local function compile_anonymous_fn(ast, f_scope, f_chunk, parent, index, arg_name_list, arg_list, docstring, scope)
      local fn_name = compiler.gensym(scope)
      return compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, true, arg_name_list, arg_list, docstring)
    end
    SPECIALS.fn = function(ast, scope, parent)
      local f_scope = nil
      do


@@ 3369,7 3717,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local f_chunk = {}
      local fn_sym = utils["sym?"](ast[2])
      local multi = (fn_sym and utils["multi-sym?"](fn_sym[1]))
      local fn_name, local_fn_3f, index = get_fn_name(ast, scope, fn_sym, multi)
      local fn_name, local_3f, index = get_fn_name(ast, scope, fn_sym, multi)
      local arg_list = compiler.assert(utils["table?"](ast[index]), "expected parameters table", ast)
      compiler.assert((not multi or not multi["multi-sym-method-call"]), ("unexpected multi symbol " .. tostring(fn_name)), fn_sym)
      local function get_arg_name(arg)


@@ 3388,32 3736,20 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          return compiler.assert(false, ("expected symbol for function parameter: %s"):format(tostring(arg)), ast[2])
        end
      end
      do
        local arg_name_list = utils.map(arg_list, get_arg_name)
        local index0, docstring = nil, nil
        if ((type(ast[(index + 1)]) == "string") and ((index + 1) < #ast)) then
          index0, docstring = (index + 1), ast[(index + 1)]
        else
          index0, docstring = index, nil
        end
        for i = (index0 + 1), #ast do
          compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
        end
        local _2_
        if local_fn_3f then
          _2_ = "local function %s(%s)"
        else
          _2_ = "%s = function(%s)"
        end
        compiler.emit(parent, string.format(_2_, 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)
      local arg_name_list = utils.map(arg_list, get_arg_name)
      local index0, docstring = nil, nil
      if ((type(ast[(index + 1)]) == "string") and ((index + 1) < #ast)) then
        index0, docstring = (index + 1), ast[(index + 1)]
      else
        index0, docstring = index, nil
      end
      if fn_name then
        return compile_named_fn(ast, f_scope, f_chunk, parent, index0, fn_name, local_3f, arg_name_list, arg_list, docstring)
      else
        return compile_anonymous_fn(ast, f_scope, f_chunk, parent, index0, arg_name_list, arg_list, docstring, scope)
      end
      utils.hook("fn", ast, f_scope)
      return utils.expr(fn_name, "sym")
    end
    doc_special("fn", {"name?", "args", "docstring?", "..."}, "Function syntax. May optionally include a name and docstring.\nIf a name is provided, the function will be bound in the current scope.\nWhen called with the wrong number of args, excess args will be discarded\nand lacking args will be nil, use lambda for arity-checked functions.")
    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)
      if (ast[2] ~= nil) then


@@ 3431,8 3767,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if special_or_macro then
        return ("print(%q)"):format(doc_2a(special_or_macro, target))
      else
        local value = tostring(compiler.compile1(ast[2], scope, parent, {nval = 1})[1])
        return ("print(require('%s').doc(%s, '%s'))"):format((utils.root.options.moduleName or "fennel"), value, tostring(ast[2]))
        local _0_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
        local value = _0_[1]
        return ("print(require('%s').doc(%s, '%s'))"):format((utils.root.options.moduleName or "fennel"), tostring(value), tostring(ast[2]))
      end
    end
    doc_special("doc", {"x"}, "Print the docstring and arglist for a function, macro, or special form.")


@@ 3511,7 3848,24 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return SPECIALS["do"](ast, scope, parent, opts, 3, sub_chunk, sub_scope, pre_syms)
    end
    doc_special("let", {"[name1 val1 ... nameN valN]", "..."}, "Introduces a new scope in which a given set of local bindings are used.")
    doc_special("let", {"[name1 val1 ... nameN valN]", "..."}, "Introduces a new scope in which a given set of local bindings are used.", true)
    local function get_prev_line(parent)
      if ("table" == type(parent)) then
        return get_prev_line((parent.leaf or parent[#parent]))
      else
        return (parent or "")
      end
    end
    local function disambiguate_3f(rootstr, parent)
      local function _1_()
        local _0_0 = get_prev_line(parent)
        if (nil ~= _0_0) then
          local prev_line = _0_0
          return prev_line:match("%)$")
        end
      end
      return (rootstr:match("^{") or _1_())
    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]


@@ 3524,12 3878,12 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local value = compiler.compile1(ast[#ast], scope, parent, {nval = 1})[1]
      local rootstr = tostring(root)
      local fmtstr = nil
      if rootstr:match("^{") then
      if disambiguate_3f(rootstr, parent) then
        fmtstr = "do end (%s)[%s] = %s"
      else
        fmtstr = "%s[%s] = %s"
      end
      return compiler.emit(parent, fmtstr:format(tostring(root), table.concat(keys, "]["), tostring(value)), ast)
      return compiler.emit(parent, fmtstr:format(rootstr, table.concat(keys, "]["), tostring(value)), ast)
    end
    doc_special("tset", {"tbl", "key1", "...", "keyN", "val"}, "Set the value of a table field. Can take additional keys to set\nnested values, but all parents must contain an existing table.")
    local function calculate_target(scope, opts)


@@ 3584,7 3938,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        local cond = tostring(branch.cond)
        local cond_line = nil
        if ((cond == "true") and branch.nested and (i == #branches)) then
        if ((cond == "true") and branch.nested and (i == #branches) and not has_else_3f) then
          cond_line = "else"
        else
          cond_line = fstr:format(cond)


@@ 3636,9 3990,24 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    SPECIALS["if"] = if_2a
    doc_special("if", {"cond1", "body1", "...", "condN", "bodyN"}, "Conditional form.\nTakes any number of condition/body pairs and evaluates the first body where\nthe condition evaluates to truthy. Similar to cond in other lisps.")
    local function remove_until_condition(bindings)
      if ("until" == bindings[(#bindings - 1)]) then
        table.remove(bindings, (#bindings - 1))
        return table.remove(bindings)
      end
    end
    local function compile_until(condition, scope, chunk)
      if condition then
        local _0_ = compiler.compile1(condition, scope, chunk, {nval = 1})
        local condition_lua = _0_[1]
        return compiler.emit(chunk, ("if %s then break end"):format(tostring(condition_lua)), condition)
      end
    end
    SPECIALS.each = function(ast, scope, parent)
      compiler.assert((#ast >= 3), "expected body expression", ast[1])
      local binding = compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
      local _ = compiler.assert((2 <= #binding), "expected binding and iterator", binding)
      local until_condition = remove_until_condition(binding)
      local iter = table.remove(binding, #binding)
      local destructures = {}
      local new_manglings = {}


@@ 3661,11 4030,12 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        compiler.destructure(args, raw, ast, sub_scope, chunk, {declaration = true, nomulti = true, symtype = "each"})
      end
      compiler["apply-manglings"](sub_scope, new_manglings, ast)
      compile_until(until_condition, sub_scope, chunk)
      compile_do(ast, sub_scope, chunk, 3)
      compiler.emit(parent, chunk, ast)
      return compiler.emit(parent, "end", ast)
    end
    doc_special("each", {"[key value (iterator)]", "..."}, "Runs the body once for each set of values provided by the given iterator.\nMost commonly used with ipairs for sequential tables or pairs for  undefined\norder, but can be used with any iterator.")
    doc_special("each", {"[key value (iterator)]", "..."}, "Runs the body once for each set of values provided by the given iterator.\nMost commonly used with ipairs for sequential tables or pairs for  undefined\norder, but can be used with any iterator.", true)
    local function while_2a(ast, scope, parent)
      local len1 = #parent
      local condition = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]


@@ 3686,9 4056,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return compiler.emit(parent, "end", ast)
    end
    SPECIALS["while"] = while_2a
    doc_special("while", {"condition", "..."}, "The classic while loop. Evaluates body until a condition is non-truthy.")
    doc_special("while", {"condition", "..."}, "The classic while loop. Evaluates body until a condition is non-truthy.", true)
    local function for_2a(ast, scope, parent)
      local ranges = compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
      local until_condition = remove_until_condition(ast[2])
      local binding_sym = table.remove(ast[2], 1)
      local sub_scope = compiler["make-scope"](scope)
      local range_args = {}


@@ 3699,12 4070,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        range_args[i] = tostring(compiler.compile1(ranges[i], sub_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)
      compile_do(ast, sub_scope, chunk, 3)
      compiler.emit(parent, chunk, ast)
      return compiler.emit(parent, "end", ast)
    end
    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).")
    doc_special("for", {"[index start stop step?]", "..."}, "Numeric loop construct.\nEvaluates body once for each value between start and stop (inclusive).", true)
    local function native_method_call(ast, _scope, _parent, target, args)
      local _0_ = ast
      local _ = _0_[1]


@@ 3766,7 4138,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return compiler.emit(parent, ("-- " .. table.concat(els, " ")), ast)
    end
    doc_special("comment", {"..."}, "Comment which will be emitted in Lua output.")
    doc_special("comment", {"..."}, "Comment which will be emitted in Lua output.", true)
    local function hashfn_max_used(f_scope, i, max)
      local max0 = nil
      if f_scope.symmeta[("$" .. i)].used then


@@ 3824,40 4196,35 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return utils.expr(name, "sym")
    end
    doc_special("hashfn", {"..."}, "Function literal shorthand; args are either $... OR $1, $2, etc.")
    local function define_arithmetic_special(name, zero_arity, unary_prefix, lua_name)
      do
        local padded_op = (" " .. (lua_name or name) .. " ")
        local function _0_(ast, scope, parent)
          local len = #ast
          if (len == 1) then
            compiler.assert((zero_arity ~= nil), "Expected more than 0 arguments", ast)
            return utils.expr(zero_arity, "literal")
    local function arithmetic_special(name, zero_arity, unary_prefix, nval, ast, scope, parent)
      local _0_0 = #ast
      if (_0_0 == 1) then
        compiler.assert(zero_arity, "Expected more than 0 arguments", ast)
        return utils.expr(zero_arity, "literal")
      elseif (nil ~= _0_0) then
        local len = _0_0
        local operands = {}
        local padded_op = (" " .. name .. " ")
        for i = 2, len do
          local subexprs = compiler.compile1(ast[i], scope, parent, {nval = nval})
          utils.map(subexprs, tostring, operands)
        end
        if (#operands == 1) then
          if unary_prefix then
            return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")")
          else
            local operands = {}
            for i = 2, len do
              local subexprs = nil
              local _1_
              if (i ~= len) then
                _1_ = 1
              else
              _1_ = nil
              end
              subexprs = compiler.compile1(ast[i], scope, parent, {nval = _1_})
              utils.map(subexprs, tostring, operands)
            end
            if (#operands == 1) then
              if unary_prefix then
                return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")")
              else
                return operands[1]
              end
            else
              return ("(" .. table.concat(operands, padded_op) .. ")")
            end
            return operands[1]
          end
        else
          return ("(" .. table.concat(operands, padded_op) .. ")")
        end
        SPECIALS[name] = _0_
      end
    end
    local function define_arithmetic_special(name, zero_arity, unary_prefix, lua_name)
      local function _0_(...)
        return arithmetic_special((lua_name or name), zero_arity, unary_prefix, 1, ...)
      end
      SPECIALS[name] = _0_
      return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.")
    end
    define_arithmetic_special("+", "0")


@@ 3868,20 4235,65 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    define_arithmetic_special("%")
    define_arithmetic_special("/", nil, "1")
    define_arithmetic_special("//", nil, "1")
    define_arithmetic_special("lshift", nil, "1", "<<")
    define_arithmetic_special("rshift", nil, "1", ">>")
    define_arithmetic_special("band", "0", "0", "&")
    define_arithmetic_special("bor", "0", "0", "|")
    define_arithmetic_special("bxor", "0", "0", "~")
    doc_special("lshift", {"x", "n"}, "Bitwise logical left shift of x by n bits; only works in Lua 5.3+.")
    doc_special("rshift", {"x", "n"}, "Bitwise logical right shift of x by n bits; only works in Lua 5.3+.")
    doc_special("band", {"x1", "x2"}, "Bitwise AND of arguments; only works in Lua 5.3+.")
    doc_special("bor", {"x1", "x2"}, "Bitwise OR of arguments; only works in Lua 5.3+.")
    doc_special("bxor", {"x1", "x2"}, "Bitwise XOR of arguments; only works in Lua 5.3+.")
    define_arithmetic_special("or", "false")
    define_arithmetic_special("and", "true")
    SPECIALS["or"] = function(ast, scope, parent)
      return arithmetic_special("or", "false", nil, nil, ast, scope, parent)
    end
    SPECIALS["and"] = function(ast, scope, parent)
      return arithmetic_special("and", "true", nil, nil, ast, scope, parent)
    end
    doc_special("and", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.")
    doc_special("or", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.")
    local function bitop_special(native_name, lib_name, zero_arity, unary_prefix, ast, scope, parent)
      if (#ast == 1) then
        return compiler.assert(zero_arity, "Expected more than 0 arguments.", ast)
      else
        local len = #ast
        local operands = {}
        local padded_native_name = (" " .. native_name .. " ")
        local prefixed_lib_name = ("bit." .. lib_name)
        for i = 2, len do
          local subexprs = nil
          local _0_
          if (i ~= len) then
            _0_ = 1
          else
          _0_ = nil
          end
          subexprs = compiler.compile1(ast[i], scope, parent, {nval = _0_})
          utils.map(subexprs, tostring, operands)
        end
        if (#operands == 1) then
          if utils.root.options.useBitLib then
            return (prefixed_lib_name .. "(" .. unary_prefix .. ", " .. operands[1] .. ")")
          else
            return ("(" .. unary_prefix .. padded_native_name .. operands[1] .. ")")
          end
        else
          if utils.root.options.useBitLib then
            return (prefixed_lib_name .. "(" .. table.concat(operands, ", ") .. ")")
          else
            return ("(" .. table.concat(operands, padded_native_name) .. ")")
          end
        end
      end
    end
    local function define_bitop_special(name, zero_arity, unary_prefix, native)
      local function _0_(...)
        return bitop_special(native, name, zero_arity, unary_prefix, ...)
      end
      SPECIALS[name] = _0_
      return nil
    end
    define_bitop_special("lshift", nil, "1", "<<")
    define_bitop_special("rshift", nil, "1", ">>")
    define_bitop_special("band", "0", "0", "&")
    define_bitop_special("bor", "0", "0", "|")
    define_bitop_special("bxor", "0", "0", "~")
    doc_special("lshift", {"x", "n"}, "Bitwise logical left shift of x by n bits.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
    doc_special("rshift", {"x", "n"}, "Bitwise logical right shift of x by n bits.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
    doc_special("band", {"x1", "x2", "..."}, "Bitwise AND of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
    doc_special("bor", {"x1", "x2", "..."}, "Bitwise OR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
    doc_special("bxor", {"x1", "x2", "..."}, "Bitwise XOR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
    doc_special("..", {"a", "b", "..."}, "String concatenation operator; works the same as Lua but accepts more arguments.")
    local function native_comparator(op, _0_0, scope, parent)
      local _1_ = _0_0


@@ 3929,7 4341,6 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    define_comparator_special("<=")
    define_comparator_special("=", "==")
    define_comparator_special("not=", "~=", "or")
    SPECIALS["~="] = SPECIALS["not="]
    local function define_unary_special(op, realop)
      local function opfn(ast, scope, parent)
        compiler.assert((#ast == 2), "expected one argument", ast)


@@ 3942,9 4353,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    define_unary_special("not", "not ")
    doc_special("not", {"x"}, "Logical operator; works the same as Lua.")
    define_unary_special("bnot", "~")
    doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+.")
    doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
    define_unary_special("length", "#")
    doc_special("length", {"x"}, "Returns the length of a table or string.")
    SPECIALS["~="] = SPECIALS["not="]
    SPECIALS["#"] = SPECIALS.length
    SPECIALS.quote = function(ast, scope, parent)
      compiler.assert((#ast == 2), "expected one argument")


@@ 3958,8 4370,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return compiler["do-quote"](ast[2], scope, parent, runtime)
    end
    doc_special("quote", {"x"}, "Quasiquote the following form. Only works in macro/compiler scope.")
    local already_warned_3f = {}
    local compile_env_warning = ("WARNING: Attempting to %s %s in compile" .. " scope.\nIn future versions of Fennel this will not" .. " be allowed without the\n--no-compiler-sandbox flag" .. " or passing a :compilerEnv globals table in options.\n")
    local macro_loaded = {}
    local already_warned_3f = {_G = true}
    local compile_env_warning = table.concat({"WARNING: Attempting to %s %s in compile scope.", "In future versions of Fennel this will not be allowed without the", "--no-compiler-sandbox flag or passing a :compilerEnv globals table", "in the options.\n"}, "\n")
    local function compiler_env_warn(_, key)
      local v = _G[key]
      if (v and io and io.stderr and not already_warned_3f[key]) then


@@ 3977,44 4390,61 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function safe_compiler_env(strict_3f)
      local _1_
      if strict_3f then
        _1_ = compiler_env_warn
        _1_ = nil
      else
      _1_ = nil
        _1_ = compiler_env_warn
      end
      return setmetatable({assert = assert, bit = rawget(_G, "bit"), error = error, getmetatable = safe_getmetatable, ipairs = ipairs, math = utils.copy(math), next = next, pairs = pairs, pcall = pcall, print = print, rawequal = rawequal, rawget = rawget, rawlen = rawget(_G, "rawlen"), rawset = rawset, require = safe_require, select = select, setmetatable = setmetatable, string = utils.copy(string), table = utils.copy(table), tonumber = tonumber, tostring = tostring, type = type, xpcall = xpcall}, {__index = _1_})
    end
    local function combined_mt_pairs(env)
      local combined = {}
      local _1_ = getmetatable(env)
      local __index = _1_["__index"]
      if ("table" == type(__index)) then
        for k, v in pairs(__index) do
          combined[k] = v
        end
      end
      for k, v in next, env, nil do
        combined[k] = v
      end
      return next, combined, nil
    end
    local function make_compiler_env(ast, scope, parent, strict_3f)
      local function _1_()
      local provided = nil
      do
        local _1_0 = utils.root.options
        if ((type(_1_0) == "table") and (_1_0["compiler-env"] == "strict")) then
          provided = safe_compiler_env(true)
        elseif ((type(_1_0) == "table") and (nil ~= _1_0.compilerEnv)) then
          local compilerEnv = _1_0.compilerEnv
          provided = compilerEnv
        elseif ((type(_1_0) == "table") and (nil ~= _1_0["compiler-env"])) then
          local compiler_env = _1_0["compiler-env"]
          provided = compiler_env
        else
          local _ = _1_0
          provided = safe_compiler_env(strict_3f)
        end
      end
      local env = nil
      local function _2_()
        return compiler.scopes.macro
      end
      local function _2_(symbol)
      local function _3_(symbol)
        compiler.assert(compiler.scopes.macro, "must call from macro", ast)
        return compiler.scopes.macro.manglings[tostring(symbol)]
      end
      local function _3_(base)
      local function _4_(base)
        return utils.sym(compiler.gensym((compiler.scopes.macro or scope), base))
      end
      local function _4_(form)
      local function _5_(form)
        compiler.assert(compiler.scopes.macro, "must call from macro", ast)
        return compiler.macroexpand(form, compiler.scopes.macro)
      end
      local _6_
      do
        local _5_0 = utils.root.options
        if ((type(_5_0) == "table") and (_5_0["compiler-env"] == "strict")) then
          _6_ = safe_compiler_env(true)
        elseif ((type(_5_0) == "table") and (nil ~= _5_0.compilerEnv)) then
          local compilerEnv = _5_0.compilerEnv
          _6_ = compilerEnv
        elseif ((type(_5_0) == "table") and (nil ~= _5_0["compiler-env"])) then
          local compiler_env = _5_0["compiler-env"]
          _6_ = compiler_env
        else
          local _ = _5_0
          _6_ = safe_compiler_env(false)
        end
      end
      return setmetatable({["assert-compile"] = compiler.assert, ["get-scope"] = _1_, ["in-scope?"] = _2_, ["list?"] = utils["list?"], ["multi-sym?"] = utils["multi-sym?"], ["sequence?"] = utils["sequence?"], ["sym?"] = utils["sym?"], ["table?"] = utils["table?"], ["varg?"] = utils["varg?"], _AST = ast, _CHUNK = parent, _IS_COMPILER = true, _SCOPE = scope, _SPECIALS = compiler.scopes.global.specials, _VARARG = utils.varg(), gensym = _3_, list = utils.list, macroexpand = _4_, sequence = utils.sequence, sym = utils.sym, unpack = unpack, view = view}, {__index = _6_})
      env = {["assert-compile"] = compiler.assert, ["get-scope"] = _2_, ["in-scope?"] = _3_, ["list?"] = utils["list?"], ["macro-loaded"] = macro_loaded, ["multi-sym?"] = utils["multi-sym?"], ["sequence?"] = utils["sequence?"], ["sym?"] = utils["sym?"], ["table?"] = utils["table?"], ["varg?"] = utils["varg?"], _AST = ast, _CHUNK = parent, _IS_COMPILER = true, _SCOPE = scope, _SPECIALS = compiler.scopes.global.specials, _VARARG = utils.varg(), gensym = _4_, list = utils.list, macroexpand = _5_, sequence = utils.sequence, sym = utils.sym, unpack = unpack, view = view}
      env._G = env
      return setmetatable(env, {__index = provided, __newindex = provided, __pairs = combined_mt_pairs})
    end
    local cfg = string.gmatch(package.config, "([^\n]+)")
    local dirsep, pathsep, pathmark = (cfg() or "/"), (cfg() or ";"), (cfg() or "?")


@@ 4071,13 4501,56 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return allowed
    end
    local function compiler_env_domodule(modname, env, _3fast, _3fscope)
      local filename = compiler.assert(search_module(modname), (modname .. " module not found."), _3fast)
      local globals = macro_globals(env, current_global_names())
      local scope = (_3fscope or compiler["make-scope"](compiler.scopes.compiler))
      return utils["fennel-module"].dofile(filename, {allowedGlobals = globals, env = env, scope = scope, useMetadata = utils.root.options.useMetadata}, modname, filename)
    local function fennel_macro_searcher(module_name)
      local _1_0 = search_module(module_name, utils["fennel-module"]["macro-path"])
      if (nil ~= _1_0) then
        local filename = _1_0
        local function _2_(...)
          return utils["fennel-module"].dofile(filename, {env = "_COMPILER"}, ...)
        end
        return _2_, filename
      end
    end
    local function lua_macro_searcher(module_name)
      local _1_0 = search_module(module_name, package.path)
      if (nil ~= _1_0) then
        local filename = _1_0
        local code = nil
        do
          local f = io.open(filename)
          local function close_handlers_0_(ok_0_, ...)
            f:close()
            if ok_0_ then
              return ...
            else
              return error(..., 0)
            end
          end
          local function _2_()
            return assert(f:read("*a"))
          end
          code = close_handlers_0_(xpcall(_2_, (package.loaded.fennel or debug).traceback))
        end
        local chunk = load_code(code, make_compiler_env(), filename)
        return chunk, filename
      end
    end
    local macro_searchers = {lua_macro_searcher, fennel_macro_searcher}
    local function search_macro_module(modname, n)
      local _1_0 = macro_searchers[n]
      if (nil ~= _1_0) then
        local f = _1_0
        local _2_0, _3_0 = f(modname)
        if ((nil ~= _2_0) and true) then
          local loader = _2_0
          local _3ffilename = _3_0
          return loader, _3ffilename
        else
          local _ = _2_0
          return search_macro_module(modname, (n + 1))
        end
      end
    end
    local macro_loaded = {}
    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}


@@ 4085,11 4558,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local function _1_(modname)
      local function _2_()
        local scope = compiler["make-scope"](compiler.scopes.compiler)
        local env = make_compiler_env(nil, scope, nil)
        local mod = compiler_env_domodule(modname, env, nil, scope)
        macro_loaded[modname] = mod
        return mod
        local loader, filename = search_macro_module(modname, 1)
        compiler.assert(loader, (modname .. " module not found."))
        macro_loaded[modname] = loader(modname, filename)
        return macro_loaded[modname]
      end
      return (macro_loaded[modname] or metadata_only_fennel(modname) or _2_())
    end


@@ 4105,12 4577,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    SPECIALS["require-macros"] = function(ast, scope, parent, real_ast)
      compiler.assert((#ast == 2), "Expected one module name argument", (real_ast or ast))
      local filename = (ast[2].filename or ast.filename)
      local modname_code = compiler.compile(ast[2])
      local modname = load_code(modname_code, nil, filename)(utils.root.options["module-name"], filename)
      local modname_chunk = load_code(compiler.compile(ast[2]), nil, filename)
      local modname = modname_chunk(utils.root.options["module-name"], filename)
      compiler.assert((type(modname) == "string"), "module name must compile to string", (real_ast or ast))
      if not macro_loaded[modname] then
        local env = make_compiler_env(ast, scope, parent)
        macro_loaded[modname] = compiler_env_domodule(modname, env, ast)
        local loader, filename0 = search_macro_module(modname, 1)
        compiler.assert(loader, (modname .. " module not found."), ast)
        macro_loaded[modname] = loader(modname, filename0)
      end
      return add_macros(macro_loaded[modname], ast, scope, parent)
    end


@@ 4229,8 4703,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      ast[1] = old_first
      return val
    end
    doc_special("eval-compiler", {"..."}, "Evaluate the body at compile-time. Use the macro system instead if possible.")
    return {["current-global-names"] = current_global_names, ["load-code"] = load_code, ["macro-loaded"] = macro_loaded, ["make-compiler-env"] = make_compiler_env, ["make-searcher"] = make_searcher, ["search-module"] = search_module, ["wrap-env"] = wrap_env, doc = doc_2a}
    doc_special("eval-compiler", {"..."}, "Evaluate the body at compile-time. Use the macro system instead if possible.", true)
    return {["current-global-names"] = current_global_names, ["load-code"] = load_code, ["macro-loaded"] = macro_loaded, ["macro-searchers"] = macro_searchers, ["make-compiler-env"] = make_compiler_env, ["make-searcher"] = make_searcher, ["search-module"] = search_module, ["wrap-env"] = wrap_env, doc = doc_2a}
  end
  package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or function(...)
    local utils = require("fennel.utils")


@@ 4246,7 4720,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      else
        _0_ = 0
      end
      return {autogensyms = {}, depth = _0_, hashfn = (parent0 and parent0.hashfn), includes = setmetatable({}, {__index = (parent0 and parent0.includes)}), macros = setmetatable({}, {__index = (parent0 and parent0.macros)}), manglings = setmetatable({}, {__index = (parent0 and parent0.manglings)}), parent = parent0, refedglobals = setmetatable({}, {__index = (parent0 and parent0.refedglobals)}), specials = setmetatable({}, {__index = (parent0 and parent0.specials)}), symmeta = setmetatable({}, {__index = (parent0 and parent0.symmeta)}), unmanglings = setmetatable({}, {__index = (parent0 and parent0.unmanglings)}), vararg = (parent0 and parent0.vararg)}
      return {autogensyms = setmetatable({}, {__index = (parent0 and parent0.autogensyms)}), depth = _0_, gensyms = setmetatable({}, {__index = (parent0 and parent0.gensyms)}), hashfn = (parent0 and parent0.hashfn), includes = setmetatable({}, {__index = (parent0 and parent0.includes)}), macros = setmetatable({}, {__index = (parent0 and parent0.macros)}), manglings = setmetatable({}, {__index = (parent0 and parent0.manglings)}), parent = parent0, refedglobals = setmetatable({}, {__index = (parent0 and parent0.refedglobals)}), specials = setmetatable({}, {__index = (parent0 and parent0.specials)}), symmeta = setmetatable({}, {__index = (parent0 and parent0.symmeta)}), unmanglings = setmetatable({}, {__index = (parent0 and parent0.unmanglings)}), vararg = (parent0 and parent0.vararg)}
    end
    local function assert_msg(ast, msg)
      local ast_tbl = nil


@@ 4320,11 4794,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
    end
    local allowed_globals = nil
    local function global_allowed(name)
    local function global_allowed_3f(name)
      return (not allowed_globals or utils["member?"](name, allowed_globals))
    end
    local function unique_mangling(original, mangling, scope, append)
      if scope.unmanglings[mangling] then
      if (scope.unmanglings[mangling] and not scope.gensyms[mangling]) then
        return unique_mangling(original, (original .. append), scope, (append + 1))
      else
        return mangling


@@ 4373,13 4847,17 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return ret
    end
    local function gensym(scope, base)
      local append, mangling = 0, ((base or "") .. "_0_")
    local function next_append()
      utils.root.scope["gensym-append"] = ((utils.root.scope["gensym-append"] or 0) + 1)
      return ("_" .. utils.root.scope["gensym-append"] .. "_")
    end
    local function gensym(scope, base, _3fsuffix)
      local mangling = ((base or "") .. next_append() .. (_3fsuffix or ""))
      while scope.unmanglings[mangling] do
        mangling = ((base or "") .. "_" .. append .. "_")
        append = (append + 1)
        mangling = ((base or "") .. next_append() .. (_3fsuffix or ""))
      end
      scope.unmanglings[mangling] = (base or true)
      scope.gensyms[mangling] = true
      return mangling
    end
    local function autogensym(base, scope)


@@ 4391,7 4869,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      else
        local _ = _0_0
        local function _1_()
          local mangling = gensym(scope, base:sub(1, ( - 2)))
          local mangling = gensym(scope, base:sub(1, ( - 2)), "auto")
          scope.autogensyms[base] = mangling
          return mangling
        end


@@ 4438,7 4916,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if (local_3f and scope.symmeta[parts[1]]) then
        scope.symmeta[parts[1]]["used"] = true
      end
      assert_compile((not reference_3f or local_3f or global_allowed(parts[1])), ("unknown global in strict mode: " .. tostring(parts[1])), symbol)
      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 global in strict mode: " .. tostring(parts[1])), symbol)
      if (allowed_globals and not local_3f) then
        utils.root.scope.refedglobals[parts[1]] = true
      end


@@ 4472,7 4951,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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)
    local function flatten_chunk_correlated(main_chunk, options)
      local function flatten(chunk, out, last_line, file)
        local last_line0 = last_line
        if chunk.leaf then


@@ 4481,7 4960,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          for _, subchunk in ipairs(chunk) do
            if (subchunk.leaf or (#subchunk > 0)) then
              local source = ast_source(subchunk.ast)
              if (file == source.file) then
              if (file == source.filename) then
                last_line0 = math.max(last_line0, (source.line or 0))
              end
              last_line0 = flatten(subchunk, out, last_line0, file)


@@ 4491,7 4970,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return last_line0
      end
      local out = {}
      local last = flatten(main_chunk, out, 1, main_chunk.file)
      local last = flatten(main_chunk, out, 1, options.filename)
      for i = 1, last do
        if (out[i] == nil) then
          out[i] = ""


@@ 4548,7 5027,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function flatten(chunk, options)
      local chunk0 = peephole(chunk)
      if options.correlate then
        return flatten_chunk_correlated(chunk0), {}
        return flatten_chunk_correlated(chunk0, options), {}
      else
        local sm = {}
        local ret = flatten_chunk(sm, chunk0, options.indent, 0)


@@ 4600,7 5079,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          emit(chunk, string.format("do local _ = %s end", tostring(se)), ast)
        elseif (se.type == "statement") then
          local code = tostring(se)
          emit(chunk, (((code:byte() == 40) and ("do end " .. code)) or code), ast)
          local disambiguated = nil
          if (code:byte() == 40) then
            disambiguated = ("do end " .. code)
          else
            disambiguated = code
          end
          emit(chunk, disambiguated, ast)
        end
      end
      return nil


@@ 4662,26 5147,35 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
    end
    local function macroexpand_2a(ast, scope, once)
      if not utils["list?"](ast) then
        return ast
      local _0_0 = nil
      if utils["list?"](ast) then
        _0_0 = find_macro(ast, scope, utils["multi-sym?"](ast[1]))
      else
        local macro_2a = find_macro(ast, scope, utils["multi-sym?"](ast[1]))
        if not macro_2a then
          return ast
      _0_0 = nil
      end
      if (_0_0 == false) then
        return ast
      elseif (nil ~= _0_0) then
        local macro_2a = _0_0
        local old_scope = scopes.macro
        local _ = nil
        scopes.macro = scope
        _ = nil
        local ok, transformed = nil, nil
        local function _2_()
          return macro_2a(unpack(ast, 2))
        end
        ok, transformed = xpcall(_2_, debug.traceback)
        scopes.macro = old_scope
        assert_compile(ok, transformed, ast)
        if (once or not transformed) then
          return transformed
        else
          local old_scope = scopes.macro
          local _ = nil
          scopes.macro = scope
          _ = nil
          local ok, transformed = pcall(macro_2a, unpack(ast, 2))
          scopes.macro = old_scope
          assert_compile(ok, transformed, ast)
          if (once or not transformed) then
            return transformed
          else
            return macroexpand_2a(transformed, scope)
          end
          return macroexpand_2a(transformed, scope)
        end
      else
        local _ = _0_0
        return ast
      end
    end
    local function compile_special(ast, scope, parent, opts, special)


@@ 4709,7 5203,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function compile_function_call(ast, scope, parent, opts, compile1, len)
      local fargs = {}
      local fcallee = compile1(ast[1], scope, parent, {nval = 1})[1]
      assert_compile((fcallee.type ~= "literal"), ("cannot call literal value " .. tostring(ast[1])), ast)
      assert_compile((("string" == type(ast[1])) or (fcallee.type ~= "literal")), ("cannot call literal value " .. tostring(ast[1])), ast)
      for i = 2, len do
        local subexprs = nil
        local _0_


@@ 4728,7 5222,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          keep_side_effects(subexprs, parent, 2, ast[i])
        end
      end
      local call = string.format("%s(%s)", tostring(fcallee), exprs1(fargs))
      local pat = nil
      if ("string" == type(ast[1])) then
        pat = "(%s)(%s)"
      else
        pat = "%s(%s)"
      end
      local call = string.format(pat, tostring(fcallee), exprs1(fargs))
      return handle_compile_opts({utils.expr(call, "statement")}, parent, opts, ast)
    end
    local function compile_call(ast, scope, parent, opts, compile1)


@@ 4743,7 5243,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      elseif (multi_sym_parts and multi_sym_parts["multi-sym-method-call"]) then
        local table_with_method = table.concat({unpack(multi_sym_parts, 1, (#multi_sym_parts - 1))}, ".")
        local method_to_call = multi_sym_parts[#multi_sym_parts]
        local new_ast = utils.list(utils.sym(":", scope), utils.sym(table_with_method, scope), method_to_call, select(2, unpack(ast)))
        local new_ast = utils.list(utils.sym(":", nil, scope), utils.sym(table_with_method, nil, scope), method_to_call, select(2, unpack(ast)))
        return compile1(new_ast, scope, parent, opts)
      else
        return compile_function_call(ast, scope, parent, opts, compile1, len)


@@ 4814,9 5314,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          table.sort(_0_0, _1_)
          keys = _0_0
        end
        local function _1_(k)
          local v = tostring(compile1(ast[k[2]], scope, parent, {nval = 1})[1])
          return string.format("%s = %s", k[1], v)
        local function _1_(_2_0)
          local _3_ = _2_0
          local k1 = _3_[1]
          local k2 = _3_[2]
          local _4_ = compile1(ast[k2], scope, parent, {nval = 1})
          local v = _4_[1]
          return string.format("%s = %s", k1, tostring(v))
        end
        utils.map(keys, _1_, buffer)
      end


@@ 4846,8 5350,6 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local forceglobal = _0_["forceglobal"]
      local forceset = _0_["forceset"]
      local isvar = _0_["isvar"]
      local nomulti = _0_["nomulti"]
      local noundef = _0_["noundef"]
      local symtype = _0_["symtype"]
      local symtype0 = ("_" .. (symtype or "dst"))
      local setter = nil


@@ 4859,7 5361,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local new_manglings = {}
      local function getname(symbol, up1)
        local raw = symbol[1]
        assert_compile(not (nomulti and utils["multi-sym?"](raw)), ("unexpected multi symbol " .. raw), up1)
        assert_compile(not (opts0.nomulti and utils["multi-sym?"](raw)), ("unexpected multi symbol " .. raw), up1)
        if declaration then
          return declare_local(symbol, nil, scope, symbol, new_manglings)
        else


@@ 4868,7 5370,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          if ((#parts == 1) and not forceset) then
            assert_compile(not (forceglobal and meta), string.format("global %s conflicts with local", tostring(symbol)), symbol)
            assert_compile(not (meta and not meta.var), ("expected var " .. raw), symbol)
            assert_compile((meta or not noundef), ("expected local " .. parts[1]), symbol)
            assert_compile((meta or not opts0.noundef), ("expected local " .. parts[1]), symbol)
          end
          if forceglobal then
            assert_compile(not scope.symmeta[scope.unmanglings[raw]], ("global " .. raw .. " conflicts with local"), symbol)


@@ 4903,6 5405,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          end
          if ((#parent == (plen + 1)) and parent[#parent].leaf) then
            parent[#parent]["leaf"] = ("local " .. parent[#parent].leaf)
          elseif (init == "nil") then
            table.insert(parent, (plen + 1), {ast = ast, leaf = ("local " .. lvalue)})
          else
            table.insert(parent, (plen + 1), {ast = ast, leaf = ("local " .. lvalue .. " = " .. init)})
          end


@@ 4985,7 5489,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        compile_top_target(left_names)
        if declaration then
          for _, sym in ipairs(left) do
            scope.symmeta[utils.deref(sym)] = {var = isvar}
            if utils["sym?"](sym) then
              scope.symmeta[utils.deref(sym)] = {var = isvar}
            end
          end
        end
        for _, pair in utils.stablepairs(tables) do


@@ 5101,7 5607,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
    end
    local function traceback(msg, start)
      local msg0 = (msg or "")
      local msg0 = tostring((msg or ""))
      if ((msg0:find("^Compile error") or msg0:find("^Parse error")) and not utils["debug-on?"]("trace")) then
        return msg0
      else


@@ 5139,9 5645,6 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return _0_
    end
    local function no()
      return nil
    end
    local function mixed_concat(t, joiner)
      local seen = {}
      local ret, s = "", ""


@@ 5175,16 5678,20 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        local symstr = utils.deref(form)
        assert_compile(not runtime_3f, "symbols may only be used at compile time", form)
        if (symstr:find("#$") or symstr:find("#[:.]")) then
          return string.format("sym('%s', nil, {filename=%s, line=%s})", autogensym(symstr, scope), filename, (form.line or "nil"))
          return string.format("sym('%s', {filename=%s, line=%s})", autogensym(symstr, scope), filename, (form.line or "nil"))
        else
          return string.format("sym('%s', nil, {quoted=true, filename=%s, line=%s})", symstr, filename, (form.line or "nil"))
          return string.format("sym('%s', {quoted=true, filename=%s, line=%s})", symstr, filename, (form.line or "nil"))
        end
      elseif (utils["list?"](form) and utils["sym?"](form[1]) and (utils.deref(form[1]) == "unquote")) then
        local payload = form[2]
        local res = unpack(compile1(payload, scope, parent))
        return res[1]
      elseif utils["list?"](form) then
        local mapped = utils.kvmap(form, entry_transform(no, q))
        local mapped = nil
        local function _0_()
          return nil
        end
        mapped = utils.kvmap(form, entry_transform(_0_, q))
        local filename = nil
        if form.filename then
          filename = string.format("%q", form.filename)


@@ 5239,7 5746,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local m = getmetatable(ast)
      return ((m and m.line and m) or (("table" == type(ast)) and ast) or {})
    end
    local suggestions = {["$ and $... in hashfn are mutually exclusive"] = {"modifying the hashfn so it only contains $... or $, $1, $2, $3, etc"}, ["can't start multisym segment with a digit"] = {"removing the digit", "adding a non-digit before the digit"}, ["cannot call literal value"] = {"checking for typos", "checking for a missing function name"}, ["could not compile value of type "] = {"debugging the macro you're calling to return a list or table"}, ["could not read number (.*)"] = {"removing the non-digit character", "beginning the identifier with a non-digit if it is not meant to be a number"}, ["expected a function.* to call"] = {"removing the empty parentheses", "using square brackets if you want an empty table"}, ["expected binding table"] = {"placing a table here in square brackets containing identifiers to bind"}, ["expected body expression"] = {"putting some code in the body of this form after the bindings"}, ["expected each macro to be function"] = {"ensuring that the value for each key in your macros table contains a function", "avoid defining nested macro tables"}, ["expected even number of name/value bindings"] = {"finding where the identifier or value is missing"}, ["expected even number of values in table literal"] = {"removing a key", "adding a value"}, ["expected local"] = {"looking for a typo", "looking for a local which is used out of its scope"}, ["expected macros to be table"] = {"ensuring your macro definitions return a table"}, ["expected parameters"] = {"adding function parameters as a list of identifiers in brackets"}, ["expected rest argument before last parameter"] = {"moving & to right before the final identifier when destructuring"}, ["expected symbol for function parameter: (.*)"] = {"changing %s to an identifier instead of a literal value"}, ["expected var (.*)"] = {"declaring %s using var instead of let/local", "introducing a new local instead of changing the value of %s"}, ["expected vararg as last parameter"] = {"moving the \"...\" to the end of the parameter list"}, ["expected whitespace before opening delimiter"] = {"adding whitespace"}, ["global (.*) conflicts with local"] = {"renaming local %s"}, ["illegal character: (.)"] = {"deleting or replacing %s", "avoiding reserved characters like \", \\, ', ~, ;, @, `, and comma"}, ["local (.*) was overshadowed by a special form or macro"] = {"renaming local %s"}, ["macro not found in macro module"] = {"checking the keys of the imported macro module's returned table"}, ["macro tried to bind (.*) without gensym"] = {"changing to %s# when introducing identifiers inside macros"}, ["malformed multisym"] = {"ensuring each period or colon is not followed by another period or colon"}, ["may only be used at compile time"] = {"moving this to inside a macro if you need to manipulate symbols/lists", "using square brackets instead of parens to construct a table"}, ["method must be last component"] = {"using a period instead of a colon for field access", "removing segments after the colon", "making the method call, then looking up the field on the result"}, ["mismatched closing delimiter (.), expected (.)"] = {"replacing %s with %s", "deleting %s", "adding matching opening delimiter earlier"}, ["multisym method calls may only be in call position"] = {"using a period instead of a colon to reference a table's fields", "putting parens around this"}, ["unable to bind (.*)"] = {"replacing the %s with an identifier"}, ["unexpected closing delimiter (.)"] = {"deleting %s", "adding matching opening delimiter earlier"}, ["unexpected multi symbol (.*)"] = {"removing periods or colons from %s"}, ["unexpected vararg"] = {"putting \"...\" at the end of the fn parameters if the vararg was intended"}, ["unknown global in strict mode: (.*)"] = {"looking to see if there's a typo", "using the _G table instead, eg. _G.%s if you really want a global", "moving this code to somewhere that %s is in scope", "binding %s as a local in the scope of this code"}, ["unused local (.*)"] = {"fixing a typo so %s is used", "renaming the local to _%s"}, ["use of global (.*) is aliased by a local"] = {"renaming local %s", "refer to the global using _G.%s instead of directly"}}
    local suggestions = {["$ and $... in hashfn are mutually exclusive"] = {"modifying the hashfn so it only contains $... or $, $1, $2, $3, etc"}, ["can't start multisym segment with a digit"] = {"removing the digit", "adding a non-digit before the digit"}, ["cannot call literal value"] = {"checking for typos", "checking for a missing function name"}, ["could not compile value of type "] = {"debugging the macro you're calling to return a list or table"}, ["could not read number (.*)"] = {"removing the non-digit character", "beginning the identifier with a non-digit if it is not meant to be a number"}, ["expected a function.* to call"] = {"removing the empty parentheses", "using square brackets if you want an empty table"}, ["expected binding and iterator"] = {"making sure you haven't omitted a local name or iterator"}, ["expected binding table"] = {"placing a table here in square brackets containing identifiers to bind"}, ["expected body expression"] = {"putting some code in the body of this form after the bindings"}, ["expected each macro to be function"] = {"ensuring that the value for each key in your macros table contains a function", "avoid defining nested macro tables"}, ["expected even number of name/value bindings"] = {"finding where the identifier or value is missing"}, ["expected even number of values in table literal"] = {"removing a key", "adding a value"}, ["expected local"] = {"looking for a typo", "looking for a local which is used out of its scope"}, ["expected macros to be table"] = {"ensuring your macro definitions return a table"}, ["expected parameters"] = {"adding function parameters as a list of identifiers in brackets"}, ["expected rest argument before last parameter"] = {"moving & to right before the final identifier when destructuring"}, ["expected symbol for function parameter: (.*)"] = {"changing %s to an identifier instead of a literal value"}, ["expected var (.*)"] = {"declaring %s using var instead of let/local", "introducing a new local instead of changing the value of %s"}, ["expected vararg as last parameter"] = {"moving the \"...\" to the end of the parameter list"}, ["expected whitespace before opening delimiter"] = {"adding whitespace"}, ["global (.*) conflicts with local"] = {"renaming local %s"}, ["illegal character: (.)"] = {"deleting or replacing %s", "avoiding reserved characters like \", \\, ', ~, ;, @, `, and comma"}, ["local (.*) was overshadowed by a special form or macro"] = {"renaming local %s"}, ["macro not found in macro module"] = {"checking the keys of the imported macro module's returned table"}, ["macro tried to bind (.*) without gensym"] = {"changing to %s# when introducing identifiers inside macros"}, ["malformed multisym"] = {"ensuring each period or colon is not followed by another period or colon"}, ["may only be used at compile time"] = {"moving this to inside a macro if you need to manipulate symbols/lists", "using square brackets instead of parens to construct a table"}, ["method must be last component"] = {"using a period instead of a colon for field access", "removing segments after the colon", "making the method call, then looking up the field on the result"}, ["mismatched closing delimiter (.), expected (.)"] = {"replacing %s with %s", "deleting %s", "adding matching opening delimiter earlier"}, ["multisym method calls may only be in call position"] = {"using a period instead of a colon to reference a table's fields", "putting parens around this"}, ["tried to reference a macro at runtime"] = {"renaming the macro so as not to conflict with locals"}, ["unable to bind (.*)"] = {"replacing the %s with an identifier"}, ["unexpected closing delimiter (.)"] = {"deleting %s", "adding matching opening delimiter earlier"}, ["unexpected multi symbol (.*)"] = {"removing periods or colons from %s"}, ["unexpected vararg"] = {"putting \"...\" at the end of the fn parameters if the vararg was intended"}, ["unknown global in strict mode: (.*)"] = {"looking to see if there's a typo", "using the _G table instead, eg. _G.%s if you really want a global", "moving this code to somewhere that %s is in scope", "binding %s as a local in the scope of this code"}, ["unused local (.*)"] = {"fixing a typo so %s is used", "renaming the local to _%s"}, ["use of global (.*) is aliased by a local"] = {"renaming local %s", "refer to the global using _G.%s instead of directly"}}
    local unpack = (table.unpack or _G.unpack)
    local function suggest(msg)
      local suggestion = nil


@@ 5504,23 6011,37 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          end
          return dispatch(val)
        end
        local function extract_comments(tbl)
          local comments = nil
          local _0_
          if utils["comment?"](tbl[#tbl]) then
            _0_ = table.remove(tbl)
        local function add_comment_at(comments, index, node)
          local _0_0 = comments[index]
          if (nil ~= _0_0) then
            local existing = _0_0
            return table.insert(existing, node)
          else
          _0_ = nil
            local _ = _0_0
            comments[index] = {node}
            return nil
          end
        end
        local function next_noncomment(tbl, i)
          if utils["comment?"](tbl[i]) then
            return next_noncomment(tbl, (i + 1))
          else
            return tbl[i]
          end
        end
        local function extract_comments(tbl)
          local comments = {keys = {}, last = {}, values = {}}
          while utils["comment?"](tbl[#tbl]) do
            table.insert(comments.last, 1, table.remove(tbl))
          end
          comments = {keys = {}, last = _0_, values = {}}
          local last_key_3f = false
          for i, node in ipairs(tbl) do
            if not utils["comment?"](node) then
              last_key_3f = not last_key_3f
            elseif last_key_3f then
              comments.values[tbl[(i + 1)]] = node
              add_comment_at(comments.values, next_noncomment(tbl, i), node)
            else
              comments.keys[tbl[(i + 1)]] = node
              add_comment_at(comments.keys, next_noncomment(tbl, i), node)
            end
          end
          for i = #tbl, 1, -1 do


@@ 5599,8 6120,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          table.remove(stack)
          local raw = string.char(unpack(chars))
          local formatted = raw:gsub("[\7-\13]", escape_char)
          local load_fn = (rawget(_G, "loadstring") or load)(("return " .. formatted))
          return dispatch(load_fn())
          local _1_0 = (rawget(_G, "loadstring") or load)(("return " .. formatted))
          if (nil ~= _1_0) then
            local load_fn = _1_0
            return dispatch(load_fn())
          elseif (_1_0 == nil) then
            return parse_error(("Invalid string: " .. raw))
          end
        end
        local function parse_prefix(b)
          table.insert(stack, {bytestart = byteindex, filename = filename, line = line, prefix = prefixes[b]})


@@ 5646,11 6172,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          if (rawstr:match("^~") and (rawstr ~= "~=")) then
            return parse_error("illegal character: ~")
          elseif rawstr:match("%.[0-9]") then
            return parse_error(("can't start multisym segment " .. "with a digit: " .. rawstr), (((byteindex - #rawstr) + rawstr:find("%.[0-9]")) + 1))
            return parse_error(("can't start multisym segment with a digit: " .. rawstr), (((byteindex - #rawstr) + rawstr:find("%.[0-9]")) + 1))
          elseif (rawstr:match("[%.:][%.:]") and (rawstr ~= "..") and (rawstr ~= "$...")) then
            return parse_error(("malformed multisym: " .. rawstr), ((byteindex - #rawstr) + 1 + rawstr:find("[%.:][%.:]")))
          elseif rawstr:match(":.+[%.:]") then
            return parse_error(("method must be last component " .. "of multisym: " .. rawstr), ((byteindex - #rawstr) + rawstr:find(":.+[%.:]")))
            return parse_error(("method must be last component of multisym: " .. rawstr), ((byteindex - #rawstr) + rawstr:find(":.+[%.:]")))
          else
            return rawstr
          end
        end
        local function parse_sym(b)


@@ 5664,12 6192,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            return dispatch(utils.varg())
          elseif rawstr:match("^:.+$") then
            return dispatch(rawstr:sub(2))
          elseif parse_number(rawstr) then
            return nil
          elseif check_malformed_sym(rawstr) then
            return nil
          else
            return dispatch(utils.sym(rawstr, nil, {byteend = byteindex, bytestart = bytestart, filename = filename, line = line}))
          elseif not parse_number(rawstr) then
            return dispatch(utils.sym(check_malformed_sym(rawstr), {byteend = byteindex, bytestart = bytestart, filename = filename, line = line}))
          end
        end
        local function parse_loop(b)


@@ 5715,8 6239,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      for k in pairs(t) do
        table.insert(keys, k)
      end
      local function _0_(a, b)
        return (tostring(a) < tostring(b))
      local function _0_(_241, _242)
        return (tostring(_241) < tostring(_242))
      end
      table.sort(keys, _0_)
      for i, k in ipairs(keys) do


@@ 5745,9 6269,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if (type(f) == "function") then
        f0 = f
      else
        local s = f
        local function _0_(x)
          return x[s]
        local function _0_(_241)
          return _241[f]
        end
        f0 = _0_
      end


@@ 5766,9 6289,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if (type(f) == "function") then
        f0 = f
      else
        local s = f
        local function _0_(x)
          return x[s]
        local function _0_(_241)
          return _241[f]
        end
        f0 = _0_
      end


@@ 5797,7 6319,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if (_0_0 == x) then
        return true
      elseif (_0_0 == nil) then
        return false
        return nil
      else
        local _ = _0_0
        return member_3f(x, tbl, ((n or 1) + 1))


@@ 5815,10 6337,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          seen[next_state] = true
          return next_state, value
        else
          local meta = getmetatable(t)
          if (meta and meta.__index) then
            t = meta.__index
            return allpairs_next(t)
          local _0_0 = getmetatable(t)
          if ((type(_0_0) == "table") and (nil ~= _0_0.__index)) then
            local __index = _0_0.__index
            if ("table" == type(__index)) then
              t = __index
              return allpairs_next(t)
            end
          end
        end
      end


@@ 5867,9 6392,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function list(...)
      return setmetatable({...}, list_mt)
    end
    local function sym(str, scope, source)
      local s = {str, scope = scope}
      for k, v in pairs((source or {})) do
    local function sym(str, _3fsource, _3fscope)
      local s = {str, ["?scope"] = _3fscope}
      for k, v in pairs((_3fsource or {})) do
        if (type(k) == "string") then
          s[k] = v
        end


@@ 5883,8 6408,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function expr(strcode, etype)
      return setmetatable({strcode, type = etype}, expr_mt)
    end
    local function comment_2a(contents, source)
      local _1_ = (source or {})
    local function comment_2a(contents, _3fsource)
      local _1_ = (_3fsource or {})
      local filename = _1_["filename"]
      local line = _1_["line"]
      return setmetatable({contents, filename = filename, line = line}, comment_mt)


@@ 5904,9 6429,6 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function sym_3f(x)
      return ((type(x) == "table") and (getmetatable(x) == symbol_mt) and x)
    end
    local function table_3f(x)
      return ((type(x) == "table") and (x ~= vararg) and (getmetatable(x) ~= list_mt) and (getmetatable(x) ~= symbol_mt) and x)
    end
    local function sequence_3f(x)
      local mt = ((type(x) == "table") and getmetatable(x))
      return (mt and (mt.sequence == sequence_marker) and x)


@@ 5914,6 6436,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function comment_3f(x)
      return ((type(x) == "table") and (getmetatable(x) == comment_mt) and x)
    end
    local function table_3f(x)
      return ((type(x) == "table") and (x ~= vararg) and (getmetatable(x) ~= list_mt) and (getmetatable(x) ~= symbol_mt) and not comment_3f(x) and x)
    end
    local function multi_sym_3f(str)
      if sym_3f(str) then
        return multi_sym_3f(tostring(str))


@@ 5992,7 6517,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return nil
      end
    end
    return {["comment?"] = comment_3f, ["debug-on?"] = debug_on_3f, ["expr?"] = expr_3f, ["list?"] = list_3f, ["lua-keywords"] = lua_keywords, ["member?"] = member_3f, ["multi-sym?"] = multi_sym_3f, ["propagate-options"] = propagate_options, ["quoted?"] = quoted_3f, ["sequence?"] = sequence_3f, ["sym?"] = sym_3f, ["table?"] = table_3f, ["valid-lua-identifier?"] = valid_lua_identifier_3f, ["varg?"] = varg_3f, ["walk-tree"] = walk_tree, allpairs = allpairs, comment = comment_2a, copy = copy, deref = deref, expr = expr, hook = hook, kvmap = kvmap, list = list, map = map, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), root = root, sequence = sequence, stablepairs = stablepairs, sym = sym, varg = varg}
    return {["comment?"] = comment_3f, ["debug-on?"] = debug_on_3f, ["expr?"] = expr_3f, ["list?"] = list_3f, ["lua-keywords"] = lua_keywords, ["macro-path"] = table.concat({"./?.fnl", "./?/init-macros.fnl", "./?/init.fnl", getenv("FENNEL_MACRO_PATH")}, ";"), ["member?"] = member_3f, ["multi-sym?"] = multi_sym_3f, ["propagate-options"] = propagate_options, ["quoted?"] = quoted_3f, ["sequence?"] = sequence_3f, ["sym?"] = sym_3f, ["table?"] = table_3f, ["valid-lua-identifier?"] = valid_lua_identifier_3f, ["varg?"] = varg_3f, ["walk-tree"] = walk_tree, allpairs = allpairs, comment = comment_2a, copy = copy, deref = deref, expr = expr, hook = hook, kvmap = kvmap, list = list, map = map, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), root = root, sequence = sequence, stablepairs = stablepairs, sym = sym, varg = varg}
  end
  utils = require("fennel.utils")
  local parser = require("fennel.parser")


@@ 6000,11 6525,12 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
  local specials = require("fennel.specials")
  local repl = require("fennel.repl")
  local view = require("fennel.view")
  local function eval_env(env)
  local function eval_env(env, opts)
    if (env == "_COMPILER") then
      local env0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
      local mt = getmetatable(env0)
      mt.__index = _G
      if (opts.allowedGlobals == nil) then
        opts.allowedGlobals = specials["current-global-names"](env0)
      end
      return specials["wrap-env"](env0)
    else
      return (env and specials["wrap-env"](env))


@@ 6012,17 6538,20 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
  end
  local function eval_opts(options, str)
    local opts = utils.copy(options)
    if ((opts.allowedGlobals == nil) and not getmetatable(opts.env)) then
    if (opts.allowedGlobals == nil) then
      opts.allowedGlobals = specials["current-global-names"](opts.env)
    end
    if (not opts.filename and not opts.source) then
      opts.source = str
    end
    if (opts.env == "_COMPILER") then
      opts.scope = compiler["make-scope"](compiler.scopes.compiler)
    end
    return opts
  end
  local function eval(str, options, ...)
    local opts = eval_opts(options, str)
    local env = eval_env(opts.env)
    local env = eval_env(opts.env, opts)
    local lua_source = compiler["compile-string"](str, opts)
    local loader = nil
    local function _0_(...)


@@ 6044,7 6573,34 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    opts.filename = filename
    return eval(source, opts, ...)
  end
  local mod = {["comment?"] = utils["comment?"], ["compile-stream"] = compiler["compile-stream"], ["compile-string"] = compiler["compile-string"], ["list?"] = utils["list?"], ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["make-searcher"] = specials["make-searcher"], ["search-module"] = specials["search-module"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["sym?"] = utils["sym?"], comment = utils.comment, compile = compiler.compile, compile1 = compiler.compile1, compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], doc = specials.doc, dofile = dofile_2a, eval = eval, gensym = compiler.gensym, granulate = parser.granulate, list = utils.list, loadCode = specials["load-code"], macroLoaded = specials["macro-loaded"], makeSearcher = specials["make-searcher"], make_searcher = specials["make-searcher"], mangle = compiler["global-mangling"], metadata = compiler.metadata, parser = parser.parser, path = utils.path, repl = repl, scope = compiler["make-scope"], searchModule = specials["search-module"], searcher = specials["make-searcher"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.8.2-dev", view = view}
  local function syntax()
    local body_3f = {"when", "with-open", "collect", "icollect", "lambda", "\206\187", "macro", "match"}
    local binding_3f = {"collect", "icollect", "each", "for", "let", "with-open"}
    local define_3f = {"fn", "lambda", "\206\187", "var", "local", "macro", "macros", "global"}
    local out = {}
    for k, v in pairs(compiler.scopes.global.specials) do
      local metadata = (compiler.metadata[v] or {})
      out[k] = {["binding-form?"] = utils["member?"](k, binding_3f), ["body-form?"] = metadata["fnl/body-form?"], ["define?"] = utils["member?"](k, define_3f), ["special?"] = true}
    end
    for k, v in pairs(compiler.scopes.global.macros) do
      out[k] = {["binding-form?"] = utils["member?"](k, binding_3f), ["body-form?"] = utils["member?"](k, body_3f), ["define?"] = utils["member?"](k, define_3f), ["macro?"] = true}
    end
    for k, v in pairs(_G) do
      local _0_0 = type(v)
      if (_0_0 == "function") then
        out[k] = {["function?"] = true, ["global?"] = true}
      elseif (_0_0 == "table") then
        for k2, v2 in pairs(v) do
          if (("function" == type(v2)) and (k ~= "_G")) then
            out[(k .. "." .. k2)] = {["function?"] = true, ["global?"] = true}
          end
        end
        out[k] = {["global?"] = true}
      end
    end
    return out
  end
  local mod = {["comment?"] = utils["comment?"], ["compile-stream"] = compiler["compile-stream"], ["compile-string"] = compiler["compile-string"], ["list?"] = utils["list?"], ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["macro-path"] = utils["macro-path"], ["macro-searchers"] = specials["macro-searchers"], ["make-searcher"] = specials["make-searcher"], ["search-module"] = specials["search-module"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["sym?"] = utils["sym?"], comment = utils.comment, compile = compiler.compile, compile1 = compiler.compile1, compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], doc = specials.doc, dofile = dofile_2a, eval = eval, gensym = compiler.gensym, granulate = parser.granulate, list = utils.list, loadCode = specials["load-code"], macroLoaded = specials["macro-loaded"], makeSearcher = specials["make-searcher"], make_searcher = specials["make-searcher"], mangle = compiler["global-mangling"], metadata = compiler.metadata, parser = parser.parser, path = utils.path, repl = repl, scope = compiler["make-scope"], searchModule = specials["search-module"], searcher = specials["make-searcher"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, syntax = syntax, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.10.0-dev", view = view}
  utils["fennel-module"] = mod
  do
    local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other


@@ 6109,13 6665,18 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
                   (-?>> ,el ,(unpack els))
                   ,tmp)))))
    
    (fn ?dot [tbl k ...]
    (fn ?dot [tbl ...]
      "Nil-safe table look up.
    Same as . (dot), except will short-circuit with nil when it encounters
    a nil value in any of subsequent keys."
      (if (= nil k) tbl
          `(let [res# (. ,tbl ,k)]
             (and res# (?. res# ,...)))))
      (let [head (gensym :t)
            lookups `(do (var ,head ,tbl) ,head)]
        (each [_ k (ipairs [...])]
          ;; Kinda gnarly to reassign in place like this, but it emits the best lua.
          ;; With this impl, it emits a flat, concise, and readable set of if blocks.
          (table.insert lookups (# lookups) `(if (not= nil ,head)
                                               (set ,head (. ,head ,k)))))
        lookups))
    
    (fn doto* [val ...]
      "Evaluates val and splices it into the first argument of subsequent forms."


@@ 6131,22 6692,26 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      "Evaluate body for side-effects only when condition is truthy."
      (assert body1 "expected body")
      `(if ,condition
           (do ,body1 ,...)))
           (do
             ,body1
             ,...)))
    
    (fn with-open* [closable-bindings ...]
      "Like `let`, but invokes (v:close) on each binding after evaluating the body.
    The body is evaluated inside `xpcall` so that bound values will be closed upon
    encountering an error before propagating it."
      (let [bodyfn    `(fn [] ,...)
            closer `(fn close-handlers# [ok# ...] (if ok# ...
                                                      (error ... 0)))
      (let [bodyfn `(fn []
                      ,...)
            closer `(fn close-handlers# [ok# ...]
                      (if ok# ... (error ... 0)))
            traceback `(. (or package.loaded.fennel debug) :traceback)]
        (for [i 1 (# closable-bindings) 2]
        (for [i 1 (length closable-bindings) 2]
          (assert (sym? (. closable-bindings i))
                  "with-open only allows symbols in bindings")
          (table.insert closer 4 `(: ,(. closable-bindings i) :close)))
        `(let ,closable-bindings ,closer
              (close-handlers# (xpcall ,bodyfn ,traceback)))))
        `(let ,closable-bindings
           ,closer
           (close-handlers# (xpcall ,bodyfn ,traceback)))))
    
    (fn collect* [iter-tbl key-value-expr ...]
      "Returns a table made by running an iterator and evaluating an expression


@@ 6161,8 6726,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      {:red \"apple\" :orange \"orange\"}"
      (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-value-expr) "expected key-value expression")
      (assert (= nil ...)
              "expected exactly one body expression. Wrap multiple expressions with do")
      `(let [tbl# {}]


@@ 6182,8 6746,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      [9 16 25]"
      (assert (and (sequence? iter-tbl) (>= (length iter-tbl) 2))
              "expected iterator binding table")
      (assert (not= nil value-expr)
              "expected table value expression")
      (assert (not= nil value-expr) "expected table value expression")
      (assert (= nil ...)
              "expected exactly one body expression. Wrap multiple expressions with do")
      `(let [tbl# []]


@@ 6191,12 6754,54 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
           (tset tbl# (+ (length tbl#) 1) ,value-expr))
         tbl#))
    
    (fn accumulate* [iter-tbl accum-expr ...]
      "Accumulation macro.
    It takes a binding table and an expression as its arguments.
    In the binding table, the first symbol is bound to the second value, being an
    initial accumulator variable. The rest are an iterator binding table in the
    format `each` takes.
    It runs through the iterator in each step of which the given expression is
    evaluated, and its returned value updates the accumulator variable.
    It eventually returns the final value of the accumulator variable.
    
    For example,
      (accumulate [total 0
                   _ n (pairs {:apple 2 :orange 3})]
        (+ total n))
    returns
      5"
      (assert (and (sequence? iter-tbl) (>= (length iter-tbl) 4))
              "expected initial value and iterator binding table")
      (assert (not= nil accum-expr) "expected accumulating expression")
      (assert (= nil ...)
              "expected exactly one body expression. Wrap multiple expressions with do")
      (let [accum-var (table.remove iter-tbl 1)
            accum-init (table.remove iter-tbl 1)]
        `(do (var ,accum-var ,accum-init)
             (each ,iter-tbl
               (set ,accum-var ,accum-expr))
             ,accum-var)))
    
    (fn partial* [f ...]
      "Returns a function with all arguments partially applied to f."
      (assert f "expected a function to partially apply")
      (let [body (list f ...)]
        (table.insert body _VARARG)
        `(fn [,_VARARG] ,body)))
      (let [bindings []
            args []]
        (each [_ arg (ipairs [...])]
          (if (or (= :number (type arg))
                  (= :string (type arg))
                  (= :boolean (type arg))
                  (= `nil arg))
            (table.insert args arg)
            (let [name (gensym)]
              (table.insert bindings name)
              (table.insert bindings arg)
              (table.insert args name))))
        (let [body (list f (unpack args))]
          (table.insert body _VARARG)
          `(let ,bindings
             (fn [,_VARARG]
               ,body)))))
    
    (fn pick-args* [n f]
      "Creates a function of arity n that applies its arguments to f.


@@ 6205,11 6810,16 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      (pick-args 2 func)
    expands to
      (fn [_0_ _1_] (func _0_ _1_))"
      (if (and _G.io _G.io.stderr)
          (_G.io.stderr:write
           "-- WARNING: pick-args is deprecated and will be removed in the future.\n"))
      (assert (and (= (type n) :number) (= n (math.floor n)) (>= n 0))
              (.. "Expected n to be an integer literal >= 0, got " (tostring n)))
      (let [bindings []]
        (for [i 1 n] (tset bindings i (gensym)))
        `(fn ,bindings (,f ,(unpack bindings)))))
        (for [i 1 n]
          (tset bindings i (gensym)))
        `(fn ,bindings
           (,f ,(unpack bindings)))))
    
    (fn pick-values* [n ...]
      "Like the `values` special, but emits exactly n values.


@@ 6221,11 6831,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        (values _0_ _1_))"
      (assert (and (= :number (type n)) (>= n 0) (= n (math.floor n)))
              (.. "Expected n to be an integer >= 0, got " (tostring n)))
      (let [let-syms   (list)
            let-values (if (= 1 (select :# ...)) ... `(values ,...))]
        (for [i 1 n] (table.insert let-syms (gensym)))
      (let [let-syms (list)
            let-values (if (= 1 (select "#" ...)) ... `(values ,...))]
        (for [i 1 n]
          (table.insert let-syms (gensym)))
        (if (= n 0) `(values)
            `(let [,let-syms ,let-values] (values ,(unpack let-syms))))))
            `(let [,let-syms ,let-values]
               (values ,(unpack let-syms))))))
    
    (fn lambda* [...]
      "Function literal with arity checking.


@@ 6235,23 6847,25 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            has-internal-name? (sym? (. args 1))
            arglist (if has-internal-name? (. args 2) (. args 1))
            docstring-position (if has-internal-name? 3 2)
            has-docstring? (and (> (# args) docstring-position)
            has-docstring? (and (> (length args) docstring-position)
                                (= :string (type (. args docstring-position))))
            arity-check-position (- 4 (if has-internal-name? 0 1)
                                    (if has-docstring? 0 1))
            empty-body? (< (# args) arity-check-position)]
            empty-body? (< (length args) arity-check-position)]
        (fn check! [a]
          (if (table? a)
              (each [_ a (pairs a)]
                (check! a))
              (let [as (tostring a)]
                (and (not (as:match "^?")) (not= as "&") (not= as "_") (not= as "...")))
                (and (not (as:match "^?")) (not= as "&") (not= as "_")
                     (not= as "...")))
              (table.insert args arity-check-position
                            `(assert (not= nil ,a)
                                     (string.format "Missing argument %s on %s:%s"
                                                    ,(tostring a)
                                                    ,(or a.filename "unknown")
                                                    ,(or a.filename :unknown)
                                                    ,(or a.line "?"))))))
    
        (assert (= :table (type arglist)) "expected arg list")
        (each [_ a (ipairs arglist)]
          (check! a))


@@ 6263,7 6877,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      "Define a single macro."
      (assert (sym? name) "expected symbol for macro name")
      (local args [...])
      `(macros { ,(tostring name) (fn ,(unpack args))}))
      `(macros {,(tostring name) (fn ,(unpack args))}))
    
    (fn macrodebug* [form return?]
      "Print the resulting form after performing macroexpansion.


@@ 6277,9 6891,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    Example:
      (import-macros mymacros                 :my-macros    ; bind to symbol
                     {:macro1 alias : macro2} :proj.macros) ; import by name"
      (assert (and binding1 module-name1 (= 0 (% (select :# ...) 2)))
      (assert (and binding1 module-name1 (= 0 (% (select "#" ...) 2)))
              "expected even number of binding/modulename pairs")
      (for [i 1 (select :# binding1 module-name1 ...) 2]
      (for [i 1 (select "#" binding1 module-name1 ...) 2]
        (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


@@ 6289,10 6903,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          (_SPECIALS.require-macros `(require-macros ,modname) subscope {} ast)
          (if (sym? binding)
              ;; bind whole table of macros to table bound to symbol
              (do (tset scope.macros (. binding 1) {})
                  (each [k v (pairs subscope.macros)]
                    (tset (. scope.macros (. binding 1)) k v)))
    
              (tset scope.macros (. binding 1) (. macro-loaded modname))
              ;; 1-level table destructuring for importing individual macros
              (table? binding)
              (each [macro-name [import-key] (pairs binding)]


@@ 6320,15 6931,25 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            bindings []]
        (each [k pat (pairs pattern)]
          (if (= pat `&)
              (do (assert (not (. 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))]))
              (and (= :number (type k))
                   (= "&" (tostring (. pattern (- k 1)))))
              nil ; don't process the pattern right after &; already got it
              (do
                (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))]))
              (= k `&as)
              (do
                (table.insert bindings pat)
                (table.insert bindings val))
              (and (= :number (type k)) (= `&as pat))
              (do
                (assert (= nil (. pattern (+ k 2)))
                        "expected &as argument before last parameter")
                (table.insert bindings (. pattern (+ k 1)))
                (table.insert bindings val))
              ;; don't process the pattern right after &/&as; already got it
              (or (not= :number (type k)) (and (not= `&as (. pattern (- k 1)))
                                               (not= `& (. pattern (- k 1)))))
              (let [subval `(. ,val ,k)
                    (subcondition subbindings) (match-pattern [subval] pat
                                                              unifications)]


@@ 6346,11 6967,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      ;; of vals) or we're not, in which case we only care about the first one.
      (let [[val] vals]
        (if (or (and (sym? pattern) ; unification with outer locals (or nil)
                     (not= :_ (tostring pattern)) ; never unify _
                     (or (in-scope? pattern)
                         (= :nil (tostring pattern))))
                (and (multi-sym? pattern)
                     (in-scope? (. (multi-sym? pattern) 1))))
                     (not= "_" (tostring pattern)) ; never unify _
                     (or (in-scope? pattern) (= :nil (tostring pattern))))
                (and (multi-sym? pattern) (in-scope? (. (multi-sym? pattern) 1))))
            (values `(= ,val ,pattern) [])
            ;; unify a local we've seen already
            (and (sym? pattern) (. unifications (tostring pattern)))


@@ 6359,18 6978,16 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            (sym? pattern)
            (let [wildcard? (: (tostring pattern) :find "^_")]
              (if (not wildcard?) (tset unifications (tostring pattern) val))
              (values (if (or wildcard? (string.find (tostring pattern) "^?"))
                          true `(not= ,(sym :nil) ,val))
                      [pattern val]))
              (values (if (or wildcard? (string.find (tostring pattern) "^?")) true
                          `(not= ,(sym :nil) ,val)) [pattern val]))
            ;; guard clause
            (and (list? pattern) (= (. pattern 2) `?))
            (let [(pcondition bindings) (match-pattern vals (. pattern 1)
                                                       unifications)
                  condition `(and ,pcondition)]
              (for [i 3 (# pattern)] ; splice in guard clauses
                (table.insert condition (. pattern i)))
              (values `(let ,bindings ,condition) bindings))
    
                  condition `(and ,(unpack pattern 3))]
              (values `(and ,pcondition
                            (let ,bindings
                              ,condition)) bindings))
            ;; multi-valued patterns (represented as lists)
            (list? pattern)
            (match-values vals pattern unifications match-pattern)


@@ 6383,24 7000,28 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    (fn match-condition [vals clauses]
      "Construct the actual `if` AST for the given match values and clauses."
      (if (not= 0 (% (length clauses) 2)) ; treat odd final clause as default
          (table.insert clauses (length clauses) (sym :_)))
          (table.insert clauses (length clauses) (sym "_")))
      (let [out `(if)]
        (for [i 1 (length clauses) 2]
          (let [pattern (. clauses i)
                body (. clauses (+ i 1))
                (condition bindings) (match-pattern vals pattern {})]
            (table.insert out condition)
            (table.insert out `(let ,bindings ,body))))
            (table.insert out `(let ,bindings
                                 ,body))))
        out))
    
    (fn match-val-syms [clauses]
      "How many multi-valued clauses are there? return a list of that many gensyms."
      (let [syms (list (gensym))]
        (for [i 1 (length clauses) 2]
          (if (list? (. clauses i))
              (each [valnum (ipairs (. clauses i))]
                (if (not (. syms valnum))
                    (tset syms valnum (gensym))))))
          (let [clause (if (and (list? (. clauses i)) (= `? (. clauses i 2)))
                           (. clauses i 1)
                           (. clauses i))]
            (if (list? clause)
                (each [valnum (ipairs clause)]
                  (if (not (. syms valnum))
                      (tset syms valnum (gensym)))))))
        syms))
    
    (fn match* [val ...]


@@ 6411,8 7032,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            vals (match-val-syms clauses)]
        ;; protect against multiple evaluation of the value, bind against as
        ;; many values as we ever match against in the clauses.
        (list `let [vals val]
              (match-condition vals clauses))))
        (list `let [vals val] (match-condition vals clauses))))
    
    ;; Construction of old match syntax from new syntax
    


@@ 6428,8 7048,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        (for [i 1 (length seq) 2]
          (let [first (. seq i)
                second (. seq (+ i 1))]
            (table.insert firsts (if (not= nil first) first 'nil))
            (table.insert seconds (if (not= nil second) second 'nil))))
            (table.insert firsts (if (not= nil first) first `nil))
            (table.insert seconds (if (not= nil second) second `nil))))
        (each [i v1 (ipairs firsts)]
          (let [v2 (. seconds i)]
            (if (not= nil v2)


@@ 6442,7 7062,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      ;; (or pat1 pat2), guard => [(pat1 ? guard) (pat2 ? guard)]
      (let [res []]
        (each [_ pat (ipairs pats)]
          (table.insert res (list pat '? (unpack guards))))
          (table.insert res (list pat `? (unpack guards))))
        res))
    
    (fn transform-cond [cond]


@@ 6456,7 7076,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            (if (and (list? second) (= (. second 1) `or))
                (transform-or second [(unpack cond 3)])
                :else
                [(list second '? (unpack cond 3))]))
                [(list second `? (unpack cond 3))]))
          :else
          [cond]))
    


@@ 6470,8 7090,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      (where pattern guard guards*) body
      (where (or pattern patterns*) guard guards*) body)"
      (let [conds-bodies (partition-2 [...])
            else-branch (if (not= 0 (% (select :# ...) 2))
                            (select (select :# ...) ...))
            else-branch (if (not= 0 (% (select "#" ...) 2))
                            (select (select "#" ...) ...))
            match-body []]
        (each [_ [cond body] (ipairs conds-bodies)]
          (each [_ cond (ipairs (transform-cond cond))]


@@ 6481,12 7101,24 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            (table.insert match-body else-branch))
        (match* val (unpack match-body))))
    
    {:-> ->* :->> ->>* :-?> -?>* :-?>> -?>>* :?. ?dot
     :doto doto* :when when* :with-open with-open*
     :collect collect* :icollect icollect*
     :partial partial* :lambda lambda*
     :pick-args pick-args* :pick-values pick-values*
     :macro macro* :macrodebug macrodebug* :import-macros import-macros*
    {:-> ->*
     :->> ->>*
     :-?> -?>*
     :-?>> -?>>*
     :?. ?dot
     :doto doto*
     :when when*
     :with-open with-open*
     :collect collect*
     :icollect icollect*
     :accumulate accumulate*
     :partial partial*
     :lambda lambda*
     :pick-args pick-args*
     :pick-values pick-values*
     :macro macro*
     :macrodebug macrodebug*
     :import-macros import-macros*
     :match match-where}
    ]===]
    local module_name = "fennel.macros"


@@ 6513,7 7145,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
  return mod
end
fennel = require("fennel")
local searcher = fennel.makeSearcher({})
local searcher = fennel.makeSearcher({correlate = true})
debug.traceback = fennel.traceback
if os.getenv("FNL") then
  table.insert((package.loaders or package.searchers), 1, searcher)


@@ 6527,7 7159,7 @@ local reader = require("lang.reader")
local compiler = require("anticompiler")
local letter = require("letter")
local fnlfmt = require("fnlfmt")
local reserved_fennel = {}
local reserved_fennel = {band = true, bnot = true, bor = true, bxor = true, doc = true, doto = true, each = true, fn = true, global = true, hashfn = true, lambda = true, let = true, lshift = true, lua = true, macro = true, macrodebug = true, macroexpand = true, macros = true, match = true, partial = true, rshift = true, set = true, tset = true, values = true, var = true, when = true}
local function uncamelize(name)
  local function splicedash(pre, cap)
    return (pre .. "-" .. cap:lower())


@@ 6561,12 7193,12 @@ if ((debug and debug.getinfo) and (debug.getinfo(3) == nil)) then
    return os.exit(1)
  end
else
  local function _1_(str, source)
  local function _356_(str, source)
    local out = {}
    for _, code in ipairs(compile(reader.string(str), (source or "*source"))) do
      table.insert(out, fnlfmt.fnlfmt(code))
    end
    return table.concat(out, "\n")
  end
  return _1_
  return _356_
end