From 82e5706d895a1f5bee2f0ca2ad445c82f4de9e5d Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Fri, 9 Apr 2021 19:05:36 -0400
Subject: [PATCH] Update to fennel 0.9.0 (monkeypatched)

---
 lib/fennel.lua | 1053 +++++++++++++++++++++++++++++++-----------------
 1 file changed, 686 insertions(+), 367 deletions(-)

diff --git a/lib/fennel.lua b/lib/fennel.lua
index 7384b1e..ea3baf6 100644
--- a/lib/fennel.lua
+++ b/lib/fennel.lua
@@ -333,12 +333,14 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
   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") then
+      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)
@@ -378,21 +380,19 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
     end
     return seen0
   end
-  local function detect_cycle(t, seen)
-    local seen0 = (seen or {})
-    seen0[t] = true
-    for k, v in pairs(t) do
-      if ((type(k) == "table") and (seen0[k] or detect_cycle(k, seen0))) then
-        return true
-      end
-      if ((type(v) == "table") and (seen0[v] or detect_cycle(v, seen0))) then
-        return true
+  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
-    return nil
   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)))
+    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
@@ -403,7 +403,7 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
     end
     return (indent + opener_length)
   end
-  local pp = {}
+  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
@@ -422,13 +422,7 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
       close = "}"
     end
     local oneline = (open .. table.concat(elements, " ") .. close)
