~technomancy/fennel-lang.org

3e2eaa6e564f99d5aa56e179fbb4313ce06bf6bd — Phil Hagelberg a month ago 3f85371
Update antifennel to latest version.
1 files changed, 2204 insertions(+), 1213 deletions(-)

M antifennel.lua
M antifennel.lua => antifennel.lua +2204 -1213
@@ 1,157 1,397 @@
#!/usr/bin/env luajit
package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
  local view = require("fennelview")
  local function identify_line(line, pos, stack)
    local closers = {[")"] = "(", ["\""] = "\"", ["]"] = "[", ["}"] = "{"}
    local char = line:sub(pos, pos)
    local looking_for = stack[#stack]
    local continue = nil
    local function _0_()
      return identify_line(line, (pos - 1), stack)
  local fennel = require("fennel")
  local unpack = (table.unpack or _G.unpack)
  local function last_line_length(line)
    return #line:match("[^\n]*$")
  end
  local function any_3f(tbl, pred)
    local _0_
    do
      local tbl_0_ = {}
      for _, v in pairs(tbl) do
        local _1_
        if pred(v) then
          _1_ = true
        else
        _1_ = nil
        end
        tbl_0_[(#tbl_0_ + 1)] = _1_
      end
      _0_ = tbl_0_
    end
    continue = _0_
    if (0 == pos) then
      return nil
    elseif (line:sub((pos - 1), (pos - 1)) == "\\") then
      return continue()
    elseif (looking_for == char) then
      table.remove(stack)
      return continue()
    elseif (closers[char] and (looking_for ~= "\"")) then
      table.insert(stack, closers[char])
      return continue()
    elseif looking_for then
      return continue()
    elseif (("[" == char) or ("{" == char)) then
      return "table", pos
    elseif ("(" == char) then
      return "call", pos, line
    elseif "else" then
      return continue()
    end
  end
  local function symbol_at(line, pos)
    return line:sub(pos):match("[^%s]+")
  end
  local body_specials = {["\206\187"] = true, ["do"] = true, ["eval-compiler"] = true, ["for"] = true, ["while"] = true, ["with-open"] = true, doto = true, each = true, fn = true, lambda = true, let = true, macro = true, match = true, when = true}
  local function remove_comment(line, in_string_3f, pos)
    if (#line < pos) then
      return line
    elseif (line:sub(pos, pos) == "\"") then
      return remove_comment(line, not in_string_3f, (pos + 1))
    elseif ((line:sub(pos, pos) == ";") and not in_string_3f) then
      return line:sub(1, (pos - 1))
    else
      return remove_comment(line, in_string_3f, (pos + 1))
    end
  end
  local function identify_indent_type(lines, last, stack)
    local line = remove_comment((lines[last] or ""), false, 1)
    local _0_0, _1_0, _2_0 = identify_line(line, #line, stack)
    if ((_0_0 == "table") and (nil ~= _1_0)) then
      local pos = _1_0
      return "table", pos
    elseif ((_0_0 == "call") and (nil ~= _1_0) and (_2_0 == line)) then
      local pos = _1_0
      local function_name = symbol_at(line, (pos + 1))
      if body_specials[function_name] then
        return "body-special", (pos - 1)
    return (0 ~= #_0_)
  end
  local function strip_comments(t)
    local tbl_0_ = {}
    for _, x in ipairs(t) do
      local _0_
      if not fennel["comment?"](x) then
        _0_ = x
      else
      _0_ = nil
      end
      tbl_0_[(#tbl_0_ + 1)] = _0_
    end
    return tbl_0_
  end
  local function view_fn_args(t, view, inspector, indent, start_indent, out, callee)
    if fennel["sym?"](t[2]) then
      local third = view(t[3], inspector, (indent + 1))
      table.insert(out, " ")
      table.insert(out, third)
      if ("string" == type(t[4])) then
        table.insert(out, ("\n" .. string.rep(" ", start_indent)))
        inspector["escape-newlines?"] = false
        table.insert(out, view(t[4], inspector, start_indent))
        inspector["escape-newlines?"] = true
        return 5
      else
        return "call", (pos - 1), function_name
        return 4
      end
    else
      local _3_
      do
        local _ = _0_0
        _3_ = (true and (1 < last))
      return 3
    end
  end
  local function first_thing_in_line_3f(out)
    local last = (out[#out] or "")
    return not last:match("[^\n]*$"):match("[^ ]")
  end
  local function break_pair_3f(pair_wise_3f, count, viewed, next_ast, indent)
    return (pair_wise_3f and (1 == math.fmod(count, 2)) and not (fennel["comment?"](next_ast) and ((indent + 1 + last_line_length(viewed) + 1 + #tostring(next_ast)) <= 80)))
  end
  local function binding_comment(c, indent, out, start_indent)
    if ((80 < (indent + #tostring(c))) and (out[#out]):match("^[^%s]")) then
      table.insert(out, ("\n" .. string.rep(" ", start_indent)))
    end
    if (not first_thing_in_line_3f(out) and (#out ~= 1)) then
      table.insert(out, " ")
    end
    table.insert(out, tostring(c))
    return table.insert(out, ("\n" .. string.rep(" ", start_indent)))
  end
  local function view_binding(bindings, view, inspector, start_indent, pair_wise_3f, open, close)
    local out = {open}
    local indent, offset, non_comment_count = start_indent, 0, 1
    for i = 1, #bindings do
      while fennel["comment?"](bindings[(i + offset)]) do
        binding_comment(bindings[(i + offset)], indent, out, start_indent)
        indent, offset = start_indent, (offset + 1)
      end
      local i0 = (offset + i)
      local viewed = view(bindings[i0], inspector, indent)
      if (i0 <= #bindings) then
        table.insert(out, viewed)
        non_comment_count = (non_comment_count + 1)
        if (i0 < #bindings) then
          if break_pair_3f(pair_wise_3f, non_comment_count, viewed, bindings[(i0 + 1)], indent) then
            table.insert(out, ("\n" .. string.rep(" ", start_indent)))
            indent = start_indent
          else
            indent = (indent + 1 + last_line_length(viewed))
            table.insert(out, " ")
          end
        end
      end
      if _3_ then
        local _ = _0_0
        return identify_indent_type(lines, (last - 1), stack)
      end
    end
  end
  local function indentation(lines, prev_line_num)
    local _0_0, _1_0, _2_0 = identify_indent_type(lines, prev_line_num, {})
    if ((_0_0 == "table") and (nil ~= _1_0)) then
      local opening = _1_0
      return opening
    elseif ((_0_0 == "body-special") and (nil ~= _1_0)) then
      local prev_indent = _1_0
      return (prev_indent + 2)
    elseif ((_0_0 == "call") and (nil ~= _1_0) and (nil ~= _2_0)) then
      local prev_indent = _1_0
      local function_name = _2_0
      return (prev_indent + #function_name + 2)
    end
    table.insert(out, close)
    return table.concat(out)
  end
  local init_bindings = {["for"] = true, ["with-open"] = true, collect = true, each = true, icollect = true, let = true}
  local fn_forms = {["\206\187"] = true, fn = true, lambda = true, macro = true}
  local force_initial_newline = {["do"] = true, ["eval-compiler"] = true}
  local function view_init_body(t, view, inspector, start_indent, out, callee)
    if force_initial_newline[callee] then
      table.insert(out, ("\n" .. string.rep(" ", start_indent)))
    else
      table.insert(out, " ")
    end
    local indent = nil
    if force_initial_newline[callee] then
      indent = start_indent
    else
      indent = (start_indent + #callee)
    end
    local second = nil
    if (init_bindings[callee] and ("unquote" ~= tostring(t[2][1]))) then
      second = view_binding(t[2], view, inspector, (indent + 1), ("let" == callee), "[", "]")
    else
      second = view(t[2], inspector, indent)
    end
    local indent2 = (indent + #second:match("[^\n]*$"))
    if (nil ~= t[2]) then
      table.insert(out, second)
    end
    if fn_forms[callee] then
      return view_fn_args(t, view, inspector, indent2, start_indent, out, callee)
    else
      local _ = _0_0
      return 0
      return 3
    end
  end
  local function indent_line(line, lines, prev_line_num)
    local without_indentation = line:match("[^%s]+.*")
    if without_indentation then
      return ((" "):rep(indentation(lines, prev_line_num)) .. without_indentation)
  local function match_same_line_3f(callee, i, out, viewed, t)
    return (("match" == callee) and (0 == math.fmod(i, 2)) and not any_3f(t, fennel["comment?"]) and (((string.find(viewed, "\n") or #viewed:match("[^\n]*$")) + 1 + last_line_length(out[#out])) <= 80))
  end
  local function trailing_comment_3f(out, viewed, body_indent, indent)
    return (viewed:match("^; ") and (body_indent <= 80))
  end
  local one_element_per_line_forms = {["->"] = true, ["->>"] = true, ["-?>"] = true, ["-?>>"] = true, ["if"] = true}
  local function space_out_fns_3f(prev, viewed, start_index, i)
    return (not (start_index == i) and (prev:match("^ *%(fn [^%[]") or viewed:match("^ *%(fn [^%[]")))
  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
    if one_element_per_line_forms[callee] then
      indent = (start_indent + #callee)
    else
      return ""
      indent = start_indent
    end
    for i = (start_index or (#t + 1)), #t do
      local viewed = view(t[i], inspector, indent)
      local body_indent = (indent + 1 + last_line_length(out[#out]))
      if (match_same_line_3f(callee, i, out, viewed, t) or trailing_comment_3f(out, viewed, body_indent, indent)) then
        table.insert(out, " ")
        table.insert(out, view(t[i], inspector, body_indent))
      else
        if space_out_fns_3f(out[#out], viewed, start_index, i) then
          table.insert(out, "\n")
        end
        table.insert(out, ("\n" .. string.rep(" ", indent)))
        table.insert(out, viewed)
      end
    end
    return nil
  end
  local function indent(code)
    local lines = {}
    for line in code:gmatch("([^\n]*)\n") do
      table.insert(lines, indent_line(line, lines, #lines))
  local function line_exceeded_3f(inspector, indent, viewed)
    return (inspector["line-length"] < (indent + last_line_length(viewed)))
  end
  local function view_with_newline(view, inspector, out, t, i, start_indent)
    if (" " == out[#out]) then
      table.remove(out)
    end
    table.insert(out, ("\n" .. string.rep(" ", start_indent)))
    local viewed = view(t[i], inspector, start_indent)
    table.insert(out, viewed)
    return (start_indent + #viewed:match("[^\n]*$"))
  end
  local function view_call(t, view, inspector, start_indent, out)
    local indent = start_indent
    for i = 2, #t do
      table.insert(out, " ")
      indent = (indent + 1)
      local viewed = view(t[i], inspector, (indent - 1))
      if (fennel["comment?"](t[(i - 1)]) or (line_exceeded_3f(inspector, indent, viewed) and (2 ~= i))) then
        indent = view_with_newline(view, inspector, out, t, i, start_indent)
      else
        table.insert(out, viewed)
        indent = (indent + #viewed:match("[^\n]*$"))
      end
    end
    return table.concat(lines, "\n")
    return nil
  end
  local newline = nil
  local function _0_()
    return "\n"
  local function view_pairwise_if(t, view, inspector, indent, out)
    return table.insert(out, (" " .. view_binding({select(2, unpack(t))}, view, inspector, indent, true, "", "")))
  end
  newline = setmetatable({}, {__fennelview = _0_})
  local function nospace_concat(tbl, sep, start, _end)
    local out = ""
    for i = start, _end do
      local val = tbl[i]
      if ((i == start) or (val == "\n")) then
        out = (out .. val)
  local function if_pair(view, a, b, c)
    local function _0_()
      if fennel["comment?"](c) then
        return (" " .. view(c))
      else
        out = (out .. " " .. val)
        return ""
      end
    end
    return out
    return (view(a) .. " " .. view(b) .. _0_())
  end
  local function pairwise_if_3f(t, indent, i, view)
    if (#strip_comments(t) < 5) then
      return false
    elseif ("if" ~= tostring(t[1])) then
      return false
    elseif not t[i] then
      return true
    elseif (80 < (indent + 1 + #if_pair(view, select(i, unpack(t))))) then
      return false
    else
      local _0_
      if fennel.comment(t[(i + 2)]) then
        _0_ = (i + 3)
      else
        _0_ = (i + 2)
      end
      return pairwise_if_3f(t, indent, _0_, 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)))
  end
  local function view_maybe_body(t, view, inspector, indent, start_indent, out, callee)
    if pairwise_if_3f(t, indent, 2, view) then
      return view_pairwise_if(t, view, inspector, indent, out)
    elseif originally_different_lines_3f(t, t.line) then
      return view_body(t, view, inspector, (start_indent + 2), out, callee)
    else
      return view_call(t, view, inspector, indent, out, callee)
    end
  end
  local function newline_if_ends_in_comment(out, indent)
    if (out[#out]):match("^ *;[^\n]*$") then
      return table.insert(out, ("\n" .. string.rep(" ", indent)))
    end
  end
  local sugars = {hashfn = "#", quote = "`", unquote = ","}
  local function sweeten(t, view, inspector, indent, view_list)
    return (sugars[tostring(t[1])] .. view(t[2], inspector, (indent + 1)))
  end
  local body_specials = {["\206\187"] = true, ["do"] = true, ["eval-compiler"] = true, ["for"] = true, ["while"] = true, ["with-open"] = true, collect = true, each = true, fn = true, icollect = true, lambda = true, let = true, macro = true, match = true, when = true}
  local maybe_body = {["->"] = true, ["->>"] = true, ["-?>"] = true, ["-?>>"] = true, ["if"] = true, doto = true}
  local renames = {["#"] = "length", ["~="] = "not="}
  local function view_list(t, view, inspector, start_indent)
    if sugars[tostring(t[1])] then
      return sweeten(t, view, inspector, start_indent, view_list)
    else
      local callee = view(t[1], inspector, (start_indent + 1))
      local callee0 = (renames[callee] or callee)
      local out = {"(", callee0}
      local indent = nil
      if body_specials[callee0] then
        indent = (start_indent + 2)
      else
        indent = (start_indent + #callee0 + 2)
      end
      if body_specials[callee0] then
        view_body(t, view, inspector, indent, out, callee0)
      elseif maybe_body[callee0] then
        view_maybe_body(t, view, inspector, indent, start_indent, out, callee0)
      else
        view_call(t, view, inspector, indent, out)
      end
      newline_if_ends_in_comment(out, indent)
      table.insert(out, ")")
      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
    else
      _2_ = _1_0
    end
  end
  local function _3_(_241)
    return #_241
  end
  slength = (_2_ or _3_)
  local function maybe_attach_comment(x, indent, c)
    if c then
      return (tostring(c) .. "\n" .. string.rep(" ", indent) .. x)
    else
      return x
    end
  end
  local nil_sym = nil
  local function _1_()
    return "nil"
  local function shorthand_pair_3f(k, v)
    return (("string" == type(k)) and fennel["sym?"](v) and (k == tostring(v)))
  end
  nil_sym = setmetatable({}, {__fennelview = _1_})
  local function view_list(open, close, self, tostring2)
    local safe, max = {}, 0
    for k in pairs(self) do
      if ((type(k) == "number") and (k > max)) then
        max = k
  local function view_pair(t, view, inspector, indent, mt, key)
    local val = t[key]
    local k = nil
    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_())
      end
      return (res_0_ and _6_())
    end
    do
      local ts = (tostring2 or tostring)
      for i = 1, max, 1 do
        local function _2_()
          if (self[i] == nil) then
            return nil_sym
          else
            return self[i]
          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
        safe[i] = ts(_2_())
        return (res_0_0 and _8_())
      end
      return (res_0_ and _7_())
    end
    return (maybe_attach_comment(k, indent, _5_()) .. " " .. maybe_attach_comment(v, indent, _6_()))
  end
  local function view_multiline_kv(pair_strs, indent, last_comment)
    if last_comment then
      local _5_
      do
        local _4_0 = pair_strs
        table.insert(_4_0, tostring(last_comment))
        table.insert(_4_0, "}")
        _5_ = _4_0
      end
      return ("{" .. table.concat(_5_, ("\n" .. string.rep(" ", indent))))
    else
      return ("{" .. table.concat(pair_strs, ("\n" .. string.rep(" ", indent))) .. "}")
    end
    return (open .. nospace_concat(safe, " ", 1, max) .. close)
  end
  local list_mt = nil
  local function _2_(...)
    return view_list("(", ")", ...)
  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_ = {}
      for k in pairs(t) do
        tbl_0_[(#tbl_0_ + 1)] = k
      end
      return tbl_0_
    end
    keys = (mt.keys or _4_())
    local pair_strs = nil
    do
      local tbl_0_ = {}
      for _, k in ipairs(keys) do
        tbl_0_[(#tbl_0_ + 1)] = view_pair(t, view, inspector, indent0, mt, k)
      end
      pair_strs = tbl_0_
    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)
      end
      _5_ = (res_0_ and _6_())
    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)
        end
        return (res_0_ and _7_())
      end
      return view_multiline_kv(pair_strs, indent0, _6_())
    else
      return oneline
    end
  end
  list_mt = {__fennelview = _2_}
  local function walk_tree(root, f, iterator)
  local function walk_tree(root, f, custom_iterator)
    local function walk(iterfn, parent, idx, node)
      if f(idx, node, parent) then
        for k, v in iterfn(node) do


@@ 160,80 400,83 @@ package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
        return nil
      end
    end
    walk((iterator or pairs), nil, nil, root)
    walk((custom_iterator or pairs), nil, nil, root)
    return root
  end
  local function step_for(_3_0)
    local _4_ = _3_0
    local callee = _4_[1]
    if ({match = true})[tostring(callee)] then
      return -2
    else
      return -1
  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
          mt["__fennelview"] = view_kv
        else
          local _ = _4_0
          setmetatable(form, {__fennelview = view_kv})
        end
      end
      return true
    end
  end
  local function end_for(node)
    if (tostring(node[1]) == "match") then
      return (#node - 1)
    else
      return #node
    end
  local function prefer_colon_3f(s)
    return (s:find("^[-%w?^_!$%&*+./@|<=>]+$") and not s:find("^[-?^_!$%&*+./@|<=>%\\]+$"))
  end
  local function anonymous_fn_3f(_4_0)
    local _5_ = _4_0
    local callee = _5_[1]
    local name_org_arglist = _5_[2]
    local _7_
  local function fnlfmt(ast)
    local _let_0_ = getmetatable(fennel.list())
    local list_mt = _let_0_
    local __fennelview = _let_0_["__fennelview"]
    local _ = nil
    list_mt.__fennelview = view_list
    _ = nil
    local _0 = walk_tree(ast, set_fennelview_metamethod)
    local ok_3f, val = pcall(fennel.view, ast, {["empty-as-sequence?"] = true, ["escape-newlines?"] = true, ["prefer-colon?"] = prefer_colon_3f})
    list_mt.__fennelview = __fennelview
    assert(ok_3f, val)
    return val
  end
  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
    do
      local _6_0 = getmetatable(name_org_arglist)
      if ((type(_6_0) == "table") and (nil ~= _6_0[1])) then
        local which = _6_0[1]
        _7_ = (which == "SYMBOL")
      local _5_0 = filename
      if (_5_0 == "-") then
        f = io.stdin
      else
      _7_ = nil
        local _ = _5_0
        f = assert(io.open(filename, "r"), "File not found.")
      end
    end
    return (("fn" == tostring(callee)) and not _7_)
  end
  local function start_for(form)
    if anonymous_fn_3f(form) then
      return 3
    else
      return ({["do"] = 2, ["for"] = 3, ["if"] = 3, ["while"] = 3, each = 3, fn = 4, let = 3, match = 3, when = 3})[tostring(form[1])]
    end
  end
  local function add_newlines(idx, node, parent)
    if ("table" == type(node)) then
      do
        local mt = (getmetatable(node) or {})
        local _5_0 = mt
        if ((type(_5_0) == "table") and (_5_0[1] == "LIST")) then
          setmetatable(node, list_mt)
          if start_for(node) then
            for i = end_for(node), start_for(node), step_for(node) do
              table.insert(node, i, newline)
            end
          end
        elseif ((type(_5_0) == "table") and (nil ~= _5_0.sequence)) then
          local sequence = _5_0.sequence
          if ("let" == tostring(parent[1])) then
            local function _6_(...)
              return view_list("[", "]", ...)
            end
            mt.__fennelview = _6_
            for i = (#node - 1), 2, -2 do
              table.insert(node, i, newline)
            end
          end
    local contents = f:read("*all")
    local parser = fennel.parser(fennel.stringStream(contents), filename, {comments = not no_comments})
    local out = {}
    f:close()
    local skip_next_3f, prev_ast = false
    for ok_3f, ast in parser do
      assert(ok_3f, ast)
      if (skip_next_3f and ast.bytestart and ast.byteend) then
        table.insert(out, contents:sub(ast.bytestart, ast.byteend))
        skip_next_3f = false
      elseif (fennel.comment(";; fnlfmt: skip") == ast) then
        skip_next_3f = true
        table.insert(out, "")
        table.insert(out, tostring(ast))
      else
        if (prev_ast and space_out_forms_3f(prev_ast, ast)) then
          table.insert(out, "")
        end
        table.insert(out, fnlfmt(ast))
        skip_next_3f = false
      end
      return true
      prev_ast = ast
    end
    table.insert(out, "")
    return table.concat(out, "\n")
  end
  local function fnlfmt(ast, options)
    return indent((view(walk_tree(ast, add_newlines), {["empty-as-square"] = true, ["table-edges"] = false}) .. "\n\n"))
  end
  return {fnlfmt = fnlfmt, indentation = indentation}
  return {["format-file"] = format_file, fnlfmt = fnlfmt, version = "0.2.1-dev"}
end
package.preload["letter"] = package.preload["letter"] or function(...)
  local fennel = require("fennel")


@@ 300,7 543,7 @@ package.preload["letter"] = package.preload["letter"] or function(...)
  local function reverse_ipairs(t)
    local function iter(t0, i)
      local i0 = (i - 1)
      local v = t0[i0]
      local v = (t0)[i0]
      if (v ~= nil) then
        return i0, v
      end


@@ 312,238 555,14 @@ package.preload["letter"] = package.preload["letter"] or function(...)
  end
  return compile
end
package.preload["fennelview"] = package.preload["fennelview"] or function(...)
  local function view_quote(str)
    return ("\"" .. str:gsub("\"", "\\\"") .. "\"")
  end
  local short_control_char_escapes = {["\11"] = "\\v", ["\12"] = "\\f", ["\13"] = "\\r", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "\\n"}
  local long_control_char_escapes = nil
  do
    local long = {}
    for i = 0, 31 do
      local ch = string.char(i)
      if not short_control_char_escapes[ch] then
        short_control_char_escapes[ch] = ("\\" .. i)
        long[ch] = ("\\%03d"):format(i)
      end
    end
    long_control_char_escapes = long
  end
  local function escape(str)
    return str:gsub("\\", "\\\\"):gsub("(%c)%f[0-9]", long_control_char_escapes):gsub("%c", short_control_char_escapes)
  end
  local function sequence_key_3f(k, len)
    return ((type(k) == "number") and (1 <= k) and (k <= len) and (math.floor(k) == k))
  end
  local type_order = {["function"] = 5, boolean = 2, number = 1, string = 3, table = 4, thread = 7, userdata = 6}
  local function sort_keys(a, b)
    local ta = type(a)
    local tb = type(b)
    if ((ta == tb) and (ta ~= "boolean") and ((ta == "string") or (ta == "number"))) then
      return (a < b)
    else
      local dta = type_order[a]
      local dtb = type_order[b]
      if (dta and dtb) then
        return (dta < dtb)
      elseif dta then
        return true
      elseif dtb then
        return false
      elseif "else" then
        return (ta < tb)
      end
    end
  end
  local function get_sequence_length(t)
    local len = 1
    for i in ipairs(t) do
      len = i
    end
    return len
  end
  local function get_nonsequential_keys(t)
    local keys = {}
    local sequence_length = get_sequence_length(t)
    for k in pairs(t) do
      if not sequence_key_3f(k, sequence_length) then
        table.insert(keys, k)
      end
    end
    table.sort(keys, sort_keys)
    return keys, sequence_length
  end
  local function count_table_appearances(t, appearances)
    if (type(t) == "table") then
      if not appearances[t] then
        appearances[t] = 1
        for k, v in pairs(t) do
          count_table_appearances(k, appearances)
          count_table_appearances(v, appearances)
        end
      end
    else
      if (t and (t == t)) then
        appearances[t] = ((appearances[t] or 0) + 1)
      end
    end
    return appearances
  end
  local put_value = nil
  local function puts(self, ...)
    for _, v in ipairs({...}) do
      table.insert(self.buffer, v)
    end
    return nil
  end
  local function tabify(self)
    return puts(self, "\n", (self.indent):rep(self.level))
  end
  local function already_visited_3f(self, v)
    return (self.ids[v] ~= nil)
  end
  local function get_id(self, v)
    local id = self.ids[v]
    if not id then
      local tv = type(v)
      id = ((self["max-ids"][tv] or 0) + 1)
      self["max-ids"][tv] = id
      self.ids[v] = id
    end
    return tostring(id)
  end
  local function put_sequential_table(self, t, len)
    puts(self, "[")
    self.level = (self.level + 1)
    for i = 1, len do
      local _0_ = (1 + len)
      if ((1 < i) and (i < _0_)) then
        puts(self, " ")
      end
      put_value(self, t[i])
    end
    self.level = (self.level - 1)
    return puts(self, "]")
  end
  local function put_key(self, k)
    if ((type(k) == "string") and k:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")) then
      return puts(self, ":", k)
    else
      return put_value(self, k)
    end
  end
  local function put_kv_table(self, t, ordered_keys)
    puts(self, "{")
    self.level = (self.level + 1)
    for i, k in ipairs(ordered_keys) do
      if (self["table-edges"] or (i ~= 1)) then
        tabify(self)
      end
      put_key(self, k)
      puts(self, " ")
      put_value(self, t[k])
    end
    for i, v in ipairs(t) do
      tabify(self)
      put_key(self, i)
      puts(self, " ")
      put_value(self, v)
    end
    self.level = (self.level - 1)
    if self["table-edges"] then
      tabify(self)
    end
    return puts(self, "}")
  end
  local function put_table(self, t)
    local metamethod = nil
    local function _1_()
      local _0_0 = t
      if _0_0 then
        local _2_0 = getmetatable(_0_0)
        if _2_0 then
          return _2_0.__fennelview
        else
          return _2_0
        end
      else
        return _0_0
      end
    end
    metamethod = (self["metamethod?"] and _1_())
    if (already_visited_3f(self, t) and self["detect-cycles?"]) then
      return puts(self, "#<table ", get_id(self, t), ">")
    elseif (self.level >= self.depth) then
      return puts(self, "{...}")
    elseif metamethod then
      return puts(self, metamethod(t, self.fennelview))
    elseif "else" then
      local non_seq_keys, len = get_nonsequential_keys(t)
      local id = get_id(self, t)
      if ((1 < (self.appearances[t] or 0)) and self["detect-cycles?"]) then
        return puts(self, "#<table", id, ">")
      elseif ((#non_seq_keys == 0) and (#t == 0)) then
        local function _2_()
          if self["empty-as-square"] then
            return "[]"
          else
            return "{}"
          end
        end
        return puts(self, _2_())
      elseif (#non_seq_keys == 0) then
        return put_sequential_table(self, t, len)
      elseif "else" then
        return put_kv_table(self, t, non_seq_keys)
      end
    end
  end
  local function _0_(self, v)
    local tv = type(v)
    if (tv == "string") then
      return puts(self, view_quote(escape(v)))
    elseif ((tv == "number") or (tv == "boolean") or (tv == "nil")) then
      return puts(self, tostring(v))
    elseif (tv == "table") then
      return put_table(self, v)
    elseif "else" then
      return puts(self, "#<", tostring(v), ">")
    end
  end
  put_value = _0_
  local function one_line(str)
    local ret = str:gsub("\n", " "):gsub("%[ ", "["):gsub(" %]", "]"):gsub("%{ ", "{"):gsub(" %}", "}"):gsub("%( ", "("):gsub(" %)", ")")
    return ret
  end
  local function fennelview(x, options)
    local options0 = (options or {})
    local inspector = nil
    local function _1_(_241)
      return fennelview(_241, options0)
    end
    local function _2_()
      if options0["one-line"] then
        return ""
      else
        return "  "
      end
    end
    inspector = {["detect-cycles?"] = not (false == options0["detect-cycles?"]), ["empty-as-square"] = options0["empty-as-square"], ["max-ids"] = {}, ["metamethod?"] = not (false == options0["metamethod?"]), ["table-edges"] = (options0["table-edges"] ~= false), appearances = count_table_appearances(x, {}), buffer = {}, depth = (options0.depth or 128), fennelview = _1_, ids = {}, indent = (options0.indent or _2_()), level = 0}
    put_value(inspector, x)
    local str = table.concat(inspector.buffer)
    if options0["one-line"] then
      return one_line(str)
    else
      return str
    end
  end
  return fennelview
end
package.preload["anticompiler"] = package.preload["anticompiler"] or function(...)
  local _0_ = require("fennel")
  local list = _0_["list"]
  local sym = _0_["sym"]
  local view = require("fennelview")
  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 unpack = (table.unpack or _G.unpack)
  local function map(tbl, f, with_last_3f)
    local len = #tbl
    local out = {}


@@ 564,42 583,41 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
    end
    return nil
  end
  local function _function(compile, scope, _1_0)
    local _2_ = _1_0
    local body = _2_["body"]
    local params = _2_["params"]
    local vararg = _2_["vararg"]
  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 _3_(...)
    local function _1_(...)
      return compile(scope, ...)
    end
    params0 = map(params, _3_)
    params0 = map(params, _1_)
    local subscope = nil
    do
      local _4_0 = make_scope(scope)
      add_to_scope(_4_0, "param", params0)
      subscope = _4_0
      local _2_0 = make_scope(scope)
      add_to_scope(_2_0, "param", params0)
      subscope = _2_0
    end
    local function _5_(...)
    local function _3_(...)
      return compile(subscope, ...)
    end
    return list(sym("fn"), params0, unpack(map(body, _5_, true)))
    return list(sym("fn"), sequence(unpack(params0)), unpack(map(body, _3_, true)))
  end
  local function declare_function(compile, scope, ast)
    if (ast.locald or ("MemberExpression" == ast.id.kind)) then
      local _2_0 = _function(compile, scope, ast)
      table.insert(_2_0, 2, compile(scope, ast.id))
      return _2_0
      local _1_0 = _function(compile, scope, ast)
      table.insert(_1_0, 2, compile(scope, ast.id))
      return _1_0
    else
      return list(sym("set-forcibly!"), compile(scope, ast.id), _function(compile, scope, ast))
    end
  end
  local function local_declaration(compile, scope, _2_0)
    local _3_ = _2_0
    local expressions = _3_["expressions"]
    local names = _3_["names"]
    local _4_ = #names
    if (((#expressions == _4_) and (_4_ == 1)) and ("FunctionExpression" == expressions[1].kind)) then
  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
      add_to_scope(scope, "function", {names[1].name})
      local function _6_()
        local _5_0 = expressions[1]


@@ 638,18 656,18 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
      return list(local_sym, _6_, _8_())
    end
  end
  local function vals(compile, scope, _3_0)
    local _4_ = _3_0
    local arguments = _4_["arguments"]
  local function vals(compile, scope, _2_0)
    local _arg_0_ = _2_0
    local arguments = _arg_0_["arguments"]
    if (1 == #arguments) then
      return compile(scope, arguments[1])
    elseif (0 == #arguments) then
      return sym("nil")
    else
      local function _5_(...)
      local function _3_(...)
        return compile(scope, ...)
      end
      return list(sym("values"), unpack(map(arguments, _5_)))
      return list(sym("values"), unpack(map(arguments, _3_)))
    end
  end
  local function any_complex_expressions_3f(args, i)


@@ 672,82 690,89 @@ 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, _4_0)
    local _5_ = _4_0
    local arguments = _5_["arguments"]
  local function early_return(compile, scope, _3_0)
    local _arg_0_ = _3_0
    local arguments = _arg_0_["arguments"]
    local args = nil
    local function _6_(...)
    local function _4_(...)
      return compile(scope, ...)
    end
    args = map(arguments, _6_)
    args = map(arguments, _4_)
    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, _5_0, ast)
    local _6_ = _5_0
    local left = _6_["left"]
    local operator = _6_["operator"]
    local right = _6_["right"]
  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 operators = {["#"] = "length", ["=="] = "=", ["~"] = "bnot", ["~="] = "not="}
    return list(sym((operators[operator] or operator)), compile(scope, left), compile(scope, right))
  end
  local function unary(compile, scope, _6_0, ast)
    local _7_ = _6_0
    local argument = _7_["argument"]
    local operator = _7_["operator"]
  local function unary(compile, scope, _5_0, ast)
    local _arg_0_ = _5_0
    local argument = _arg_0_["argument"]
    local operator = _arg_0_["operator"]
    return list(sym(operator), compile(scope, argument))
  end
  local function call(compile, scope, _7_0)
    local _8_ = _7_0
    local arguments = _8_["arguments"]
    local callee = _8_["callee"]
    local function _9_(...)
  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, ...)
    end
    return list(compile(scope, callee), unpack(map(arguments, _9_)))
    return list(compile(scope, callee), unpack(map(arguments, _7_)))
  end
  local function send(compile, scope, _8_0)
    local _9_ = _8_0
    local arguments = _9_["arguments"]
    local method = _9_["method"]
    local receiver = _9_["receiver"]
    local function _10_(...)
  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 target = compile(scope, receiver)
    local args = nil
    local function _8_(...)
      return compile(scope, ...)
    end
    return list(sym(":"), compile(scope, receiver), method.name, unpack(map(arguments, _10_)))
    args = map(arguments, _8_)
    if sym_3f(target) then
      return list(sym((tostring(target) .. ":" .. method.name)), unpack(args))
    else
      return list(sym(":"), target, method.name, unpack(args))
    end
  end
  local function any_computed_3f(ast)
    local function _9_()
    local function _8_()
      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 _9_()))
    return (ast.computed or (ast.object and (ast.object.kind ~= "Identifier") and _8_()))
  end
  local function member(compile, scope, ast)
    if any_computed_3f(ast) then
      local function _9_()
      local function _8_()
        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), _9_())
      return list(sym("."), compile(scope, ast.object), _8_())
    else
      return sym((tostring(compile(scope, ast.object)) .. "." .. ast.property.name))
    end
  end
  local function if_2a(compile, scope, _9_0, tail_3f)
    local _10_ = _9_0
    local alternate = _10_["alternate"]
    local cons = _10_["cons"]
    local tests = _10_["tests"]
  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"]
    for _, v in ipairs(cons) do
      if (0 == #v) then
        table.insert(v, sym("nil"))


@@ 755,85 780,85 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
    end
    local subscope = make_scope(scope)
    if (not alternate and (1 == #tests)) then
      local function _11_(...)
      local function _9_(...)
        return compile(subscope, ...)
      end
      return list(sym("when"), compile(scope, tests[1]), unpack(map(cons[1], _11_, tail_3f)))
      return list(sym("when"), compile(scope, tests[1]), unpack(map(cons[1], _9_, 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 _11_()
        local function _9_()
          if (1 == #c) then
            return compile(subscope, c[1], tail_3f)
          else
            local function _11_(...)
            local function _9_(...)
              return compile(subscope, ...)
            end
            return list(sym("do"), unpack(map(c, _11_, tail_3f)))
            return list(sym("do"), unpack(map(c, _9_, tail_3f)))
          end
        end
        table.insert(out, _11_())
        table.insert(out, _9_())
      end
      if alternate then
        local function _11_()
        local function _9_()
          if (1 == #alternate) then
            return compile(subscope, alternate[1], tail_3f)
          else
            local function _11_(...)
            local function _9_(...)
              return compile(subscope, ...)
            end
            return list(sym("do"), unpack(map(alternate, _11_, tail_3f)))
            return list(sym("do"), unpack(map(alternate, _9_, tail_3f)))
          end
        end
        table.insert(out, _11_())
        table.insert(out, _9_())
      end
      return out
    end
  end
  local function concat(compile, scope, _10_0)
    local _11_ = _10_0
    local terms = _11_["terms"]
    local function _12_(...)
  local function concat(compile, scope, _9_0)
    local _arg_0_ = _9_0
    local terms = _arg_0_["terms"]
    local function _10_(...)
      return compile(scope, ...)
    end
    return list(sym(".."), unpack(map(terms, _12_)))
    return list(sym(".."), unpack(map(terms, _10_)))
  end
  local function each_2a(compile, scope, _11_0)
    local _12_ = _11_0
    local body = _12_["body"]
    local explist = _12_["explist"]
    local namelist = _12_["namelist"]
  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 subscope = make_scope(scope)
    local binding = nil
    local function _13_(...)
    local function _11_(...)
      return compile(scope, ...)
    end
    binding = map(namelist.names, _13_)
    binding = map(namelist.names, _11_)
    add_to_scope(subscope, "param", binding)
    local function _14_(...)
    local function _12_(...)
      return compile(scope, ...)
    end
    for _, form in ipairs(map(explist, _14_)) do
    for _, form in ipairs(map(explist, _12_)) do
      table.insert(binding, form)
    end
    local function _14_(...)
    local function _12_(...)
      return compile(subscope, ...)
    end
    return list(sym("each"), binding, unpack(map(body, _14_)))
    return list(sym("each"), binding, unpack(map(body, _12_)))
  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 _13_
    local _12_
    if (not left[1].computed and (left[1].property.kind == "Identifier")) then
      _13_ = left[1].property.name
      _12_ = left[1].property.name
    else
      _13_ = compile(scope, left[1].property)
      _12_ = compile(scope, left[1].property)
    end
    return list(sym("tset"), compile(scope, left[1].object), _13_, right_out)
    return list(sym("tset"), compile(scope, left[1].object), _12_, right_out)
  end
  local function varize_local_21(scope, name)
    scope[name].ast[1] = "var"


@@ 841,125 866,125 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
  end
  local function setter_for(scope, names)
    local kinds = nil
    local function _12_(_241)
      local _13_0 = (scope[_241] or _241)
      if ((type(_13_0) == "table") and (nil ~= _13_0.kind)) then
        local kind = _13_0.kind
    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
        return kind
      else
        local _ = _13_0
        local _ = _12_0
        return "global"
      end
    end
    kinds = map(names, _12_)
    local _13_0, _14_0, _15_0 = kinds
    local _16_
    kinds = map(names, _11_)
    local _12_0, _13_0, _14_0 = kinds
    local _15_
    do
      local _ = _13_0
      _16_ = (true and (1 < #kinds))
      local _ = _12_0
      _15_ = (true and (1 < #kinds))
    end
    if _16_ then
      local _ = _13_0
    if _15_ then
      local _ = _12_0
      return "set-forcibly!"
    elseif ((type(_13_0) == "table") and (_13_0[1] == "local")) then
      local function _17_(...)
    elseif ((type(_12_0) == "table") and ((_12_0)[1] == "local")) then
      local function _16_(...)
        return varize_local_21(scope, ...)
      end
      map(names, _17_)
      map(names, _16_)
      return "set"
    elseif ((type(_13_0) == "table") and (_13_0[1] == "MemberExpression")) then
    elseif ((type(_12_0) == "table") and ((_12_0)[1] == "MemberExpression")) then
      return "set"
    elseif ((type(_13_0) == "table") and (_13_0[1] == "function")) then
    elseif ((type(_12_0) == "table") and ((_12_0)[1] == "function")) then
      return "set-forcibly!"
    elseif ((type(_13_0) == "table") and (_13_0[1] == "param")) then
    elseif ((type(_12_0) == "table") and ((_12_0)[1] == "param")) then
      return "set-forcibly!"
    else
      local _ = _13_0
      local _ = _12_0
      return "global"
    end
  end
  local function assignment(compile, scope, ast)
    local _12_ = ast
    local left = _12_["left"]
    local right = _12_["right"]
    local _let_0_ = ast
    local left = _let_0_["left"]
    local right = _let_0_["right"]
    local right_out = nil
    if (1 == #right) then
      right_out = compile(scope, right[1])
    elseif (0 == #right) then
      right_out = sym("nil")
    else
      local function _13_(...)
      local function _11_(...)
        return compile(scope, ...)
      end
      right_out = list(sym("values"), unpack(map(right, _13_)))
      right_out = list(sym("values"), unpack(map(right, _11_)))
    end
    if any_computed_3f(left[1]) then
      return tset_2a(compile, scope, left, right_out, ast)
    else
      local setter = nil
      local function _14_(_241)
      local function _12_(_241)
        return (_241.name or _241)
      end
      setter = setter_for(scope, map(left, _14_))
      local _15_
      setter = setter_for(scope, map(left, _12_))
      local _13_
      if (1 == #left) then
        _15_ = compile(scope, left[1])
        _13_ = compile(scope, left[1])
      else
        local function _16_(...)
        local function _14_(...)
          return compile(scope, ...)
        end
        _15_ = list(unpack(map(left, _16_)))
        _13_ = list(unpack(map(left, _14_)))
      end
      return list(sym(setter), _15_, right_out)
      return list(sym(setter), _13_, right_out)
    end
  end
  local function while_2a(compile, scope, _12_0)
    local _13_ = _12_0
    local body = _13_["body"]
    local test = _13_["test"]
  local function while_2a(compile, scope, _11_0)
    local _arg_0_ = _11_0
    local body = _arg_0_["body"]
    local test = _arg_0_["test"]
    local subscope = make_scope(scope)
    local function _14_(...)
    local function _12_(...)
      return compile(subscope, ...)
    end
    return list(sym("while"), compile(scope, test), unpack(map(body, _14_)))
    return list(sym("while"), compile(scope, test), unpack(map(body, _12_)))
  end
  local function repeat_2a(compile, scope, _13_0)
    local _14_ = _13_0
    local body = _14_["body"]
    local test = _14_["test"]
    local function _16_()
      local _15_0 = nil
      local function _16_(...)
  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
      _15_0 = map(body, _16_)
      table.insert(_15_0, list(sym("when"), compile(scope, test), list(sym("lua"), "break")))
      return _15_0
      _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(_16_()))
    return list(sym("while"), true, unpack(_14_()))
  end
  local function for_2a(compile, scope, _14_0)
    local _15_ = _14_0
    local body = _15_["body"]
    local init = _15_["init"]
    local last = _15_["last"]
    local step = _15_["step"]
  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 i = compile(scope, init.id)
    local subscope = make_scope(scope)
    add_to_scope(subscope, "param", {i})
    local function _16_(...)
    local function _14_(...)
      return compile(subscope, ...)
    end
    return list(sym("for"), {i, compile(scope, init.value), compile(scope, last), (step and (step ~= 1) and compile(scope, step))}, unpack(map(body, _16_)))
    return list(sym("for"), {i, compile(scope, init.value), compile(scope, last), (step and (step ~= 1) and compile(scope, step))}, unpack(map(body, _14_)))
  end
  local function table_2a(compile, scope, _15_0)
    local _16_ = _15_0
    local keyvals = _16_["keyvals"]
  local function table_2a(compile, scope, _14_0)
    local _arg_0_ = _14_0
    local keyvals = _arg_0_["keyvals"]
    local out = {}
    for i, _17_0 in pairs(keyvals) do
      local _18_ = _17_0
      local v = _18_[1]
      local k = _18_[2]
    for i, _15_0 in pairs(keyvals) do
      local _each_0_ = _15_0
      local v = _each_0_[1]
      local k = _each_0_[2]
      if k then
        out[compile(scope, k)] = compile(scope, v)
      else


@@ 968,14 993,14 @@ package.preload["anticompiler"] = package.preload["anticompiler"] or function(..
    end
    return out
  end
  local function do_2a(compile, scope, _16_0, tail_3f)
    local _17_ = _16_0
    local body = _17_["body"]
  local function do_2a(compile, scope, _15_0, tail_3f)
    local _arg_0_ = _15_0
    local body = _arg_0_["body"]
    local subscope = make_scope(scope)
    local function _18_(...)
    local function _16_(...)
      return compile(subscope, ...)
    end
    return list(sym("do"), unpack(map(body, _18_, tail_3f)))
    return list(sym("do"), unpack(map(body, _16_, tail_3f)))
  end
  local function _break(compile, scope, ast)
    return list(sym("lua"), "break")


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


@@ 2461,7 2486,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        if (_0_0 == "Lua Compile") then
          return ("Bad code generated - likely a bug with the compiler:\n" .. "--- Generated Lua Start ---\n" .. lua_source .. "--- Generated Lua End ---\n")
        elseif (_0_0 == "Runtime") then
          return (compiler.traceback(err, 4) .. "\n")
          return (compiler.traceback(tostring(err), 4) .. "\n")
        else
          local _ = _0_0
          return ("%s error: %s\n"):format(errtype, tostring(err))


@@ 2485,6 2510,111 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return table.concat(spliced_source, "\n")
    end
    local commands = {}
    local function command_3f(input)
      return input:match("^%s*,")
    end
    local function command_docs()
      local _0_
      do
        local tbl_0_ = {}
        for name, f in pairs(commands) do
          tbl_0_[(#tbl_0_ + 1)] = ("  ,%s - %s"):format(name, ((compiler.metadata):get(f, "fnl/docstring") or "undocumented"))
        end
        _0_ = tbl_0_
      end
      return table.concat(_0_, "\n")
    end
    commands.help = function(_, _0, on_values)
      return on_values({("Welcome to Fennel.\nThis is the REPL where you can enter code to be evaluated.\nYou can also run these repl commands:\n\n" .. command_docs() .. "\n  ,exit - Leave the repl.\n\nUse (doc something) to see descriptions for individual macros and special forms.\n\nFor more information about the language, see https://fennel-lang.org/reference")})
    end
    do end (compiler.metadata):set(commands.help, "fnl/docstring", "Show this message.")
    local function reload(module_name, env, on_values, on_error)
      local _0_0, _1_0 = pcall(specials["load-code"]("return require(...)", env), module_name)
      if ((_0_0 == true) and (nil ~= _1_0)) then
        local old = _1_0
        local _ = nil
        package.loaded[module_name] = nil
        _ = nil
        local ok, new = pcall(require, module_name)
        local new0 = nil
        if not ok then
          on_values({new})
          new0 = old
        else
          new0 = new
        end
        if ((type(old) == "table") and (type(new0) == "table")) then
          for k, v in pairs(new0) do
            old[k] = v
          end
          for k in pairs(old) do
            if (nil == new0[k]) then
              old[k] = nil
            end
          end
          package.loaded[module_name] = old
        end
        return on_values({"ok"})
      elseif ((_0_0 == false) and (nil ~= _1_0)) then
        local msg = _1_0
        local function _3_()
          local _2_0 = msg:gsub("\n.*", "")
          return _2_0
        end
        return on_error("Runtime", _3_())
      end
    end
    commands.reload = function(env, read, on_values, on_error)
      local _0_0, _1_0, _2_0 = pcall(read)
      if ((_0_0 == true) and (_1_0 == true) and (nil ~= _2_0)) then
        local module_sym = _2_0
        return reload(tostring(module_sym), env, on_values, on_error)
      elseif ((_0_0 == false) and true and true) then
        local _3fparse_ok = _1_0
        local _3fmsg = _2_0
        return on_error("Parse", (_3fmsg or _3fparse_ok))
      end
    end
    do end (compiler.metadata):set(commands.reload, "fnl/docstring", "Reload the specified module.")
    commands.reset = function(env, _, on_values)
      env.___replLocals___ = {}
      return on_values({"ok"})
    end
    do end (compiler.metadata):set(commands.reset, "fnl/docstring", "Erase all repl-local scope.")
    local function load_plugin_commands()
      if (utils.root and utils.root.options and utils.root.options.plugins) then
        for _, plugin in ipairs(utils.root.options.plugins) do
          for name, f in pairs(plugin) do
            local _0_0 = name:match("^repl%-command%-(.*)")
            if (nil ~= _0_0) then
              local cmd_name = _0_0
              commands[cmd_name] = (commands[cmd_name] or f)
            end
          end
        end
        return nil
      end
    end
    local function run_command(input, read, loop, env, on_values, on_error)
      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)
        else
          local _ = _0_0
          if ("exit" ~= command_name) then
            on_values({"Unknown command", command_name})
          end
        end
      end
      if ("exit" ~= command_name) then
        return loop()
      end
    end
    local function completer(env, scope, text)
      local matches = {}
      local input_fragment = text:gsub(".*[%s)(]+", "")


@@ 2535,9 2665,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local old_root_options = utils.root.options
      local env = nil
      if options.env then
        env = utils["wrap-env"](options.env)
        env = specials["wrap-env"](options.env)
      else
        env = setmetatable({}, {__index = (_G._ENV or _G)})
        env = setmetatable({}, {__index = (rawget(_G, "_ENV") or _G)})
      end
      local save_locals_3f = ((options.saveLocals ~= false) and env.debug and env.debug.getlocal)
      local opts = {}


@@ 2555,7 2685,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local read, reset = nil, nil
      local function _1_(parser_state)
        local c = byte_stream(parser_state)
        chars[(#chars + 1)] = c
        table.insert(chars, c)
        return c
      end
      read, reset = parser.parser(_1_)


@@ 2570,18 2700,29 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        opts.registerCompleter(_3_)
      end
      local function print_values(...)
        local vals = {...}
        local out = {}
        env._, env.__ = vals[1], vals
        for i = 1, select("#", ...) do
          table.insert(out, pp(vals[i]))
        end
        return on_values(out)
      end
      local function loop()
        for k in pairs(chars) do
          chars[k] = nil
        end
        local ok, parse_ok_3f, x = pcall(read)
        local src_string = string.char((_G.unpack or table.unpack)(chars))
        local src_string = string.char((table.unpack or _G.unpack)(chars))
        utils.root.options = opts
        if not ok then
          on_error("Parse", parse_ok_3f)
          clear_stream()
          reset()
          return loop()
        elseif command_3f(src_string) then
          return run_command(src_string, read, loop, env, on_values, on_error)
        else
          if parse_ok_3f then
            do


@@ 2591,32 2732,28 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
                clear_stream()
                on_error("Compile", msg)
              elseif ((_4_0 == true) and (nil ~= _5_0)) then
                local source = _5_0
                local source0 = nil
                local src = _5_0
                local src0 = nil
                if save_locals_3f then
                  source0 = splice_save_locals(env, source)
                  src0 = splice_save_locals(env, src)
                else
                  source0 = source
                  src0 = src
                end
                local lua_ok_3f, loader = pcall(specials["load-code"], source0, env)
                if not lua_ok_3f then
                local _7_0, _8_0 = pcall(specials["load-code"], src0, env)
                if ((_7_0 == false) and (nil ~= _8_0)) then
                  local msg = _8_0
                  clear_stream()
                  on_error("Lua Compile", loader, source0)
                else
                  local _7_0, _8_0 = nil, nil
                  on_error("Lua Compile", msg, src0)
                elseif (true and (nil ~= _8_0)) then
                  local _0 = _7_0
                  local chunk = _8_0
                  local function _9_()
                    return {loader()}
                    return print_values(chunk())
                  end
                  local function _10_(...)
                    return on_error("Runtime", ...)
                  end
                  _7_0, _8_0 = xpcall(_9_, _10_)
                  if ((_7_0 == true) and (nil ~= _8_0)) then
                    local ret = _8_0
                    env._ = ret[1]
                    env.__ = ret
                    on_values(utils.map(ret, pp))
                  end
                  xpcall(_9_, _10_)
                end
              end
            end


@@ 2629,11 2766,396 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    return repl
  end
  package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
    local type_order = {["function"] = 5, boolean = 2, number = 1, string = 3, table = 4, thread = 7, userdata = 6}
    local function sort_keys(_0_0, _1_0)
      local _1_ = _0_0
      local a = _1_[1]
      local _2_ = _1_0
      local b = _2_[1]
      local ta = type(a)
      local tb = type(b)
      if ((ta == tb) and ((ta == "string") or (ta == "number"))) then
        return (a < b)
      else
        local dta = type_order[ta]
        local dtb = type_order[tb]
        if (dta and dtb) then
          return (dta < dtb)
        elseif dta then
          return true
        elseif dtb then
          return false
        else
          return (ta < tb)
        end
      end
    end
    local function table_kv_pairs(t)
      local assoc_3f = false
      local i = 1
      local kv = {}
      local insert = table.insert
      for k, v in pairs(t) do
        if ((type(k) ~= "number") or (k ~= i)) then
          assoc_3f = true
        end
        i = (i + 1)
        insert(kv, {k, v})
      end
      table.sort(kv, sort_keys)
      if (#kv == 0) then
        return kv, "empty"
      else
        local function _2_()
          if assoc_3f then
            return "table"
          else
            return "seq"
          end
        end
        return kv, _2_()
      end
    end
    local function count_table_appearances(t, appearances)
      if (type(t) == "table") then
        if not appearances[t] then
          appearances[t] = 1
          for k, v in pairs(t) do
            count_table_appearances(k, appearances)
            count_table_appearances(v, appearances)
          end
        else
          appearances[t] = ((appearances[t] or 0) + 1)
        end
      end
      return appearances
    end
    local function save_table(t, seen)
      local seen0 = (seen or {len = 0})
      local id = (seen0.len + 1)
      if not seen0[t] then
        seen0[t] = id
        seen0.len = id
      end
      return seen0
    end
    local function detect_cycle(t, seen, _3fk)
      if ("table" == type(t)) then
        seen[t] = true
        local _2_0, _3_0 = next(t, _3fk)
        if ((nil ~= _2_0) and (nil ~= _3_0)) then
          local k = _2_0
          local v = _3_0
          return (seen[k] or detect_cycle(k, seen) or seen[v] or detect_cycle(v, seen) or detect_cycle(t, seen, k))
        end
      end
    end
    local function visible_cycle_3f(t, options)
      return (options["detect-cycles?"] and detect_cycle(t, {}) and save_table(t, options.seen) and (1 < (options.appearances[t] or 0)))
    end
    local function table_indent(t, indent, id)
      local opener_length = nil
      if id then
        opener_length = (#tostring(id) + 2)
      else
        opener_length = 1
      end
      return (indent + opener_length)
    end
    local pp = nil
    local function concat_table_lines(elements, options, multiline_3f, indent, table_type, prefix)
      local indent_str = ("\n" .. string.rep(" ", indent))
      local open = nil
      local function _2_()
        if ("seq" == table_type) then
          return "["
        else
          return "{"
        end
      end
      open = ((prefix or "") .. _2_())
      local close = nil
      if ("seq" == table_type) then
        close = "]"
      else
        close = "}"
      end
      local oneline = (open .. table.concat(elements, " ") .. close)
      if (not options["one-line?"] and (multiline_3f or ((indent + #oneline) > options["line-length"]))) then
        return (open .. table.concat(elements, indent_str) .. close)
      else
        return oneline
      end
    end
    local function pp_associative(t, kv, options, indent, key_3f)
      local multiline_3f = false
      local id = options.seen[t]
      if (options.level >= options.depth) then
        return "{...}"
      elseif (id and options["detect-cycles?"]) then
        return ("@" .. id .. "{...}")
      else
        local visible_cycle_3f0 = visible_cycle_3f(t, options)
        local id0 = (visible_cycle_3f0 and options.seen[t])
        local indent0 = table_indent(t, indent, id0)
        local slength = nil
        local function _3_()
          local _2_0 = rawget(_G, "utf8")
          if _2_0 then
            return _2_0.len
          else
            return _2_0
          end
        end
        local function _4_(_241)
          return #_241
        end
        slength = ((options["utf8?"] and _3_()) or _4_)
        local prefix = nil
        if visible_cycle_3f0 then
          prefix = ("@" .. id0)
        else
          prefix = ""
        end
        local elements = nil
        do
          local tbl_0_ = {}
          for _, _6_0 in pairs(kv) do
            local _7_ = _6_0
            local k = _7_[1]
            local v = _7_[2]
            local _8_
            do
              local k0 = pp(k, options, (indent0 + 1), true)
              local v0 = pp(v, options, (indent0 + slength(k0) + 1))
              multiline_3f = (multiline_3f or k0:find("\n") or v0:find("\n"))
              _8_ = (k0 .. " " .. v0)
            end
            tbl_0_[(#tbl_0_ + 1)] = _8_
          end
          elements = tbl_0_
        end
        return concat_table_lines(elements, options, multiline_3f, indent0, "table", prefix)
      end
    end
    local function pp_sequence(t, kv, options, indent)
      local multiline_3f = false
      local id = options.seen[t]
      if (options.level >= options.depth) then
        return "[...]"
      elseif (id and options["detect-cycles?"]) then
        return ("@" .. id .. "[...]")
      else
        local visible_cycle_3f0 = visible_cycle_3f(t, options)
        local id0 = (visible_cycle_3f0 and options.seen[t])
        local indent0 = table_indent(t, indent, id0)
        local prefix = nil
        if visible_cycle_3f0 then
          prefix = ("@" .. id0)
        else
          prefix = ""
        end
        local elements = nil
        do
          local tbl_0_ = {}
          for _, _3_0 in pairs(kv) do
            local _4_ = _3_0
            local _0 = _4_[1]
            local v = _4_[2]
            local _5_
            do
              local v0 = pp(v, options, indent0)
              multiline_3f = (multiline_3f or v0:find("\n"))
              _5_ = v0
            end
            tbl_0_[(#tbl_0_ + 1)] = _5_
          end
          elements = tbl_0_
        end
        return concat_table_lines(elements, options, multiline_3f, indent0, "seq", prefix)
      end
    end
    local function concat_lines(lines, options, indent, force_multi_line_3f)
      if (#lines == 0) then
        if options["empty-as-sequence?"] then
          return "[]"
        else
          return "{}"
        end
      else
        local oneline = nil
        local _2_
        do
          local tbl_0_ = {}
          for _, line in ipairs(lines) do
            tbl_0_[(#tbl_0_ + 1)] = line:gsub("^%s+", "")
          end
          _2_ = tbl_0_
        end
        oneline = table.concat(_2_, " ")
        if (not options["one-line?"] and (force_multi_line_3f or oneline:find("\n") or ((indent + #oneline) > options["line-length"]))) then
          return table.concat(lines, ("\n" .. string.rep(" ", indent)))
        else
          return oneline
        end
      end
    end
    local function pp_metamethod(t, metamethod, options, indent)
      if (options.level >= options.depth) then
        if options["empty-as-sequence?"] then
          return "[...]"
        else
          return "{...}"
        end
      else
        local _ = nil
        local function _2_(_241)
          return visible_cycle_3f(_241, options)
        end
        options["visible-cycle?"] = _2_
        _ = nil
        local lines, force_multi_line_3f = metamethod(t, pp, options, indent)
        options["visible-cycle?"] = nil
        local _3_0 = type(lines)
        if (_3_0 == "string") then
          return lines
        elseif (_3_0 == "table") then
          return concat_lines(lines, options, indent, force_multi_line_3f)
        else
          local _0 = _3_0
          return error("Error: __fennelview metamethod must return a table of lines")
        end
      end
    end
    local function pp_table(x, options, indent)
      options.level = (options.level + 1)
      local x0 = nil
      do
        local _2_0 = nil
        if options["metamethod?"] then
          local _3_0 = x
          if _3_0 then
            local _4_0 = getmetatable(_3_0)
            if _4_0 then
              _2_0 = _4_0.__fennelview
            else
              _2_0 = _4_0
            end
          else
            _2_0 = _3_0
          end
        else
        _2_0 = nil
        end
        if (nil ~= _2_0) then
          local metamethod = _2_0
          x0 = pp_metamethod(x, metamethod, options, indent)
        else
          local _ = _2_0
          local _4_0, _5_0 = table_kv_pairs(x)
          if (true and (_5_0 == "empty")) then
            local _0 = _4_0
            if options["empty-as-sequence?"] then
              x0 = "[]"
            else
              x0 = "{}"
            end
          elseif ((nil ~= _4_0) and (_5_0 == "table")) then
            local kv = _4_0
            x0 = pp_associative(x, kv, options, indent)
          elseif ((nil ~= _4_0) and (_5_0 == "seq")) then
            local kv = _4_0
            x0 = pp_sequence(x, kv, options, indent)
          else
          x0 = nil
          end
        end
      end
      options.level = (options.level - 1)
      return x0
    end
    local function number__3estring(n)
      local _2_0 = string.gsub(tostring(n), ",", ".")
      return _2_0
    end
    local function colon_string_3f(s)
      return s:find("^[-%w?^_!$%&*+./@|<=>]+$")
    end
    local function pp_string(str, options, indent)
      local escs = nil
      local _2_
      if (options["escape-newlines?"] and (#str < (options["line-length"] - indent))) then
        _2_ = "\\n"
      else
        _2_ = "\n"
      end
      local function _4_(_241, _242)
        return ("\\%03d"):format(_242:byte())
      end
      escs = setmetatable({["\""] = "\\\"", ["\11"] = "\\v", ["\12"] = "\\f", ["\13"] = "\\r", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\\"] = "\\\\", ["\n"] = _2_}, {__index = _4_})
      return ("\"" .. str:gsub("[%c\\\"]", escs) .. "\"")
    end
    local function make_options(t, options)
      local defaults = {["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["escape-newlines?"] = false, ["line-length"] = 80, ["metamethod?"] = true, ["one-line?"] = false, ["prefer-colon?"] = false, ["utf8?"] = true, depth = 128}
      local overrides = {appearances = count_table_appearances(t, {}), level = 0, seen = {len = 0}}
      for k, v in pairs((options or {})) do
        defaults[k] = v
      end
      for k, v in pairs(overrides) do
        defaults[k] = v
      end
      return defaults
    end
    local function _2_(x, options, indent, colon_3f)
      local indent0 = (indent or 0)
      local options0 = (options or make_options(x))
      local tv = type(x)
      local function _4_()
        local _3_0 = getmetatable(x)
        if _3_0 then
          return _3_0.__fennelview
        else
          return _3_0
        end
      end
      if ((tv == "table") or ((tv == "userdata") and _4_())) then
        return pp_table(x, options0, indent0)
      elseif (tv == "number") then
        return number__3estring(x)
      else
        local function _5_()
          if (colon_3f ~= nil) then
            return colon_3f
          elseif ("function" == type(options0["prefer-colon?"])) then
            return options0["prefer-colon?"](x)
          else
            return options0["prefer-colon?"]
          end
        end
        if ((tv == "string") and colon_string_3f(x) and _5_()) then
          return (":" .. x)
        elseif (tv == "string") then
          return pp_string(x, options0, indent0)
        elseif ((tv == "boolean") or (tv == "nil")) then
          return tostring(x)
        else
          return ("#<" .. tostring(x) .. ">")
        end
      end
    end
    pp = _2_
    local function view(x, options)
      return pp(x, make_options(x, options), 0)
    end
    return view
  end
  package.preload["fennel.specials"] = package.preload["fennel.specials"] or function(...)
    local utils = require("fennel.utils")
    local view = require("fennel.view")
    local parser = require("fennel.parser")
    local compiler = require("fennel.compiler")
    local unpack = (_G.unpack or table.unpack)
    local unpack = (table.unpack or _G.unpack)
    local SPECIALS = compiler.scopes.global.specials
    local function wrap_env(env)
      local function _0_(_, key)


@@ 2670,8 3192,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return utils.kvmap((env or _G), compiler["global-unmangling"])
    end
    local function load_code(code, environment, filename)
      local environment0 = ((environment or _ENV) or _G)
      if (_G.setfenv and _G.loadstring) then
      local environment0 = (environment or rawget(_G, "_ENV") or _G)
      if (rawget(_G, "setfenv") and rawget(_G, "loadstring")) then
        local f = assert(_G.loadstring(code, filename))
        _G.setfenv(f, environment0)
        return f


@@ 2684,7 3206,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return (name .. " not found")
      else
        local docstring = (((compiler.metadata):get(tgt, "fnl/docstring") or "#<undocumented>")):gsub("\n$", ""):gsub("\n", "\n  ")
        if (type(tgt) == "function") then
        local mt = getmetatable(tgt)
        if ((type(tgt) == "function") or ((type(mt) == "table") and (type(mt.__call) == "function"))) then
          local arglist = table.concat(((compiler.metadata):get(tgt, "fnl/arglist") or {"#<unknown-arguments>"}), " ")
          local _0_
          if (#arglist > 0) then


@@ 2739,7 3262,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return compile_body(opts.target, opts.tail)
      elseif opts.nval then
        local syms = {}
        for i = 1, opts.nval, 1 do
        for i = 1, opts.nval do
          local s = ((pre_syms and pre_syms[i]) or compiler.gensym(scope))
          syms[i] = s
          retexprs[i] = utils.expr(s, "sym")


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


@@ 2766,18 3290,76 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local exprs = {}
      for i = 2, len do
        local subexprs = compiler.compile1(ast[i], scope, parent, {nval = ((i ~= len) and 1)})
        exprs[(#exprs + 1)] = subexprs[1]
        table.insert(exprs, subexprs[1])
        if (i == len) then
          for j = 2, #subexprs, 1 do
            exprs[(#exprs + 1)] = subexprs[j]
          for j = 2, #subexprs do
            table.insert(exprs, subexprs[j])
          end
        end
      end
      return exprs
    end
    doc_special("values", {"..."}, "Return multiple values from a function. Must be in tail position.")
    local function deep_tostring(x, key_3f)
      local elems = {}
      if utils["sequence?"](x) then
        local _0_
        do
          local tbl_0_ = {}
          for _, v in ipairs(x) do
            tbl_0_[(#tbl_0_ + 1)] = deep_tostring(v)
          end
          _0_ = tbl_0_
        end
        return ("[" .. table.concat(_0_, " ") .. "]")
      elseif utils["table?"](x) then
        local _0_
        do
          local tbl_0_ = {}
          for k, v in pairs(x) do
            tbl_0_[(#tbl_0_ + 1)] = (deep_tostring(k, true) .. " " .. deep_tostring(v))
          end
          _0_ = tbl_0_
        end
        return ("{" .. table.concat(_0_, " ") .. "}")
      elseif (key_3f and (type(x) == "string") and x:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")) then
        return (":" .. x)
      elseif (type(x) == "string") then
        return string.format("%q", x):gsub("\\\"", "\\\\\""):gsub("\"", "\\\"")
      else
        return tostring(x)
      end
    end
    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))
        end
        args = utils.map(arg_list, _0_)
        local meta_fields = {"\"fnl/arglist\"", ("{" .. table.concat(args, ", ") .. "}")}
        if docstring then
          table.insert(meta_fields, "\"fnl/docstring\"")
          table.insert(meta_fields, ("\"" .. docstring:gsub("%s+$", ""):gsub("\\", "\\\\"):gsub("\n", "\\n"):gsub("\"", "\\\"") .. "\""))
        end
        local meta_str = ("require(\"%s\").metadata"):format((utils.root.options.moduleName or "fennel"))
        return compiler.emit(parent, ("pcall(function() %s:setall(%s, %s) end)"):format(meta_str, fn_name, table.concat(meta_fields, ", ")))
      end
    end
    local function get_fn_name(ast, scope, fn_name, multi)
      if (fn_name and (fn_name[1] ~= "nil")) then
        local _0_
        if not multi then
          _0_ = compiler["declare-local"](fn_name, {}, scope, ast)
        else
          _0_ = compiler["symbol-to-expression"](fn_name, scope)[1]
        end
        return _0_, not multi, 3
      else
        return compiler.gensym(scope), true, 2
      end
    end
    SPECIALS.fn = function(ast, scope, parent)
      local index, fn_name, is_local_fn, docstring = 2, utils["sym?"](ast[2])
      local f_scope = nil
      do
        local _0_0 = compiler["make-scope"](scope)


@@ 2785,80 3367,50 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        f_scope = _0_0
      end
      local f_chunk = {}
      local multi = (fn_name and utils["multi-sym?"](fn_name[1]))
      compiler.assert((not multi or not multi["multi-sym-method-call"]), ("unexpected multi symbol " .. tostring(fn_name)), ast[index])
      if (fn_name and (fn_name[1] ~= "nil")) then
        is_local_fn = not multi
        if is_local_fn then
          fn_name = compiler["declare-local"](fn_name, {}, scope, ast)
      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 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)
        if utils["varg?"](arg) then
          compiler.assert((arg == arg_list[#arg_list]), "expected vararg as last parameter", ast)
          f_scope.vararg = true
          return "..."
        elseif (utils["sym?"](arg) and (utils.deref(arg) ~= "nil") and not utils["multi-sym?"](utils.deref(arg))) then
          return compiler["declare-local"](arg, {}, f_scope, ast)
        elseif utils["table?"](arg) then
          local raw = utils.sym(compiler.gensym(scope))
          local declared = compiler["declare-local"](raw, {}, f_scope, ast)
          compiler.destructure(arg, raw, ast, f_scope, f_chunk, {declaration = true, nomulti = true, symtype = "arg"})
          return declared
        else
          fn_name = compiler["symbol-to-expression"](fn_name, scope)[1]
          return compiler.assert(false, ("expected symbol for function parameter: %s"):format(tostring(arg)), ast[2])
        end
        index = (index + 1)
      else
        is_local_fn = true
        fn_name = compiler.gensym(scope)
      end
      do
        local arg_list = nil
        local function _2_()
          if (type(ast[index]) == "table") then
            return ast[index]
          else
            return ast
          end
        end
        arg_list = compiler.assert(utils["table?"](ast[index]), "expected parameters", _2_())
        local function get_arg_name(i, name)
          if utils["varg?"](name) then
            compiler.assert((i == #arg_list), "expected vararg as last parameter", ast[2])
            f_scope.vararg = true
            return "..."
          elseif (utils["sym?"](name) and (utils.deref(name) ~= "nil") and not utils["multi-sym?"](utils.deref(name))) then
            return compiler["declare-local"](name, {}, f_scope, ast)
          elseif utils["table?"](name) then
            local raw = utils.sym(compiler.gensym(scope))
            local declared = compiler["declare-local"](raw, {}, f_scope, ast)
            compiler.destructure(name, raw, ast, f_scope, f_chunk, {declaration = true, nomulti = true})
            return declared
          else
            return compiler.assert(false, ("expected symbol for function parameter: %s"):format(tostring(name)), ast[2])
          end
        end
        local arg_name_list = utils.kvmap(arg_list, get_arg_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
          index = (index + 1)
          docstring = ast[index]
          index0, docstring = (index + 1), ast[(index + 1)]
        else
          index0, docstring = index, nil
        end
        for i = (index + 1), #ast, 1 do
        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
        if is_local_fn then
          compiler.emit(parent, ("local function %s(%s)"):format(fn_name, table.concat(arg_name_list, ", ")), ast)
        local _2_
        if local_fn_3f then
          _2_ = "local function %s(%s)"
        else
          compiler.emit(parent, ("%s = function(%s)"):format(fn_name, table.concat(arg_name_list, ", ")), ast)
          _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)
        if utils.root.options.useMetadata then
          local args = nil
          local function _5_(v)
            if utils["table?"](v) then
              return "\"#<table>\""
            else
              return ("\"%s\""):format(tostring(v))
            end
          end
          args = utils.map(arg_list, _5_)
          local meta_fields = {"\"fnl/arglist\"", ("{" .. table.concat(args, ", ") .. "}")}
          if docstring then
            table.insert(meta_fields, "\"fnl/docstring\"")
            table.insert(meta_fields, ("\"" .. docstring:gsub("%s+$", ""):gsub("\\", "\\\\"):gsub("\n", "\\n"):gsub("\"", "\\\"") .. "\""))
          end
          local meta_str = ("require(\"%s\").metadata"):format((utils.root.options.moduleName or "fennel"))
          compiler.emit(parent, ("pcall(function() %s:setall(%s, %s) end)"):format(meta_str, fn_name, table.concat(meta_fields, ", ")))
        end
        set_fn_metadata(arg_list, docstring, parent, fn_name)
      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.")


@@ 2867,7 3419,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      if (ast[2] ~= nil) then
        table.insert(parent, {ast = ast, leaf = tostring(ast[2])})
      end
      if (#ast == 3) then
      if (ast[3] ~= nil) then
        return tostring(ast[3])
      end
    end


@@ 2877,7 3429,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local target = utils.deref(ast[2])
      local special_or_macro = (scope.specials[target] or scope.macros[target])
      if special_or_macro then
        return ("print([[%s]])"):format(doc_2a(special_or_macro, target))
        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]))


@@ 2887,25 3439,26 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function dot(ast, scope, parent)
      compiler.assert((1 < #ast), "expected table argument", ast)
      local len = #ast
      local lhs = compiler.compile1(ast[2], scope, parent, {nval = 1})
      local _0_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
      local lhs = _0_[1]
      if (len == 2) then
        return tostring(lhs[1])
        return tostring(lhs)
      else
        local indices = {}
        for i = 3, len, 1 do
        for i = 3, len do
          local index = ast[i]
          if ((type(index) == "string") and utils["valid-lua-identifier?"](index)) then
            table.insert(indices, ("." .. index))
          else
            local _0_ = compiler.compile1(index, scope, parent, {nval = 1})
            local index0 = _0_[1]
            local _1_ = compiler.compile1(index, scope, parent, {nval = 1})
            local index0 = _1_[1]
            table.insert(indices, ("[" .. tostring(index0) .. "]"))
          end
        end
        if utils["table?"](ast[2]) then
          return ("(" .. tostring(lhs[1]) .. ")" .. table.concat(indices))
        if (tostring(lhs):find("[{\"0-9]") or ("nil" == tostring(lhs))) then
          return ("(" .. tostring(lhs) .. ")" .. table.concat(indices))
        else
          return (tostring(lhs[1]) .. table.concat(indices))
          return (tostring(lhs) .. table.concat(indices))
        end
      end
    end


@@ 2913,32 3466,32 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    doc_special(".", {"tbl", "key1", "..."}, "Look up key1 in tbl table. If more args are provided, do a nested lookup.")
    SPECIALS.global = function(ast, scope, parent)
      compiler.assert((#ast == 3), "expected name and value", ast)
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {forceglobal = true, nomulti = true})
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {forceglobal = true, nomulti = true, symtype = "global"})
      return nil
    end
    doc_special("global", {"name", "val"}, "Set name as a global with val.")
    SPECIALS.set = function(ast, scope, parent)
      compiler.assert((#ast == 3), "expected name and value", ast)
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {noundef = true})
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {noundef = true, symtype = "set"})
      return nil
    end
    doc_special("set", {"name", "val"}, "Set a local variable to a new value. Only works on locals using var.")
    local function set_forcibly_21_2a(ast, scope, parent)
      compiler.assert((#ast == 3), "expected name and value", ast)
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {forceset = true})
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {forceset = true, symtype = "set"})
      return nil
    end
    SPECIALS["set-forcibly!"] = set_forcibly_21_2a
    local function local_2a(ast, scope, parent)
      compiler.assert((#ast == 3), "expected name and value", ast)
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {declaration = true, nomulti = true})
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {declaration = true, nomulti = true, symtype = "local"})
      return nil
    end
    SPECIALS["local"] = local_2a
    doc_special("local", {"name", "val"}, "Introduce new top-level immutable local.")
    SPECIALS.var = function(ast, scope, parent)
      compiler.assert((#ast == 3), "expected name and value", ast)
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {declaration = true, isvar = true, nomulti = true})
      compiler.destructure(ast[2], ast[3], ast, scope, parent, {declaration = true, isvar = true, nomulti = true, symtype = "var"})
      return nil
    end
    doc_special("var", {"name", "val"}, "Introduce new mutable local.")


@@ 2948,13 3501,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      compiler.assert((utils["list?"](bindings) or utils["table?"](bindings)), "expected binding table", ast)
      compiler.assert(((#bindings % 2) == 0), "expected even number of name/value bindings", ast[2])
      compiler.assert((#ast >= 3), "expected body expression", ast[1])
      for _ = 1, (opts.nval or 0), 1 do
      for _ = 1, (opts.nval or 0) do
        table.insert(pre_syms, compiler.gensym(scope))
      end
      local sub_scope = compiler["make-scope"](scope)
      local sub_chunk = {}
      for i = 1, #bindings, 2 do
        compiler.destructure(bindings[i], bindings[(i + 1)], ast, sub_scope, sub_chunk, {declaration = true, nomulti = true})
        compiler.destructure(bindings[i], bindings[(i + 1)], ast, sub_scope, sub_chunk, {declaration = true, nomulti = true, symtype = "let"})
      end
      return SPECIALS["do"](ast, scope, parent, opts, 3, sub_chunk, sub_scope, pre_syms)
    end


@@ 2963,9 3516,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      compiler.assert((#ast > 3), "expected table, key, and value arguments", ast)
      local root = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
      local keys = {}
      for i = 3, (#ast - 1), 1 do
        local key = compiler.compile1(ast[i], scope, parent, {nval = 1})[1]
        keys[(#keys + 1)] = tostring(key)
      for i = 3, (#ast - 1) do
        local _0_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
        local key = _0_[1]
        table.insert(keys, tostring(key))
      end
      local value = compiler.compile1(ast[#ast], scope, parent, {nval = 1})[1]
      local rootstr = tostring(root)


@@ 2978,28 3532,26 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return compiler.emit(parent, fmtstr:format(tostring(root), 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)
      if not (opts.tail or opts.target or opts.nval) then
        return "iife", true, nil
      elseif (opts.nval and (opts.nval ~= 0) and not opts.target) then
        local accum = {}
        local target_exprs = {}
        for i = 1, opts.nval do
          local s = compiler.gensym(scope)
          accum[i] = s
          target_exprs[i] = utils.expr(s, "sym")
        end
        return "target", opts.tail, table.concat(accum, ", "), target_exprs
      else
        return "none", opts.tail, opts.target
      end
    end
    local function if_2a(ast, scope, parent, opts)
      local do_scope = compiler["make-scope"](scope)
      local branches = {}
      local has_else = ((#ast > 3) and ((#ast % 2) == 0))
      local else_branch = nil
      local wrapper, inner_tail, inner_target, target_exprs = nil
      if (opts.tail or opts.target or opts.nval) then
        if (opts.nval and (opts.nval ~= 0) and not opts.target) then
          local accum = {}
          target_exprs = {}
          for i = 1, opts.nval, 1 do
            local s = compiler.gensym(scope)
            accum[i] = s
            target_exprs[i] = utils.expr(s, "sym")
          end
          wrapper, inner_tail, inner_target = "target", opts.tail, table.concat(accum, ", ")
        else
          wrapper, inner_tail, inner_target = "none", opts.tail, opts.target
        end
      else
        wrapper, inner_tail, inner_target = "iife", true, nil
      end
      local wrapper, inner_tail, inner_target, target_exprs = calculate_target(scope, opts)
      local body_opts = {nval = opts.nval, tail = inner_tail, target = inner_target}
      local function compile_body(i)
        local chunk = {}


@@ 3017,9 3569,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        branch.nested = ((i ~= 2) and (next(condchunk, nil) == nil))
        table.insert(branches, branch)
      end
      if has_else then
        else_branch = compile_body(#ast)
      end
      local has_else_3f = ((#ast > 3) and ((#ast % 2) == 0))
      local else_branch = (has_else_3f and compile_body(#ast))
      local s = compiler.gensym(scope)
      local buffer = {}
      local last_buffer = buffer


@@ 3048,7 3599,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        compiler.emit(last_buffer, cond_line, ast)
        compiler.emit(last_buffer, branch.chunk, ast)
        if (i == #branches) then
          if has_else then
          if has_else_3f then
            compiler.emit(last_buffer, "else", ast)
            compiler.emit(last_buffer, else_branch.chunk, ast)
          elseif (inner_target and (cond_line ~= "else")) then


@@ 3071,13 3622,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        compiler.emit(parent, "end", ast)
        return utils.expr(("%s(%s)"):format(tostring(s), iifeargs), "statement")
      elseif (wrapper == "none") then
        for i = 1, #buffer, 1 do
        for i = 1, #buffer do
          compiler.emit(parent, buffer[i], ast)
        end
        return {returned = true}
      else
        compiler.emit(parent, ("local %s"):format(inner_target), ast)
        for i = 1, #buffer, 1 do
        for i = 1, #buffer do
          compiler.emit(parent, buffer[i], ast)
        end
        return target_exprs


@@ 3107,7 3658,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local chunk = {}
      compiler.emit(parent, ("for %s in %s do"):format(table.concat(bind_vars, ", "), table.concat(val_names, ", ")), ast)
      for raw, args in utils.stablepairs(destructures) do
        compiler.destructure(args, raw, ast, sub_scope, chunk, {declaration = true, nomulti = true})
        compiler.destructure(args, raw, ast, sub_scope, chunk, {declaration = true, nomulti = true, symtype = "each"})
      end
      compiler["apply-manglings"](sub_scope, new_manglings, ast)
      compile_do(ast, sub_scope, chunk, 3)


@@ 3121,8 3672,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local len2 = #parent
      local sub_chunk = {}
      if (len1 ~= len2) then
        for i = (len1 + 1), len2, 1 do
          sub_chunk[(#sub_chunk + 1)] = parent[i]
        for i = (len1 + 1), len2 do
          table.insert(sub_chunk, parent[i])
          parent[i] = nil
        end
        compiler.emit(parent, "while true do", ast)


@@ 3144,7 3695,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local chunk = {}
      compiler.assert(utils["sym?"](binding_sym), ("unable to bind %s %s"):format(type(binding_sym), tostring(binding_sym)), ast[2])
      compiler.assert((#ast >= 3), "expected body expression", ast[1])
      for i = 1, math.min(#ranges, 3), 1 do
      for i = 1, math.min(#ranges, 3) do
        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)


@@ 3154,7 3705,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    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).")
    local function native_method_call(ast, scope, parent, target, args)
    local function native_method_call(ast, _scope, _parent, target, args)
      local _0_ = ast
      local _ = _0_[1]
      local _0 = _0_[2]


@@ 3169,13 3720,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local function nonnative_method_call(ast, scope, parent, target, args)
      local method_string = tostring(compiler.compile1(ast[3], scope, parent, {nval = 1})[1])
      table.insert(args, tostring(target))
      return utils.expr(string.format("%s[%s](%s)", tostring(target), method_string, tostring(target), table.concat(args, ", ")), "statement")
      local args0 = {tostring(target), unpack(args)}
      return utils.expr(string.format("%s[%s](%s)", tostring(target), method_string, table.concat(args0, ", ")), "statement")
    end
    local function double_eval_protected_method_call(ast, scope, parent, target, args)
      local method_string = tostring(compiler.compile1(ast[3], scope, parent, {nval = 1})[1])
      local call = "(function(tgt, m, ...) return tgt[m](tgt, ...) end)(%s, %s)"
      table.insert(args, method_string)
      table.insert(args, 1, method_string)
      return utils.expr(string.format(call, tostring(target), table.concat(args, ", ")), "statement")
    end
    local function method_call(ast, scope, parent)


@@ 3206,8 3757,12 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    doc_special(":", {"tbl", "method-name", "..."}, "Call the named method on tbl with the provided args.\nMethod name doesn't have to be known at compile-time; if it is, use\n(tbl:method-name ...) instead.")
    SPECIALS.comment = function(ast, _, parent)
      local els = {}
      for i = 2, #ast, 1 do
        els[(#els + 1)] = tostring(ast[i]):gsub("\n", " ")
      for i = 2, #ast do
        local function _1_()
          local _0_0 = tostring(ast[i]):gsub("\n", " ")
          return _0_0
        end
        table.insert(els, _1_())
      end
      return compiler.emit(parent, ("-- " .. table.concat(els, " ")), ast)
    end


@@ 3279,10 3834,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            return utils.expr(zero_arity, "literal")
          else
            local operands = {}
            for i = 2, len, 1 do
            for i = 2, len do
              local subexprs = nil
              local _1_
              if (i == 1) then
              if (i ~= len) then
                _1_ = 1
              else
              _1_ = nil


@@ 3403,7 3958,32 @@ 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 function make_compiler_env(ast, scope, parent)
    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 function compiler_env_warn(_, key)
      local v = _G[key]
      if (v and io and io.stderr and not already_warned_3f[key]) then
        already_warned_3f[key] = true
        do end (io.stderr):write(compile_env_warning:format("use global", key))
      end
      return v
    end
    local function safe_getmetatable(tbl)
      local mt = getmetatable(tbl)
      assert((mt ~= getmetatable("")), "Illegal metatable access!")
      return mt
    end
    local safe_require = nil
    local function safe_compiler_env(strict_3f)
      local _1_
      if strict_3f then
        _1_ = compiler_env_warn
      else
      _1_ = nil
      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 make_compiler_env(ast, scope, parent, strict_3f)
      local function _1_()
        return compiler.scopes.macro
      end


@@ 3411,14 3991,30 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        compiler.assert(compiler.scopes.macro, "must call from macro", ast)
        return compiler.scopes.macro.manglings[tostring(symbol)]
      end
      local function _3_()
        return utils.sym(compiler.gensym((compiler.scopes.macro or scope)))
      local function _3_(base)
        return utils.sym(compiler.gensym((compiler.scopes.macro or scope), base))
      end
      local function _4_(form)
        compiler.assert(compiler.scopes.macro, "must call from macro", ast)
        return compiler.macroexpand(form, compiler.scopes.macro)
      end
      return setmetatable({["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(), fennel = utils["fennel-module"], gensym = _3_, list = utils.list, macroexpand = _4_, sequence = utils.sequence, sym = utils.sym, unpack = unpack}, {__index = (_ENV or _G)})
      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_})
    end
    local cfg = string.gmatch(package.config, "([^\n]+)")
    local dirsep, pathsep, pathmark = (cfg() or "/"), (cfg() or ";"), (cfg() or "?")


@@ 3451,17 4047,19 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return find_in_path(1)
    end
    local function make_searcher(options)
      local opts = utils.copy(utils.root.options)
      for k, v in pairs((options or {})) do
        opts[k] = v
      end
      local function _1_(module_name)
        local filename = search_module(module_name)
        if filename then
          local function _2_(mod_name)
            return utils["fennel-module"].dofile(filename, opts, mod_name)
        local opts = utils.copy(utils.root.options)
        for k, v in pairs((options or {})) do
          opts[k] = v
        end
        opts["module-name"] = module_name
        local _2_0 = search_module(module_name)
        if (nil ~= _2_0) then
          local filename = _2_0
          local function _3_(...)
            return utils["fennel-module"].dofile(filename, opts, ...)
          end
          return _2_
          return _3_, filename
        end
      end
      return _1_


@@ 3473,6 4071,29 @@ 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)
    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}
      end
    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
      end
      return (macro_loaded[modname] or metadata_only_fennel(modname) or _2_())
    end
    safe_require = _1_
    local function add_macros(macros_2a, ast, scope)
      compiler.assert(utils["table?"](macros_2a), "expected macros to be table", ast)
      for k, v in pairs(macros_2a) do


@@ 3481,23 4102,20 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return nil
    end
    local function load_macros(modname, ast, scope, parent)
      local filename = compiler.assert(search_module(modname), (modname .. " module not found."), ast)
      local env = make_compiler_env(ast, scope, parent)
      local globals = macro_globals(env, current_global_names())
      return utils["fennel-module"].dofile(filename, {allowedGlobals = globals, env = env, scope = compiler.scopes.compiler, useMetadata = utils.root.options.useMetadata})
    end
    local macro_loaded = {}
    SPECIALS["require-macros"] = function(ast, scope, parent)
      compiler.assert((#ast == 2), "Expected one module name argument", ast)
      local modname = ast[2]
    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)
      compiler.assert((type(modname) == "string"), "module name must compile to string", (real_ast or ast))
      if not macro_loaded[modname] then
        macro_loaded[modname] = load_macros(modname, ast, scope, parent)
        local env = make_compiler_env(ast, scope, parent)
        macro_loaded[modname] = compiler_env_domodule(modname, env, ast)
      end
      return add_macros(macro_loaded[modname], ast, scope, parent)
    end
    doc_special("require-macros", {"macro-module-name"}, "Load given module and use its contents as macro definitions in current scope.\nMacro module should return a table of macro functions with string keys.\nConsider using import-macros instead as it is more flexible.")
    local function emit_fennel(src, path, opts, sub_chunk)
    local function emit_included_fennel(src, path, opts, sub_chunk)
      local subscope = compiler["make-scope"](utils.root.scope.parent)
      local forms = {}
      if utils.root.options.requireAsInclude then


@@ 3509,7 4127,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      for i = 1, #forms do
        local subopts = nil
        if (i == #forms) then
          subopts = {nval = 1, tail = true}
          subopts = {tail = true}
        else
          subopts = {nval = 0}
        end


@@ 3531,10 4149,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            return error(..., 0)
          end
        end
        local function _1_()
        local function _2_()
          return f:read("*all"):gsub("[\13\n]*$", "")
        end
        src = close_handlers_0_(xpcall(_1_, (package.loaded.fennel or debug).traceback))
        src = close_handlers_0_(xpcall(_2_, (package.loaded.fennel or debug).traceback))
      end
      local ret = utils.expr(("require(\"" .. mod .. "\")"), "statement")
      local target = ("package.preload[%q]"):format(mod)


@@ 3547,7 4165,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        table.insert(utils.root.chunk, i, v)
      end
      if fennel_3f then
        emit_fennel(src, path, opts, sub_chunk)
        emit_included_fennel(src, path, opts, sub_chunk)
      else
        compiler.emit(sub_chunk, src, ast)
      end


@@ 3571,13 4189,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
      else
        local mod = load_code(("return " .. modexpr[1]))()
        local function _2_()
          local _1_0 = search_module(mod)
          if (nil ~= _1_0) then
            local fennel_path = _1_0
        local function _3_()
          local _2_0 = search_module(mod)
          if (nil ~= _2_0) then
            local fennel_path = _2_0
            return include_path(ast, opts, fennel_path, mod, true)
          else
            local _ = _1_0
            local _ = _2_0
            local lua_path = search_module(mod, package.path)
            if lua_path then
              return include_path(ast, opts, lua_path, mod, false)


@@ 3588,15 4206,16 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            end
          end
        end
        return (include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _2_())
        return (include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _3_())
      end
    end
    doc_special("include", {"module-name-literal"}, "Like require but load the target module during compilation and embed it in the\nLua output. The module must be a string literal and resolvable at compile time.")
    local function eval_compiler_2a(ast, scope, parent)
      local scope0 = compiler["make-scope"](compiler.scopes.compiler)
      local luasrc = compiler.compile(ast, {scope = scope0, useMetadata = utils.root.options.useMetadata})
      local loader = load_code(luasrc, wrap_env(make_compiler_env(ast, scope0, parent)))
      return loader()
      local env = make_compiler_env(ast, scope, parent)
      local opts = utils.copy(utils.root.options)
      opts.scope = compiler["make-scope"](compiler.scopes.compiler)
      opts.allowedGlobals = macro_globals(env, current_global_names())
      return load_code(compiler.compile(ast, opts), wrap_env(env))(opts["module-name"], ast.filename)
    end
    SPECIALS.macros = function(ast, scope, parent)
      compiler.assert((#ast == 2), "Expected one table argument", ast)


@@ 3617,7 4236,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local utils = require("fennel.utils")
    local parser = require("fennel.parser")
    local friend = require("fennel.friend")
    local unpack = (_G.unpack or table.unpack)
    local unpack = (table.unpack or _G.unpack)
    local scopes = {}
    local function make_scope(parent)
      local parent0 = (parent or scopes.global)


@@ 3629,6 4248,27 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      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)}
    end
    local function assert_msg(ast, msg)
      local ast_tbl = nil
      if ("table" == type(ast)) then
        ast_tbl = ast
      else
        ast_tbl = {}
      end
      local m = getmetatable(ast)
      local filename = ((m and m.filename) or ast_tbl.filename or "unknown")
      local line = ((m and m.line) or ast_tbl.line or "?")
      local target = nil
      local function _1_()
        if utils["sym?"](ast_tbl[1]) then
          return utils.deref(ast_tbl[1])
        else
          return (ast_tbl[1] or "()")
        end
      end
      target = tostring(_1_())
      return string.format("Compile error in '%s' %s:%s: %s", target, filename, line, msg)
    end
    local function assert_compile(condition, msg, ast)
      if not condition then
        local _0_ = (utils.root.options or {})


@@ 3636,19 4276,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        local unfriendly = _0_["unfriendly"]
        utils.root.reset()
        if unfriendly then
          local m = getmetatable(ast)
          local filename = ((m and m.filename) or ast.filename or "unknown")
          local line = ((m and m.line) or ast.line or "?")
          local target = nil
          local function _1_()
            if utils["sym?"](ast[1]) then
              return utils.deref(ast[1])
            else
              return (ast[1] or "()")
            end
          end
          target = tostring(_1_())
          error(string.format("Compile error in '%s' %s:%s: %s", target, filename, line, msg), 0)
          error(assert_msg(ast, msg), 0)
        else
          friend["assert-compile"](condition, msg, ast, source)
        end


@@ 3693,12 4321,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local allowed_globals = nil
    local function global_allowed(name)
      local found_3f = not allowed_globals
      if not allowed_globals then
        return true
      else
        return utils["member?"](name, allowed_globals)
      end
      return (not allowed_globals or utils["member?"](name, allowed_globals))
    end
    local function unique_mangling(original, mangling, scope, append)
      if scope.unmanglings[mangling] then


@@ 3709,7 4332,6 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local function local_mangling(str, scope, ast, temp_manglings)
      assert_compile(not utils["multi-sym?"](str), ("unexpected multi symbol " .. str), ast)
      local append = 0
      local raw = nil
      if (utils["lua-keywords"][str] or str:match("^%d")) then
        raw = ("_" .. str)


@@ 3738,7 4360,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local function combine_parts(parts, scope)
      local ret = (scope.manglings[parts[1]] or global_mangling(parts[1]))
      for i = 2, #parts, 1 do
      for i = 2, #parts do
        if utils["valid-lua-identifier?"](parts[i]) then
          if (parts["multi-sym-method-call"] and (i == #parts)) then
            ret = (ret .. ":" .. parts[i])


@@ 3757,7 4379,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        mangling = ((base or "") .. "_" .. append .. "_")
        append = (append + 1)
      end
      scope.unmanglings[mangling] = true
      scope.unmanglings[mangling] = (base or true)
      return mangling
    end
    local function autogensym(base, scope)


@@ 3776,8 4398,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return (scope.autogensyms[base] or _1_())
      end
    end
    local already_warned = {}
    local function check_binding_valid(symbol, scope, ast)
      local name = utils.deref(symbol)
      if (io and io.stderr and name:find("&") and not already_warned[symbol]) then
        already_warned[symbol] = true
        do end (io.stderr):write(("-- Warning: & will not be allowed in identifier names in " .. "future versions: " .. (symbol.filename or "unknown") .. ":" .. (symbol.line or "?") .. "\n"))
      end
      assert_compile(not (scope.specials[name] or scope.macros[name]), ("local %s was overshadowed by a special form or macro"):format(name), ast)
      return assert_compile(not utils["quoted?"](symbol), string.format("macro tried to bind %s without gensym", name), symbol)
    end


@@ 3801,6 4428,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
    end
    local function symbol_to_expression(symbol, scope, reference_3f)
      utils.hook("symbol-to-expression", symbol, scope, reference_3f)
      local name = symbol[1]
      local multi_sym_parts = utils["multi-sym?"](name)
      local name0 = (hashfn_arg_name(name, multi_sym_parts, scope) or name)


@@ 3810,7 4438,7 @@ 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: " .. parts[1]), symbol)
      assert_compile((not reference_3f or local_3f or global_allowed(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


@@ 3829,10 4457,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      elseif ((#chunk >= 3) and (chunk[(#chunk - 2)].leaf == "do") and not chunk[(#chunk - 1)].leaf and (chunk[#chunk].leaf == "end")) then
        local kid = peephole(chunk[(#chunk - 1)])
        local new_chunk = {ast = chunk.ast}
        for i = 1, (#chunk - 3), 1 do
        for i = 1, (#chunk - 3) do
          table.insert(new_chunk, peephole(chunk[i]))
        end
        for i = 1, #kid, 1 do
        for i = 1, #kid do
          table.insert(new_chunk, kid[i])
        end
        return new_chunk


@@ 3840,6 4468,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return utils.map(chunk, peephole)
      end
    end
    local function ast_source(ast)
      local m = getmetatable(ast)
      return ((m and m.line and m) or (("table" == type(ast)) and ast) or {})
    end
    local function flatten_chunk_correlated(main_chunk)
      local function flatten(chunk, out, last_line, file)
        local last_line0 = last_line


@@ 3848,8 4480,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        else
          for _, subchunk in ipairs(chunk) do
            if (subchunk.leaf or (#subchunk > 0)) then
              if (subchunk.ast and (file == subchunk.ast.file)) then
                last_line0 = math.max(last_line0, (subchunk.ast.line or 0))
              local source = ast_source(subchunk.ast)
              if (file == source.file) then
                last_line0 = math.max(last_line0, (source.line or 0))
              end
              last_line0 = flatten(subchunk, out, last_line0, file)
            end


@@ 3871,7 4504,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        local code = chunk.leaf
        local info = chunk.ast
        if sm then
          sm[(#sm + 1)] = ((info and info.line) or ( - 1))
          table.insert(sm, {(info and info.filename), (info and info.line)})
        end
        return code
      else


@@ 3920,7 4553,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        local sm = {}
        local ret = flatten_chunk(sm, chunk0, options.indent, 0)
        if sm then
          sm.short_src = (options.filename or ret)
          sm.short_src = (options.filename or make_short_src((options.source or ret)))
          if options.filename then
            sm.key = ("@" .. options.filename)
          else


@@ 3961,7 4594,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local function keep_side_effects(exprs, chunk, start, ast)
      local start0 = (start or 1)
      for j = start0, #exprs, 1 do
      for j = start0, #exprs do
        local se = exprs[j]
        if ((se.type == "expression") and (se[1] ~= "nil")) then
          emit(chunk, string.format("do local _ = %s end", tostring(se)), ast)


@@ 3979,11 4612,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        if (n ~= len) then
          if (len > n) then
            keep_side_effects(exprs, parent, (n + 1), ast)
            for i = (n + 1), len, 1 do
            for i = (n + 1), len do
              exprs[i] = nil
            end
          else
            for i = (#exprs + 1), n, 1 do
            for i = (#exprs + 1), n do
              exprs[i] = utils.expr("nil", "literal")
            end
          end


@@ 4073,7 4706,33 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        return exprs2
      end
    end
    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)
      for i = 2, len do
        local subexprs = nil
        local _0_
        if (i ~= len) then
          _0_ = 1
        else
        _0_ = nil
        end
        subexprs = compile1(ast[i], scope, parent, {nval = _0_})
        table.insert(fargs, (subexprs[1] or utils.expr("nil", "literal")))
        if (i == len) then
          for j = 2, #subexprs do
            table.insert(fargs, subexprs[j])
          end
        else
          keep_side_effects(subexprs, parent, 2, ast[i])
        end
      end
      local call = string.format("%s(%s)", 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)
      utils.hook("call", ast, scope)
      local len = #ast
      local first = ast[1]
      local multi_sym_parts = utils["multi-sym?"](first)


@@ 4084,28 4743,10 @@ 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)
        for i = 2, len, 1 do
          new_ast[(#new_ast + 1)] = ast[i]
        end
        local new_ast = utils.list(utils.sym(":", scope), utils.sym(table_with_method, scope), method_to_call, select(2, unpack(ast)))
        return compile1(new_ast, scope, parent, opts)
      else
        local fargs = {}
        local fcallee = compile1(ast[1], scope, parent, {nval = 1})[1]
        assert_compile((fcallee.type ~= "literal"), ("cannot call literal value " .. tostring(first)), ast)
        for i = 2, len, 1 do
          local subexprs = compile1(ast[i], scope, parent, {nval = (((i ~= len) and 1) or nil)})
          fargs[(#fargs + 1)] = (subexprs[1] or utils.expr("nil", "literal"))
          if (i == len) then
            for j = 2, #subexprs, 1 do
              fargs[(#fargs + 1)] = subexprs[j]
            end
          else
            keep_side_effects(subexprs, parent, 2, ast[i])
          end
        end
        local call = string.format("%s(%s)", tostring(fcallee), exprs1(fargs))
        return handle_compile_opts({utils.expr(call, "statement")}, parent, opts, ast)
        return compile_function_call(ast, scope, parent, opts, compile1, len)
      end
    end
    local function compile_varg(ast, scope, parent, opts)


@@ 4123,7 4764,11 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return handle_compile_opts({e}, parent, opts, ast)
    end
    local function compile_scalar(ast, scope, parent, opts)
    local function serialize_number(n)
      local _0_0 = string.gsub(tostring(n), ",", ".")
      return _0_0
    end
    local function compile_scalar(ast, _scope, parent, opts)
      local serialize = nil
      do
        local _0_0 = type(ast)


@@ 4134,10 4779,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        elseif (_0_0 == "string") then
          serialize = serialize_string
        elseif (_0_0 == "number") then
          local function _1_(...)
            return string.format("%.17g", ...)
          end
          serialize = _1_
          serialize = serialize_number
        else
        serialize = nil
        end


@@ 4146,9 4788,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    local function compile_table(ast, scope, parent, opts, compile1)
      local buffer = {}
      for i = 1, #ast, 1 do
      for i = 1, #ast do
        local nval = ((i ~= #ast) and 1)
        buffer[(#buffer + 1)] = exprs1(compile1(ast[i], scope, parent, {nval = nval}))
        table.insert(buffer, exprs1(compile1(ast[i], scope, parent, {nval = nval})))
      end
      local function write_other_values(k)
        if ((type(k) ~= "number") or (math.floor(k) ~= k) or (k < 1) or (k > #ast)) then


@@ 4206,6 4848,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local isvar = _0_["isvar"]
      local nomulti = _0_["nomulti"]
      local noundef = _0_["noundef"]
      local symtype = _0_["symtype"]
      local symtype0 = ("_" .. (symtype or "dst"))
      local setter = nil
      if declaration then
        setter = "local %s = %s"


@@ 4217,7 4861,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        local raw = symbol[1]
        assert_compile(not (nomulti and utils["multi-sym?"](raw)), ("unexpected multi symbol " .. raw), up1)
        if declaration then
          return declare_local(symbol, {var = isvar}, scope, symbol, new_manglings)
          return declare_local(symbol, nil, scope, symbol, new_manglings)
        else
          local parts = (utils["multi-sym?"](raw) or {raw})
          local meta = scope.symmeta[parts[1]]


@@ 4265,76 4909,106 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        return ret
      end
      local function destructure1(left, rightexprs, up1, top)
        if (utils["sym?"](left) and (left[1] ~= "nil")) then
          local lname = getname(left, up1)
          check_binding_valid(left, scope, left)
          if top then
            compile_top_target({lname})
          else
            emit(parent, setter:format(lname, exprs1(rightexprs)), left)
          end
        elseif utils["table?"](left) then
          local s = gensym(scope)
          local right = nil
          if top then
            right = exprs1(compile1(from, scope, parent))
      local function destructure_sym(left, rightexprs, up1, top_3f)
        local lname = getname(left, up1)
        check_binding_valid(left, scope, left)
        if top_3f then
          compile_top_target({lname})
        else
          emit(parent, setter:format(lname, exprs1(rightexprs)), left)
        end
        if declaration then
          scope.symmeta[utils.deref(left)] = {var = isvar}
          return nil
        end
      end
      local function destructure_table(left, rightexprs, top_3f, destructure1)
        local s = gensym(scope, symtype0)
        local right = nil
        do
          local _2_0 = nil
          if top_3f then
            _2_0 = exprs1(compile1(from, scope, parent))
          else
            right = exprs1(rightexprs)
            _2_0 = exprs1(rightexprs)
          end
          if (right == "") then
          if (_2_0 == "") then
            right = "nil"
          elseif (nil ~= _2_0) then
            local right0 = _2_0
            right = right0
          else
          right = nil
          end
          emit(parent, string.format("local %s = %s", s, right), left)
          for k, v in utils.stablepairs(left) do
            if (utils["sym?"](left[k]) and (left[k][1] == "&")) then
              assert_compile(((type(k) == "number") and not left[(k + 2)]), "expected rest argument before last parameter", left)
        end
        emit(parent, string.format("local %s = %s", s, right), left)
        for k, v in utils.stablepairs(left) do
          if not (("number" == type(k)) and tostring(left[(k - 1)]):find("^&")) then
            if (utils["sym?"](v) and (utils.deref(v) == "&")) then
              local unpack_str = "{(table.unpack or unpack)(%s, %s)}"
              local formatted = string.format(unpack_str, s, k)
              local subexpr = utils.expr(formatted, "expression")
              assert_compile((utils["sequence?"](left) and (nil == left[(k + 2)])), "expected rest argument before last parameter", left)
              destructure1(left[(k + 1)], {subexpr}, left)
              return
            elseif (utils["sym?"](k) and (utils.deref(k) == "&as")) then
              destructure_sym(v, {utils.expr(tostring(s))}, left)
            elseif (utils["sequence?"](left) and (utils.deref(v) == "&as")) then
              local _, next_sym, trailing = select(k, unpack(left))
              assert_compile((nil == trailing), "expected &as argument before last parameter", left)
              destructure_sym(next_sym, {utils.expr(tostring(s))}, left)
            else
              if (utils["sym?"](k) and (tostring(k) == ":") and utils["sym?"](v)) then
                k = tostring(v)
              end
              if (type(k) ~= "number") then
                k = serialize_string(k)
              local key = nil
              if (type(k) == "string") then
                key = serialize_string(k)
              else
                key = k
              end
              local subexpr = utils.expr(string.format("%s[%s]", s, k), "expression")
              local subexpr = utils.expr(string.format("%s[%s]", s, key), "expression")
              destructure1(v, {subexpr}, left)
            end
          end
        elseif utils["list?"](left) then
          local left_names, tables = {}, {}
          for i, name in ipairs(left) do
            local symname = nil
            if utils["sym?"](name) then
              symname = getname(name, up1)
            else
              symname = gensym(scope)
              tables[i] = {name, utils.expr(symname, "sym")}
            end
            table.insert(left_names, symname)
          end
          if top then
            compile_top_target(left_names)
        end
        return nil
      end
      local function destructure_values(left, up1, top_3f, destructure1)
        local left_names, tables = {}, {}
        for i, name in ipairs(left) do
          if utils["sym?"](name) then
            table.insert(left_names, getname(name, up1))
          else
            local lvalue = table.concat(left_names, ", ")
            local setting = setter:format(lvalue, exprs1(rightexprs))
            emit(parent, setting, left)
            local symname = gensym(scope, symtype0)
            table.insert(left_names, symname)
            tables[i] = {name, utils.expr(symname, "sym")}
          end
          for _, pair in utils.stablepairs(tables) do
            destructure1(pair[1], {pair[2]}, left)
        end
        assert_compile(top_3f, "can't nest multi-value destructuring", left)
        compile_top_target(left_names)
        if declaration then
          for _, sym in ipairs(left) do
            scope.symmeta[utils.deref(sym)] = {var = isvar}
          end
        end
        for _, pair in utils.stablepairs(tables) do
          destructure1(pair[1], {pair[2]}, left)
        end
        return nil
      end
      local function destructure1(left, rightexprs, up1, top_3f)
        if (utils["sym?"](left) and (left[1] ~= "nil")) then
          destructure_sym(left, rightexprs, up1, top_3f)
        elseif utils["table?"](left) then
          destructure_table(left, rightexprs, top_3f, destructure1)
        elseif utils["list?"](left) then
          destructure_values(left, up1, top_3f, destructure1)
        else
          assert_compile(false, string.format("unable to bind %s %s", type(left), tostring(left)), (((type(up1[2]) == "table") and up1[2]) or up1))
        end
        if top then
        if top_3f then
          return {returned = true}
        end
      end
      local ret = destructure1(to, nil, ast, true)
      utils.hook("destructure", from, to, scope)
      apply_manglings(scope, new_manglings, ast)
      return ret
    end


@@ 4360,10 5034,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        scope.specials.require = require_include
      end
      utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts
      for ok, val in parser.parser(strm, opts.filename, opts) do
        vals[(#vals + 1)] = val
      for _, val in parser.parser(strm, opts.filename, opts) do
        table.insert(vals, val)
      end
      for i = 1, #vals, 1 do
      for i = 1, #vals do
        local exprs = compile1(vals[i], scope, chunk, {nval = (((i < #vals) and 0) or nil), tail = (i == #vals)})
        keep_side_effects(exprs, chunk, nil, vals[i])
      end


@@ 4403,8 5077,12 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      else
        local remap = fennel_sourcemap[info.source]
        if (remap and remap[info.currentline]) then
          info["short-src"] = remap["short-src"]
          info.currentline = remap[info.currentline]
          if remap[info.currentline][1] then
            info.short_src = fennel_sourcemap[("@" .. remap[info.currentline][1])].short_src
          else
            info.short_src = remap.short_src
          end
          info.currentline = (remap[info.currentline][2] or -1)
        end
        if (info.what == "Lua") then
          local function _1_()


@@ 4415,7 5093,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            end
          end
          return string.format("  %s:%d: in function %s", info.short_src, info.currentline, _1_())
        elseif (info["short-src"] == "(tail call)") then
        elseif (info.short_src == "(tail call)") then
          return "  (tail call)"
        else
          return string.format("  %s:%d: in main chunk", info.short_src, info.currentline)


@@ 4515,6 5193,22 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        assert_compile(not runtime_3f, "lists may only be used at compile time", form)
        return string.format(("setmetatable({filename=%s, line=%s, bytestart=%s, %s}" .. ", getmetatable(list()))"), filename, (form.line or "nil"), (form.bytestart or "nil"), mixed_concat(mapped, ", "))
      elseif utils["sequence?"](form) then
        local mapped = utils.kvmap(form, entry_transform(q, q))
        local source = getmetatable(form)
        local filename = nil
        if source.filename then
          filename = string.format("%q", source.filename)
        else
          filename = "nil"
        end
        local _1_
        if source then
          _1_ = source.line
        else
          _1_ = "nil"
        end
        return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _1_, "(getmetatable(sequence()))['sequence']")
      elseif (type(form) == "table") then
        local mapped = utils.kvmap(form, entry_transform(q, q))
        local source = getmetatable(form)


@@ 4543,14 5237,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
  package.preload["fennel.friend"] = package.preload["fennel.friend"] or function(...)
    local function ast_source(ast)
      local m = getmetatable(ast)
      if (m and m.line and m) then
        return m
      else
        return ast
      end
      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 not to return a coroutine or userdata"}, ["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 unpack = (_G.unpack or table.unpack)
    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 unpack = (table.unpack or _G.unpack)
    local function suggest(msg)
      local suggestion = nil
      for pat, sug in pairs(suggestions) do


@@ 4581,21 5271,19 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      f:close()
      return codeline, bytes
    end
    local function read_line_from_source(source, line)
      local lines, bytes, codeline = 0, 0
      for this_line, newline in string.gmatch((source .. "\n"), "(.-)(\13?\n)") do
        lines = (lines + 1)
        if (lines == line) then
          codeline = this_line
          break
        end
        bytes = (bytes + #newline + #this_line)
    local function read_line_from_string(matcher, target_line, _3fcurrent_line, _3fbytes)
      local this_line, newline = matcher()
      local current_line = (_3fcurrent_line or 1)
      local bytes = ((_3fbytes or 0) + #this_line + #newline)
      if (target_line == current_line) then
        return this_line, bytes
      elseif this_line then
        return read_line_from_string(matcher, target_line, (current_line + 1), bytes)
      end
      return codeline, bytes
    end
    local function read_line(filename, line, source)
      if source then
        return read_line_from_source(source, line)
        return read_line_from_string(string.gmatch((source .. "\n"), "(.-)(\13?\n)"), line)
      else
        return read_line_from_file(filename, line)
      end


@@ 4606,7 5294,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local bytestart = _1_["bytestart"]
      local filename = _1_["filename"]
      local line = _1_["line"]
      local ok, codeline, bol, eol = pcall(read_line, filename, line, source)
      local ok, codeline, bol = pcall(read_line, filename, line, source)
      local suggestions0 = suggest(msg)
      local out = {msg, ""}
      if (ok and codeline) then


@@ 4643,7 5331,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
  package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(...)
    local utils = require("fennel.utils")
    local friend = require("fennel.friend")
    local unpack = (_G.unpack or table.unpack)
    local unpack = (table.unpack or _G.unpack)
    local function granulate(getchunk)
      local c, index, done_3f = "", 1, false
      local function _0_(parser_state)


@@ 4653,13 5341,22 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            index = (index + 1)
            return b
          else
            c = getchunk(parser_state)
            if (not c or (c == "")) then
            local _1_0, _2_0, _3_0 = getchunk(parser_state)
            local _4_
            do
              local char = _1_0
              _4_ = ((nil ~= _1_0) and (char ~= ""))
            end
            if _4_ then
              local char = _1_0
              c = char
              index = 2
              return c:byte()
            else
              local _ = _1_0
              done_3f = true
              return nil
            end
            index = 2
            return c:byte(1)
          end
        end
      end


@@ 4670,7 5367,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      return _0_, _1_
    end
    local function string_stream(str)
      local str0 = str:gsub("^#![^\n]*\n", "")
      local str0 = str:gsub("^#!", ";;")
      local index = 1
      local function _0_()
        local r = str0:byte(index)


@@ 4683,8 5380,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function whitespace_3f(b)
      return ((b == 32) or ((b >= 9) and (b <= 13)))
    end
    local function symbolchar_3f(b)
      return ((b > 32) and not delims[b] and (b ~= 127) and (b ~= 34) and (b ~= 39) and (b ~= 126) and (b ~= 59) and (b ~= 44) and (b ~= 64) and (b ~= 96))
    local function sym_char_3f(b)
      local b0 = nil
      if ("number" == type(b)) then
        b0 = b
      else
        b0 = string.byte(b)
      end
      return ((b0 > 32) and not delims[b0] and (b0 ~= 127) and (b0 ~= 34) and (b0 ~= 39) and (b0 ~= 126) and (b0 ~= 59) and (b0 ~= 44) and (b0 ~= 64) and (b0 ~= 96))
    end
    local prefixes = {[35] = "hashfn", [39] = "quote", [44] = "unquote", [96] = "quote"}
    local function parser(getbyte, filename, options)


@@ 4713,198 5416,288 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        end
        return r
      end
      local function parse_error(msg)
        local _0_ = (utils.root.options or {})
      assert(((nil == filename) or ("string" == type(filename))), "expected filename as second argument to parser")
      local function parse_error(msg, byteindex_override)
        local _0_ = (options or utils.root.options or {})
        local source = _0_["source"]
        local unfriendly = _0_["unfriendly"]
        utils.root.reset()
        if unfriendly then
          return error(string.format("Parse error in %s:%s: %s", (filename or "unknown"), (line or "?"), msg), 0)
        else
          return friend["parse-error"](msg, (filename or "unknown"), (line or "?"), byteindex, source)
          return friend["parse-error"](msg, (filename or "unknown"), (line or "?"), (byteindex_override or byteindex), source)
        end
      end
      local function parse_stream()
        local whitespace_since_dispatch, done_3f, retval = true
        local function dispatch(v)
          if (#stack == 0) then
          local _0_0 = stack[#stack]
          if (_0_0 == nil) then
            retval, done_3f, whitespace_since_dispatch = v, true, false
            return nil
          elseif stack[#stack].prefix then
            local stacktop = stack[#stack]
            stack[#stack] = nil
            return dispatch(utils.list(utils.sym(stacktop.prefix), v))
          else
          elseif ((type(_0_0) == "table") and (nil ~= _0_0.prefix)) then
            local prefix = _0_0.prefix
            local source = nil
            do
              local _1_0 = table.remove(stack)
              _1_0["byteend"] = byteindex
              source = _1_0
            end
            local list = utils.list(utils.sym(prefix, source), v)
            for k, v0 in pairs(source) do
              list[k] = v0
            end
            return dispatch(list)
          elseif (nil ~= _0_0) then
            local top = _0_0
            whitespace_since_dispatch = false
            return table.insert(stack[#stack], v)
            return table.insert(top, v)
          end
        end
        local function badend()
          local accum = utils.map(stack, "closer")
          return parse_error(string.format("expected closing delimiter%s %s", (((#stack == 1) and "") or "s"), string.char(unpack(accum))))
        end
        while true do
          local b = nil
          while true do
            b = getb()
            if (b and whitespace_3f(b)) then
              whitespace_since_dispatch = true
            end
            if (not b or not whitespace_3f(b)) then
              break
            end
          local _0_
          if (#stack == 1) then
            _0_ = ""
          else
            _0_ = "s"
          end
          if not b then
            if (#stack > 0) then
              badend()
            end
            return nil
          return parse_error(string.format("expected closing delimiter%s %s", _0_, string.char(unpack(accum))))
        end
        local function skip_whitespace(b)
          if (b and whitespace_3f(b)) then
            whitespace_since_dispatch = true
            return skip_whitespace(getb())
          elseif (not b and (#stack > 0)) then
            return badend()
          else
            return b
          end
          if (b == 59) then
            while true do
              b = getb()
              if (not b or (b == 10)) then
                break
              end
            end
          elseif (type(delims[b]) == "number") then
            if not whitespace_since_dispatch then
              parse_error(("expected whitespace before opening delimiter " .. string.char(b)))
            end
            table.insert(stack, setmetatable({bytestart = byteindex, closer = delims[b], filename = filename, line = line}, getmetatable(utils.list())))
          elseif delims[b] then
            local last = stack[#stack]
            if (#stack == 0) then
              parse_error(("unexpected closing delimiter " .. string.char(b)))
            end
            local val = nil
            if (last.closer ~= b) then
              parse_error(("mismatched closing delimiter " .. string.char(b) .. ", expected " .. string.char(last.closer)))
        end
        local function parse_comment(b, contents)
          if (b and (10 ~= b)) then
            local function _1_()
              local _0_0 = contents
              table.insert(_0_0, string.char(b))
              return _0_0
            end
            last.byteend = byteindex
            if (b == 41) then
              val = last
            elseif (b == 93) then
              val = utils.sequence(unpack(last))
              for k, v in pairs(last) do
                getmetatable(val)[k] = v
              end
            return parse_comment(getb(), _1_())
          elseif (options and options.comments) then
            return dispatch(utils.comment(table.concat(contents), {filename = filename, line = (line - 1)}))
          else
            return b
          end
        end
        local function open_table(b)
          if not whitespace_since_dispatch then
            parse_error(("expected whitespace before opening delimiter " .. string.char(b)))
          end
          return table.insert(stack, {bytestart = byteindex, closer = delims[b], filename = filename, line = line})
        end
        local function close_list(list)
          return dispatch(setmetatable(list, getmetatable(utils.list())))
        end
        local function close_sequence(tbl)
          local val = utils.sequence(unpack(tbl))
          for k, v in pairs(tbl) do
            getmetatable(val)[k] = v
          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)
          else
          _0_ = nil
          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
            else
              if ((#last % 2) ~= 0) then
                byteindex = (byteindex - 1)
                parse_error("expected even number of values in table literal")
              end
              val = {}
              setmetatable(val, last)
              for i = 1, #last, 2 do
                if ((tostring(last[i]) == ":") and utils["sym?"](last[(i + 1)]) and utils["sym?"](last[i])) then
                  last[i] = tostring(last[(i + 1)])
                end
                val[last[i]] = last[(i + 1)]
              end
            end
            stack[#stack] = nil
            dispatch(val)
          elseif (b == 34) then
            local chars = {34}
            local state = "base"
            stack[(#stack + 1)] = {closer = 34}
            while true do
              b = getb()
              chars[(#chars + 1)] = b
              if (state == "base") then
                if (b == 92) then
                  state = "backslash"
                elseif (b == 34) then
                  state = "done"
                end
              else
                state = "base"
              end
              if (not b or (state == "done")) then
                break
              end
              comments.keys[tbl[(i + 1)]] = node
            end
            if not b then
              badend()
          end
          for i = #tbl, 1, -1 do
            if utils["comment?"](tbl[i]) then
              table.remove(tbl, i)
            end
            stack[#stack] = nil
            local raw = string.char(unpack(chars))
            local formatted = nil
            local function _2_(c)
              return ("\\" .. c:byte())
          end
          return comments
        end
        local function close_curly_table(tbl)
          local comments = extract_comments(tbl)
          local keys = {}
          local val = {}
          if ((#tbl % 2) ~= 0) then
            byteindex = (byteindex - 1)
            parse_error("expected even number of values in table literal")
          end
          setmetatable(val, tbl)
          for i = 1, #tbl, 2 do
            if ((tostring(tbl[i]) == ":") and utils["sym?"](tbl[(i + 1)]) and utils["sym?"](tbl[i])) then
              tbl[i] = tostring(tbl[(i + 1)])
            end
            formatted = raw:gsub("[\1-\31]", _2_)
            local load_fn = (_G.loadstring or load)(string.format("return %s", formatted))
            dispatch(load_fn())
          elseif prefixes[b] then
            table.insert(stack, {prefix = prefixes[b]})
            local nextb = getb()
            if whitespace_3f(nextb) then
              if (b ~= 35) then
                parse_error("invalid whitespace after quoting prefix")
              end
              stack[#stack] = nil
              dispatch(utils.sym("#"))
            val[tbl[i]] = tbl[(i + 1)]
            table.insert(keys, tbl[i])
          end
          tbl.comments = comments
          tbl.keys = keys
          return dispatch(val)
        end
        local function close_table(b)
          local top = table.remove(stack)
          if (top == nil) then
            parse_error(("unexpected closing delimiter " .. string.char(b)))
          end
          if (top.closer and (top.closer ~= b)) then
            parse_error(("mismatched closing delimiter " .. string.char(b) .. ", expected " .. string.char(top.closer)))
          end
          top.byteend = byteindex
          if (b == 41) then
            return close_list(top)
          elseif (b == 93) then
            return close_sequence(top)
          else
            return close_curly_table(top)
          end
        end
        local function parse_string_loop(chars, b, state)
          table.insert(chars, b)
          local state0 = nil
          do
            local _0_0 = {state, b}
            if ((type(_0_0) == "table") and (_0_0[1] == "base") and (_0_0[2] == 92)) then
              state0 = "backslash"
            elseif ((type(_0_0) == "table") and (_0_0[1] == "base") and (_0_0[2] == 34)) then
              state0 = "done"
            else
              local _ = _0_0
              state0 = "base"
            end
            ungetb(nextb)
          elseif (symbolchar_3f(b) or (b == string.byte("~"))) then
            local chars = {}
            local bytestart = byteindex
            while true do
              chars[(#chars + 1)] = b
              b = getb()
              if (not b or not symbolchar_3f(b)) then
                break
              end
          end
          if (b and (state0 ~= "done")) then
            return parse_string_loop(chars, getb(), state0)
          else
            return b
          end
        end
        local function escape_char(c)
          return ({[10] = "\\n", [11] = "\\v", [12] = "\\f", [13] = "\\r", [7] = "\\a", [8] = "\\b", [9] = "\\t"})[c:byte()]
        end
        local function parse_string()
          table.insert(stack, {closer = 34})
          local chars = {34}
          if not parse_string_loop(chars, getb(), "base") then
            badend()
          end
          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())
        end
        local function parse_prefix(b)
          table.insert(stack, {bytestart = byteindex, filename = filename, line = line, prefix = prefixes[b]})
          local nextb = getb()
          if (whitespace_3f(nextb) or (true == delims[nextb])) then
            if (b ~= 35) then
              parse_error("invalid whitespace after quoting prefix")
            end
            table.remove(stack)
            dispatch(utils.sym("#"))
          end
          return ungetb(nextb)
        end
        local function parse_sym_loop(chars, b)
          if (b and sym_char_3f(b)) then
            table.insert(chars, b)
            return parse_sym_loop(chars, getb())
          else
            if b then
              ungetb(b)
            end
            local rawstr = string.char(unpack(chars))
            if (rawstr == "true") then
              dispatch(true)
            elseif (rawstr == "false") then
              dispatch(false)
            elseif (rawstr == "...") then
              dispatch(utils.varg())
            elseif rawstr:match("^:.+$") then
              dispatch(rawstr:sub(2))
            elseif (rawstr:match("^~") and (rawstr ~= "~=")) then
              parse_error("illegal character: ~")
            else
              local force_number = rawstr:match("^%d")
              local number_with_stripped_underscores = rawstr:gsub("_", "")
              local x = nil
              if force_number then
                x = (tonumber(number_with_stripped_underscores) or parse_error(("could not read number \"" .. rawstr .. "\"")))
              else
                x = tonumber(number_with_stripped_underscores)
                if not x then
                  if rawstr:match("%.[0-9]") then
                    byteindex = (((byteindex - #rawstr) + rawstr:find("%.[0-9]")) + 1)
                    parse_error(("can't start multisym segment " .. "with a digit: " .. rawstr))
                  elseif (rawstr:match("[%.:][%.:]") and (rawstr ~= "..") and (rawstr ~= "$...")) then
                    byteindex = ((byteindex - #rawstr) + 1 + rawstr:find("[%.:][%.:]"))
                    parse_error(("malformed multisym: " .. rawstr))
                  elseif rawstr:match(":.+[%.:]") then
                    byteindex = ((byteindex - #rawstr) + rawstr:find(":.+[%.:]"))
                    parse_error(("method must be last component " .. "of multisym: " .. rawstr))
                  else
                    x = utils.sym(rawstr, nil, {byteend = byteindex, bytestart = bytestart, filename = filename, line = line})
                  end
                end
              end
            return chars
          end
        end
        local function parse_number(rawstr)
          local number_with_stripped_underscores = (not rawstr:find("^_") and rawstr:gsub("_", ""))
          if rawstr:match("^%d") then
            dispatch((tonumber(number_with_stripped_underscores) or parse_error(("could not read number \"" .. rawstr .. "\""))))
            return true
          else
            local _0_0 = tonumber(number_with_stripped_underscores)
            if (nil ~= _0_0) then
              local x = _0_0
              dispatch(x)
              return true
            else
              local _ = _0_0
              return false
            end
          end
        end
        local function check_malformed_sym(rawstr)
          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))
          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(":.+[%.:]")))
          end
        end
        local function parse_sym(b)
          local bytestart = byteindex
          local rawstr = string.char(unpack(parse_sym_loop({b}, getb())))
          if (rawstr == "true") then
            return dispatch(true)
          elseif (rawstr == "false") then
            return dispatch(false)
          elseif (rawstr == "...") then
            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}))
          end
        end
        local function parse_loop(b)
          if not b then
          elseif (b == 59) then
            parse_comment(getb(), {";"})
          elseif (type(delims[b]) == "number") then
            open_table(b)
          elseif delims[b] then
            close_table(b)
          elseif (b == 34) then
            parse_string(b)
          elseif prefixes[b] then
            parse_prefix(b)
          elseif (sym_char_3f(b) or (b == string.byte("~"))) then
            parse_sym(b)
          else
            parse_error(("illegal character: " .. string.char(b)))
          end
          if done_3f then
            break
          if not b then
            return nil
          elseif done_3f then
            return true, retval
          else
            return parse_loop(skip_whitespace(getb()))
          end
        end
        return true, retval
        return parse_loop(skip_whitespace(getb()))
      end
      local function _0_()
        stack = {}


@@ 4912,7 5705,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      end
      return parse_stream, _0_
    end
    return {["string-stream"] = string_stream, granulate = granulate, parser = parser}
    return {["string-stream"] = string_stream, ["sym-char?"] = sym_char_3f, granulate = granulate, parser = parser}
  end
  local utils = nil
  package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(...)


@@ 4930,11 5723,19 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        succ[k] = keys[(i + 1)]
      end
      local function stablenext(tbl, idx)
        local key = nil
        if (idx == nil) then
          return keys[1], tbl[keys[1]]
          key = keys[1]
        else
          return succ[idx], tbl[succ[idx]]
          key = succ[idx]
        end
        local value = nil
        if (key == nil) then
          value = nil
        else
          value = tbl[key]
        end
        return key, value
      end
      return stablenext, t, nil
    end


@@ 4972,22 5773,24 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        f0 = _0_
      end
      for k, x in stablepairs(t) do
        local korv, v = f0(k, x)
        if (korv and not v) then
          table.insert(out0, korv)
        end
        if (korv and v) then
          out0[korv] = v
        local _1_0, _2_0 = f0(k, x)
        if ((nil ~= _1_0) and (nil ~= _2_0)) then
          local key = _1_0
          local value = _2_0
          out0[key] = value
        elseif (nil ~= _1_0) then
          local value = _1_0
          table.insert(out0, value)
        end
      end
      return out0
    end
    local function copy(from)
      local to = {}
    local function copy(from, to)
      local to0 = (to or {})
      for k, v in pairs((from or {})) do
        to[k] = v
        to0[k] = v
      end
      return to
      return to0
    end
    local function member_3f(x, tbl, n)
      local _0_0 = tbl[(n or 1)]


@@ 5032,14 5835,24 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          max = k
        end
      end
      for i = 1, max, 1 do
      for i = 1, max do
        safe[i] = (((self[i] == nil) and nil_sym) or self[i])
      end
      return ("(" .. table.concat(map(safe, (tostring2 or tostring)), " ", 1, max) .. ")")
    end
    local symbol_mt = {"SYMBOL", __fennelview = deref, __tostring = deref}
    local function comment_view(c)
      return c, true
    end
    local function sym_3d(a, b)
      return ((deref(a) == deref(b)) and (getmetatable(a) == getmetatable(b)))
    end
    local function sym_3c(a, b)
      return (a[1] < tostring(b))
    end
    local symbol_mt = {"SYMBOL", __eq = sym_3d, __fennelview = deref, __lt = sym_3c, __tostring = deref}
    local expr_mt = {"EXPR", __tostring = deref}
    local list_mt = {"LIST", __fennelview = list__3estring, __tostring = list__3estring}
    local comment_mt = {"COMMENT", __eq = sym_3d, __fennelview = comment_view, __lt = sym_3c, __tostring = deref}
    local sequence_marker = {"SEQUENCE"}
    local vararg = setmetatable({"..."}, {"VARARG", __fennelview = deref, __tostring = deref})
    local getenv = nil


@@ 5070,6 5883,12 @@ 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 filename = _1_["filename"]
      local line = _1_["line"]
      return setmetatable({contents, filename = filename, line = line}, comment_mt)
    end
    local function varg()
      return vararg
    end


@@ 5092,6 5911,9 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      local mt = ((type(x) == "table") and getmetatable(x))
      return (mt and (mt.sequence == sequence_marker) and x)
    end
    local function comment_3f(x)
      return ((type(x) == "table") and (getmetatable(x) == comment_mt) and x)
    end
    local function multi_sym_3f(str)
      if sym_3f(str) then
        return multi_sym_3f(tostring(str))


@@ 5135,7 5957,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function valid_lua_identifier_3f(str)
      return (str:match("^[%a_][%w_]*$") and not lua_keywords[str])
    end
    local propagated_options = {"allowedGlobals", "indent", "correlate", "useMetadata", "env"}
    local propagated_options = {"allowedGlobals", "indent", "correlate", "useMetadata", "env", "compiler-env", "compilerEnv"}
    local function propagate_options(options, subopts)
      for _, name in ipairs(propagated_options) do
        subopts[name] = options[name]


@@ 5146,58 5968,96 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    local function _1_()
    end
    root = {chunk = nil, options = nil, reset = _1_, scope = nil}
    root["set-reset"] = function(new_root)
    root["set-reset"] = function(_2_0)
      local _3_ = _2_0
      local chunk = _3_["chunk"]
      local options = _3_["options"]
      local reset = _3_["reset"]
      local scope = _3_["scope"]
      root.reset = function()
        root.chunk, root.scope, root.options, root.reset = new_root.chunk, new_root.scope, new_root.options, new_root.reset
        root.chunk, root.scope, root.options, root.reset = chunk, scope, options, reset
        return nil
      end
      return root.reset
    end
    return {["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, copy = copy, deref = deref, expr = expr, kvmap = kvmap, list = list, map = map, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), root = root, sequence = sequence, stablepairs = stablepairs, sym = sym, varg = varg}
    local function hook(event, ...)
      if (root.options and root.options.plugins) then
        for _, plugin in ipairs(root.options.plugins) do
          local _3_0 = plugin[event]
          if (nil ~= _3_0) then
            local f = _3_0
            f(...)
          end
        end
        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}
  end
  utils = require("fennel.utils")
  local parser = require("fennel.parser")
  local compiler = require("fennel.compiler")
  local specials = require("fennel.specials")
  local repl = require("fennel.repl")
  local function eval(str, options, ...)
  local view = require("fennel.view")
  local function eval_env(env)
    if (env == "_COMPILER") then
      local env0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
      local mt = getmetatable(env0)
      mt.__index = _G
      return specials["wrap-env"](env0)
    else
      return (env and specials["wrap-env"](env))
    end
  end
  local function eval_opts(options, str)
    local opts = utils.copy(options)
    local _ = nil
    if ((opts.allowedGlobals == nil) and not getmetatable(opts.env)) then
      opts.allowedGlobals = specials["current-global-names"](opts.env)
      _ = nil
    else
    _ = nil
    end
    local env = (opts.env and specials["wrap-env"](opts.env))
    if (not opts.filename and not opts.source) then
      opts.source = str
    end
    return opts
  end
  local function eval(str, options, ...)
    local opts = eval_opts(options, str)
    local env = eval_env(opts.env)
    local lua_source = compiler["compile-string"](str, opts)
    local loader = nil
    local function _1_(...)
    local function _0_(...)
      if opts.filename then
        return ("@" .. opts.filename)
      else
        return str
      end
    end
    loader = specials["load-code"](lua_source, env, _1_(...))
    loader = specials["load-code"](lua_source, env, _0_(...))
    opts.filename = nil
    return loader(...)
  end
  local function dofile_2a(filename, options, ...)
    local opts = utils.copy(options)
    local f = assert(io.open(filename, "rb"))
    local source = f:read("*all")
    local source = assert(f:read("*all"), ("Could not read " .. filename))
    f:close()
    opts.filename = filename
    return eval(source, opts, ...)
  end
  local mod = {["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"], ["string-stream"] = parser["string-stream"], ["sym?"] = utils["sym?"], 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"](), stringStream = parser["string-stream"], sym = utils.sym, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.5.1-dev"}
  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}
  utils["fennel-module"] = mod
  do
    local builtin_macros = [===[;; The code for these macros is somewhat idiosyncratic because it cannot use any
    local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other
    ;; modules that are loaded by the old bootstrap compiler, this runs in the
    ;; compiler scope of the version of the compiler being defined.
    
    ;; The code for these macros is somewhat idiosyncratic because it cannot use any
    ;; macros which have not yet been defined.
    
    (fn -> [val ...]
    ;; TODO: some of these macros modify their arguments; we should stop doing that,
    ;; but in a way that preserves file/line metadata.
    
    (fn ->* [val ...]
      "Thread-first macro.
    Take the first value and splice it into the second form as its first argument.
    The value of the second form is spliced into the first arg of the third, etc."


@@ 5208,7 6068,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          (set x elt)))
      x)
    
    (fn ->> [val ...]
    (fn ->>* [val ...]
      "Thread-last macro.
    Same as ->, except splices the value into the last position of each form
    rather than the first."


@@ 5219,7 6079,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          (set x elt)))
      x)
    
    (fn -?> [val ...]
    (fn -?>* [val ...]
      "Nil-safe thread-first macro.
    Same as -> except will short-circuit with nil when it encounters a nil value."
      (if (= 0 (select "#" ...))


@@ 5234,7 6094,7 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
                   (-?> ,el ,(unpack els))
                   ,tmp)))))
    
    (fn -?>> [val ...]
    (fn -?>>* [val ...]
      "Nil-safe thread-last macro.
    Same as ->> except will short-circuit with nil when it encounters a nil value."
      (if (= 0 (select "#" ...))


@@ 5249,7 6109,15 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
                   (-?>> ,el ,(unpack els))
                   ,tmp)))))
    
    (fn doto [val ...]
    (fn ?dot [tbl k ...]
      "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# ,...)))))
    
    (fn doto* [val ...]
      "Evaluates val and splices it into the first argument of subsequent forms."
      (let [name (gensym)
            form `(let [,name ,val])]


@@ 5259,13 6127,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        (table.insert form name)
        form))
    
    (fn when [condition body1 ...]
    (fn when* [condition body1 ...]
      "Evaluate body for side-effects only when condition is truthy."
      (assert body1 "expected body")
      `(if ,condition
           (do ,body1 ,...)))
    
    (fn with-open [closable-bindings ...]
    (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."


@@ 5280,13 6148,57 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        `(let ,closable-bindings ,closer
              (close-handlers# (xpcall ,bodyfn ,traceback)))))
    
    (fn partial [f ...]
    (fn collect* [iter-tbl key-value-expr ...]
      "Returns a table made by running an iterator and evaluating an expression
    that returns key-value pairs to be inserted sequentially into the table.
    This can be thought of as a \"table comprehension\". The provided key-value
    expression must return either 2 values, or nil.
    
    For example,
      (collect [k v (pairs {:apple \"red\" :orange \"orange\"})]
        (values v k))
    returns
      {: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 (= nil ...)
              "expected exactly one body expression. Wrap multiple expressions with do")
      `(let [tbl# {}]
         (each ,iter-tbl
           (match ,key-value-expr
             (k# v#) (tset tbl# k# v#)))
         tbl#))
    
    (fn icollect* [iter-tbl value-expr ...]
      "Returns a sequential table made by running an iterator and evaluating an
    expression that returns values to be inserted sequentially into the table.
    This can be thought of as a \"list comprehension\".
    
    For example,
      (icollect [_ v (ipairs [1 2 3 4 5])] (when (> v 2) (* v v)))
    returns
      [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 (= nil ...)
              "expected exactly one body expression. Wrap multiple expressions with do")
      `(let [tbl# []]
         (each ,iter-tbl
           (tset tbl# (+ (length tbl#) 1) ,value-expr))
         tbl#))
    
    (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)))
    
    (fn pick-args [n f]
    (fn pick-args* [n f]
      "Creates a function of arity n that applies its arguments to f.
    
    For example,


@@ 5294,12 6206,12 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    expands to
      (fn [_0_ _1_] (func _0_ _1_))"
      (assert (and (= (type n) :number) (= n (math.floor n)) (>= n 0))
              "Expected n to be an integer literal >= 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)))))
    
    (fn pick-values [n ...]
    (fn pick-values* [n ...]
      "Like the `values` special, but emits exactly n values.
    
    For example,


@@ 5308,14 6220,14 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      (let [(_0_ _1_) ...]
        (values _0_ _1_))"
      (assert (and (= :number (type n)) (>= n 0) (= n (math.floor n)))
              "Expected n to be an integer >= 0")
              (.. "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)))
        (if (= n 0) `(values)
            `(let [,let-syms ,let-values] (values ,(unpack let-syms))))))
    
    (fn lambda [...]
    (fn lambda* [...]
      "Function literal with arity checking.
    Will throw an exception if a declared argument is passed in as nil, unless
    that argument name begins with ?."


@@ 5332,9 6244,8 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
          (if (table? a)
              (each [_ a (pairs a)]
                (check! a))
              (and (not (string.match (tostring a) "^?"))
                   (not= (tostring a) "&")
                   (not= (tostring a) "..."))
              (let [as (tostring a)]
                (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"


@@ 5348,20 6259,19 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
            (table.insert args (sym :nil)))
        `(fn ,(unpack args))))
    
    (fn macro [name ...]
    (fn macro* [name ...]
      "Define a single macro."
      (assert (sym? name) "expected symbol for macro name")
      (local args [...])
      `(macros { ,(tostring name) (fn ,name ,(unpack args))}))
      `(macros { ,(tostring name) (fn ,(unpack args))}))
    
    (fn macrodebug [form return?]
    (fn macrodebug* [form return?]
      "Print the resulting form after performing macroexpansion.
    With a second argument, returns expanded form as a string instead of printing."
      (let [(ok view) (pcall require :fennelview)
            handle (if return? `do `print)]
        `(,handle ,((if ok view tostring) (macroexpand form _SCOPE)))))
      (let [handle (if return? `do `print)]
        `(,handle ,(view (macroexpand form _SCOPE)))))
    
    (fn import-macros [binding1 module-name1 ...]
    (fn import-macros* [binding1 module-name1 ...]
      "Binds a table of macros from each macro module according to a binding form.
    Each binding form can be either a symbol or a k/v destructuring table.
    Example:


@@ 5370,31 6280,63 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
      (assert (and binding1 module-name1 (= 0 (% (select :# ...) 2)))
              "expected even number of binding/modulename pairs")
      (for [i 1 (select :# binding1 module-name1 ...) 2]
        (local (binding modname) (select i binding1 module-name1 ...))
        ;; generate a subscope of current scope, use require-macros
        ;; to bring in macro module. after that, we just copy the
        ;; macros from subscope to scope.
        (local scope (get-scope))
        (local subscope (fennel.scope scope))
        (fennel.compile-string (string.format "(require-macros %q)"
                                             modname)
                              {:scope subscope})
        (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)))
        (let [(binding modname) (select i binding1 module-name1 ...)
              ;; generate a subscope of current scope, use require-macros
              ;; to bring in macro module. after that, we just copy the
              ;; macros from subscope to scope.
              scope (get-scope)
              subscope (fennel.scope scope)]
          (_SPECIALS.require-macros `(require-macros ,modname) subscope {} ast)
          (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)))
    
            ;; 1-level table destructuring for importing individual macros
            (table? binding)
            (each [macro-name [import-key] (pairs binding)]
              (assert (= :function (type (. subscope.macros macro-name)))
                      (.. "macro " macro-name " not found in module " modname))
              (tset scope.macros import-key (. subscope.macros macro-name)))))
              ;; 1-level table destructuring for importing individual macros
              (table? binding)
              (each [macro-name [import-key] (pairs binding)]
                (assert (= :function (type (. subscope.macros macro-name)))
                        (.. "macro " macro-name " not found in module "
                            (tostring modname)))
                (tset scope.macros import-key (. subscope.macros macro-name))))))
      nil)
    
    ;;; Pattern matching
    
    (fn match-values [vals pattern unifications match-pattern]
      (let [condition `(and)
            bindings []]
        (each [i pat (ipairs pattern)]
          (let [(subcondition subbindings) (match-pattern [(. vals i)] pat
                                                          unifications)]
            (table.insert condition subcondition)
            (each [_ b (ipairs subbindings)]
              (table.insert bindings b))))
        (values condition bindings)))
    
    (fn match-table [val pattern unifications match-pattern]
      (let [condition `(and (= (type ,val) :table))
            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
              (let [subval `(. ,val ,k)
                    (subcondition subbindings) (match-pattern [subval] pat
                                                              unifications)]
                (table.insert condition subcondition)
                (each [_ b (ipairs subbindings)]
                  (table.insert bindings b)))))
        (values condition bindings)))
    
    (fn match-pattern [vals pattern unifications]
      "Takes the AST of values and a single pattern and returns a condition
    to determine if it matches as well as a list of bindings to


@@ 5411,18 6353,17 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
                     (in-scope? (. (multi-sym? pattern) 1))))
            (values `(= ,val ,pattern) [])
            ;; unify a local we've seen already
            (and (sym? pattern)
                 (. unifications (tostring pattern)))
            (and (sym? pattern) (. unifications (tostring pattern)))
            (values `(= ,(. unifications (tostring pattern)) ,val) [])
            ;; bind a fresh local
            (sym? pattern)
            (let [wildcard? (= (tostring 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]))
            ;; guard clause
            (and (list? pattern) (sym? (. pattern 2)) (= :? (tostring (. pattern 2))))
            (and (list? pattern) (= (. pattern 2) `?))
            (let [(pcondition bindings) (match-pattern vals (. pattern 1)
                                                       unifications)
                  condition `(and ,pcondition)]


@@ 5432,37 6373,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    
            ;; multi-valued patterns (represented as lists)
            (list? pattern)
            (let [condition `(and)
                  bindings []]
              (each [i pat (ipairs pattern)]
                (let [(subcondition subbindings) (match-pattern [(. vals i)] pat
                                                                unifications)]
                  (table.insert condition subcondition)
                  (each [_ b (ipairs subbindings)]
                    (table.insert bindings b))))
              (values condition bindings))
            (match-values vals pattern unifications match-pattern)
            ;; table patterns
            (= (type pattern) :table)
            (let [condition `(and (= (type ,val) :table))
                  bindings []]
              (each [k pat (pairs pattern)]
                (if (and (sym? pat) (= "&" (tostring 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 _G.unpack
                                                                 table.unpack)
                                                             ,val))]))
                    (and (= :number (type k))
                         (= "&" (tostring (. pattern (- k 1)))))
                    nil ; don't process the pattern right after &; already got it
                    (let [subval `(. ,val ,k)
                          (subcondition subbindings) (match-pattern [subval] pat
                                                                    unifications)]
                      (table.insert condition subcondition)
                      (each [_ b (ipairs subbindings)]
                        (table.insert bindings b)))))
              (values condition bindings))
            (match-table val pattern unifications match-pattern)
            ;; literal value
            (values `(= ,val ,pattern) []))))
    


@@ 5489,8 6403,10 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
                    (tset syms valnum (gensym))))))
        syms))
    
    (fn match [val ...]
      "Perform pattern matching on val. See reference for details."
    (fn match* [val ...]
      ;; Old implementation of match macro, which doesn't directly support
      ;; `where' and `or'. New syntax is implemented in `match-where',
      ;; which simply generates old syntax and feeds it to `match*'.
      (let [clauses [...]
            vals (match-val-syms clauses)]
        ;; protect against multiple evaluation of the value, bind against as


@@ 5498,12 6414,80 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
        (list `let [vals val]
              (match-condition vals clauses))))
    
    {: -> : ->> : -?> : -?>>
     : doto : when : with-open
     : partial : lambda
     : pick-args : pick-values
     : macro : macrodebug : import-macros
     : match}
    ;; Construction of old match syntax from new syntax
    
    (fn partition-2 [seq]
      ;; Partition `seq` by 2.
      ;; If `seq` has odd amount of elements, the last one is dropped.
      ;;
      ;; Input: [1 2 3 4 5]
      ;; Output: [[1 2] [3 4]]
      (let [firsts []
            seconds []
            res []]
        (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))))
        (each [i v1 (ipairs firsts)]
          (let [v2 (. seconds i)]
            (if (not= nil v2)
                (table.insert res [v1 v2]))))
        res))
    
    (fn transform-or [[_ & pats] guards]
      ;; Transforms `(or pat pats*)` lists into match `guard` patterns.
      ;;
      ;; (or pat1 pat2), guard => [(pat1 ? guard) (pat2 ? guard)]
      (let [res []]
        (each [_ pat (ipairs pats)]
          (table.insert res (list pat '? (unpack guards))))
        res))
    
    (fn transform-cond [cond]
      ;; Transforms `where` cond into sequence of `match` guards.
      ;;
      ;; pat => [pat]
      ;; (where pat guard) => [(pat ? guard)]
      ;; (where (or pat1 pat2) guard) => [(pat1 ? guard) (pat2 ? guard)]
      (if (and (list? cond) (= (. cond 1) `where))
          (let [second (. cond 2)]
            (if (and (list? second) (= (. second 1) `or))
                (transform-or second [(unpack cond 3)])
                :else
                [(list second '? (unpack cond 3))]))
          :else
          [cond]))
    
    (fn match-where [val ...]
      "Perform pattern matching on val. See reference for details.
    
    Syntax:
    
    (match data-expression
      pattern body
      (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 :# ...) ...))
            match-body []]
        (each [_ [cond body] (ipairs conds-bodies)]
          (each [_ cond (ipairs (transform-cond cond))]
            (table.insert match-body cond)
            (table.insert match-body body)))
        (if else-branch
            (table.insert match-body else-branch))
        (match* val (unpack match-body))))
    
    {:-> ->* :->> ->>* :-?> -?>* :-?>> -?>>* :?. ?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*
     :match match-where}
    ]===]
    local module_name = "fennel.macros"
    local _ = nil


@@ 5512,7 6496,13 @@ package.preload["fennel"] = package.preload["fennel"] or function(...)
    end
    package.preload[module_name] = _0_
    _ = nil
    local env = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
    local env = nil
    do
      local _1_0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
      _1_0["utils"] = utils
      _1_0["fennel"] = mod
      env = _1_0
    end
    local built_ins = eval(builtin_macros, {allowedGlobals = false, env = env, filename = "src/fennel/macros.fnl", moduleName = module_name, scope = compiler.scopes.compiler, useMetadata = true})
    for k, v in pairs(built_ins) do
      compiler.scopes.global.macros[k] = v


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


@@ 5536,7 6527,7 @@ local reader = require("lang.reader")
local compiler = require("anticompiler")
local letter = require("letter")
local fnlfmt = require("fnlfmt")
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 reserved_fennel = {}
local function uncamelize(name)
  local function splicedash(pre, cap)
    return (pre .. "-" .. cap:lower())


@@ 5561,7 6552,7 @@ if ((debug and debug.getinfo) and (debug.getinfo(3) == nil)) then
  if f then
    f:close()
    for _, code in ipairs(compile(reader.file(filename), filename)) do
      print(fnlfmt.fnlfmt(code))
      print((fnlfmt.fnlfmt(code) .. "\n"))
    end
    return nil
  else