-    local _4_
-    if (table_type == "seq") then
-      _4_ = options["sequential-length"]
-    else
-      _4_ = options["associative-length"]
-    end
-    if (not options["one-line?"] and (multiline_3f or (#elements > _4_) or ((indent + #oneline) > options["line-length"]))) then
+    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
@@ -464,7 +458,7 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
       else
         prefix = ""
       end
-      local elements = nil
+      local items = nil
       do
         local tbl_0_ = {}
         for _, _6_0 in pairs(kv) do
@@ -473,16 +467,16 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
           local v = _7_[2]
           local _8_
           do
-            local k0 = pp.pp(k, options, (indent0 + 1), true)
-            local v0 = pp.pp(v, options, (indent0 + slength(k0) + 1))
+            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_
+        items = tbl_0_
       end
-      return concat_table_lines(elements, options, multiline_3f, indent0, "table", prefix)
+      return concat_table_lines(items, options, multiline_3f, indent0, "table", prefix)
     end
   end
   local function pp_sequence(t, kv, options, indent)
@@ -502,7 +496,7 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
       else
         prefix = ""
       end
-      local elements = nil
+      local items = nil
       do
         local tbl_0_ = {}
         for _, _3_0 in pairs(kv) do
@@ -511,15 +505,15 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
           local v = _4_[2]
           local _5_
           do
-            local v0 = pp.pp(v, options, indent0)
+            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_
+        items = tbl_0_
       end
-      return concat_table_lines(elements, options, multiline_3f, indent0, "seq", prefix)
+      return concat_table_lines(items, options, multiline_3f, indent0, "seq", prefix)
     end
   end
   local function concat_lines(lines, options, indent, force_multi_line_3f)
@@ -561,7 +555,7 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
       end
       options["visible-cycle?"] = _2_
       _ = nil
-      local lines, force_multi_line_3f = metamethod(t, pp.pp, options, indent)
+      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
@@ -570,7 +564,7 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
         return concat_lines(lines, options, indent, force_multi_line_3f)
       else
         local _0 = _3_0
-        return error("Error: __fennelview metamethod must return a table of lines")
+        return error("__fennelview metamethod must return a table of lines")
       end
     end
   end
@@ -622,31 +616,28 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
     return x0
   end
   local function number__3estring(n)
-    local _2_0, _3_0, _4_0 = math.modf(n)
-    if ((nil ~= _2_0) and (_3_0 == 0)) then
-      local int = _2_0
-      return tostring(int)
-    else
-      local _5_
-      do
-        local frac = _3_0
-        _5_ = (((_2_0 == 0) and (nil ~= _3_0)) and (frac < 0))
-      end
-      if _5_ then
-        local frac = _3_0
-        return ("-0." .. tostring(frac):gsub("^-?0.", ""))
-      elseif ((nil ~= _2_0) and (nil ~= _3_0)) then
-        local int = _2_0
-        local frac = _3_0
-        return (int .. "." .. tostring(frac):gsub("^-?0.", ""))
-      end
-    end
+    local _2_0 = string.gsub(tostring(n), ",", ".")
+    return _2_0
   end
   local function colon_string_3f(s)
-    return s:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")
+    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 = {["associative-length"] = 4, ["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["line-length"] = 80, ["metamethod?"] = true, ["one-line?"] = false, ["sequential-length"] = 10, ["utf8?"] = true, depth = 128}
+    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
@@ -656,34 +647,46 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
     end
     return defaults
   end
-  pp.pp = function(x, options, indent, key_3f)
+  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 _3_()
-      local _2_0 = getmetatable(x)
-      if _2_0 then
-        return _2_0.__fennelview
+    local function _4_()
+      local _3_0 = getmetatable(x)
+      if _3_0 then
+        return _3_0.__fennelview
       else
-        return _2_0
+        return _3_0
       end
     end
-    if ((tv == "table") or ((tv == "userdata") and _3_())) then
+    if ((tv == "table") or ((tv == "userdata") and _4_())) then
       return pp_table(x, options0, indent0)
     elseif (tv == "number") then
       return number__3estring(x)
-    elseif ((tv == "string") and key_3f and colon_string_3f(x)) then
-      return (":" .. x)
-    elseif (tv == "string") then
-      return string.format("%q", x)
-    elseif ((tv == "boolean") or (tv == "nil")) then
-      return tostring(x)
     else
-      return ("#<" .. tostring(x) .. ">")
+      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.pp(x, make_options(x, options), 0)
+    return pp(x, make_options(x, options), 0)
   end
   return view
 end
@@ -870,8 +873,8 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
   local function set_fn_metadata(arg_list, docstring, parent, fn_name)
     if utils.root.options.useMetadata then
       local args = nil
-      local function _0_(v)
-        return ("\"%s\""):format(deep_tostring(v))
+      local function _0_(_241)
+        return ("\"%s\""):format(deep_tostring(_241))
       end
       args = utils.map(arg_list, _0_)
       local meta_fields = {"\"fnl/arglist\"", ("{" .. table.concat(args, ", ") .. "}")}
@@ -893,9 +896,30 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
       end
       return _0_, not multi, 3
     else
-      return compiler.gensym(scope), true, 2
+      return nil, true, 2
     end
   end
+  local function compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, local_3f, arg_name_list, arg_list, docstring)
+    for i = (index + 1), #ast do
+      compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
+    end
+    local _0_
+    if local_3f then
+      _0_ = "local function %s(%s)"
+    else
+      _0_ = "%s = function(%s)"
+    end
+    compiler.emit(parent, string.format(_0_, fn_name, table.concat(arg_name_list, ", ")), ast)
+    compiler.emit(parent, f_chunk, ast)
+    compiler.emit(parent, "end", ast)
+    set_fn_metadata(arg_list, docstring, parent, fn_name)
+    utils.hook("fn", ast, f_scope)
+    return utils.expr(fn_name, "sym")
+  end
+  local function compile_anonymous_fn(ast, f_scope, f_chunk, parent, index, arg_name_list, arg_list, docstring, scope)
+    local fn_name = compiler.gensym(scope)
+    return compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, true, arg_name_list, arg_list, docstring)
+  end
   SPECIALS.fn = function(ast, scope, parent)
     local f_scope = nil
     do
@@ -906,7 +930,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
     local f_chunk = {}
     local fn_sym = utils["sym?"](ast[2])
     local multi = (fn_sym and utils["multi-sym?"](fn_sym[1]))
-    local fn_name, local_fn_3f, index = get_fn_name(ast, scope, fn_sym, multi)
+    local fn_name, local_3f, index = get_fn_name(ast, scope, fn_sym, multi)
     local arg_list = compiler.assert(utils["table?"](ast[index]), "expected parameters table", ast)
     compiler.assert((not multi or not multi["multi-sym-method-call"]), ("unexpected multi symbol " .. tostring(fn_name)), fn_sym)
     local function get_arg_name(arg)
@@ -925,30 +949,18 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
         return compiler.assert(false, ("expected symbol for function parameter: %s"):format(tostring(arg)), ast[2])
       end
     end
-    do
-      local arg_name_list = utils.map(arg_list, get_arg_name)
-      local index0, docstring = nil, nil
-      if ((type(ast[(index + 1)]) == "string") and ((index + 1) < #ast)) then
-        index0, docstring = (index + 1), ast[(index + 1)]
-      else
-        index0, docstring = index, nil
-      end
-      for i = (index0 + 1), #ast do
-        compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
-      end
-      local _2_
-      if local_fn_3f then
-        _2_ = "local function %s(%s)"
-      else
-        _2_ = "%s = function(%s)"
-      end
-      compiler.emit(parent, string.format(_2_, fn_name, table.concat(arg_name_list, ", ")), ast)
-      compiler.emit(parent, f_chunk, ast)
-      compiler.emit(parent, "end", ast)
-      set_fn_metadata(arg_list, docstring, parent, fn_name)
+    local arg_name_list = utils.map(arg_list, get_arg_name)
+    local index0, docstring = nil, nil
+    if ((type(ast[(index + 1)]) == "string") and ((index + 1) < #ast)) then
+      index0, docstring = (index + 1), ast[(index + 1)]
+    else
+      index0, docstring = index, nil
+    end
+    if fn_name then
+      return compile_named_fn(ast, f_scope, f_chunk, parent, index0, fn_name, local_3f, arg_name_list, arg_list, docstring)
+    else
+      return compile_anonymous_fn(ast, f_scope, f_chunk, parent, index0, arg_name_list, arg_list, docstring, scope)
     end
-    utils.hook("fn", ast, f_scope)
-    return utils.expr(fn_name, "sym")
   end
   doc_special("fn", {"name?", "args", "docstring?", "..."}, "Function syntax. May optionally include a name and docstring.\nIf a name is provided, the function will be bound in the current scope.\nWhen called with the wrong number of args, excess args will be discarded\nand lacking args will be nil, use lambda for arity-checked functions.")
   SPECIALS.lua = function(ast, _, parent)
@@ -968,8 +980,9 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
     if special_or_macro then
       return ("print(%q)"):format(doc_2a(special_or_macro, target))
     else
-      local value = tostring(compiler.compile1(ast[2], scope, parent, {nval = 1})[1])
-      return ("print(require('%s').doc(%s, '%s'))"):format((utils.root.options.moduleName or "fennel"), value, tostring(ast[2]))
+      local _0_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
+      local value = _0_[1]
+      return ("print(require('%s').doc(%s, '%s'))"):format((utils.root.options.moduleName or "fennel"), tostring(value), tostring(ast[2]))
     end
   end
   doc_special("doc", {"x"}, "Print the docstring and arglist for a function, macro, or special form.")
@@ -1121,7 +1134,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
       end
       local cond = tostring(branch.cond)
       local cond_line = nil
-      if ((cond == "true") and branch.nested and (i == #branches)) then
+      if ((cond == "true") and branch.nested and (i == #branches) and not has_else_3f) then
         cond_line = "else"
       else
         cond_line = fstr:format(cond)
@@ -1173,9 +1186,23 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
   end
   SPECIALS["if"] = if_2a
   doc_special("if", {"cond1", "body1", "...", "condN", "bodyN"}, "Conditional form.\nTakes any number of condition/body pairs and evaluates the first body where\nthe condition evaluates to truthy. Similar to cond in other lisps.")
+  local function remove_until_condition(bindings)
+    if ("until" == bindings[(#bindings - 1)]) then
+      table.remove(bindings, (#bindings - 1))
+      return table.remove(bindings)
+    end
+  end
+  local function compile_until(condition, scope, chunk)
+    if condition then
+      local _0_ = compiler.compile1(condition, scope, chunk, {nval = 1})
+      local condition_lua = _0_[1]
+      return compiler.emit(chunk, ("if %s then break end"):format(tostring(condition_lua)), condition)
+    end
+  end
   SPECIALS.each = function(ast, scope, parent)
     compiler.assert((#ast >= 3), "expected body expression", ast[1])
     local binding = compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
+    local until_condition = remove_until_condition(binding)
     local iter = table.remove(binding, #binding)
     local destructures = {}
     local new_manglings = {}
@@ -1198,6 +1225,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
       compiler.destructure(args, raw, ast, sub_scope, chunk, {declaration = true, nomulti = true, symtype = "each"})
     end
     compiler["apply-manglings"](sub_scope, new_manglings, ast)
+    compile_until(until_condition, sub_scope, chunk)
     compile_do(ast, sub_scope, chunk, 3)
     compiler.emit(parent, chunk, ast)
     return compiler.emit(parent, "end", ast)
@@ -1226,6 +1254,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
   doc_special("while", {"condition", "..."}, "The classic while loop. Evaluates body until a condition is non-truthy.")
   local function for_2a(ast, scope, parent)
     local ranges = compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
+    local until_condition = remove_until_condition(ast[2])
     local binding_sym = table.remove(ast[2], 1)
     local sub_scope = compiler["make-scope"](scope)
     local range_args = {}
@@ -1236,6 +1265,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
       range_args[i] = tostring(compiler.compile1(ranges[i], sub_scope, parent, {nval = 1})[1])
     end
     compiler.emit(parent, ("for %s = %s do"):format(compiler["declare-local"](binding_sym, {}, sub_scope, ast), table.concat(range_args, ", ")), ast)
+    compile_until(until_condition, sub_scope, chunk)
     compile_do(ast, sub_scope, chunk, 3)
     compiler.emit(parent, chunk, ast)
     return compiler.emit(parent, "end", ast)
@@ -1361,40 +1391,41 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
     return utils.expr(name, "sym")
   end
   doc_special("hashfn", {"..."}, "Function literal shorthand; args are either $... OR $1, $2, etc.")
-  local function define_arithmetic_special(name, zero_arity, unary_prefix, lua_name)
-    do
-      local padded_op = (" " .. (lua_name or name) .. " ")
-      local function _0_(ast, scope, parent)
-        local len = #ast
-        if (len == 1) then
-          compiler.assert((zero_arity ~= nil), "Expected more than 0 arguments", ast)
-          return utils.expr(zero_arity, "literal")
+  local function arithmetic_special(name, zero_arity, unary_prefix, ast, scope, parent)
+    local len = #ast
+    if (len == 1) then
+      compiler.assert(zero_arity, "Expected more than 0 arguments", ast)
+      return utils.expr(zero_arity, "literal")
+    else
+      local operands = {}
+      local padded_op = (" " .. name .. " ")
+      for i = 2, len do
+        local subexprs = nil
+        local _0_
+        if (i ~= len) then
+          _0_ = 1
         else
-          local operands = {}
-          for i = 2, len do
-            local subexprs = nil
-            local _1_
-            if (i ~= len) then
-              _1_ = 1
-            else
-            _1_ = nil
-            end
-            subexprs = compiler.compile1(ast[i], scope, parent, {nval = _1_})
-            utils.map(subexprs, tostring, operands)
-          end
-          if (#operands == 1) then
-            if unary_prefix then
-              return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")")
-            else
-              return operands[1]
-            end
-          else
-            return ("(" .. table.concat(operands, padded_op) .. ")")
-          end
+        _0_ = nil
         end
+        subexprs = compiler.compile1(ast[i], scope, parent, {nval = _0_})
+        utils.map(subexprs, tostring, operands)
+      end
+      if (#operands == 1) then
+        if unary_prefix then
+          return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")")
+        else
+          return operands[1]
+        end
+      else
+        return ("(" .. table.concat(operands, padded_op) .. ")")
       end
-      SPECIALS[name] = _0_
     end
+  end
+  local function define_arithmetic_special(name, zero_arity, unary_prefix, lua_name)
+    local function _0_(...)
+      return arithmetic_special((lua_name or name), zero_arity, unary_prefix, ...)
+    end
+    SPECIALS[name] = _0_
     return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.")
   end
   define_arithmetic_special("+", "0")
@@ -1405,16 +1436,57 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
   define_arithmetic_special("%")
   define_arithmetic_special("/", nil, "1")
   define_arithmetic_special("//", nil, "1")
-  define_arithmetic_special("lshift", nil, "1", "<<")
-  define_arithmetic_special("rshift", nil, "1", ">>")
-  define_arithmetic_special("band", "0", "0", "&")
-  define_arithmetic_special("bor", "0", "0", "|")
-  define_arithmetic_special("bxor", "0", "0", "~")
-  doc_special("lshift", {"x", "n"}, "Bitwise logical left shift of x by n bits; only works in Lua 5.3+.")
-  doc_special("rshift", {"x", "n"}, "Bitwise logical right shift of x by n bits; only works in Lua 5.3+.")
-  doc_special("band", {"x1", "x2"}, "Bitwise AND of arguments; only works in Lua 5.3+.")
-  doc_special("bor", {"x1", "x2"}, "Bitwise OR of arguments; only works in Lua 5.3+.")
-  doc_special("bxor", {"x1", "x2"}, "Bitwise XOR of arguments; only works in Lua 5.3+.")
+  local function bitop_special(native_name, lib_name, zero_arity, unary_prefix, ast, scope, parent)
+    if (#ast == 1) then
+      return compiler.assert(zero_arity, "Expected more than 0 arguments.", ast)
+    else
+      local len = #ast
+      local operands = {}
+      local padded_native_name = (" " .. native_name .. " ")
+      local prefixed_lib_name = ("bit." .. lib_name)
+      for i = 2, len do
+        local subexprs = nil
+        local _0_
+        if (i ~= len) then
+          _0_ = 1
+        else
+        _0_ = nil
+        end
+        subexprs = compiler.compile1(ast[i], scope, parent, {nval = _0_})
+        utils.map(subexprs, tostring, operands)
+      end
+      if (#operands == 1) then
+        if utils.root.options.useBitLib then
+          return (prefixed_lib_name .. "(" .. unary_prefix .. ", " .. operands[1] .. ")")
+        else
+          return ("(" .. unary_prefix .. padded_native_name .. operands[1] .. ")")
+        end
+      else
+        if utils.root.options.useBitLib then
+          return (prefixed_lib_name .. "(" .. table.concat(operands, ", ") .. ")")
+        else
+          return ("(" .. table.concat(operands, padded_native_name) .. ")")
+        end
+      end
+    end
+  end
+  local function define_bitop_special(name, zero_arity, unary_prefix, native)
+    local function _0_(...)
+      return bitop_special(native, name, zero_arity, unary_prefix, ...)
+    end
+    SPECIALS[name] = _0_
+    return nil
+  end
+  define_bitop_special("lshift", nil, "1", "<<")
+  define_bitop_special("rshift", nil, "1", ">>")
+  define_bitop_special("band", "0", "0", "&")
+  define_bitop_special("bor", "0", "0", "|")
+  define_bitop_special("bxor", "0", "0", "~")
+  doc_special("lshift", {"x", "n"}, "Bitwise logical left shift of x by n bits.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
+  doc_special("rshift", {"x", "n"}, "Bitwise logical right shift of x by n bits.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
+  doc_special("band", {"x1", "x2", "..."}, "Bitwise AND of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
+  doc_special("bor", {"x1", "x2", "..."}, "Bitwise OR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
+  doc_special("bxor", {"x1", "x2", "..."}, "Bitwise XOR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
   define_arithmetic_special("or", "false")
   define_arithmetic_special("and", "true")
   doc_special("and", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.")
@@ -1466,7 +1538,6 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
   define_comparator_special("<=")
   define_comparator_special("=", "==")
   define_comparator_special("not=", "~=", "or")
-  SPECIALS["~="] = SPECIALS["not="]
   local function define_unary_special(op, realop)
     local function opfn(ast, scope, parent)
       compiler.assert((#ast == 2), "expected one argument", ast)
@@ -1479,9 +1550,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
   define_unary_special("not", "not ")
   doc_special("not", {"x"}, "Logical operator; works the same as Lua.")
   define_unary_special("bnot", "~")
-  doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+.")
+  doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
   define_unary_special("length", "#")
   doc_special("length", {"x"}, "Returns the length of a table or string.")
+  SPECIALS["~="] = SPECIALS["not="]
   SPECIALS["#"] = SPECIALS.length
   SPECIALS.quote = function(ast, scope, parent)
     compiler.assert((#ast == 2), "expected one argument")
@@ -1496,7 +1568,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
   end
   doc_special("quote", {"x"}, "Quasiquote the following form. Only works in macro/compiler scope.")
   local already_warned_3f = {}
-  local compile_env_warning = ("WARNING: Attempting to %s %s in compile" .. " scope.\nIn future versions of Fennel this will not" .. " be allowed without the\n--no-compiler-sandbox flag" .. " or passing a :compilerEnv globals table in options.\n")
+  local compile_env_warning = table.concat({"WARNING: Attempting to %s %s in compile scope.", "In future versions of Fennel this will not be allowed without the", "--no-compiler-sandbox flag or passing a :compilerEnv globals table", "in the options.\n"}, "\n")
   local function compiler_env_warn(_, key)
     local v = _G[key]
     if (v and io and io.stderr and not already_warned_3f[key]) then
@@ -1505,8 +1577,22 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
     end
     return v
   end
-  local safe_compiler_env = setmetatable({assert = assert, bit = rawget(_G, "bit"), error = error, getmetatable = getmetatable, ipairs = ipairs, math = math, next = next, pairs = pairs, pcall = pcall, print = print, rawequal = rawequal, rawget = rawget, rawlen = rawget(_G, "rawlen"), rawset = rawset, select = select, setmetatable = setmetatable, string = string, table = table, tonumber = tonumber, tostring = tostring, type = type, xpcall = xpcall}, {__index = compiler_env_warn})
-  local function make_compiler_env(ast, scope, parent)
+  local function safe_getmetatable(tbl)
+    local mt = getmetatable(tbl)
+    assert((mt ~= getmetatable("")), "Illegal metatable access!")
+    return mt
+  end
+  local safe_require = nil
+  local function safe_compiler_env(strict_3f)
+    local _1_
+    if strict_3f then
+      _1_ = nil
+    else
+      _1_ = compiler_env_warn
+    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
@@ -1524,7 +1610,9 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
     local _6_
     do
       local _5_0 = utils.root.options
-      if ((type(_5_0) == "table") and (nil ~= _5_0.compilerEnv)) then
+      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
@@ -1532,7 +1620,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
         _6_ = compiler_env
       else
         local _ = _5_0
-        _6_ = safe_compiler_env
+        _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_})
@@ -1592,10 +1680,31 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
     end
     return allowed
   end
-  local function compiler_env_domodule(modname, env, _3fast)
-    local filename = compiler.assert(search_module(modname), (modname .. " module not found."), _3fast)
-    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}, modname, filename)
+  local function default_macro_searcher(module_name)
+    local _1_0 = search_module(module_name)
+    if (nil ~= _1_0) then
+      local filename = _1_0
+      local function _2_(...)
+        return utils["fennel-module"].dofile(filename, {env = "_COMPILER"}, ...)
+      end
+      return _2_, filename
+    end
+  end
+  local macro_searchers = {default_macro_searcher}
+  local function search_macro_module(modname, n)
+    local _1_0 = macro_searchers[n]
+    if (nil ~= _1_0) then
+      local f = _1_0
+      local _2_0, _3_0 = f(modname)
+      if ((nil ~= _2_0) and true) then
+        local loader = _2_0
+        local _3ffilename = _3_0
+        return loader, _3ffilename
+      else
+        local _ = _2_0
+        return search_macro_module(modname, (n + 1))
+      end
+    end
   end
   local macro_loaded = {}
   local function metadata_only_fennel(modname)
@@ -1603,14 +1712,16 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
       return {metadata = compiler.metadata}
     end
   end
-  safe_compiler_env.require = function(modname)
-    local function _1_()
-      local mod = compiler_env_domodule(modname, safe_compiler_env)
-      macro_loaded[modname] = mod
-      return mod
+  local function _1_(modname)
+    local function _2_()
+      local loader, filename = search_macro_module(modname, 1)
+      compiler.assert(loader, (modname .. " module not found."))
+      macro_loaded[modname] = loader(modname, filename)
+      return macro_loaded[modname]
     end
-    return (macro_loaded[modname] or metadata_only_fennel(modname) or _1_())
+    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
@@ -1622,12 +1733,14 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
   SPECIALS["require-macros"] = function(ast, scope, parent, real_ast)
     compiler.assert((#ast == 2), "Expected one module name argument", (real_ast or ast))
     local filename = (ast[2].filename or ast.filename)
-    local modname_code = compiler.compile(ast[2])
-    local modname = load_code(modname_code, nil, filename)(utils.root.options["module-name"], filename)
+    local modname_chunk = load_code(compiler.compile(ast[2]), nil, filename)
+    local modname = modname_chunk(utils.root.options["module-name"], filename)
     compiler.assert((type(modname) == "string"), "module name must compile to string", (real_ast or ast))
     if not macro_loaded[modname] then
       local env = make_compiler_env(ast, scope, parent)
-      macro_loaded[modname] = compiler_env_domodule(modname, env, ast)
+      local loader, filename0 = search_macro_module(modname, 1)
+      compiler.assert(loader, (modname .. " module not found."), ast)
+      macro_loaded[modname] = loader(modname, filename0)
     end
     return add_macros(macro_loaded[modname], ast, scope, parent)
   end
@@ -1666,10 +1779,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
           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)
@@ -1706,13 +1819,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
       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)
@@ -1723,7 +1836,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
           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.")
@@ -1747,7 +1860,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
     return val
   end
   doc_special("eval-compiler", {"..."}, "Evaluate the body at compile-time. Use the macro system instead if possible.")
-  return {["current-global-names"] = current_global_names, ["load-code"] = load_code, ["macro-loaded"] = macro_loaded, ["make-compiler-env"] = make_compiler_env, ["make-searcher"] = make_searcher, ["search-module"] = search_module, ["wrap-env"] = wrap_env, doc = doc_2a}
+  return {["current-global-names"] = current_global_names, ["load-code"] = load_code, ["macro-loaded"] = macro_loaded, ["macro-searchers"] = macro_searchers, ["make-compiler-env"] = make_compiler_env, ["make-searcher"] = make_searcher, ["search-module"] = search_module, ["wrap-env"] = wrap_env, doc = doc_2a}
 end
 package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or function(...)
   local utils = require("fennel.utils")
@@ -1920,7 +2033,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     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 .. ":" .. symbol.line .. "\n"))
+      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)
@@ -1955,7 +2068,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     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
@@ -1985,6 +2098,10 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
       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
@@ -1993,8 +2110,9 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
       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
@@ -2016,7 +2134,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
       local code = chunk.leaf
       local info = chunk.ast
       if sm then
-        table.insert(sm, ((info and info.line) or ( - 1)))
+        table.insert(sm, {(info and info.filename), (info and info.line)})
       end
       return code
     else
@@ -2065,7 +2183,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
       local sm = {}
       local ret = flatten_chunk(sm, chunk0, options.indent, 0)
       if sm then
-        sm.short_src = make_short_src((options.filename or options.source or ret))
+        sm.short_src = (options.filename or make_short_src((options.source or ret)))
         if options.filename then
           sm.key = ("@" .. options.filename)
         else
@@ -2105,14 +2223,19 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     return table.concat(utils.map(exprs, 1), ", ")
   end
   local function keep_side_effects(exprs, chunk, start, ast)
-    local start0 = (start or 1)
-    for j = start0, #exprs do
+    for j = (start or 1), #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)
       elseif (se.type == "statement") then
         local code = tostring(se)
-        emit(chunk, (((code:byte() == 40) and ("do end " .. code)) or code), ast)
+        local unambiguous_code = nil
+        if (code:byte() == 40) then
+          unambiguous_code = ("do end " .. code)
+        else
+          unambiguous_code = code
+        end
+        emit(chunk, unambiguous_code, ast)
       end
     end
     return nil
@@ -2174,26 +2297,35 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     end
   end
   local function macroexpand_2a(ast, scope, once)
-    if not utils["list?"](ast) then
-      return ast
+    local _0_0 = nil
+    if utils["list?"](ast) then
+      _0_0 = find_macro(ast, scope, utils["multi-sym?"](ast[1]))
     else
-      local macro_2a = find_macro(ast, scope, utils["multi-sym?"](ast[1]))
-      if not macro_2a then
-        return ast
-      else
-        local old_scope = scopes.macro
-        local _ = nil
-        scopes.macro = scope
-        _ = nil
-        local ok, transformed = pcall(macro_2a, unpack(ast, 2))
-        scopes.macro = old_scope
-        assert_compile(ok, transformed, ast)
-        if (once or not transformed) then
-          return transformed
-        else
-          return macroexpand_2a(transformed, scope)
-        end
+    _0_0 = nil
+    end
+    if (_0_0 == false) then
+      return ast
+    elseif (nil ~= _0_0) then
+      local macro_2a = _0_0
+      local old_scope = scopes.macro
+      local _ = nil
+      scopes.macro = scope
+      _ = nil
+      local ok, transformed = nil, nil
+      local function _2_()
+        return macro_2a(unpack(ast, 2))
       end
+      ok, transformed = xpcall(_2_, debug.traceback)
+      scopes.macro = old_scope
+      assert_compile(ok, transformed, ast)
+      if (once or not transformed) then
+        return transformed
+      else
+        return macroexpand_2a(transformed, scope)
+      end
+    else
+      local _ = _0_0
+      return ast
     end
   end
   local function compile_special(ast, scope, parent, opts, special)
@@ -2255,7 +2387,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     elseif (multi_sym_parts and multi_sym_parts["multi-sym-method-call"]) then
       local table_with_method = table.concat({unpack(multi_sym_parts, 1, (#multi_sym_parts - 1))}, ".")
       local method_to_call = multi_sym_parts[#multi_sym_parts]
-      local new_ast = utils.list(utils.sym(":", scope), utils.sym(table_with_method, scope), method_to_call, select(2, unpack(ast)))
+      local new_ast = utils.list(utils.sym(":", nil, scope), utils.sym(table_with_method, nil, scope), method_to_call, select(2, unpack(ast)))
       return compile1(new_ast, scope, parent, opts)
     else
       return compile_function_call(ast, scope, parent, opts, compile1, len)
@@ -2277,25 +2409,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     return handle_compile_opts({e}, parent, opts, ast)
   end
   local function serialize_number(n)
-    local _0_0, _1_0, _2_0 = math.modf(n)
-    if ((nil ~= _0_0) and (_1_0 == 0)) then
-      local int = _0_0
-      return tostring(int)
-    else
-      local _3_
-      do
-        local frac = _1_0
-        _3_ = (((_0_0 == 0) and (nil ~= _1_0)) and (frac < 0))
-      end
-      if _3_ then
-        local frac = _1_0
-        return ("-0." .. tostring(frac):gsub("^-?0.", ""))
-      elseif ((nil ~= _0_0) and (nil ~= _1_0)) then
-        local int = _0_0
-        local frac = _1_0
-        return (int .. "." .. tostring(frac):gsub("^-?0.", ""))
-      end
-    end
+    local _0_0 = string.gsub(tostring(n), ",", ".")
+    return _0_0
   end
   local function compile_scalar(ast, _scope, parent, opts)
     local serialize = nil
@@ -2343,9 +2458,13 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
         table.sort(_0_0, _1_)
         keys = _0_0
       end
-      local function _1_(k)
-        local v = tostring(compile1(ast[k[2]], scope, parent, {nval = 1})[1])
-        return string.format("%s = %s", k[1], v)
+      local function _1_(_2_0)
+        local _3_ = _2_0
+        local k1 = _3_[1]
+        local k2 = _3_[2]
+        local _4_ = compile1(ast[k2], scope, parent, {nval = 1})
+        local v = _4_[1]
+        return string.format("%s = %s", k1, tostring(v))
       end
       utils.map(keys, _1_, buffer)
     end
@@ -2375,8 +2494,6 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     local forceglobal = _0_["forceglobal"]
     local forceset = _0_["forceset"]
     local isvar = _0_["isvar"]
-    local nomulti = _0_["nomulti"]
-    local noundef = _0_["noundef"]
     local symtype = _0_["symtype"]
     local symtype0 = ("_" .. (symtype or "dst"))
     local setter = nil
@@ -2388,7 +2505,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     local new_manglings = {}
     local function getname(symbol, up1)
       local raw = symbol[1]
-      assert_compile(not (nomulti and utils["multi-sym?"](raw)), ("unexpected multi symbol " .. raw), up1)
+      assert_compile(not (opts0.nomulti and utils["multi-sym?"](raw)), ("unexpected multi symbol " .. raw), up1)
       if declaration then
         return declare_local(symbol, nil, scope, symbol, new_manglings)
       else
@@ -2397,7 +2514,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
         if ((#parts == 1) and not forceset) then
           assert_compile(not (forceglobal and meta), string.format("global %s conflicts with local", tostring(symbol)), symbol)
           assert_compile(not (meta and not meta.var), ("expected var " .. raw), symbol)
-          assert_compile((meta or not noundef), ("expected local " .. parts[1]), symbol)
+          assert_compile((meta or not opts0.noundef), ("expected local " .. parts[1]), symbol)
         end
         if forceglobal then
           assert_compile(not scope.symmeta[scope.unmanglings[raw]], ("global " .. raw .. " conflicts with local"), symbol)
@@ -2432,6 +2549,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
         end
         if ((#parent == (plen + 1)) and parent[#parent].leaf) then
           parent[#parent]["leaf"] = ("local " .. parent[#parent].leaf)
+        elseif (init == "nil") then
+          table.insert(parent, (plen + 1), {ast = ast, leaf = ("local " .. lvalue)})
         else
           table.insert(parent, (plen + 1), {ast = ast, leaf = ("local " .. lvalue .. " = " .. init)})
         end
@@ -2606,8 +2725,12 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     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_()
@@ -2618,7 +2741,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
           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)
@@ -2664,9 +2787,6 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     end
     return _0_
   end
-  local function no()
-    return nil
-  end
   local function mixed_concat(t, joiner)
     local seen = {}
     local ret, s = "", ""
@@ -2700,16 +2820,20 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
       local symstr = utils.deref(form)
       assert_compile(not runtime_3f, "symbols may only be used at compile time", form)
       if (symstr:find("#$") or symstr:find("#[:.]")) then
-        return string.format("sym('%s', nil, {filename=%s, line=%s})", autogensym(symstr, scope), filename, (form.line or "nil"))
+        return string.format("sym('%s', {filename=%s, line=%s})", autogensym(symstr, scope), filename, (form.line or "nil"))
       else
-        return string.format("sym('%s', nil, {quoted=true, filename=%s, line=%s})", symstr, filename, (form.line or "nil"))
+        return string.format("sym('%s', {quoted=true, filename=%s, line=%s})", symstr, filename, (form.line or "nil"))
       end
     elseif (utils["list?"](form) and utils["sym?"](form[1]) and (utils.deref(form[1]) == "unquote")) then
       local payload = form[2]
       local res = unpack(compile1(payload, scope, parent))
       return res[1]
     elseif utils["list?"](form) then
-      local mapped = utils.kvmap(form, entry_transform(no, q))
+      local mapped = nil
+      local function _0_()
+        return nil
+      end
+      mapped = utils.kvmap(form, entry_transform(_0_, q))
       local filename = nil
       if form.filename then
         filename = string.format("%q", form.filename)
@@ -2718,6 +2842,22 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
       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)
@@ -2748,7 +2888,7 @@ package.preload["fennel.friend"] = package.preload["fennel.friend"] or function(
     local m = getmetatable(ast)
     return ((m and m.line and m) or (("table" == type(ast)) and ast) or {})
   end
-  local suggestions = {["$ and $... in hashfn are mutually exclusive"] = {"modifying the hashfn so it only contains $... or $, $1, $2, $3, etc"}, ["can't start multisym segment with a digit"] = {"removing the digit", "adding a non-digit before the digit"}, ["cannot call literal value"] = {"checking for typos", "checking for a missing function name"}, ["could not compile value of type "] = {"debugging the macro you're calling 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 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
@@ -2780,21 +2920,19 @@ package.preload["fennel.friend"] = package.preload["fennel.friend"] 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
@@ -2927,6 +3065,7 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
       end
       return r
     end
+    assert(((nil == filename) or ("string" == type(filename))), "expected filename as second argument to parser")
     local function parse_error(msg, byteindex_override)
       local _0_ = (options or utils.root.options or {})
       local source = _0_["source"]
@@ -2947,8 +3086,17 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
           return nil
         elseif ((type(_0_0) == "table") and (nil ~= _0_0.prefix)) then
           local prefix = _0_0.prefix
-          table.remove(stack)
-          return dispatch(utils.list(utils.sym(prefix), v))
+          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
@@ -2984,7 +3132,7 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
           end
           return parse_comment(getb(), _1_())
         elseif (options and options.comments) then
-          return dispatch(utils.comment(table.concat(contents)))
+          return dispatch(utils.comment(table.concat(contents), {filename = filename, line = (line - 1)}))
         else
           return b
         end
@@ -3005,7 +3153,49 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
         end
         return dispatch(val)
       end
+      local function add_comment_at(comments, index, node)
+        local _0_0 = comments[index]
+        if (nil ~= _0_0) then
+          local existing = _0_0
+          return table.insert(existing, node)
+        else
+          local _ = _0_0
+          comments[index] = {node}
+          return nil
+        end
+      end
+      local function next_noncomment(tbl, i)
+        if utils["comment?"](tbl[i]) then
+          return next_noncomment(tbl, (i + 1))
+        else
+          return tbl[i]
+        end
+      end
+      local function extract_comments(tbl)
+        local comments = {keys = {}, last = {}, values = {}}
+        while utils["comment?"](tbl[#tbl]) do
+          table.insert(comments.last, 1, table.remove(tbl))
+        end
+        local last_key_3f = false
+        for i, node in ipairs(tbl) do
+          if not utils["comment?"](node) then
+            last_key_3f = not last_key_3f
+          elseif last_key_3f then
+            add_comment_at(comments.values, next_noncomment(tbl, i), node)
+          else
+            add_comment_at(comments.keys, next_noncomment(tbl, i), node)
+          end
+        end
+        for i = #tbl, 1, -1 do
+          if utils["comment?"](tbl[i]) then
+            table.remove(tbl, i)
+          end
+        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)
@@ -3017,7 +3207,10 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
             tbl[i] = tostring(tbl[(i + 1)])
           end
           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)
@@ -3025,7 +3218,7 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
         if (top == nil) then
           parse_error(("unexpected closing delimiter " .. string.char(b)))
         end
-        if (top.closer ~= b) then
+        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
@@ -3073,9 +3266,9 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
         return dispatch(load_fn())
       end
       local function parse_prefix(b)
-        table.insert(stack, {prefix = prefixes[b]})
+        table.insert(stack, {bytestart = byteindex, filename = filename, line = line, prefix = prefixes[b]})
         local nextb = getb()
-        if whitespace_3f(nextb) then
+        if (whitespace_3f(nextb) or (true == delims[nextb])) then
           if (b ~= 35) then
             parse_error("invalid whitespace after quoting prefix")
           end
@@ -3116,11 +3309,13 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
         if (rawstr:match("^~") and (rawstr ~= "~=")) then
           return parse_error("illegal character: ~")
         elseif rawstr:match("%.[0-9]") then
-          return parse_error(("can't start multisym segment " .. "with a digit: " .. rawstr), (((byteindex - #rawstr) + rawstr:find("%.[0-9]")) + 1))
+          return parse_error(("can't start multisym segment with a digit: " .. rawstr), (((byteindex - #rawstr) + rawstr:find("%.[0-9]")) + 1))
         elseif (rawstr:match("[%.:][%.:]") and (rawstr ~= "..") and (rawstr ~= "$...")) then
           return parse_error(("malformed multisym: " .. rawstr), ((byteindex - #rawstr) + 1 + rawstr:find("[%.:][%.:]")))
         elseif rawstr:match(":.+[%.:]") then
-          return parse_error(("method must be last component " .. "of multisym: " .. rawstr), ((byteindex - #rawstr) + rawstr:find(":.+[%.:]")))
+          return parse_error(("method must be last component of multisym: " .. rawstr), ((byteindex - #rawstr) + rawstr:find(":.+[%.:]")))
+        else
+          return rawstr
         end
       end
       local function parse_sym(b)
@@ -3134,12 +3329,8 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
           return dispatch(utils.varg())
         elseif rawstr:match("^:.+$") then
           return dispatch(rawstr:sub(2))
-        elseif parse_number(rawstr) then
-          return nil
-        elseif check_malformed_sym(rawstr) then
-          return nil
-        else
-          return dispatch(utils.sym(rawstr, nil, {byteend = byteindex, bytestart = bytestart, filename = filename, line = line}))
+        elseif not parse_number(rawstr) then
+          return dispatch(utils.sym(check_malformed_sym(rawstr), {byteend = byteindex, bytestart = bytestart, filename = filename, line = line}))
         end
       end
       local function parse_loop(b)
@@ -3185,19 +3376,27 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
     for k in pairs(t) do
       table.insert(keys, k)
     end
-    local function _0_(a, b)
-      return (tostring(a) < tostring(b))
+    local function _0_(_241, _242)
+      return (tostring(_241) < tostring(_242))
     end
     table.sort(keys, _0_)
     for i, k in ipairs(keys) do
       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], succ[idx] and 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
@@ -3207,9 +3406,8 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
     if (type(f) == "function") then
       f0 = f
     else
-      local s = f
-      local function _0_(x)
-        return x[s]
+      local function _0_(_241)
+        return _241[f]
       end
       f0 = _0_
     end
@@ -3228,9 +3426,8 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
     if (type(f) == "function") then
       f0 = f
     else
-      local s = f
-      local function _0_(x)
-        return x[s]
+      local function _0_(_241)
+        return _241[f]
       end
       f0 = _0_
     end
@@ -3302,10 +3499,19 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
     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", __fennelview = deref, __tostring = deref}
+  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
@@ -3320,9 +3526,9 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
   local function list(...)
     return setmetatable({...}, list_mt)
   end
-  local function sym(str, scope, source)
-    local s = {str, scope = scope}
-    for k, v in pairs((source or {})) do
+  local function sym(str, _3fsource, _3fscope)
+    local s = {str, ["?scope"] = _3fscope}
+    for k, v in pairs((_3fsource or {})) do
       if (type(k) == "string") then
         s[k] = v
       end
@@ -3336,8 +3542,11 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
   local function expr(strcode, etype)
     return setmetatable({strcode, type = etype}, expr_mt)
   end
-  local function comment_2a(contents)
-    return setmetatable({contents}, comment_mt)
+  local function comment_2a(contents, _3fsource)
+    local _1_ = (_3fsource or {})
+    local filename = _1_["filename"]
+    local line = _1_["line"]
+    return setmetatable({contents, filename = filename, line = line}, comment_mt)
   end
   local function varg()
     return vararg
@@ -3354,9 +3563,6 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
   local function sym_3f(x)
     return ((type(x) == "table") and (getmetatable(x) == symbol_mt) and x)
   end
-  local function table_3f(x)
-    return ((type(x) == "table") and (x ~= vararg) and (getmetatable(x) ~= list_mt) and (getmetatable(x) ~= symbol_mt) and x)
-  end
   local function sequence_3f(x)
     local mt = ((type(x) == "table") and getmetatable(x))
     return (mt and (mt.sequence == sequence_marker) and x)
@@ -3364,6 +3570,9 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
   local function comment_3f(x)
     return ((type(x) == "table") and (getmetatable(x) == comment_mt) and x)
   end
+  local function table_3f(x)
+    return ((type(x) == "table") and (x ~= vararg) and (getmetatable(x) ~= list_mt) and (getmetatable(x) ~= symbol_mt) and not comment_3f(x) and x)
+  end
   local function multi_sym_3f(str)
     if sym_3f(str) then
       return multi_sym_3f(tostring(str))
@@ -3450,7 +3659,7 @@ local compiler = require("fennel.compiler")
 local specials = require("fennel.specials")
 local repl = require("fennel.repl")
 local view = require("fennel.view")
-local function get_env(env)
+local function eval_env(env)
   if (env == "_COMPILER") then
     local env0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
     local mt = getmetatable(env0)
@@ -3460,26 +3669,32 @@ local function get_env(env)
     return (env and specials["wrap-env"](env))
   end
 end
-local function eval(str, options, ...)
+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 = get_env(opts.env)
+  if (not opts.filename and not opts.source) then
+    opts.source = str
+  end
+  if (opts.env == "_COMPILER") then
+    opts.scope = compiler["make-scope"](compiler.scopes.compiler)
+  end
+  return opts
+end
+local function eval(str, options, ...)
+  local opts = eval_opts(options, str)
+  local env = eval_env(opts.env)
   local 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
@@ -3491,7 +3706,7 @@ local function dofile_2a(filename, options, ...)
   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"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["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"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.8.0", view = view}
+local mod = {["comment?"] = utils["comment?"], ["compile-stream"] = compiler["compile-stream"], ["compile-string"] = compiler["compile-string"], ["list?"] = utils["list?"], ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["make-searcher"] = specials["make-searcher"], ["search-module"] = specials["search-module"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["sym?"] = utils["sym?"], comment = utils.comment, compile = compiler.compile, compile1 = compiler.compile1, compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], doc = specials.doc, dofile = dofile_2a, eval = eval, gensym = compiler.gensym, granulate = parser.granulate, list = utils.list, loadCode = specials["load-code"], macroLoaded = specials["macro-loaded"], makeSearcher = specials["make-searcher"], make_searcher = specials["make-searcher"], mangle = compiler["global-mangling"], metadata = compiler.metadata, parser = parser.parser, path = utils.path, repl = repl, scope = compiler["make-scope"], searchModule = specials["search-module"], searcher = specials["make-searcher"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.9.0", view = view}
 utils["fennel-module"] = mod
 do
   local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other
@@ -3504,7 +3719,7 @@ do
   ;; TODO: some of these macros modify their arguments; we should stop doing that,
   ;; but in a way that preserves file/line metadata.
   
-  (fn -> [val ...]
+  (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."
@@ -3515,7 +3730,7 @@ do
         (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."
@@ -3526,7 +3741,7 @@ do
         (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 "#" ...))
@@ -3541,7 +3756,7 @@ do
                  (-?> ,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 "#" ...))
@@ -3556,7 +3771,14 @@ do
                  (-?>> ,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])]
@@ -3566,28 +3788,32 @@ do
       (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 ,...)))
+         (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."
-    (let [bodyfn    `(fn [] ,...)
-          closer `(fn close-handlers# [ok# ...] (if ok# ...
-                                                    (error ... 0)))
+    (let [bodyfn `(fn []
+                    ,...)
+          closer `(fn close-handlers# [ok# ...]
+                    (if ok# ... (error ... 0)))
           traceback `(. (or package.loaded.fennel debug) :traceback)]
-      (for [i 1 (# closable-bindings) 2]
+      (for [i 1 (length closable-bindings) 2]
         (assert (sym? (. closable-bindings i))
                 "with-open only allows symbols in bindings")
         (table.insert closer 4 `(: ,(. closable-bindings i) :close)))
-      `(let ,closable-bindings ,closer
-            (close-handlers# (xpcall ,bodyfn ,traceback)))))
+      `(let ,closable-bindings
+         ,closer
+         (close-handlers# (xpcall ,bodyfn ,traceback)))))
   
-  (fn collect [iter-tbl key-value-expr ...]
+  (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
@@ -3600,8 +3826,7 @@ do
     {:red \"apple\" :orange \"orange\"}"
     (assert (and (sequence? iter-tbl) (>= (length iter-tbl) 2))
             "expected iterator binding table")
-    (assert (not= nil key-value-expr)
-            "expected key-value expression")
+    (assert (not= nil key-value-expr) "expected key-value expression")
     (assert (= nil ...)
             "expected exactly one body expression. Wrap multiple expressions with do")
     `(let [tbl# {}]
@@ -3610,7 +3835,7 @@ do
            (k# v#) (tset tbl# k# v#)))
        tbl#))
   
-  (fn icollect [iter-tbl value-expr ...]
+  (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\".
@@ -3621,8 +3846,7 @@ do
     [9 16 25]"
     (assert (and (sequence? iter-tbl) (>= (length iter-tbl) 2))
             "expected iterator binding table")
-    (assert (not= nil value-expr)
-            "expected table value expression")
+    (assert (not= nil value-expr) "expected table value expression")
     (assert (= nil ...)
             "expected exactly one body expression. Wrap multiple expressions with do")
     `(let [tbl# []]
@@ -3630,13 +3854,15 @@ do
          (tset tbl# (+ (length tbl#) 1) ,value-expr))
        tbl#))
   
-  (fn partial [f ...]
+  (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 [,_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,
@@ -3644,12 +3870,14 @@ do
   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)))))
+      (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,
@@ -3658,14 +3886,16 @@ do
     (let [(_0_ _1_) ...]
       (values _0_ _1_))"
     (assert (and (= :number (type n)) (>= n 0) (= n (math.floor n)))
-            "Expected n to be an integer >= 0")
-    (let [let-syms   (list)
-          let-values (if (= 1 (select :# ...)) ... `(values ,...))]
-      (for [i 1 n] (table.insert let-syms (gensym)))
+            (.. "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))))))
+          `(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 ?."
@@ -3673,23 +3903,25 @@ do
           has-internal-name? (sym? (. args 1))
           arglist (if has-internal-name? (. args 2) (. args 1))
           docstring-position (if has-internal-name? 3 2)
-          has-docstring? (and (> (# args) docstring-position)
+          has-docstring? (and (> (length args) docstring-position)
                               (= :string (type (. args docstring-position))))
           arity-check-position (- 4 (if has-internal-name? 0 1)
                                   (if has-docstring? 0 1))
-          empty-body? (< (# args) arity-check-position)]
+          empty-body? (< (length args) arity-check-position)]
       (fn check! [a]
         (if (table? a)
             (each [_ a (pairs a)]
               (check! a))
             (let [as (tostring a)]
-              (and (not (as:match "^?")) (not= as "&") (not= as "_") (not= as "...")))
+              (and (not (as:match "^?")) (not= as "&") (not= as "_")
+                   (not= as "...")))
             (table.insert args arity-check-position
                           `(assert (not= nil ,a)
                                    (string.format "Missing argument %s on %s:%s"
                                                   ,(tostring a)
-                                                  ,(or a.filename "unknown")
+                                                  ,(or a.filename :unknown)
                                                   ,(or a.line "?"))))))
+  
       (assert (= :table (type arglist)) "expected arg list")
       (each [_ a (ipairs arglist)]
         (check! a))
@@ -3697,27 +3929,27 @@ do
           (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 ,(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 [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:
     (import-macros mymacros                 :my-macros    ; bind to symbol
                    {:macro1 alias : macro2} :proj.macros) ; import by name"
-    (assert (and binding1 module-name1 (= 0 (% (select :# ...) 2)))
+    (assert (and binding1 module-name1 (= 0 (% (select "#" ...) 2)))
             "expected even number of binding/modulename pairs")
-    (for [i 1 (select :# binding1 module-name1 ...) 2]
+    (for [i 1 (select "#" binding1 module-name1 ...) 2]
       (let [(binding modname) (select i binding1 module-name1 ...)
             ;; generate a subscope of current scope, use require-macros
             ;; to bring in macro module. after that, we just copy the
@@ -3727,10 +3959,10 @@ do
         (_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)))
-  
+            (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)]
@@ -3757,16 +3989,26 @@ do
     (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 table.unpack
-                                                         _G.unpack)
-                                                     ,val))]))
-            (and (= :number (type k))
-                 (= "&" (tostring (. pattern (- k 1)))))
-            nil ; don't process the pattern right after &; already got it
+        (if (= pat `&)
+            (do
+              (assert (= nil (. pattern (+ k 2)))
+                      "expected & rest argument before last parameter")
+              (table.insert bindings (. pattern (+ k 1)))
+              (table.insert bindings
+                            [`(select ,k ((or table.unpack _G.unpack) ,val))]))
+            (= k `&as)
+            (do
+              (table.insert bindings pat)
+              (table.insert bindings val))
+            (and (= :number (type k)) (= `&as pat))
+            (do
+              (assert (= nil (. pattern (+ k 2)))
+                      "expected &as argument before last parameter")
+              (table.insert bindings (. pattern (+ k 1)))
+              (table.insert bindings val))
+            ;; don't process the pattern right after &/&as; already got it
+            (or (not= :number (type k)) (and (not= `&as (. pattern (- k 1)))
+                                             (not= `& (. pattern (- k 1)))))
             (let [subval `(. ,val ,k)
                   (subcondition subbindings) (match-pattern [subval] pat
                                                             unifications)]
@@ -3784,11 +4026,9 @@ do
     ;; of vals) or we're not, in which case we only care about the first one.
     (let [[val] vals]
       (if (or (and (sym? pattern) ; unification with outer locals (or nil)
-                   (not= :_ (tostring pattern)) ; never unify _
-                   (or (in-scope? pattern)
-                       (= :nil (tostring pattern))))
-              (and (multi-sym? pattern)
-                   (in-scope? (. (multi-sym? pattern) 1))))
+                   (not= "_" (tostring pattern)) ; never unify _
+                   (or (in-scope? pattern) (= :nil (tostring pattern))))
+              (and (multi-sym? pattern) (in-scope? (. (multi-sym? pattern) 1))))
           (values `(= ,val ,pattern) [])
           ;; unify a local we've seen already
           (and (sym? pattern) (. unifications (tostring pattern)))
@@ -3797,18 +4037,17 @@ do
           (sym? pattern)
           (let [wildcard? (: (tostring pattern) :find "^_")]
             (if (not wildcard?) (tset unifications (tostring pattern) val))
-            (values (if (or wildcard? (string.find (tostring pattern) "^?"))
-                        true `(not= ,(sym :nil) ,val))
-                    [pattern val]))
+            (values (if (or wildcard? (string.find (tostring pattern) "^?")) true
+                        `(not= ,(sym :nil) ,val)) [pattern val]))
           ;; guard clause
-          (and (list? pattern) (sym? (. pattern 2)) (= :? (tostring (. pattern 2))))
+          (and (list? pattern) (= (. pattern 2) `?))
           (let [(pcondition bindings) (match-pattern vals (. pattern 1)
                                                      unifications)
                 condition `(and ,pcondition)]
-            (for [i 3 (# pattern)] ; splice in guard clauses
+            (for [i 3 (length pattern)] ; splice in guard clauses
               (table.insert condition (. pattern i)))
-            (values `(let ,bindings ,condition) bindings))
-  
+            (values `(let ,bindings
+                       ,condition) bindings))
           ;; multi-valued patterns (represented as lists)
           (list? pattern)
           (match-values vals pattern unifications match-pattern)
@@ -3821,14 +4060,15 @@ do
   (fn match-condition [vals clauses]
     "Construct the actual `if` AST for the given match values and clauses."
     (if (not= 0 (% (length clauses) 2)) ; treat odd final clause as default
-        (table.insert clauses (length clauses) (sym :_)))
+        (table.insert clauses (length clauses) (sym "_")))
     (let [out `(if)]
       (for [i 1 (length clauses) 2]
         (let [pattern (. clauses i)
               body (. clauses (+ i 1))
               (condition bindings) (match-pattern vals pattern {})]
           (table.insert out condition)
-          (table.insert out `(let ,bindings ,body))))
+          (table.insert out `(let ,bindings
+                               ,body))))
       out))
   
   (fn match-val-syms [clauses]
@@ -3841,22 +4081,101 @@ do
                   (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
       ;; many values as we ever match against in the clauses.
-      (list `let [vals val]
-            (match-condition vals clauses))))
+      (list `let [vals val] (match-condition vals clauses))))
   
-  {: -> : ->> : -?> : -?>>
-   : doto : when : with-open
-   : collect : icollect
-   : 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