nano-bots 3.1.0 → 3.3.0

Sign up to get free protection for your applications and to get access to all the features.
@@ -6,7 +6,6 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
6
6
  local compiler = require("fennel.compiler")
7
7
  local specials = require("fennel.specials")
8
8
  local view = require("fennel.view")
9
- local unpack = (table.unpack or _G.unpack)
10
9
  local depth = 0
11
10
  local function prompt_for(top_3f)
12
11
  if top_3f then
@@ -26,18 +25,18 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
26
25
  return io.write("\n")
27
26
  end
28
27
  local function default_on_error(errtype, err, lua_source)
29
- local function _612_()
30
- local _611_0 = errtype
31
- if (_611_0 == "Lua Compile") then
28
+ local function _616_()
29
+ local _615_0 = errtype
30
+ if (_615_0 == "Lua Compile") then
32
31
  return ("Bad code generated - likely a bug with the compiler:\n" .. "--- Generated Lua Start ---\n" .. lua_source .. "--- Generated Lua End ---\n")
33
- elseif (_611_0 == "Runtime") then
32
+ elseif (_615_0 == "Runtime") then
34
33
  return (compiler.traceback(tostring(err), 4) .. "\n")
35
34
  else
36
- local _ = _611_0
35
+ local _ = _615_0
37
36
  return ("%s error: %s\n"):format(errtype, tostring(err))
38
37
  end
39
38
  end
40
- return io.write(_612_())
39
+ return io.write(_616_())
41
40
  end
42
41
  local function splice_save_locals(env, lua_source, scope)
43
42
  local saves = nil
@@ -77,25 +76,25 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
77
76
  else
78
77
  gap = " "
79
78
  end
80
- local function _618_()
79
+ local function _622_()
81
80
  if next(saves) then
82
81
  return (table.concat(saves, " ") .. gap)
83
82
  else
84
83
  return ""
85
84
  end
86
85
  end
87
- local function _621_()
88
- local _619_0, _620_0 = lua_source:match("^(.*)[\n ](return .*)$")
89
- if ((nil ~= _619_0) and (nil ~= _620_0)) then
90
- local body = _619_0
91
- local _return = _620_0
86
+ local function _625_()
87
+ local _623_0, _624_0 = lua_source:match("^(.*)[\n ](return .*)$")
88
+ if ((nil ~= _623_0) and (nil ~= _624_0)) then
89
+ local body = _623_0
90
+ local _return = _624_0
92
91
  return (body .. gap .. table.concat(binds, " ") .. gap .. _return)
93
92
  else
94
- local _ = _619_0
93
+ local _ = _623_0
95
94
  return lua_source
96
95
  end
97
96
  end
98
- return (_618_() .. _621_())
97
+ return (_622_() .. _625_())
99
98
  end
100
99
  local function completer(env, scope, text)
101
100
  local max_items = 2000
@@ -107,14 +106,14 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
107
106
  local scope_first_3f = ((tbl == env) or (tbl == env.___replLocals___))
108
107
  local tbl_17_ = matches
109
108
  local i_18_ = #tbl_17_
110
- local function _623_()
109
+ local function _627_()
111
110
  if scope_first_3f then
112
111
  return scope.manglings
113
112
  else
114
113
  return tbl
115
114
  end
116
115
  end
117
- for k, is_mangled in utils.allpairs(_623_()) do
116
+ for k, is_mangled in utils.allpairs(_627_()) do
118
117
  if (max_items <= #matches) then break end
119
118
  local val_19_ = nil
120
119
  do
@@ -182,7 +181,7 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
182
181
  return input:match("^%s*,")
183
182
  end
184
183
  local function command_docs()
185
- local _632_
184
+ local _636_
186
185
  do
187
186
  local tbl_17_ = {}
188
187
  local i_18_ = #tbl_17_
@@ -193,18 +192,18 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
193
192
  tbl_17_[i_18_] = val_19_
194
193
  end
195
194
  end
196
- _632_ = tbl_17_
195
+ _636_ = tbl_17_
197
196
  end
198
- return table.concat(_632_, "\n")
197
+ return table.concat(_636_, "\n")
199
198
  end
200
199
  commands.help = function(_, _0, on_values)
201
200
  return on_values({("Welcome to Fennel.\nThis is the REPL where you can enter code to be evaluated.\nYou can also run these repl commands:\n\n" .. command_docs() .. "\n ,return FORM - Evaluate FORM and return its value to the REPL's caller.\n ,exit - Leave the repl.\n\nUse ,doc something to see descriptions for individual macros and special forms.\nValues from previous inputs are kept in *1, *2, and *3.\n\nFor more information about the language, see https://fennel-lang.org/reference")})
202
201
  end
203
202
  do end (compiler.metadata):set(commands.help, "fnl/docstring", "Show this message.")
204
203
  local function reload(module_name, env, on_values, on_error)
205
- local _634_0, _635_0 = pcall(specials["load-code"]("return require(...)", env), module_name)
206
- if ((_634_0 == true) and (nil ~= _635_0)) then
207
- local old = _635_0
204
+ local _638_0, _639_0 = pcall(specials["load-code"]("return require(...)", env), module_name)
205
+ if ((_638_0 == true) and (nil ~= _639_0)) then
206
+ local old = _639_0
208
207
  local _ = nil
209
208
  package.loaded[module_name] = nil
210
209
  _ = nil
@@ -229,8 +228,8 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
229
228
  package.loaded[module_name] = old
230
229
  end
231
230
  return on_values({"ok"})
232
- elseif ((_634_0 == false) and (nil ~= _635_0)) then
233
- local msg = _635_0
231
+ elseif ((_638_0 == false) and (nil ~= _639_0)) then
232
+ local msg = _639_0
234
233
  if msg:match("loop or previous error loading module") then
235
234
  package.loaded[module_name] = nil
236
235
  return reload(module_name, env, on_values, on_error)
@@ -238,32 +237,32 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
238
237
  specials["macro-loaded"][module_name] = nil
239
238
  return nil
240
239
  else
241
- local function _640_()
242
- local _639_0 = msg:gsub("\n.*", "")
243
- return _639_0
240
+ local function _644_()
241
+ local _643_0 = msg:gsub("\n.*", "")
242
+ return _643_0
244
243
  end
245
- return on_error("Runtime", _640_())
244
+ return on_error("Runtime", _644_())
246
245
  end
247
246
  end
248
247
  end
249
248
  local function run_command(read, on_error, f)
250
- local _643_0, _644_0, _645_0 = pcall(read)
251
- if ((_643_0 == true) and (_644_0 == true) and (nil ~= _645_0)) then
252
- local val = _645_0
253
- local _646_0, _647_0 = pcall(f, val)
254
- if ((_646_0 == false) and (nil ~= _647_0)) then
255
- local msg = _647_0
249
+ local _647_0, _648_0, _649_0 = pcall(read)
250
+ if ((_647_0 == true) and (_648_0 == true) and (nil ~= _649_0)) then
251
+ local val = _649_0
252
+ local _650_0, _651_0 = pcall(f, val)
253
+ if ((_650_0 == false) and (nil ~= _651_0)) then
254
+ local msg = _651_0
256
255
  return on_error("Runtime", msg)
257
256
  end
258
- elseif (_643_0 == false) then
257
+ elseif (_647_0 == false) then
259
258
  return on_error("Parse", "Couldn't parse input.")
260
259
  end
261
260
  end
262
261
  commands.reload = function(env, read, on_values, on_error)
263
- local function _650_(_241)
262
+ local function _654_(_241)
264
263
  return reload(tostring(_241), env, on_values, on_error)
265
264
  end
266
- return run_command(read, on_error, _650_)
265
+ return run_command(read, on_error, _654_)
267
266
  end
268
267
  do end (compiler.metadata):set(commands.reload, "fnl/docstring", "Reload the specified module.")
269
268
  commands.reset = function(env, _, on_values)
@@ -272,28 +271,28 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
272
271
  end
273
272
  do end (compiler.metadata):set(commands.reset, "fnl/docstring", "Erase all repl-local scope.")
274
273
  commands.complete = function(env, read, on_values, on_error, scope, chars)
275
- local function _651_()
274
+ local function _655_()
276
275
  return on_values(completer(env, scope, table.concat(chars):gsub(",complete +", ""):sub(1, -2)))
277
276
  end
278
- return run_command(read, on_error, _651_)
277
+ return run_command(read, on_error, _655_)
279
278
  end
280
279
  do end (compiler.metadata):set(commands.complete, "fnl/docstring", "Print all possible completions for a given input symbol.")
281
280
  local function apropos_2a(pattern, tbl, prefix, seen, names)
282
281
  for name, subtbl in pairs(tbl) do
283
282
  if (("string" == type(name)) and (package ~= subtbl)) then
284
- local _652_0 = type(subtbl)
285
- if (_652_0 == "function") then
283
+ local _656_0 = type(subtbl)
284
+ if (_656_0 == "function") then
286
285
  if ((prefix .. name)):match(pattern) then
287
286
  table.insert(names, (prefix .. name))
288
287
  end
289
- elseif (_652_0 == "table") then
288
+ elseif (_656_0 == "table") then
290
289
  if not seen[subtbl] then
291
- local _654_
290
+ local _658_
292
291
  do
293
292
  seen[subtbl] = true
294
- _654_ = seen
293
+ _658_ = seen
295
294
  end
296
- apropos_2a(pattern, subtbl, (prefix .. name:gsub("%.", "/") .. "."), _654_, names)
295
+ apropos_2a(pattern, subtbl, (prefix .. name:gsub("%.", "/") .. "."), _658_, names)
297
296
  end
298
297
  end
299
298
  end
@@ -314,10 +313,10 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
314
313
  return tbl_17_
315
314
  end
316
315
  commands.apropos = function(_env, read, on_values, on_error, _scope)
317
- local function _659_(_241)
316
+ local function _663_(_241)
318
317
  return on_values(apropos(tostring(_241)))
319
318
  end
320
- return run_command(read, on_error, _659_)
319
+ return run_command(read, on_error, _663_)
321
320
  end
322
321
  do end (compiler.metadata):set(commands.apropos, "fnl/docstring", "Print all functions matching a pattern in all loaded modules.")
323
322
  local function apropos_follow_path(path)
@@ -337,12 +336,12 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
337
336
  local tgt = package.loaded
338
337
  for _, path0 in ipairs(paths) do
339
338
  if (nil == tgt) then break end
340
- local _662_
339
+ local _666_
341
340
  do
342
- local _661_0 = path0:gsub("%/", ".")
343
- _662_ = _661_0
341
+ local _665_0 = path0:gsub("%/", ".")
342
+ _666_ = _665_0
344
343
  end
345
- tgt = tgt[_662_]
344
+ tgt = tgt[_666_]
346
345
  end
347
346
  return tgt
348
347
  end
@@ -354,9 +353,9 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
354
353
  do
355
354
  local tgt = apropos_follow_path(path)
356
355
  if ("function" == type(tgt)) then
357
- local _663_0 = (compiler.metadata):get(tgt, "fnl/docstring")
358
- if (nil ~= _663_0) then
359
- local docstr = _663_0
356
+ local _667_0 = (compiler.metadata):get(tgt, "fnl/docstring")
357
+ if (nil ~= _667_0) then
358
+ local docstr = _667_0
360
359
  val_19_ = (docstr:match(pattern) and path)
361
360
  else
362
361
  val_19_ = nil
@@ -373,10 +372,10 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
373
372
  return tbl_17_
374
373
  end
375
374
  commands["apropos-doc"] = function(_env, read, on_values, on_error, _scope)
376
- local function _667_(_241)
375
+ local function _671_(_241)
377
376
  return on_values(apropos_doc(tostring(_241)))
378
377
  end
379
- return run_command(read, on_error, _667_)
378
+ return run_command(read, on_error, _671_)
380
379
  end
381
380
  do end (compiler.metadata):set(commands["apropos-doc"], "fnl/docstring", "Print all functions that match the pattern in their docs")
382
381
  local function apropos_show_docs(on_values, pattern)
@@ -390,108 +389,108 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
390
389
  return nil
391
390
  end
392
391
  commands["apropos-show-docs"] = function(_env, read, on_values, on_error)
393
- local function _669_(_241)
392
+ local function _673_(_241)
394
393
  return apropos_show_docs(on_values, tostring(_241))
395
394
  end
396
- return run_command(read, on_error, _669_)
395
+ return run_command(read, on_error, _673_)
397
396
  end
398
397
  do end (compiler.metadata):set(commands["apropos-show-docs"], "fnl/docstring", "Print all documentations matching a pattern in function name")
399
- local function resolve(identifier, _670_0, scope)
400
- local _671_ = _670_0
401
- local env = _671_
402
- local ___replLocals___ = _671_["___replLocals___"]
398
+ local function resolve(identifier, _674_0, scope)
399
+ local _675_ = _674_0
400
+ local env = _675_
401
+ local ___replLocals___ = _675_["___replLocals___"]
403
402
  local e = nil
404
- local function _672_(_241, _242)
403
+ local function _676_(_241, _242)
405
404
  return (___replLocals___[scope.unmanglings[_242]] or env[_242])
406
405
  end
407
- e = setmetatable({}, {__index = _672_})
408
- local function _673_(...)
409
- local _674_0, _675_0 = ...
410
- if ((_674_0 == true) and (nil ~= _675_0)) then
411
- local code = _675_0
412
- local function _676_(...)
413
- local _677_0, _678_0 = ...
414
- if ((_677_0 == true) and (nil ~= _678_0)) then
415
- local val = _678_0
406
+ e = setmetatable({}, {__index = _676_})
407
+ local function _677_(...)
408
+ local _678_0, _679_0 = ...
409
+ if ((_678_0 == true) and (nil ~= _679_0)) then
410
+ local code = _679_0
411
+ local function _680_(...)
412
+ local _681_0, _682_0 = ...
413
+ if ((_681_0 == true) and (nil ~= _682_0)) then
414
+ local val = _682_0
416
415
  return val
417
416
  else
418
- local _ = _677_0
417
+ local _ = _681_0
419
418
  return nil
420
419
  end
421
420
  end
422
- return _676_(pcall(specials["load-code"](code, e)))
421
+ return _680_(pcall(specials["load-code"](code, e)))
423
422
  else
424
- local _ = _674_0
423
+ local _ = _678_0
425
424
  return nil
426
425
  end
427
426
  end
428
- return _673_(pcall(compiler["compile-string"], tostring(identifier), {scope = scope}))
427
+ return _677_(pcall(compiler["compile-string"], tostring(identifier), {scope = scope}))
429
428
  end
430
429
  commands.find = function(env, read, on_values, on_error, scope)
431
- local function _681_(_241)
432
- local _682_0 = nil
430
+ local function _685_(_241)
431
+ local _686_0 = nil
433
432
  do
434
- local _683_0 = utils["sym?"](_241)
435
- if (nil ~= _683_0) then
436
- local _684_0 = resolve(_683_0, env, scope)
437
- if (nil ~= _684_0) then
438
- _682_0 = debug.getinfo(_684_0)
433
+ local _687_0 = utils["sym?"](_241)
434
+ if (nil ~= _687_0) then
435
+ local _688_0 = resolve(_687_0, env, scope)
436
+ if (nil ~= _688_0) then
437
+ _686_0 = debug.getinfo(_688_0)
439
438
  else
440
- _682_0 = _684_0
439
+ _686_0 = _688_0
441
440
  end
442
441
  else
443
- _682_0 = _683_0
442
+ _686_0 = _687_0
444
443
  end
445
444
  end
446
- if ((_G.type(_682_0) == "table") and (nil ~= _682_0.linedefined) and (nil ~= _682_0.short_src) and (nil ~= _682_0.source) and (_682_0.what == "Lua")) then
447
- local line = _682_0.linedefined
448
- local src = _682_0.short_src
449
- local source = _682_0.source
445
+ if ((_G.type(_686_0) == "table") and (nil ~= _686_0.linedefined) and (nil ~= _686_0.short_src) and (nil ~= _686_0.source) and (_686_0.what == "Lua")) then
446
+ local line = _686_0.linedefined
447
+ local src = _686_0.short_src
448
+ local source = _686_0.source
450
449
  local fnlsrc = nil
451
450
  do
452
- local _687_0 = compiler.sourcemap
453
- if (nil ~= _687_0) then
454
- _687_0 = _687_0[source]
451
+ local _691_0 = compiler.sourcemap
452
+ if (nil ~= _691_0) then
453
+ _691_0 = _691_0[source]
455
454
  end
456
- if (nil ~= _687_0) then
457
- _687_0 = _687_0[line]
455
+ if (nil ~= _691_0) then
456
+ _691_0 = _691_0[line]
458
457
  end
459
- if (nil ~= _687_0) then
460
- _687_0 = _687_0[2]
458
+ if (nil ~= _691_0) then
459
+ _691_0 = _691_0[2]
461
460
  end
462
- fnlsrc = _687_0
461
+ fnlsrc = _691_0
463
462
  end
464
463
  return on_values({string.format("%s:%s", src, (fnlsrc or line))})
465
- elseif (_682_0 == nil) then
464
+ elseif (_686_0 == nil) then
466
465
  return on_error("Repl", "Unknown value")
467
466
  else
468
- local _ = _682_0
467
+ local _ = _686_0
469
468
  return on_error("Repl", "No source info")
470
469
  end
471
470
  end
472
- return run_command(read, on_error, _681_)
471
+ return run_command(read, on_error, _685_)
473
472
  end
474
473
  do end (compiler.metadata):set(commands.find, "fnl/docstring", "Print the filename and line number for a given function")
475
474
  commands.doc = function(env, read, on_values, on_error, scope)
476
- local function _692_(_241)
475
+ local function _696_(_241)
477
476
  local name = tostring(_241)
478
477
  local path = (utils["multi-sym?"](name) or {name})
479
478
  local ok_3f, target = nil, nil
480
- local function _693_()
479
+ local function _697_()
481
480
  return (utils["get-in"](scope.specials, path) or utils["get-in"](scope.macros, path) or resolve(name, env, scope))
482
481
  end
483
- ok_3f, target = pcall(_693_)
482
+ ok_3f, target = pcall(_697_)
484
483
  if ok_3f then
485
484
  return on_values({specials.doc(target, name)})
486
485
  else
487
486
  return on_error("Repl", ("Could not find " .. name .. " for docs."))
488
487
  end
489
488
  end
490
- return run_command(read, on_error, _692_)
489
+ return run_command(read, on_error, _696_)
491
490
  end
492
491
  do end (compiler.metadata):set(commands.doc, "fnl/docstring", "Print the docstring and arglist for a function, macro, or special form.")
493
492
  commands.compile = function(env, read, on_values, on_error, scope)
494
- local function _695_(_241)
493
+ local function _699_(_241)
495
494
  local allowedGlobals = specials["current-global-names"](env)
496
495
  local ok_3f, result = pcall(compiler.compile, _241, {allowedGlobals = allowedGlobals, env = env, scope = scope})
497
496
  if ok_3f then
@@ -500,15 +499,15 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
500
499
  return on_error("Repl", ("Error compiling expression: " .. result))
501
500
  end
502
501
  end
503
- return run_command(read, on_error, _695_)
502
+ return run_command(read, on_error, _699_)
504
503
  end
505
504
  do end (compiler.metadata):set(commands.compile, "fnl/docstring", "compiles the expression into lua and prints the result.")
506
505
  local function load_plugin_commands(plugins)
507
506
  for i = #(plugins or {}), 1, -1 do
508
507
  for name, f in pairs(plugins[i]) do
509
- local _697_0 = name:match("^repl%-command%-(.*)")
510
- if (nil ~= _697_0) then
511
- local cmd_name = _697_0
508
+ local _701_0 = name:match("^repl%-command%-(.*)")
509
+ if (nil ~= _701_0) then
510
+ local cmd_name = _701_0
512
511
  commands[cmd_name] = f
513
512
  end
514
513
  end
@@ -518,12 +517,12 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
518
517
  local function run_command_loop(input, read, loop, env, on_values, on_error, scope, chars)
519
518
  local command_name = input:match(",([^%s/]+)")
520
519
  do
521
- local _699_0 = commands[command_name]
522
- if (nil ~= _699_0) then
523
- local command = _699_0
520
+ local _703_0 = commands[command_name]
521
+ if (nil ~= _703_0) then
522
+ local command = _703_0
524
523
  command(env, read, on_values, on_error, scope, chars)
525
524
  else
526
- local _ = _699_0
525
+ local _ = _703_0
527
526
  if ((command_name ~= "exit") and (command_name ~= "return")) then
528
527
  on_values({"Unknown command", command_name})
529
528
  end
@@ -573,9 +572,9 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
573
572
  end
574
573
  local function repl(_3foptions)
575
574
  local old_root_options = utils.root.options
576
- local _708_ = utils.copy(_3foptions)
577
- local opts = _708_
578
- local _3ffennelrc = _708_["fennelrc"]
575
+ local _712_ = utils.copy(_3foptions)
576
+ local opts = _712_
577
+ local _3ffennelrc = _712_["fennelrc"]
579
578
  local _ = nil
580
579
  opts.fennelrc = nil
581
580
  _ = nil
@@ -590,20 +589,20 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
590
589
  local callbacks = {env = env, onError = (opts.onError or default_on_error), onValues = (opts.onValues or default_on_values), pp = (opts.pp or view), readChunk = (opts.readChunk or default_read_chunk)}
591
590
  local save_locals_3f = (opts.saveLocals ~= false)
592
591
  local byte_stream, clear_stream = nil, nil
593
- local function _710_(_241)
592
+ local function _714_(_241)
594
593
  return callbacks.readChunk(_241)
595
594
  end
596
- byte_stream, clear_stream = parser.granulate(_710_)
595
+ byte_stream, clear_stream = parser.granulate(_714_)
597
596
  local chars = {}
598
597
  local read, reset = nil, nil
599
- local function _711_(parser_state)
598
+ local function _715_(parser_state)
600
599
  local b = byte_stream(parser_state)
601
600
  if b then
602
601
  table.insert(chars, string.char(b))
603
602
  end
604
603
  return b
605
604
  end
606
- read, reset = parser.parser(_711_)
605
+ read, reset = parser.parser(_715_)
607
606
  depth = (depth + 1)
608
607
  if opts.message then
609
608
  callbacks.onValues({opts.message})
@@ -618,14 +617,14 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
618
617
  opts.init(opts, depth)
619
618
  end
620
619
  if opts.registerCompleter then
621
- local function _717_()
622
- local _716_0 = opts.scope
623
- local function _718_(...)
624
- return completer(env, _716_0, ...)
620
+ local function _721_()
621
+ local _720_0 = opts.scope
622
+ local function _722_(...)
623
+ return completer(env, _720_0, ...)
625
624
  end
626
- return _718_
625
+ return _722_
627
626
  end
628
- opts.registerCompleter(_717_())
627
+ opts.registerCompleter(_721_())
629
628
  end
630
629
  load_plugin_commands(opts.plugins)
631
630
  if save_locals_3f then
@@ -672,28 +671,28 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
672
671
  return run_command_loop(src_string, read, loop, env, callbacks.onValues, callbacks.onError, opts.scope, chars)
673
672
  else
674
673
  if not_eof_3f then
675
- local function _722_(...)
676
- local _723_0, _724_0 = ...
677
- if ((_723_0 == true) and (nil ~= _724_0)) then
678
- local src = _724_0
679
- local function _725_(...)
680
- local _726_0, _727_0 = ...
681
- if ((_726_0 == true) and (nil ~= _727_0)) then
682
- local chunk = _727_0
683
- local function _728_()
674
+ local function _726_(...)
675
+ local _727_0, _728_0 = ...
676
+ if ((_727_0 == true) and (nil ~= _728_0)) then
677
+ local src = _728_0
678
+ local function _729_(...)
679
+ local _730_0, _731_0 = ...
680
+ if ((_730_0 == true) and (nil ~= _731_0)) then
681
+ local chunk = _731_0
682
+ local function _732_()
684
683
  return print_values(save_value(chunk()))
685
684
  end
686
- local function _729_(...)
685
+ local function _733_(...)
687
686
  return callbacks.onError("Runtime", ...)
688
687
  end
689
- return xpcall(_728_, _729_)
690
- elseif ((_726_0 == false) and (nil ~= _727_0)) then
691
- local msg = _727_0
688
+ return xpcall(_732_, _733_)
689
+ elseif ((_730_0 == false) and (nil ~= _731_0)) then
690
+ local msg = _731_0
692
691
  clear_stream()
693
692
  return callbacks.onError("Compile", msg)
694
693
  end
695
694
  end
696
- local function _732_(...)
695
+ local function _736_(...)
697
696
  local src0 = nil
698
697
  if save_locals_3f then
699
698
  src0 = splice_save_locals(env, src, opts.scope)
@@ -702,18 +701,18 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
702
701
  end
703
702
  return pcall(specials["load-code"], src0, env)
704
703
  end
705
- return _725_(_732_(...))
706
- elseif ((_723_0 == false) and (nil ~= _724_0)) then
707
- local msg = _724_0
704
+ return _729_(_736_(...))
705
+ elseif ((_727_0 == false) and (nil ~= _728_0)) then
706
+ local msg = _728_0
708
707
  clear_stream()
709
708
  return callbacks.onError("Compile", msg)
710
709
  end
711
710
  end
712
- local function _734_()
711
+ local function _738_()
713
712
  opts["source"] = src_string
714
713
  return opts
715
714
  end
716
- _722_(pcall(compiler.compile, form, _734_()))
715
+ _726_(pcall(compiler.compile, form, _738_()))
717
716
  utils.root.options = old_root_options
718
717
  if exit_next_3f then
719
718
  return env.___replLocals___["*1"]
@@ -733,7 +732,10 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
733
732
  end
734
733
  return value
735
734
  end
736
- return repl
735
+ local function _744_(overrides, _3fopts)
736
+ return repl(utils.copy(_3fopts, utils.copy(overrides)))
737
+ end
738
+ return setmetatable({}, {__call = _744_, __index = {repl = repl}})
737
739
  end
738
740
  package.preload["fennel.specials"] = package.preload["fennel.specials"] or function(...)
739
741
  local utils = require("fennel.utils")
@@ -743,14 +745,14 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
743
745
  local unpack = (table.unpack or _G.unpack)
744
746
  local SPECIALS = compiler.scopes.global.specials
745
747
  local function wrap_env(env)
746
- local function _417_(_, key)
748
+ local function _420_(_, key)
747
749
  if utils["string?"](key) then
748
750
  return env[compiler["global-unmangling"](key)]
749
751
  else
750
752
  return env[key]
751
753
  end
752
754
  end
753
- local function _419_(_, key, value)
755
+ local function _422_(_, key, value)
754
756
  if utils["string?"](key) then
755
757
  env[compiler["global-unmangling"](key)] = value
756
758
  return nil
@@ -759,26 +761,29 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
759
761
  return nil
760
762
  end
761
763
  end
762
- local function _421_()
764
+ local function _424_()
763
765
  local function putenv(k, v)
764
- local _422_
766
+ local _425_
765
767
  if utils["string?"](k) then
766
- _422_ = compiler["global-unmangling"](k)
768
+ _425_ = compiler["global-unmangling"](k)
767
769
  else
768
- _422_ = k
770
+ _425_ = k
769
771
  end
770
- return _422_, v
772
+ return _425_, v
771
773
  end
772
774
  return next, utils.kvmap(env, putenv), nil
773
775
  end
774
- return setmetatable({}, {__index = _417_, __newindex = _419_, __pairs = _421_})
776
+ return setmetatable({}, {__index = _420_, __newindex = _422_, __pairs = _424_})
777
+ end
778
+ local function fennel_module_name()
779
+ return (utils.root.options.moduleName or "fennel")
775
780
  end
776
781
  local function current_global_names(_3fenv)
777
782
  local mt = nil
778
783
  do
779
- local _424_0 = getmetatable(_3fenv)
780
- if ((_G.type(_424_0) == "table") and (nil ~= _424_0.__pairs)) then
781
- local mtpairs = _424_0.__pairs
784
+ local _427_0 = getmetatable(_3fenv)
785
+ if ((_G.type(_427_0) == "table") and (nil ~= _427_0.__pairs)) then
786
+ local mtpairs = _427_0.__pairs
782
787
  local tbl_14_ = {}
783
788
  for k, v in mtpairs(_3fenv) do
784
789
  local k_15_, v_16_ = k, v
@@ -787,7 +792,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
787
792
  end
788
793
  end
789
794
  mt = tbl_14_
790
- elseif (_424_0 == nil) then
795
+ elseif (_427_0 == nil) then
791
796
  mt = (_3fenv or _G)
792
797
  else
793
798
  mt = nil
@@ -797,15 +802,15 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
797
802
  end
798
803
  local function load_code(code, _3fenv, _3ffilename)
799
804
  local env = (_3fenv or rawget(_G, "_ENV") or _G)
800
- local _427_0, _428_0 = rawget(_G, "setfenv"), rawget(_G, "loadstring")
801
- if ((nil ~= _427_0) and (nil ~= _428_0)) then
802
- local setfenv = _427_0
803
- local loadstring = _428_0
805
+ local _430_0, _431_0 = rawget(_G, "setfenv"), rawget(_G, "loadstring")
806
+ if ((nil ~= _430_0) and (nil ~= _431_0)) then
807
+ local setfenv = _430_0
808
+ local loadstring = _431_0
804
809
  local f = assert(loadstring(code, _3ffilename))
805
810
  setfenv(f, env)
806
811
  return f
807
812
  else
808
- local _ = _427_0
813
+ local _ = _430_0
809
814
  return assert(load(code, _3ffilename, "t", env))
810
815
  end
811
816
  end
@@ -817,13 +822,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
817
822
  local mt = getmetatable(tgt)
818
823
  if ((type(tgt) == "function") or ((type(mt) == "table") and (type(mt.__call) == "function"))) then
819
824
  local arglist = table.concat(((compiler.metadata):get(tgt, "fnl/arglist") or {"#<unknown-arguments>"}), " ")
820
- local _430_
825
+ local _433_
821
826
  if (0 < #arglist) then
822
- _430_ = " "
827
+ _433_ = " "
823
828
  else
824
- _430_ = ""
829
+ _433_ = ""
825
830
  end
826
- return string.format("(%s%s%s)\n %s", name, _430_, arglist, docstring)
831
+ return string.format("(%s%s%s)\n %s", name, _433_, arglist, docstring)
827
832
  else
828
833
  return string.format("%s\n %s", name, docstring)
829
834
  end
@@ -848,6 +853,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
848
853
  local chunk = (_3fchunk or {})
849
854
  local len = #ast
850
855
  local retexprs = {returned = true}
856
+ utils.hook("pre-do", ast, sub_scope)
851
857
  local function compile_body(outer_target, outer_tail, outer_retexprs)
852
858
  for i = start, len do
853
859
  local subopts = {nval = (((i ~= len) and 0) or opts.nval), tail = (((i == len) and outer_tail) or nil), target = (((i == len) and outer_target) or nil)}
@@ -932,9 +938,9 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
932
938
  local opts = {nval = 1, tail = false}
933
939
  local scope = compiler["make-scope"]()
934
940
  local chunk = {}
935
- local _440_ = compiler.compile1(v, scope, chunk, opts)
936
- local _441_ = _440_[1]
937
- local v0 = _441_[1]
941
+ local _443_ = compiler.compile1(v, scope, chunk, opts)
942
+ local _444_ = _443_[1]
943
+ local v0 = _444_[1]
938
944
  return v0
939
945
  end
940
946
  local function insert_meta(meta, k, v)
@@ -942,23 +948,23 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
942
948
  compiler.assert((type(k) == "string"), ("expected string keys in metadata table, got: %s"):format(view(k, view_opts)))
943
949
  compiler.assert(literal_3f(v), ("expected literal value in metadata table, got: %s %s"):format(view(k, view_opts), view(v, view_opts)))
944
950
  table.insert(meta, view(k))
945
- local function _442_()
951
+ local function _445_()
946
952
  if ("string" == type(v)) then
947
953
  return view(v, view_opts)
948
954
  else
949
955
  return compile_value(v)
950
956
  end
951
957
  end
952
- table.insert(meta, _442_())
958
+ table.insert(meta, _445_())
953
959
  return meta
954
960
  end
955
961
  local function insert_arglist(meta, arg_list)
956
962
  local view_opts = {["escape-newlines?"] = true, ["line-length"] = math.huge, ["one-line?"] = true}
957
963
  table.insert(meta, "\"fnl/arglist\"")
958
- local function _443_(_241)
964
+ local function _446_(_241)
959
965
  return view(view(_241, view_opts))
960
966
  end
961
- table.insert(meta, ("{" .. table.concat(utils.map(arg_list, _443_), ", ") .. "}"))
967
+ table.insert(meta, ("{" .. table.concat(utils.map(arg_list, _446_), ", ") .. "}"))
962
968
  return meta
963
969
  end
964
970
  local function set_fn_metadata(f_metadata, parent, fn_name)
@@ -971,34 +977,35 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
971
977
  insert_meta(meta_fields, k, v)
972
978
  end
973
979
  end
974
- local meta_str = ("require(\"%s\").metadata"):format((utils.root.options.moduleName or "fennel"))
980
+ local meta_str = ("require(\"%s\").metadata"):format(fennel_module_name())
975
981
  return compiler.emit(parent, ("pcall(function() %s:setall(%s, %s) end)"):format(meta_str, fn_name, table.concat(meta_fields, ", ")))
976
982
  end
977
983
  end
978
984
  local function get_fn_name(ast, scope, fn_name, multi)
979
985
  if (fn_name and (fn_name[1] ~= "nil")) then
980
- local _446_
986
+ local _449_
981
987
  if not multi then
982
- _446_ = compiler["declare-local"](fn_name, {}, scope, ast)
988
+ _449_ = compiler["declare-local"](fn_name, {}, scope, ast)
983
989
  else
984
- _446_ = compiler["symbol-to-expression"](fn_name, scope)[1]
990
+ _449_ = compiler["symbol-to-expression"](fn_name, scope)[1]
985
991
  end
986
- return _446_, not multi, 3
992
+ return _449_, not multi, 3
987
993
  else
988
994
  return nil, true, 2
989
995
  end
990
996
  end
991
997
  local function compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, local_3f, arg_name_list, f_metadata)
998
+ utils.hook("pre-fn", ast, f_scope)
992
999
  for i = (index + 1), #ast do
993
1000
  compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
994
1001
  end
995
- local _449_
1002
+ local _452_
996
1003
  if local_3f then
997
- _449_ = "local function %s(%s)"
1004
+ _452_ = "local function %s(%s)"
998
1005
  else
999
- _449_ = "%s = function(%s)"
1006
+ _452_ = "%s = function(%s)"
1000
1007
  end
1001
- compiler.emit(parent, string.format(_449_, fn_name, table.concat(arg_name_list, ", ")), ast)
1008
+ compiler.emit(parent, string.format(_452_, fn_name, table.concat(arg_name_list, ", ")), ast)
1002
1009
  compiler.emit(parent, f_chunk, ast)
1003
1010
  compiler.emit(parent, "end", ast)
1004
1011
  set_fn_metadata(f_metadata, parent, fn_name)
@@ -1020,7 +1027,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1020
1027
  end
1021
1028
  end
1022
1029
  local function get_function_metadata(ast, arg_list, index)
1023
- local function _452_(_241, _242)
1030
+ local function _455_(_241, _242)
1024
1031
  local tbl_14_ = _241
1025
1032
  for k, v in pairs(_242) do
1026
1033
  local k_15_, v_16_ = k, v
@@ -1030,18 +1037,18 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1030
1037
  end
1031
1038
  return tbl_14_
1032
1039
  end
1033
- local function _454_(_241, _242)
1040
+ local function _457_(_241, _242)
1034
1041
  _241["fnl/docstring"] = _242
1035
1042
  return _241
1036
1043
  end
1037
- return maybe_metadata(ast, utils["kv-table?"], _452_, maybe_metadata(ast, utils["string?"], _454_, {["fnl/arglist"] = arg_list}, index))
1044
+ return maybe_metadata(ast, utils["kv-table?"], _455_, maybe_metadata(ast, utils["string?"], _457_, {["fnl/arglist"] = arg_list}, index))
1038
1045
  end
1039
1046
  SPECIALS.fn = function(ast, scope, parent)
1040
1047
  local f_scope = nil
1041
1048
  do
1042
- local _455_0 = compiler["make-scope"](scope)
1043
- _455_0["vararg"] = false
1044
- f_scope = _455_0
1049
+ local _458_0 = compiler["make-scope"](scope)
1050
+ _458_0["vararg"] = false
1051
+ f_scope = _458_0
1045
1052
  end
1046
1053
  local f_chunk = {}
1047
1054
  local fn_sym = utils["sym?"](ast[2])
@@ -1101,36 +1108,37 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1101
1108
  doc_special("fn", {"name?", "args", "docstring?", "..."}, "Function syntax. May optionally include a name and docstring or a metadata table.\nIf a name is provided, the function will be bound in the current scope.\nWhen called with the wrong number of args, excess args will be discarded\nand lacking args will be nil, use lambda for arity-checked functions.", true)
1102
1109
  SPECIALS.lua = function(ast, _, parent)
1103
1110
  compiler.assert(((#ast == 2) or (#ast == 3)), "expected 1 or 2 arguments", ast)
1104
- local _460_
1111
+ local _463_
1105
1112
  do
1106
- local _459_0 = utils["sym?"](ast[2])
1107
- if (nil ~= _459_0) then
1108
- _460_ = tostring(_459_0)
1113
+ local _462_0 = utils["sym?"](ast[2])
1114
+ if (nil ~= _462_0) then
1115
+ _463_ = tostring(_462_0)
1109
1116
  else
1110
- _460_ = _459_0
1117
+ _463_ = _462_0
1111
1118
  end
1112
1119
  end
1113
- if ("nil" ~= _460_) then
1120
+ if ("nil" ~= _463_) then
1114
1121
  table.insert(parent, {ast = ast, leaf = tostring(ast[2])})
1115
1122
  end
1116
- local _464_
1123
+ local _467_
1117
1124
  do
1118
- local _463_0 = utils["sym?"](ast[3])
1119
- if (nil ~= _463_0) then
1120
- _464_ = tostring(_463_0)
1125
+ local _466_0 = utils["sym?"](ast[3])
1126
+ if (nil ~= _466_0) then
1127
+ _467_ = tostring(_466_0)
1121
1128
  else
1122
- _464_ = _463_0
1129
+ _467_ = _466_0
1123
1130
  end
1124
1131
  end
1125
- if ("nil" ~= _464_) then
1132
+ if ("nil" ~= _467_) then
1126
1133
  return tostring(ast[3])
1127
1134
  end
1128
1135
  end
1129
1136
  local function dot(ast, scope, parent)
1130
1137
  compiler.assert((1 < #ast), "expected table argument", ast)
1131
1138
  local len = #ast
1132
- local _467_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1133
- local lhs = _467_[1]
1139
+ local lhs_node = compiler.macroexpand(ast[2], scope)
1140
+ local _470_ = compiler.compile1(lhs_node, scope, parent, {nval = 1})
1141
+ local lhs = _470_[1]
1134
1142
  if (len == 2) then
1135
1143
  return tostring(lhs)
1136
1144
  else
@@ -1140,12 +1148,12 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1140
1148
  if (utils["string?"](index) and utils["valid-lua-identifier?"](index)) then
1141
1149
  table.insert(indices, ("." .. index))
1142
1150
  else
1143
- local _468_ = compiler.compile1(index, scope, parent, {nval = 1})
1144
- local index0 = _468_[1]
1151
+ local _471_ = compiler.compile1(index, scope, parent, {nval = 1})
1152
+ local index0 = _471_[1]
1145
1153
  table.insert(indices, ("[" .. tostring(index0) .. "]"))
1146
1154
  end
1147
1155
  end
1148
- if (not (utils["sym?"](ast[2]) or utils["list?"](ast[2])) or ("nil" == tostring(lhs))) then
1156
+ if (not (utils["sym?"](lhs_node) or utils["list?"](lhs_node)) or ("nil" == tostring(lhs_node))) then
1149
1157
  return ("(" .. tostring(lhs) .. ")" .. table.concat(indices))
1150
1158
  else
1151
1159
  return (tostring(lhs) .. table.concat(indices))
@@ -1186,7 +1194,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1186
1194
  end
1187
1195
  doc_special("var", {"name", "val"}, "Introduce new mutable local.")
1188
1196
  local function kv_3f(t)
1189
- local _472_
1197
+ local _475_
1190
1198
  do
1191
1199
  local tbl_17_ = {}
1192
1200
  local i_18_ = #tbl_17_
@@ -1202,9 +1210,9 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1202
1210
  tbl_17_[i_18_] = val_19_
1203
1211
  end
1204
1212
  end
1205
- _472_ = tbl_17_
1213
+ _475_ = tbl_17_
1206
1214
  end
1207
- return _472_[1]
1215
+ return _475_[1]
1208
1216
  end
1209
1217
  SPECIALS.let = function(ast, scope, parent, opts)
1210
1218
  local bindings = ast[2]
@@ -1231,22 +1239,22 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1231
1239
  end
1232
1240
  end
1233
1241
  local function disambiguate_3f(rootstr, parent)
1234
- local function _477_()
1235
- local _476_0 = get_prev_line(parent)
1236
- if (nil ~= _476_0) then
1237
- local prev_line = _476_0
1242
+ local function _480_()
1243
+ local _479_0 = get_prev_line(parent)
1244
+ if (nil ~= _479_0) then
1245
+ local prev_line = _479_0
1238
1246
  return prev_line:match("%)$")
1239
1247
  end
1240
1248
  end
1241
- return (rootstr:match("^{") or rootstr:match("^%(") or _477_())
1249
+ return (rootstr:match("^{") or rootstr:match("^%(") or _480_())
1242
1250
  end
1243
1251
  SPECIALS.tset = function(ast, scope, parent)
1244
1252
  compiler.assert((3 < #ast), "expected table, key, and value arguments", ast)
1245
1253
  local root = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
1246
1254
  local keys = {}
1247
1255
  for i = 3, (#ast - 1) do
1248
- local _479_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
1249
- local key = _479_[1]
1256
+ local _482_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
1257
+ local key = _482_[1]
1250
1258
  table.insert(keys, tostring(key))
1251
1259
  end
1252
1260
  local value = compiler.compile1(ast[#ast], scope, parent, {nval = 1})[1]
@@ -1364,31 +1372,56 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1364
1372
  end
1365
1373
  SPECIALS["if"] = if_2a
1366
1374
  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.")
1367
- local function remove_until_condition(bindings)
1368
- local last_item = bindings[(#bindings - 1)]
1369
- if ((utils["sym?"](last_item) and (tostring(last_item) == "&until")) or ("until" == last_item)) then
1370
- table.remove(bindings, (#bindings - 1))
1371
- return table.remove(bindings)
1372
- end
1373
- end
1374
- local function compile_until(condition, scope, chunk)
1375
- if condition then
1376
- local _490_ = compiler.compile1(condition, scope, chunk, {nval = 1})
1377
- local condition_lua = _490_[1]
1378
- return compiler.emit(chunk, ("if %s then break end"):format(tostring(condition_lua)), utils.expr(condition, "expression"))
1375
+ local function clause_3f(v)
1376
+ return (utils["string?"](v) or (utils["sym?"](v) and not utils["multi-sym?"](v) and tostring(v):match("^&(.+)")))
1377
+ end
1378
+ local function remove_until_condition(bindings, ast)
1379
+ local _until = nil
1380
+ for i = (#bindings - 1), 3, -1 do
1381
+ local _492_0 = clause_3f(bindings[i])
1382
+ if ((_492_0 == false) or (_492_0 == nil)) then
1383
+ elseif (nil ~= _492_0) then
1384
+ local clause = _492_0
1385
+ compiler.assert(((clause == "until") and not _until), ("unexpected iterator clause: " .. clause), ast)
1386
+ table.remove(bindings, i)
1387
+ _until = table.remove(bindings, i)
1388
+ end
1389
+ end
1390
+ return _until
1391
+ end
1392
+ local function compile_until(_3fcondition, scope, chunk)
1393
+ if _3fcondition then
1394
+ local _494_ = compiler.compile1(_3fcondition, scope, chunk, {nval = 1})
1395
+ local condition_lua = _494_[1]
1396
+ return compiler.emit(chunk, ("if %s then break end"):format(tostring(condition_lua)), utils.expr(_3fcondition, "expression"))
1397
+ end
1398
+ end
1399
+ local function iterator_bindings(ast)
1400
+ local bindings = utils.copy(ast)
1401
+ local _3funtil = remove_until_condition(bindings, ast)
1402
+ local iter = table.remove(bindings)
1403
+ local bindings0 = nil
1404
+ if (1 == #bindings) then
1405
+ bindings0 = (utils["list?"](bindings[1]) or bindings)
1406
+ else
1407
+ for _, b in ipairs(bindings) do
1408
+ if utils["list?"](b) then
1409
+ utils.warn("unexpected parens in iterator", b)
1410
+ end
1411
+ end
1412
+ bindings0 = bindings
1379
1413
  end
1414
+ return bindings0, iter, _3funtil
1380
1415
  end
1381
1416
  SPECIALS.each = function(ast, scope, parent)
1382
1417
  compiler.assert((3 <= #ast), "expected body expression", ast[1])
1383
1418
  compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
1384
- local binding = setmetatable(utils.copy(ast[2]), getmetatable(ast[2]))
1385
- local until_condition = remove_until_condition(binding)
1386
- local iter = table.remove(binding, #binding)
1419
+ local sub_scope = compiler["make-scope"](scope)
1420
+ local binding, iter, _3funtil_condition = iterator_bindings(ast[2])
1387
1421
  local destructures = {}
1388
1422
  local new_manglings = {}
1389
- local sub_scope = compiler["make-scope"](scope)
1423
+ utils.hook("pre-each", ast, sub_scope, binding, iter, _3funtil_condition)
1390
1424
  local function destructure_binding(v)
1391
- compiler.assert(not utils["string?"](v), ("unexpected iterator clause " .. tostring(v)), binding)
1392
1425
  if utils["sym?"](v) then
1393
1426
  return compiler["declare-local"](v, {}, sub_scope, ast, new_manglings)
1394
1427
  else
@@ -1407,7 +1440,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1407
1440
  compiler.destructure(args, raw, ast, sub_scope, chunk, {declaration = true, nomulti = true, symtype = "each"})
1408
1441
  end
1409
1442
  compiler["apply-manglings"](sub_scope, new_manglings, ast)
1410
- compile_until(until_condition, sub_scope, chunk)
1443
+ compile_until(_3funtil_condition, sub_scope, chunk)
1411
1444
  compile_do(ast, sub_scope, chunk, 3)
1412
1445
  compiler.emit(parent, chunk, ast)
1413
1446
  return compiler.emit(parent, "end", ast)
@@ -1437,7 +1470,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1437
1470
  local function for_2a(ast, scope, parent)
1438
1471
  compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
1439
1472
  local ranges = setmetatable(utils.copy(ast[2]), getmetatable(ast[2]))
1440
- local until_condition = remove_until_condition(ranges)
1473
+ local until_condition = remove_until_condition(ranges, ast)
1441
1474
  local binding_sym = table.remove(ranges, 1)
1442
1475
  local sub_scope = compiler["make-scope"](scope)
1443
1476
  local range_args = {}
@@ -1446,6 +1479,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1446
1479
  compiler.assert((3 <= #ast), "expected body expression", ast[1])
1447
1480
  compiler.assert((#ranges <= 3), "unexpected arguments", ranges)
1448
1481
  compiler.assert((1 < #ranges), "expected range to include start and stop", ranges)
1482
+ utils.hook("pre-for", ast, sub_scope, binding_sym)
1449
1483
  for i = 1, math.min(#ranges, 3) do
1450
1484
  range_args[i] = tostring(compiler.compile1(ranges[i], scope, parent, {nval = 1})[1])
1451
1485
  end
@@ -1458,10 +1492,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1458
1492
  SPECIALS["for"] = for_2a
1459
1493
  doc_special("for", {"[index start stop step?]", "..."}, "Numeric loop construct.\nEvaluates body once for each value between start and stop (inclusive).", true)
1460
1494
  local function native_method_call(ast, _scope, _parent, target, args)
1461
- local _494_ = ast
1462
- local _ = _494_[1]
1463
- local _0 = _494_[2]
1464
- local method_string = _494_[3]
1495
+ local _500_ = ast
1496
+ local _ = _500_[1]
1497
+ local _0 = _500_[2]
1498
+ local method_string = _500_[3]
1465
1499
  local call_string = nil
1466
1500
  if ((target.type == "literal") or (target.type == "varg") or (target.type == "expression")) then
1467
1501
  call_string = "(%s):%s(%s)"
@@ -1483,18 +1517,18 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1483
1517
  end
1484
1518
  local function method_call(ast, scope, parent)
1485
1519
  compiler.assert((2 < #ast), "expected at least 2 arguments", ast)
1486
- local _496_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1487
- local target = _496_[1]
1520
+ local _502_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1521
+ local target = _502_[1]
1488
1522
  local args = {}
1489
1523
  for i = 4, #ast do
1490
1524
  local subexprs = nil
1491
- local _497_
1525
+ local _503_
1492
1526
  if (i ~= #ast) then
1493
- _497_ = 1
1527
+ _503_ = 1
1494
1528
  else
1495
- _497_ = nil
1529
+ _503_ = nil
1496
1530
  end
1497
- subexprs = compiler.compile1(ast[i], scope, parent, {nval = _497_})
1531
+ subexprs = compiler.compile1(ast[i], scope, parent, {nval = _503_})
1498
1532
  utils.map(subexprs, tostring, args)
1499
1533
  end
1500
1534
  if (utils["string?"](ast[3]) and utils["valid-lua-identifier?"](ast[3])) then
@@ -1509,7 +1543,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1509
1543
  doc_special(":", {"tbl", "method-name", "..."}, "Call the named method on tbl with the provided args.\nMethod name doesn't have to be known at compile-time; if it is, use\n(tbl:method-name ...) instead.")
1510
1544
  SPECIALS.comment = function(ast, _, parent)
1511
1545
  local c = nil
1512
- local _500_
1546
+ local _506_
1513
1547
  do
1514
1548
  local tbl_17_ = {}
1515
1549
  local i_18_ = #tbl_17_
@@ -1525,9 +1559,9 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1525
1559
  tbl_17_[i_18_] = val_19_
1526
1560
  end
1527
1561
  end
1528
- _500_ = tbl_17_
1562
+ _506_ = tbl_17_
1529
1563
  end
1530
- c = table.concat(_500_, " "):gsub("%]%]", "]\\]")
1564
+ c = table.concat(_506_, " "):gsub("%]%]", "]\\]")
1531
1565
  return compiler.emit(parent, ("--[[ " .. c .. " ]]"), ast)
1532
1566
  end
1533
1567
  doc_special("comment", {"..."}, "Comment which will be emitted in Lua output.", true)
@@ -1548,10 +1582,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1548
1582
  compiler.assert((#ast == 2), "expected one argument", ast)
1549
1583
  local f_scope = nil
1550
1584
  do
1551
- local _505_0 = compiler["make-scope"](scope)
1552
- _505_0["vararg"] = false
1553
- _505_0["hashfn"] = true
1554
- f_scope = _505_0
1585
+ local _511_0 = compiler["make-scope"](scope)
1586
+ _511_0["vararg"] = false
1587
+ _511_0["hashfn"] = true
1588
+ f_scope = _511_0
1555
1589
  end
1556
1590
  local f_chunk = {}
1557
1591
  local name = compiler.gensym(scope)
@@ -1592,9 +1626,9 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1592
1626
  return utils.expr(name, "sym")
1593
1627
  end
1594
1628
  doc_special("hashfn", {"..."}, "Function literal shorthand; args are either $... OR $1, $2, etc.")
1595
- local function maybe_short_circuit_protect(ast, i, name, _510_0)
1596
- local _511_ = _510_0
1597
- local mac = _511_["macros"]
1629
+ local function maybe_short_circuit_protect(ast, i, name, _516_0)
1630
+ local _517_ = _516_0
1631
+ local mac = _517_["macros"]
1598
1632
  local call = (utils["list?"](ast) and tostring(ast[1]))
1599
1633
  if ((("or" == name) or ("and" == name)) and (1 < i) and (mac[call] or ("set" == call) or ("tset" == call) or ("global" == call))) then
1600
1634
  return utils.list(utils.list(utils.sym("fn"), utils.sequence(utils.varg()), ast))
@@ -1615,15 +1649,15 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1615
1649
  table.insert(operands, tostring(subexprs[1]))
1616
1650
  end
1617
1651
  end
1618
- local _514_0 = #operands
1619
- if (_514_0 == 0) then
1620
- local _515_
1652
+ local _520_0 = #operands
1653
+ if (_520_0 == 0) then
1654
+ local _521_
1621
1655
  do
1622
1656
  compiler.assert(zero_arity, "Expected more than 0 arguments", ast)
1623
- _515_ = zero_arity
1657
+ _521_ = zero_arity
1624
1658
  end
1625
- return utils.expr(_515_, "literal")
1626
- elseif (_514_0 == 1) then
1659
+ return utils.expr(_521_, "literal")
1660
+ elseif (_520_0 == 1) then
1627
1661
  if utils["varg?"](ast[2]) then
1628
1662
  return compiler.assert(false, "tried to use vararg with operator", ast)
1629
1663
  elseif unary_prefix then
@@ -1632,20 +1666,20 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1632
1666
  return operands[1]
1633
1667
  end
1634
1668
  else
1635
- local _ = _514_0
1669
+ local _ = _520_0
1636
1670
  return ("(" .. table.concat(operands, padded_op) .. ")")
1637
1671
  end
1638
1672
  end
1639
1673
  local function define_arithmetic_special(name, zero_arity, unary_prefix, _3flua_name)
1640
- local _519_
1674
+ local _525_
1641
1675
  do
1642
- local _518_0 = (_3flua_name or name)
1643
- local function _520_(...)
1644
- return operator_special(_518_0, zero_arity, unary_prefix, ...)
1676
+ local _524_0 = (_3flua_name or name)
1677
+ local function _526_(...)
1678
+ return operator_special(_524_0, zero_arity, unary_prefix, ...)
1645
1679
  end
1646
- _519_ = _520_
1680
+ _525_ = _526_
1647
1681
  end
1648
- SPECIALS[name] = _519_
1682
+ SPECIALS[name] = _525_
1649
1683
  return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.")
1650
1684
  end
1651
1685
  define_arithmetic_special("+", "0")
@@ -1674,13 +1708,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1674
1708
  local prefixed_lib_name = ("bit." .. lib_name)
1675
1709
  for i = 2, len do
1676
1710
  local subexprs = nil
1677
- local _521_
1711
+ local _527_
1678
1712
  if (i ~= len) then
1679
- _521_ = 1
1713
+ _527_ = 1
1680
1714
  else
1681
- _521_ = nil
1715
+ _527_ = nil
1682
1716
  end
1683
- subexprs = compiler.compile1(ast[i], scope, parent, {nval = _521_})
1717
+ subexprs = compiler.compile1(ast[i], scope, parent, {nval = _527_})
1684
1718
  utils.map(subexprs, tostring, operands)
1685
1719
  end
1686
1720
  if (#operands == 1) then
@@ -1699,15 +1733,15 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1699
1733
  end
1700
1734
  end
1701
1735
  local function define_bitop_special(name, zero_arity, unary_prefix, native)
1702
- local function _527_(...)
1736
+ local function _533_(...)
1703
1737
  return bitop_special(native, name, zero_arity, unary_prefix, ...)
1704
1738
  end
1705
- SPECIALS[name] = _527_
1739
+ SPECIALS[name] = _533_
1706
1740
  return nil
1707
1741
  end
1708
1742
  define_bitop_special("lshift", nil, "1", "<<")
1709
1743
  define_bitop_special("rshift", nil, "1", ">>")
1710
- define_bitop_special("band", "0", "0", "&")
1744
+ define_bitop_special("band", "-1", "-1", "&")
1711
1745
  define_bitop_special("bor", "0", "0", "|")
1712
1746
  define_bitop_special("bxor", "0", "0", "~")
1713
1747
  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.")
@@ -1717,8 +1751,8 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1717
1751
  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.")
1718
1752
  SPECIALS.bnot = function(ast, scope, parent)
1719
1753
  compiler.assert((#ast == 2), "expected one argument", ast)
1720
- local _528_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1721
- local value = _528_[1]
1754
+ local _534_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1755
+ local value = _534_[1]
1722
1756
  if utils.root.options.useBitLib then
1723
1757
  return ("bit.bnot(" .. tostring(value) .. ")")
1724
1758
  else
@@ -1727,15 +1761,15 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1727
1761
  end
1728
1762
  doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
1729
1763
  doc_special("..", {"a", "b", "..."}, "String concatenation operator; works the same as Lua but accepts more arguments.")
1730
- local function native_comparator(op, _530_0, scope, parent)
1731
- local _531_ = _530_0
1732
- local _ = _531_[1]
1733
- local lhs_ast = _531_[2]
1734
- local rhs_ast = _531_[3]
1735
- local _532_ = compiler.compile1(lhs_ast, scope, parent, {nval = 1})
1736
- local lhs = _532_[1]
1737
- local _533_ = compiler.compile1(rhs_ast, scope, parent, {nval = 1})
1738
- local rhs = _533_[1]
1764
+ local function native_comparator(op, _536_0, scope, parent)
1765
+ local _537_ = _536_0
1766
+ local _ = _537_[1]
1767
+ local lhs_ast = _537_[2]
1768
+ local rhs_ast = _537_[3]
1769
+ local _538_ = compiler.compile1(lhs_ast, scope, parent, {nval = 1})
1770
+ local lhs = _538_[1]
1771
+ local _539_ = compiler.compile1(rhs_ast, scope, parent, {nval = 1})
1772
+ local rhs = _539_[1]
1739
1773
  return string.format("(%s %s %s)", tostring(lhs), op, tostring(rhs))
1740
1774
  end
1741
1775
  local function idempotent_comparator(op, chain_op, ast, scope, parent)
@@ -1848,21 +1882,21 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1848
1882
  end
1849
1883
  local safe_require = nil
1850
1884
  local function safe_compiler_env()
1851
- local _540_
1885
+ local _546_
1852
1886
  do
1853
- local _539_0 = rawget(_G, "utf8")
1854
- if (nil ~= _539_0) then
1855
- _540_ = utils.copy(_539_0)
1887
+ local _545_0 = rawget(_G, "utf8")
1888
+ if (nil ~= _545_0) then
1889
+ _546_ = utils.copy(_545_0)
1856
1890
  else
1857
- _540_ = _539_0
1891
+ _546_ = _545_0
1858
1892
  end
1859
1893
  end
1860
- return {_VERSION = _VERSION, assert = assert, bit = rawget(_G, "bit"), error = error, getmetatable = safe_getmetatable, ipairs = ipairs, math = utils.copy(math), next = next, pairs = utils.stablepairs, 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, utf8 = _540_, xpcall = xpcall}
1894
+ return {_VERSION = _VERSION, assert = assert, bit = rawget(_G, "bit"), error = error, getmetatable = safe_getmetatable, ipairs = ipairs, math = utils.copy(math), next = next, pairs = utils.stablepairs, 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, utf8 = _546_, xpcall = xpcall}
1861
1895
  end
1862
1896
  local function combined_mt_pairs(env)
1863
1897
  local combined = {}
1864
- local _542_ = getmetatable(env)
1865
- local __index = _542_["__index"]
1898
+ local _548_ = getmetatable(env)
1899
+ local __index = _548_["__index"]
1866
1900
  if ("table" == type(__index)) then
1867
1901
  for k, v in pairs(__index) do
1868
1902
  combined[k] = v
@@ -1876,40 +1910,40 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1876
1910
  local function make_compiler_env(ast, scope, parent, _3fopts)
1877
1911
  local provided = nil
1878
1912
  do
1879
- local _544_0 = (_3fopts or utils.root.options)
1880
- if ((_G.type(_544_0) == "table") and (_544_0["compiler-env"] == "strict")) then
1913
+ local _550_0 = (_3fopts or utils.root.options)
1914
+ if ((_G.type(_550_0) == "table") and (_550_0["compiler-env"] == "strict")) then
1881
1915
  provided = safe_compiler_env()
1882
- elseif ((_G.type(_544_0) == "table") and (nil ~= _544_0.compilerEnv)) then
1883
- local compilerEnv = _544_0.compilerEnv
1916
+ elseif ((_G.type(_550_0) == "table") and (nil ~= _550_0.compilerEnv)) then
1917
+ local compilerEnv = _550_0.compilerEnv
1884
1918
  provided = compilerEnv
1885
- elseif ((_G.type(_544_0) == "table") and (nil ~= _544_0["compiler-env"])) then
1886
- local compiler_env = _544_0["compiler-env"]
1919
+ elseif ((_G.type(_550_0) == "table") and (nil ~= _550_0["compiler-env"])) then
1920
+ local compiler_env = _550_0["compiler-env"]
1887
1921
  provided = compiler_env
1888
1922
  else
1889
- local _ = _544_0
1923
+ local _ = _550_0
1890
1924
  provided = safe_compiler_env()
1891
1925
  end
1892
1926
  end
1893
1927
  local env = nil
1894
- local function _546_()
1928
+ local function _552_()
1895
1929
  return compiler.scopes.macro
1896
1930
  end
1897
- local function _547_(symbol)
1931
+ local function _553_(symbol)
1898
1932
  compiler.assert(compiler.scopes.macro, "must call from macro", ast)
1899
1933
  return compiler.scopes.macro.manglings[tostring(symbol)]
1900
1934
  end
1901
- local function _548_(base)
1935
+ local function _554_(base)
1902
1936
  return utils.sym(compiler.gensym((compiler.scopes.macro or scope), base))
1903
1937
  end
1904
- local function _549_(form)
1938
+ local function _555_(form)
1905
1939
  compiler.assert(compiler.scopes.macro, "must call from macro", ast)
1906
1940
  return compiler.macroexpand(form, compiler.scopes.macro)
1907
1941
  end
1908
- env = {["assert-compile"] = compiler.assert, ["ast-source"] = utils["ast-source"], ["comment?"] = utils["comment?"], ["get-scope"] = _546_, ["in-scope?"] = _547_, ["list?"] = utils["list?"], ["macro-loaded"] = macro_loaded, ["multi-sym?"] = utils["multi-sym?"], ["sequence?"] = utils["sequence?"], ["sym?"] = utils["sym?"], ["table?"] = utils["table?"], ["varg?"] = utils["varg?"], _AST = ast, _CHUNK = parent, _IS_COMPILER = true, _SCOPE = scope, _SPECIALS = compiler.scopes.global.specials, _VARARG = utils.varg(), comment = utils.comment, gensym = _548_, list = utils.list, macroexpand = _549_, sequence = utils.sequence, sym = utils.sym, unpack = unpack, version = utils.version, view = view}
1942
+ env = {["assert-compile"] = compiler.assert, ["ast-source"] = utils["ast-source"], ["comment?"] = utils["comment?"], ["fennel-module-name"] = fennel_module_name, ["get-scope"] = _552_, ["in-scope?"] = _553_, ["list?"] = utils["list?"], ["macro-loaded"] = macro_loaded, ["multi-sym?"] = utils["multi-sym?"], ["sequence?"] = utils["sequence?"], ["sym?"] = utils["sym?"], ["table?"] = utils["table?"], ["varg?"] = utils["varg?"], _AST = ast, _CHUNK = parent, _IS_COMPILER = true, _SCOPE = scope, _SPECIALS = compiler.scopes.global.specials, _VARARG = utils.varg(), comment = utils.comment, gensym = _554_, list = utils.list, macroexpand = _555_, sequence = utils.sequence, sym = utils.sym, unpack = unpack, version = utils.version, view = view}
1909
1943
  env._G = env
1910
1944
  return setmetatable(env, {__index = provided, __newindex = provided, __pairs = combined_mt_pairs})
1911
1945
  end
1912
- local function _550_(...)
1946
+ local function _556_(...)
1913
1947
  local tbl_17_ = {}
1914
1948
  local i_18_ = #tbl_17_
1915
1949
  for c in string.gmatch((package.config or ""), "([^\n]+)") do
@@ -1921,10 +1955,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1921
1955
  end
1922
1956
  return tbl_17_
1923
1957
  end
1924
- local _552_ = _550_(...)
1925
- local dirsep = _552_[1]
1926
- local pathsep = _552_[2]
1927
- local pathmark = _552_[3]
1958
+ local _558_ = _556_(...)
1959
+ local dirsep = _558_[1]
1960
+ local pathsep = _558_[2]
1961
+ local pathmark = _558_[3]
1928
1962
  local pkg_config = {dirsep = (dirsep or "/"), pathmark = (pathmark or "?"), pathsep = (pathsep or ";")}
1929
1963
  local function escapepat(str)
1930
1964
  return string.gsub(str, "[^%w]", "%%%1")
@@ -1937,36 +1971,36 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1937
1971
  local function try_path(path)
1938
1972
  local filename = path:gsub(escapepat(pkg_config.pathmark), no_dot_module)
1939
1973
  local filename2 = path:gsub(escapepat(pkg_config.pathmark), modulename)
1940
- local _553_0 = (io.open(filename) or io.open(filename2))
1941
- if (nil ~= _553_0) then
1942
- local file = _553_0
1974
+ local _559_0 = (io.open(filename) or io.open(filename2))
1975
+ if (nil ~= _559_0) then
1976
+ local file = _559_0
1943
1977
  file:close()
1944
1978
  return filename
1945
1979
  else
1946
- local _ = _553_0
1980
+ local _ = _559_0
1947
1981
  return nil, ("no file '" .. filename .. "'")
1948
1982
  end
1949
1983
  end
1950
1984
  local function find_in_path(start, _3ftried_paths)
1951
- local _555_0 = fullpath:match(pattern, start)
1952
- if (nil ~= _555_0) then
1953
- local path = _555_0
1954
- local _556_0, _557_0 = try_path(path)
1955
- if (nil ~= _556_0) then
1956
- local filename = _556_0
1985
+ local _561_0 = fullpath:match(pattern, start)
1986
+ if (nil ~= _561_0) then
1987
+ local path = _561_0
1988
+ local _562_0, _563_0 = try_path(path)
1989
+ if (nil ~= _562_0) then
1990
+ local filename = _562_0
1957
1991
  return filename
1958
- elseif ((_556_0 == nil) and (nil ~= _557_0)) then
1959
- local error = _557_0
1960
- local function _559_()
1961
- local _558_0 = (_3ftried_paths or {})
1962
- table.insert(_558_0, error)
1963
- return _558_0
1992
+ elseif ((_562_0 == nil) and (nil ~= _563_0)) then
1993
+ local error = _563_0
1994
+ local function _565_()
1995
+ local _564_0 = (_3ftried_paths or {})
1996
+ table.insert(_564_0, error)
1997
+ return _564_0
1964
1998
  end
1965
- return find_in_path((start + #path + 1), _559_())
1999
+ return find_in_path((start + #path + 1), _565_())
1966
2000
  end
1967
2001
  else
1968
- local _ = _555_0
1969
- local function _561_()
2002
+ local _ = _561_0
2003
+ local function _567_()
1970
2004
  local tried_paths = table.concat((_3ftried_paths or {}), "\n\9")
1971
2005
  if (_VERSION < "Lua 5.4") then
1972
2006
  return ("\n\9" .. tried_paths)
@@ -1974,31 +2008,31 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1974
2008
  return tried_paths
1975
2009
  end
1976
2010
  end
1977
- return nil, _561_()
2011
+ return nil, _567_()
1978
2012
  end
1979
2013
  end
1980
2014
  return find_in_path(1)
1981
2015
  end
1982
2016
  local function make_searcher(_3foptions)
1983
- local function _564_(module_name)
2017
+ local function _570_(module_name)
1984
2018
  local opts = utils.copy(utils.root.options)
1985
2019
  for k, v in pairs((_3foptions or {})) do
1986
2020
  opts[k] = v
1987
2021
  end
1988
2022
  opts["module-name"] = module_name
1989
- local _565_0, _566_0 = search_module(module_name)
1990
- if (nil ~= _565_0) then
1991
- local filename = _565_0
1992
- local function _567_(...)
2023
+ local _571_0, _572_0 = search_module(module_name)
2024
+ if (nil ~= _571_0) then
2025
+ local filename = _571_0
2026
+ local function _573_(...)
1993
2027
  return utils["fennel-module"].dofile(filename, opts, ...)
1994
2028
  end
1995
- return _567_, filename
1996
- elseif ((_565_0 == nil) and (nil ~= _566_0)) then
1997
- local error = _566_0
2029
+ return _573_, filename
2030
+ elseif ((_571_0 == nil) and (nil ~= _572_0)) then
2031
+ local error = _572_0
1998
2032
  return error
1999
2033
  end
2000
2034
  end
2001
- return _564_
2035
+ return _570_
2002
2036
  end
2003
2037
  local function dofile_with_searcher(fennel_macro_searcher, filename, opts, ...)
2004
2038
  local searchers = (package.loaders or package.searchers or {})
@@ -2010,35 +2044,35 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2010
2044
  local function fennel_macro_searcher(module_name)
2011
2045
  local opts = nil
2012
2046
  do
2013
- local _569_0 = utils.copy(utils.root.options)
2014
- _569_0["module-name"] = module_name
2015
- _569_0["env"] = "_COMPILER"
2016
- _569_0["requireAsInclude"] = false
2017
- _569_0["allowedGlobals"] = nil
2018
- opts = _569_0
2019
- end
2020
- local _570_0 = search_module(module_name, utils["fennel-module"]["macro-path"])
2021
- if (nil ~= _570_0) then
2022
- local filename = _570_0
2023
- local _571_
2047
+ local _575_0 = utils.copy(utils.root.options)
2048
+ _575_0["module-name"] = module_name
2049
+ _575_0["env"] = "_COMPILER"
2050
+ _575_0["requireAsInclude"] = false
2051
+ _575_0["allowedGlobals"] = nil
2052
+ opts = _575_0
2053
+ end
2054
+ local _576_0 = search_module(module_name, utils["fennel-module"]["macro-path"])
2055
+ if (nil ~= _576_0) then
2056
+ local filename = _576_0
2057
+ local _577_
2024
2058
  if (opts["compiler-env"] == _G) then
2025
- local function _572_(...)
2059
+ local function _578_(...)
2026
2060
  return dofile_with_searcher(fennel_macro_searcher, filename, opts, ...)
2027
2061
  end
2028
- _571_ = _572_
2062
+ _577_ = _578_
2029
2063
  else
2030
- local function _573_(...)
2064
+ local function _579_(...)
2031
2065
  return utils["fennel-module"].dofile(filename, opts, ...)
2032
2066
  end
2033
- _571_ = _573_
2067
+ _577_ = _579_
2034
2068
  end
2035
- return _571_, filename
2069
+ return _577_, filename
2036
2070
  end
2037
2071
  end
2038
2072
  local function lua_macro_searcher(module_name)
2039
- local _576_0 = search_module(module_name, package.path)
2040
- if (nil ~= _576_0) then
2041
- local filename = _576_0
2073
+ local _582_0 = search_module(module_name, package.path)
2074
+ if (nil ~= _582_0) then
2075
+ local filename = _582_0
2042
2076
  local code = nil
2043
2077
  do
2044
2078
  local f = io.open(filename)
@@ -2050,10 +2084,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2050
2084
  return error(..., 0)
2051
2085
  end
2052
2086
  end
2053
- local function _578_()
2087
+ local function _584_()
2054
2088
  return assert(f:read("*a"))
2055
2089
  end
2056
- code = close_handlers_10_(_G.xpcall(_578_, (package.loaded.fennel or debug).traceback))
2090
+ code = close_handlers_10_(_G.xpcall(_584_, (package.loaded.fennel or debug).traceback))
2057
2091
  end
2058
2092
  local chunk = load_code(code, make_compiler_env(), filename)
2059
2093
  return chunk, filename
@@ -2061,38 +2095,38 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2061
2095
  end
2062
2096
  local macro_searchers = {fennel_macro_searcher, lua_macro_searcher}
2063
2097
  local function search_macro_module(modname, n)
2064
- local _580_0 = macro_searchers[n]
2065
- if (nil ~= _580_0) then
2066
- local f = _580_0
2067
- local _581_0, _582_0 = f(modname)
2068
- if ((nil ~= _581_0) and true) then
2069
- local loader = _581_0
2070
- local _3ffilename = _582_0
2098
+ local _586_0 = macro_searchers[n]
2099
+ if (nil ~= _586_0) then
2100
+ local f = _586_0
2101
+ local _587_0, _588_0 = f(modname)
2102
+ if ((nil ~= _587_0) and true) then
2103
+ local loader = _587_0
2104
+ local _3ffilename = _588_0
2071
2105
  return loader, _3ffilename
2072
2106
  else
2073
- local _ = _581_0
2107
+ local _ = _587_0
2074
2108
  return search_macro_module(modname, (n + 1))
2075
2109
  end
2076
2110
  end
2077
2111
  end
2078
2112
  local function sandbox_fennel_module(modname)
2079
2113
  if ((modname == "fennel.macros") or (package and package.loaded and ("table" == type(package.loaded[modname])) and (package.loaded[modname].metadata == compiler.metadata))) then
2080
- local function _585_(_, ...)
2114
+ local function _591_(_, ...)
2081
2115
  return (compiler.metadata):setall(...)
2082
2116
  end
2083
- return {metadata = {setall = _585_}, view = view}
2117
+ return {metadata = {setall = _591_}, view = view}
2084
2118
  end
2085
2119
  end
2086
- local function _587_(modname)
2087
- local function _588_()
2120
+ local function _593_(modname)
2121
+ local function _594_()
2088
2122
  local loader, filename = search_macro_module(modname, 1)
2089
2123
  compiler.assert(loader, (modname .. " module not found."))
2090
2124
  macro_loaded[modname] = loader(modname, filename)
2091
2125
  return macro_loaded[modname]
2092
2126
  end
2093
- return (macro_loaded[modname] or sandbox_fennel_module(modname) or _588_())
2127
+ return (macro_loaded[modname] or sandbox_fennel_module(modname) or _594_())
2094
2128
  end
2095
- safe_require = _587_
2129
+ safe_require = _593_
2096
2130
  local function add_macros(macros_2a, ast, scope)
2097
2131
  compiler.assert(utils["table?"](macros_2a), "expected macros to be table", ast)
2098
2132
  for k, v in pairs(macros_2a) do
@@ -2102,10 +2136,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2102
2136
  end
2103
2137
  return nil
2104
2138
  end
2105
- local function resolve_module_name(_589_0, _scope, _parent, opts)
2106
- local _590_ = _589_0
2107
- local second = _590_[2]
2108
- local filename = _590_["filename"]
2139
+ local function resolve_module_name(_595_0, _scope, _parent, opts)
2140
+ local _596_ = _595_0
2141
+ local second = _596_[2]
2142
+ local filename = _596_["filename"]
2109
2143
  local filename0 = (filename or (utils["table?"](second) and second.filename))
2110
2144
  local module_name = utils.root.options["module-name"]
2111
2145
  local modexpr = compiler.compile(second, opts)
@@ -2162,10 +2196,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2162
2196
  return error(..., 0)
2163
2197
  end
2164
2198
  end
2165
- local function _596_()
2199
+ local function _602_()
2166
2200
  return assert(f:read("*all")):gsub("[\13\n]*$", "")
2167
2201
  end
2168
- src = close_handlers_10_(_G.xpcall(_596_, (package.loaded.fennel or debug).traceback))
2202
+ src = close_handlers_10_(_G.xpcall(_602_, (package.loaded.fennel or debug).traceback))
2169
2203
  end
2170
2204
  local ret = utils.expr(("require(\"" .. mod .. "\")"), "statement")
2171
2205
  local target = ("package.preload[%q]"):format(mod)
@@ -2195,12 +2229,12 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2195
2229
  compiler.assert((#ast == 2), "expected one argument", ast)
2196
2230
  local modexpr = nil
2197
2231
  do
2198
- local _599_0, _600_0 = pcall(resolve_module_name, ast, scope, parent, opts)
2199
- if ((_599_0 == true) and (nil ~= _600_0)) then
2200
- local modname = _600_0
2232
+ local _605_0, _606_0 = pcall(resolve_module_name, ast, scope, parent, opts)
2233
+ if ((_605_0 == true) and (nil ~= _606_0)) then
2234
+ local modname = _606_0
2201
2235
  modexpr = utils.expr(string.format("%q", modname), "literal")
2202
2236
  else
2203
- local _ = _599_0
2237
+ local _ = _605_0
2204
2238
  modexpr = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
2205
2239
  end
2206
2240
  end
@@ -2217,13 +2251,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2217
2251
  utils.root.options["module-name"] = mod
2218
2252
  _ = nil
2219
2253
  local res = nil
2220
- local function _604_()
2221
- local _603_0 = search_module(mod)
2222
- if (nil ~= _603_0) then
2223
- local fennel_path = _603_0
2254
+ local function _610_()
2255
+ local _609_0 = search_module(mod)
2256
+ if (nil ~= _609_0) then
2257
+ local fennel_path = _609_0
2224
2258
  return include_path(ast, opts, fennel_path, mod, true)
2225
2259
  else
2226
- local _0 = _603_0
2260
+ local _0 = _609_0
2227
2261
  local lua_path = search_module(mod, package.path)
2228
2262
  if lua_path then
2229
2263
  return include_path(ast, opts, lua_path, mod, false)
@@ -2234,7 +2268,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2234
2268
  end
2235
2269
  end
2236
2270
  end
2237
- res = ((utils["member?"](mod, (utils.root.options.skipInclude or {})) and opts.fallback(modexpr, true)) or include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _604_())
2271
+ res = ((utils["member?"](mod, (utils.root.options.skipInclude or {})) and opts.fallback(modexpr, true)) or include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _610_())
2238
2272
  utils.root.options["module-name"] = oldmod
2239
2273
  return res
2240
2274
  end
@@ -2254,13 +2288,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2254
2288
  return add_macros(macro_tbl, ast, scope)
2255
2289
  end
2256
2290
  doc_special("macros", {"{:macro-name-1 (fn [...] ...) ... :macro-name-N macro-body-N}"}, "Define all functions in the given table as macros local to the current scope.")
2257
- SPECIALS["tail!"] = function(ast, scope, _parent, _608_0)
2258
- local _609_ = _608_0
2259
- local tail = _609_["tail"]
2291
+ SPECIALS["tail!"] = function(ast, scope, parent, opts)
2260
2292
  compiler.assert((#ast == 2), "Expected one argument", ast)
2261
- compiler.assert(utils["list?"](ast[2]), "Expected a call as argument", ast)
2262
- compiler.assert(tail, "Must be in tail position", ast)
2263
- return compiler.compile(ast[2], {nval = 1, scope = scope})
2293
+ local call = utils["list?"](compiler.macroexpand(ast[2], scope))
2294
+ local callee = tostring((call and utils["sym?"](call[1])))
2295
+ compiler.assert((call and not scope.specials[callee]), "Expected a function call as argument", ast)
2296
+ compiler.assert(opts.tail, "Must be in tail position", ast)
2297
+ return compiler.compile1(call, scope, parent, opts)
2264
2298
  end
2265
2299
  doc_special("tail!", {"body"}, "Assert that the body being called is in tail position.")
2266
2300
  SPECIALS["eval-compiler"] = function(ast, scope, parent)
@@ -2275,23 +2309,23 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2275
2309
  return compiler.assert(false, "tried to use unquote outside quote", ast)
2276
2310
  end
2277
2311
  doc_special("unquote", {"..."}, "Evaluate the argument even if it's in a quoted form.")
2278
- 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}
2312
+ return {["current-global-names"] = current_global_names, ["get-function-metadata"] = get_function_metadata, ["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}
2279
2313
  end
2280
2314
  package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or function(...)
2281
2315
  local utils = require("fennel.utils")
2282
2316
  local parser = require("fennel.parser")
2283
2317
  local friend = require("fennel.friend")
2284
2318
  local unpack = (table.unpack or _G.unpack)
2285
- local scopes = {}
2319
+ local scopes = {compiler = nil, global = nil, macro = nil}
2286
2320
  local function make_scope(_3fparent)
2287
2321
  local parent = (_3fparent or scopes.global)
2288
- local _261_
2322
+ local _264_
2289
2323
  if parent then
2290
- _261_ = ((parent.depth or 0) + 1)
2324
+ _264_ = ((parent.depth or 0) + 1)
2291
2325
  else
2292
- _261_ = 0
2326
+ _264_ = 0
2293
2327
  end
2294
- return {["gensym-base"] = setmetatable({}, {__index = (parent and parent["gensym-base"])}), autogensyms = setmetatable({}, {__index = (parent and parent.autogensyms)}), depth = _261_, gensyms = setmetatable({}, {__index = (parent and parent.gensyms)}), hashfn = (parent and parent.hashfn), includes = setmetatable({}, {__index = (parent and parent.includes)}), macros = setmetatable({}, {__index = (parent and parent.macros)}), manglings = setmetatable({}, {__index = (parent and parent.manglings)}), parent = parent, refedglobals = {}, specials = setmetatable({}, {__index = (parent and parent.specials)}), symmeta = setmetatable({}, {__index = (parent and parent.symmeta)}), unmanglings = setmetatable({}, {__index = (parent and parent.unmanglings)}), vararg = (parent and parent.vararg)}
2328
+ return {["gensym-base"] = setmetatable({}, {__index = (parent and parent["gensym-base"])}), autogensyms = setmetatable({}, {__index = (parent and parent.autogensyms)}), depth = _264_, gensyms = setmetatable({}, {__index = (parent and parent.gensyms)}), hashfn = (parent and parent.hashfn), includes = setmetatable({}, {__index = (parent and parent.includes)}), macros = setmetatable({}, {__index = (parent and parent.macros)}), manglings = setmetatable({}, {__index = (parent and parent.manglings)}), parent = parent, refedglobals = {}, specials = setmetatable({}, {__index = (parent and parent.specials)}), symmeta = setmetatable({}, {__index = (parent and parent.symmeta)}), unmanglings = setmetatable({}, {__index = (parent and parent.unmanglings)}), vararg = (parent and parent.vararg)}
2295
2329
  end
2296
2330
  local function assert_msg(ast, msg)
2297
2331
  local ast_tbl = nil
@@ -2305,14 +2339,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2305
2339
  local line = ((m and m.line) or ast_tbl.line or "?")
2306
2340
  local col = ((m and m.col) or ast_tbl.col or "?")
2307
2341
  local target = tostring((utils["sym?"](ast_tbl[1]) or ast_tbl[1] or "()"))
2308
- return string.format("%s:%s:%s Compile error in '%s': %s", filename, line, col, target, msg)
2342
+ return string.format("%s:%s:%s: Compile error in '%s': %s", filename, line, col, target, msg)
2309
2343
  end
2310
2344
  local function assert_compile(condition, msg, ast, _3ffallback_ast)
2311
2345
  if not condition then
2312
- local _264_ = (utils.root.options or {})
2313
- local error_pinpoint = _264_["error-pinpoint"]
2314
- local source = _264_["source"]
2315
- local unfriendly = _264_["unfriendly"]
2346
+ local _267_ = (utils.root.options or {})
2347
+ local error_pinpoint = _267_["error-pinpoint"]
2348
+ local source = _267_["source"]
2349
+ local unfriendly = _267_["unfriendly"]
2316
2350
  local ast0 = nil
2317
2351
  if next(utils["ast-source"](ast)) then
2318
2352
  ast0 = ast
@@ -2336,33 +2370,33 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2336
2370
  scopes.macro = scopes.global
2337
2371
  local serialize_subst = {["\11"] = "\\v", ["\12"] = "\\f", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "n"}
2338
2372
  local function serialize_string(str)
2339
- local function _269_(_241)
2373
+ local function _272_(_241)
2340
2374
  return ("\\" .. _241:byte())
2341
2375
  end
2342
- return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _269_)
2376
+ return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _272_)
2343
2377
  end
2344
2378
  local function global_mangling(str)
2345
2379
  if utils["valid-lua-identifier?"](str) then
2346
2380
  return str
2347
2381
  else
2348
- local function _270_(_241)
2382
+ local function _273_(_241)
2349
2383
  return string.format("_%02x", _241:byte())
2350
2384
  end
2351
- return ("__fnl_global__" .. str:gsub("[^%w]", _270_))
2385
+ return ("__fnl_global__" .. str:gsub("[^%w]", _273_))
2352
2386
  end
2353
2387
  end
2354
2388
  local function global_unmangling(identifier)
2355
- local _272_0 = string.match(identifier, "^__fnl_global__(.*)$")
2356
- if (nil ~= _272_0) then
2357
- local rest = _272_0
2358
- local _273_0 = nil
2359
- local function _274_(_241)
2389
+ local _275_0 = string.match(identifier, "^__fnl_global__(.*)$")
2390
+ if (nil ~= _275_0) then
2391
+ local rest = _275_0
2392
+ local _276_0 = nil
2393
+ local function _277_(_241)
2360
2394
  return string.char(tonumber(_241:sub(2), 16))
2361
2395
  end
2362
- _273_0 = string.gsub(rest, "_[%da-f][%da-f]", _274_)
2363
- return _273_0
2396
+ _276_0 = string.gsub(rest, "_[%da-f][%da-f]", _277_)
2397
+ return _276_0
2364
2398
  else
2365
- local _ = _272_0
2399
+ local _ = _275_0
2366
2400
  return identifier
2367
2401
  end
2368
2402
  end
@@ -2386,10 +2420,10 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2386
2420
  raw = str
2387
2421
  end
2388
2422
  local mangling = nil
2389
- local function _278_(_241)
2423
+ local function _281_(_241)
2390
2424
  return string.format("_%02x", _241:byte())
2391
2425
  end
2392
- mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _278_)
2426
+ mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _281_)
2393
2427
  local unique = unique_mangling(mangling, mangling, scope, 0)
2394
2428
  scope.unmanglings[unique] = (scope["gensym-base"][str] or str)
2395
2429
  do
@@ -2444,31 +2478,31 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2444
2478
  return table.concat(parts, ".")
2445
2479
  end
2446
2480
  local function autogensym(base, scope)
2447
- local _282_0 = utils["multi-sym?"](base)
2448
- if (nil ~= _282_0) then
2449
- local parts = _282_0
2481
+ local _285_0 = utils["multi-sym?"](base)
2482
+ if (nil ~= _285_0) then
2483
+ local parts = _285_0
2450
2484
  return combine_auto_gensym(parts, autogensym(parts[1], scope))
2451
2485
  else
2452
- local _ = _282_0
2453
- local function _283_()
2454
- local mangling = gensym(scope, base:sub(1, ( - 2)), "auto")
2486
+ local _ = _285_0
2487
+ local function _286_()
2488
+ local mangling = gensym(scope, base:sub(1, -2), "auto")
2455
2489
  scope.autogensyms[base] = mangling
2456
2490
  return mangling
2457
2491
  end
2458
- return (scope.autogensyms[base] or _283_())
2492
+ return (scope.autogensyms[base] or _286_())
2459
2493
  end
2460
2494
  end
2461
2495
  local function check_binding_valid(symbol, scope, ast, _3fopts)
2462
2496
  local name = tostring(symbol)
2463
2497
  local macro_3f = nil
2464
2498
  do
2465
- local _285_0 = _3fopts
2466
- if (nil ~= _285_0) then
2467
- _285_0 = _285_0["macro?"]
2499
+ local _288_0 = _3fopts
2500
+ if (nil ~= _288_0) then
2501
+ _288_0 = _288_0["macro?"]
2468
2502
  end
2469
- macro_3f = _285_0
2503
+ macro_3f = _288_0
2470
2504
  end
2471
- assert_compile(not name:find("&"), "invalid character: &", symbol)
2505
+ assert_compile(("&" ~= name:match("[&.:]")), "invalid character: &", symbol)
2472
2506
  assert_compile(not name:find("^%."), "invalid character: .", symbol)
2473
2507
  assert_compile(not (scope.specials[name] or (not macro_3f and scope.macros[name])), ("local %s was overshadowed by a special form or macro"):format(name), ast)
2474
2508
  return assert_compile(not utils["quoted?"](symbol), string.format("macro tried to bind %s without gensym", name), symbol)
@@ -2542,7 +2576,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2542
2576
  out[last_line0] = ((out[last_line0] or "") .. " " .. chunk.leaf)
2543
2577
  else
2544
2578
  for _, subchunk in ipairs(chunk) do
2545
- if (subchunk.leaf or (0 < #subchunk)) then
2579
+ if (subchunk.leaf or next(subchunk)) then
2546
2580
  local source = utils["ast-source"](subchunk.ast)
2547
2581
  if (file == source.filename) then
2548
2582
  last_line0 = math.max(last_line0, (source.line or 0))
@@ -2564,29 +2598,29 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2564
2598
  end
2565
2599
  local function flatten_chunk(file_sourcemap, chunk, tab, depth)
2566
2600
  if chunk.leaf then
2567
- local _297_ = utils["ast-source"](chunk.ast)
2568
- local filename = _297_["filename"]
2569
- local line = _297_["line"]
2601
+ local _300_ = utils["ast-source"](chunk.ast)
2602
+ local filename = _300_["filename"]
2603
+ local line = _300_["line"]
2570
2604
  table.insert(file_sourcemap, {filename, line})
2571
2605
  return chunk.leaf
2572
2606
  else
2573
2607
  local tab0 = nil
2574
2608
  do
2575
- local _298_0 = tab
2576
- if (_298_0 == true) then
2609
+ local _301_0 = tab
2610
+ if (_301_0 == true) then
2577
2611
  tab0 = " "
2578
- elseif (_298_0 == false) then
2612
+ elseif (_301_0 == false) then
2579
2613
  tab0 = ""
2580
- elseif (_298_0 == tab) then
2614
+ elseif (_301_0 == tab) then
2581
2615
  tab0 = tab
2582
- elseif (_298_0 == nil) then
2616
+ elseif (_301_0 == nil) then
2583
2617
  tab0 = ""
2584
2618
  else
2585
2619
  tab0 = nil
2586
2620
  end
2587
2621
  end
2588
2622
  local function parter(c)
2589
- if (c.leaf or (0 < #c)) then
2623
+ if (c.leaf or next(c)) then
2590
2624
  local sub = flatten_chunk(file_sourcemap, c, tab0, (depth + 1))
2591
2625
  if (0 < depth) then
2592
2626
  return (tab0 .. sub:gsub("\n", ("\n" .. tab0)))
@@ -2625,7 +2659,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2625
2659
  end
2626
2660
  end
2627
2661
  local function make_metadata()
2628
- local function _306_(self, tgt, _3fkey)
2662
+ local function _309_(self, tgt, _3fkey)
2629
2663
  if self[tgt] then
2630
2664
  if (nil ~= _3fkey) then
2631
2665
  return self[tgt][_3fkey]
@@ -2634,12 +2668,12 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2634
2668
  end
2635
2669
  end
2636
2670
  end
2637
- local function _309_(self, tgt, key, value)
2671
+ local function _312_(self, tgt, key, value)
2638
2672
  self[tgt] = (self[tgt] or {})
2639
2673
  self[tgt][key] = value
2640
2674
  return tgt
2641
2675
  end
2642
- local function _310_(self, tgt, ...)
2676
+ local function _313_(self, tgt, ...)
2643
2677
  local kv_len = select("#", ...)
2644
2678
  local kvs = {...}
2645
2679
  if ((kv_len % 2) ~= 0) then
@@ -2651,7 +2685,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2651
2685
  end
2652
2686
  return tgt
2653
2687
  end
2654
- return setmetatable({}, {__index = {get = _306_, set = _309_, setall = _310_}, __mode = "k"})
2688
+ return setmetatable({}, {__index = {get = _309_, set = _312_, setall = _313_}, __mode = "k"})
2655
2689
  end
2656
2690
  local function exprs1(exprs)
2657
2691
  return table.concat(utils.map(exprs, tostring), ", ")
@@ -2697,14 +2731,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2697
2731
  end
2698
2732
  if opts.target then
2699
2733
  local result = exprs1(exprs)
2700
- local function _318_()
2734
+ local function _321_()
2701
2735
  if (result == "") then
2702
2736
  return "nil"
2703
2737
  else
2704
2738
  return result
2705
2739
  end
2706
2740
  end
2707
- emit(parent, string.format("%s = %s", opts.target, _318_()), ast)
2741
+ emit(parent, string.format("%s = %s", opts.target, _321_()), ast)
2708
2742
  end
2709
2743
  if (opts.tail or opts.target) then
2710
2744
  return {returned = true}
@@ -2716,16 +2750,16 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2716
2750
  local function find_macro(ast, scope)
2717
2751
  local macro_2a = nil
2718
2752
  do
2719
- local _321_0 = utils["sym?"](ast[1])
2720
- if (_321_0 ~= nil) then
2721
- local _322_0 = tostring(_321_0)
2722
- if (_322_0 ~= nil) then
2723
- macro_2a = scope.macros[_322_0]
2753
+ local _324_0 = utils["sym?"](ast[1])
2754
+ if (_324_0 ~= nil) then
2755
+ local _325_0 = tostring(_324_0)
2756
+ if (_325_0 ~= nil) then
2757
+ macro_2a = scope.macros[_325_0]
2724
2758
  else
2725
- macro_2a = _322_0
2759
+ macro_2a = _325_0
2726
2760
  end
2727
2761
  else
2728
- macro_2a = _321_0
2762
+ macro_2a = _324_0
2729
2763
  end
2730
2764
  end
2731
2765
  local multi_sym_parts = utils["multi-sym?"](ast[1])
@@ -2737,12 +2771,12 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2737
2771
  return macro_2a
2738
2772
  end
2739
2773
  end
2740
- local function propagate_trace_info(_326_0, _index, node)
2741
- local _327_ = _326_0
2742
- local byteend = _327_["byteend"]
2743
- local bytestart = _327_["bytestart"]
2744
- local filename = _327_["filename"]
2745
- local line = _327_["line"]
2774
+ local function propagate_trace_info(_329_0, _index, node)
2775
+ local _330_ = _329_0
2776
+ local byteend = _330_["byteend"]
2777
+ local bytestart = _330_["bytestart"]
2778
+ local filename = _330_["filename"]
2779
+ local line = _330_["line"]
2746
2780
  do
2747
2781
  local src = utils["ast-source"](node)
2748
2782
  if (("table" == type(node)) and (filename ~= src.filename)) then
@@ -2755,8 +2789,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2755
2789
  local function quote_literal_nils(index, node, parent)
2756
2790
  if (parent and utils["list?"](parent)) then
2757
2791
  for i = 1, utils.maxn(parent) do
2758
- local _329_0 = parent[i]
2759
- if (_329_0 == nil) then
2792
+ local _332_0 = parent[i]
2793
+ if (_332_0 == nil) then
2760
2794
  parent[i] = utils.sym("nil")
2761
2795
  end
2762
2796
  end
@@ -2764,10 +2798,10 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2764
2798
  return index, node, parent
2765
2799
  end
2766
2800
  local function comp(f, g)
2767
- local function _332_(...)
2801
+ local function _335_(...)
2768
2802
  return f(g(...))
2769
2803
  end
2770
- return _332_
2804
+ return _335_
2771
2805
  end
2772
2806
  local function built_in_3f(m)
2773
2807
  local found_3f = false
@@ -2778,45 +2812,46 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2778
2812
  return found_3f
2779
2813
  end
2780
2814
  local function macroexpand_2a(ast, scope, _3fonce)
2781
- local _333_0 = nil
2815
+ local _336_0 = nil
2782
2816
  if utils["list?"](ast) then
2783
- _333_0 = find_macro(ast, scope)
2817
+ _336_0 = find_macro(ast, scope)
2784
2818
  else
2785
- _333_0 = nil
2819
+ _336_0 = nil
2786
2820
  end
2787
- if (_333_0 == false) then
2821
+ if (_336_0 == false) then
2788
2822
  return ast
2789
- elseif (nil ~= _333_0) then
2790
- local macro_2a = _333_0
2823
+ elseif (nil ~= _336_0) then
2824
+ local macro_2a = _336_0
2791
2825
  local old_scope = scopes.macro
2792
2826
  local _ = nil
2793
2827
  scopes.macro = scope
2794
2828
  _ = nil
2795
2829
  local ok, transformed = nil, nil
2796
- local function _335_()
2830
+ local function _338_()
2797
2831
  return macro_2a(unpack(ast, 2))
2798
2832
  end
2799
- local function _336_()
2833
+ local function _339_()
2800
2834
  if built_in_3f(macro_2a) then
2801
2835
  return tostring
2802
2836
  else
2803
2837
  return debug.traceback
2804
2838
  end
2805
2839
  end
2806
- ok, transformed = xpcall(_335_, _336_())
2807
- local function _337_(...)
2840
+ ok, transformed = xpcall(_338_, _339_())
2841
+ local function _340_(...)
2808
2842
  return propagate_trace_info(ast, ...)
2809
2843
  end
2810
- utils["walk-tree"](transformed, comp(_337_, quote_literal_nils))
2844
+ utils["walk-tree"](transformed, comp(_340_, quote_literal_nils))
2811
2845
  scopes.macro = old_scope
2812
2846
  assert_compile(ok, transformed, ast)
2847
+ utils.hook("macroexpand", ast, transformed, scope)
2813
2848
  if (_3fonce or not transformed) then
2814
2849
  return transformed
2815
2850
  else
2816
2851
  return macroexpand_2a(transformed, scope)
2817
2852
  end
2818
2853
  else
2819
- local _ = _333_0
2854
+ local _ = _336_0
2820
2855
  return ast
2821
2856
  end
2822
2857
  end
@@ -2848,13 +2883,13 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2848
2883
  assert_compile((utils["sym?"](ast[1]) or utils["list?"](ast[1]) or ("string" == type(ast[1]))), ("cannot call literal value " .. tostring(ast[1])), ast)
2849
2884
  for i = 2, len do
2850
2885
  local subexprs = nil
2851
- local _343_
2886
+ local _346_
2852
2887
  if (i ~= len) then
2853
- _343_ = 1
2888
+ _346_ = 1
2854
2889
  else
2855
- _343_ = nil
2890
+ _346_ = nil
2856
2891
  end
2857
- subexprs = compile1(ast[i], scope, parent, {nval = _343_})
2892
+ subexprs = compile1(ast[i], scope, parent, {nval = _346_})
2858
2893
  table.insert(fargs, subexprs[1])
2859
2894
  if (i == len) then
2860
2895
  for j = 2, #subexprs do
@@ -2892,13 +2927,13 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2892
2927
  end
2893
2928
  end
2894
2929
  local function compile_varg(ast, scope, parent, opts)
2895
- local _348_
2930
+ local _351_
2896
2931
  if scope.hashfn then
2897
- _348_ = "use $... in hashfn"
2932
+ _351_ = "use $... in hashfn"
2898
2933
  else
2899
- _348_ = "unexpected vararg"
2934
+ _351_ = "unexpected vararg"
2900
2935
  end
2901
- assert_compile(scope.vararg, _348_, ast)
2936
+ assert_compile(scope.vararg, _351_, ast)
2902
2937
  return handle_compile_opts({utils.expr("...", "varg")}, parent, opts, ast)
2903
2938
  end
2904
2939
  local function compile_sym(ast, scope, parent, opts)
@@ -2913,20 +2948,20 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2913
2948
  return handle_compile_opts({e}, parent, opts, ast)
2914
2949
  end
2915
2950
  local function serialize_number(n)
2916
- local _351_0 = string.gsub(tostring(n), ",", ".")
2917
- return _351_0
2951
+ local _354_0 = string.gsub(tostring(n), ",", ".")
2952
+ return _354_0
2918
2953
  end
2919
2954
  local function compile_scalar(ast, _scope, parent, opts)
2920
2955
  local serialize = nil
2921
2956
  do
2922
- local _352_0 = type(ast)
2923
- if (_352_0 == "nil") then
2957
+ local _355_0 = type(ast)
2958
+ if (_355_0 == "nil") then
2924
2959
  serialize = tostring
2925
- elseif (_352_0 == "boolean") then
2960
+ elseif (_355_0 == "boolean") then
2926
2961
  serialize = tostring
2927
- elseif (_352_0 == "string") then
2962
+ elseif (_355_0 == "string") then
2928
2963
  serialize = serialize_string
2929
- elseif (_352_0 == "number") then
2964
+ elseif (_355_0 == "number") then
2930
2965
  serialize = serialize_number
2931
2966
  else
2932
2967
  serialize = nil
@@ -2939,8 +2974,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2939
2974
  if ((type(k) == "string") and utils["valid-lua-identifier?"](k)) then
2940
2975
  return k
2941
2976
  else
2942
- local _354_ = compile1(k, scope, parent, {nval = 1})
2943
- local compiled = _354_[1]
2977
+ local _357_ = compile1(k, scope, parent, {nval = 1})
2978
+ local compiled = _357_[1]
2944
2979
  return ("[" .. tostring(compiled) .. "]")
2945
2980
  end
2946
2981
  end
@@ -2969,8 +3004,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2969
3004
  for k in utils.stablepairs(ast) do
2970
3005
  local val_19_ = nil
2971
3006
  if not keys[k] then
2972
- local _357_ = compile1(ast[k], scope, parent, {nval = 1})
2973
- local v = _357_[1]
3007
+ local _360_ = compile1(ast[k], scope, parent, {nval = 1})
3008
+ local v = _360_[1]
2974
3009
  val_19_ = string.format("%s = %s", escape_key(k), tostring(v))
2975
3010
  else
2976
3011
  val_19_ = nil
@@ -3002,12 +3037,12 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3002
3037
  end
3003
3038
  local function destructure(to, from, ast, scope, parent, opts)
3004
3039
  local opts0 = (opts or {})
3005
- local _361_ = opts0
3006
- local declaration = _361_["declaration"]
3007
- local forceglobal = _361_["forceglobal"]
3008
- local forceset = _361_["forceset"]
3009
- local isvar = _361_["isvar"]
3010
- local symtype = _361_["symtype"]
3040
+ local _364_ = opts0
3041
+ local declaration = _364_["declaration"]
3042
+ local forceglobal = _364_["forceglobal"]
3043
+ local forceset = _364_["forceset"]
3044
+ local isvar = _364_["isvar"]
3045
+ local symtype = _364_["symtype"]
3011
3046
  local symtype0 = ("_" .. (symtype or "dst"))
3012
3047
  local setter = nil
3013
3048
  if declaration then
@@ -3023,8 +3058,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3023
3058
  return declare_local(symbol, nil, scope, symbol, new_manglings)
3024
3059
  else
3025
3060
  local parts = (utils["multi-sym?"](raw) or {raw})
3026
- local _363_ = parts
3027
- local first = _363_[1]
3061
+ local _366_ = parts
3062
+ local first = _366_[1]
3028
3063
  local meta = scope.symmeta[first]
3029
3064
  assert_compile(not raw:find(":"), "cannot set method sym", symbol)
3030
3065
  if ((#parts == 1) and not forceset) then
@@ -3045,14 +3080,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3045
3080
  end
3046
3081
  local function compile_top_target(lvalues)
3047
3082
  local inits = nil
3048
- local function _368_(_241)
3083
+ local function _371_(_241)
3049
3084
  if scope.manglings[_241] then
3050
3085
  return _241
3051
3086
  else
3052
3087
  return "nil"
3053
3088
  end
3054
3089
  end
3055
- inits = utils.map(lvalues, _368_)
3090
+ inits = utils.map(lvalues, _371_)
3056
3091
  local init = table.concat(inits, ", ")
3057
3092
  local lvalue = table.concat(lvalues, ", ")
3058
3093
  local plast = parent[#parent]
@@ -3090,7 +3125,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3090
3125
  local unpack_fn = "function (t, k, e)\n local mt = getmetatable(t)\n if 'table' == type(mt) and mt.__fennelrest then\n return mt.__fennelrest(t, k)\n elseif e then\n local rest = {}\n for k, v in pairs(t) do\n if not e[k] then rest[k] = v end\n end\n return rest\n else\n return {(table.unpack or unpack)(t, k)}\n end\n end"
3091
3126
  local function destructure_kv_rest(s, v, left, excluded_keys, destructure1)
3092
3127
  local exclude_str = nil
3093
- local _375_
3128
+ local _378_
3094
3129
  do
3095
3130
  local tbl_17_ = {}
3096
3131
  local i_18_ = #tbl_17_
@@ -3101,9 +3136,9 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3101
3136
  tbl_17_[i_18_] = val_19_
3102
3137
  end
3103
3138
  end
3104
- _375_ = tbl_17_
3139
+ _378_ = tbl_17_
3105
3140
  end
3106
- exclude_str = table.concat(_375_, ", ")
3141
+ exclude_str = table.concat(_378_, ", ")
3107
3142
  local subexpr = utils.expr(string.format(string.gsub(("(" .. unpack_fn .. ")(%s, %s, {%s})"), "\n%s*", " "), s, tostring(v), exclude_str), "expression")
3108
3143
  return destructure1(v, {subexpr}, left)
3109
3144
  end
@@ -3118,16 +3153,16 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3118
3153
  local s = gensym(scope, symtype0)
3119
3154
  local right = nil
3120
3155
  do
3121
- local _377_0 = nil
3156
+ local _380_0 = nil
3122
3157
  if top_3f then
3123
- _377_0 = exprs1(compile1(from, scope, parent))
3158
+ _380_0 = exprs1(compile1(from, scope, parent))
3124
3159
  else
3125
- _377_0 = exprs1(rightexprs)
3160
+ _380_0 = exprs1(rightexprs)
3126
3161
  end
3127
- if (_377_0 == "") then
3162
+ if (_380_0 == "") then
3128
3163
  right = "nil"
3129
- elseif (nil ~= _377_0) then
3130
- local right0 = _377_0
3164
+ elseif (nil ~= _380_0) then
3165
+ local right0 = _380_0
3131
3166
  right = right0
3132
3167
  else
3133
3168
  right = nil
@@ -3212,7 +3247,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3212
3247
  local function require_include(ast, scope, parent, opts)
3213
3248
  opts.fallback = function(e, no_warn)
3214
3249
  if (not no_warn and ("literal" == e.type)) then
3215
- utils.warn(("include module not found, falling back to require: %s"):format(tostring(e)))
3250
+ utils.warn(("include module not found, falling back to require: %s"):format(tostring(e)), ast)
3216
3251
  end
3217
3252
  return utils.expr(string.format("require(%s)", tostring(e)), "statement")
3218
3253
  end
@@ -3235,8 +3270,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3235
3270
  if opts.assertAsRepl then
3236
3271
  scope.macros.assert = scope.macros["assert-repl"]
3237
3272
  end
3238
- local _392_ = utils.root
3239
- _392_["set-reset"](_392_)
3273
+ local _395_ = utils.root
3274
+ _395_["set-reset"](_395_)
3240
3275
  utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts
3241
3276
  for i = 1, #asts do
3242
3277
  local exprs = compile1(asts[i], scope, chunk, {nval = (((i < #asts) and 0) or nil), tail = (i == #asts)})
@@ -3249,7 +3284,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3249
3284
  utils.root.reset()
3250
3285
  return flatten(chunk, opts)
3251
3286
  end
3252
- local function compile_stream(stream, opts)
3287
+ local function compile_stream(stream, _3fopts)
3288
+ local opts = (_3fopts or {})
3253
3289
  local asts = nil
3254
3290
  do
3255
3291
  local tbl_17_ = {}
@@ -3266,16 +3302,16 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3266
3302
  return compile_asts(asts, opts)
3267
3303
  end
3268
3304
  local function compile_string(str, _3fopts)
3269
- return compile_stream(parser["string-stream"](str, (_3fopts or {})), (_3fopts or {}))
3305
+ return compile_stream(parser["string-stream"](str, _3fopts), _3fopts)
3270
3306
  end
3271
3307
  local function compile(ast, _3fopts)
3272
3308
  return compile_asts({ast}, _3fopts)
3273
3309
  end
3274
3310
  local function traceback_frame(info)
3275
3311
  if ((info.what == "C") and info.name) then
3276
- return string.format(" [C]: in function '%s'", info.name)
3312
+ return string.format("\9[C]: in function '%s'", info.name)
3277
3313
  elseif (info.what == "C") then
3278
- return " [C]: in ?"
3314
+ return "\9[C]: in ?"
3279
3315
  else
3280
3316
  local remap = sourcemap[info.source]
3281
3317
  if (remap and remap[info.currentline]) then
@@ -3287,18 +3323,18 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3287
3323
  info.currentline = (remap[info.currentline][2] or -1)
3288
3324
  end
3289
3325
  if (info.what == "Lua") then
3290
- local function _397_()
3326
+ local function _400_()
3291
3327
  if info.name then
3292
3328
  return ("'" .. info.name .. "'")
3293
3329
  else
3294
3330
  return "?"
3295
3331
  end
3296
3332
  end
3297
- return string.format(" %s:%d: in function %s", info.short_src, info.currentline, _397_())
3333
+ return string.format("\9%s:%d: in function %s", info.short_src, info.currentline, _400_())
3298
3334
  elseif (info.short_src == "(tail call)") then
3299
3335
  return " (tail call)"
3300
3336
  else
3301
- return string.format(" %s:%d: in main chunk", info.short_src, info.currentline)
3337
+ return string.format("\9%s:%d: in main chunk", info.short_src, info.currentline)
3302
3338
  end
3303
3339
  end
3304
3340
  end
@@ -3318,11 +3354,11 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3318
3354
  local done_3f, level = false, (_3fstart or 2)
3319
3355
  while not done_3f do
3320
3356
  do
3321
- local _401_0 = debug.getinfo(level, "Sln")
3322
- if (_401_0 == nil) then
3357
+ local _404_0 = debug.getinfo(level, "Sln")
3358
+ if (_404_0 == nil) then
3323
3359
  done_3f = true
3324
- elseif (nil ~= _401_0) then
3325
- local info = _401_0
3360
+ elseif (nil ~= _404_0) then
3361
+ local info = _404_0
3326
3362
  table.insert(lines, traceback_frame(info))
3327
3363
  end
3328
3364
  end
@@ -3332,14 +3368,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3332
3368
  end
3333
3369
  end
3334
3370
  local function entry_transform(fk, fv)
3335
- local function _404_(k, v)
3371
+ local function _407_(k, v)
3336
3372
  if (type(k) == "number") then
3337
3373
  return k, fv(v)
3338
3374
  else
3339
3375
  return fk(k), fv(v)
3340
3376
  end
3341
3377
  end
3342
- return _404_
3378
+ return _407_
3343
3379
  end
3344
3380
  local function mixed_concat(t, joiner)
3345
3381
  local seen = {}
@@ -3384,10 +3420,10 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3384
3420
  return res[1]
3385
3421
  elseif utils["list?"](form) then
3386
3422
  local mapped = nil
3387
- local function _409_()
3423
+ local function _412_()
3388
3424
  return nil
3389
3425
  end
3390
- mapped = utils.kvmap(form, entry_transform(_409_, q))
3426
+ mapped = utils.kvmap(form, entry_transform(_412_, q))
3391
3427
  local filename = nil
3392
3428
  if form.filename then
3393
3429
  filename = string.format("%q", form.filename)
@@ -3405,13 +3441,13 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3405
3441
  else
3406
3442
  filename = "nil"
3407
3443
  end
3408
- local _412_
3444
+ local _415_
3409
3445
  if source then
3410
- _412_ = source.line
3446
+ _415_ = source.line
3411
3447
  else
3412
- _412_ = "nil"
3448
+ _415_ = "nil"
3413
3449
  end
3414
- return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _412_, "(getmetatable(sequence()))['sequence']")
3450
+ return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _415_, "(getmetatable(sequence()))['sequence']")
3415
3451
  elseif (type(form) == "table") then
3416
3452
  local mapped = utils.kvmap(form, entry_transform(q, q))
3417
3453
  local source = getmetatable(form)
@@ -3421,14 +3457,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3421
3457
  else
3422
3458
  filename = "nil"
3423
3459
  end
3424
- local function _415_()
3460
+ local function _418_()
3425
3461
  if source then
3426
3462
  return source.line
3427
3463
  else
3428
3464
  return "nil"
3429
3465
  end
3430
3466
  end
3431
- return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _415_())
3467
+ return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _418_())
3432
3468
  elseif (type(form) == "string") then
3433
3469
  return serialize_string(form)
3434
3470
  else
@@ -3447,7 +3483,7 @@ package.preload["fennel.friend"] = package.preload["fennel.friend"] or function(
3447
3483
  for pat, sug in pairs(suggestions) do
3448
3484
  if s then break end
3449
3485
  local matches = {msg:match(pat)}
3450
- if (0 < #matches) then
3486
+ if next(matches) then
3451
3487
  local tbl_17_ = {}
3452
3488
  local i_18_ = #tbl_17_
3453
3489
  for _, s0 in ipairs(sug) do
@@ -3481,13 +3517,13 @@ package.preload["fennel.friend"] = package.preload["fennel.friend"] or function(
3481
3517
  return error(..., 0)
3482
3518
  end
3483
3519
  end
3484
- local function _184_()
3520
+ local function _187_()
3485
3521
  for _ = 2, line do
3486
3522
  f:read()
3487
3523
  end
3488
3524
  return f:read()
3489
3525
  end
3490
- return close_handlers_10_(_G.xpcall(_184_, (package.loaded.fennel or debug).traceback))
3526
+ return close_handlers_10_(_G.xpcall(_187_, (package.loaded.fennel or debug).traceback))
3491
3527
  end
3492
3528
  end
3493
3529
  local function sub(str, start, _end)
@@ -3503,8 +3539,8 @@ package.preload["fennel.friend"] = package.preload["fennel.friend"] or function(
3503
3539
  if ((opts and (false == opts["error-pinpoint"])) or (os and os.getenv and os.getenv("NO_COLOR"))) then
3504
3540
  return codeline
3505
3541
  else
3506
- local _187_ = (opts or {})
3507
- local error_pinpoint = _187_["error-pinpoint"]
3542
+ local _190_ = (opts or {})
3543
+ local error_pinpoint = _190_["error-pinpoint"]
3508
3544
  local endcol = (_3fendcol or col)
3509
3545
  local eol = nil
3510
3546
  if utf8_ok_3f then
@@ -3512,19 +3548,19 @@ package.preload["fennel.friend"] = package.preload["fennel.friend"] or function(
3512
3548
  else
3513
3549
  eol = string.len(codeline)
3514
3550
  end
3515
- local _189_ = (error_pinpoint or {"\27[7m", "\27[0m"})
3516
- local open = _189_[1]
3517
- local close = _189_[2]
3551
+ local _192_ = (error_pinpoint or {"\27[7m", "\27[0m"})
3552
+ local open = _192_[1]
3553
+ local close = _192_[2]
3518
3554
  return (sub(codeline, 1, col) .. open .. sub(codeline, (col + 1), (endcol + 1)) .. close .. sub(codeline, (endcol + 2), eol))
3519
3555
  end
3520
3556
  end
3521
- local function friendly_msg(msg, _191_0, source, opts)
3522
- local _192_ = _191_0
3523
- local col = _192_["col"]
3524
- local endcol = _192_["endcol"]
3525
- local endline = _192_["endline"]
3526
- local filename = _192_["filename"]
3527
- local line = _192_["line"]
3557
+ local function friendly_msg(msg, _194_0, source, opts)
3558
+ local _195_ = _194_0
3559
+ local col = _195_["col"]
3560
+ local endcol = _195_["endcol"]
3561
+ local endline = _195_["endline"]
3562
+ local filename = _195_["filename"]
3563
+ local line = _195_["line"]
3528
3564
  local ok, codeline = pcall(read_line, filename, line, source)
3529
3565
  local endcol0 = nil
3530
3566
  if (ok and codeline and (line ~= endline)) then
@@ -3547,16 +3583,16 @@ package.preload["fennel.friend"] = package.preload["fennel.friend"] or function(
3547
3583
  end
3548
3584
  local function assert_compile(condition, msg, ast, source, opts)
3549
3585
  if not condition then
3550
- local _196_ = utils["ast-source"](ast)
3551
- local col = _196_["col"]
3552
- local filename = _196_["filename"]
3553
- local line = _196_["line"]
3554
- error(friendly_msg(("%s:%s:%s Compile error: %s"):format((filename or "unknown"), (line or "?"), (col or "?"), msg), utils["ast-source"](ast), source, opts), 0)
3586
+ local _199_ = utils["ast-source"](ast)
3587
+ local col = _199_["col"]
3588
+ local filename = _199_["filename"]
3589
+ local line = _199_["line"]
3590
+ error(friendly_msg(("%s:%s:%s: Compile error: %s"):format((filename or "unknown"), (line or "?"), (col or "?"), msg), utils["ast-source"](ast), source, opts), 0)
3555
3591
  end
3556
3592
  return condition
3557
3593
  end
3558
3594
  local function parse_error(msg, filename, line, col, source, opts)
3559
- return error(friendly_msg(("%s:%s:%s Parse error: %s"):format(filename, line, col, msg), {col = col, filename = filename, line = line}, source, opts), 0)
3595
+ return error(friendly_msg(("%s:%s:%s: Parse error: %s"):format(filename, line, col, msg), {col = col, filename = filename, line = line}, source, opts), 0)
3560
3596
  end
3561
3597
  return {["assert-compile"] = assert_compile, ["parse-error"] = parse_error}
3562
3598
  end
@@ -3566,36 +3602,36 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3566
3602
  local unpack = (table.unpack or _G.unpack)
3567
3603
  local function granulate(getchunk)
3568
3604
  local c, index, done_3f = "", 1, false
3569
- local function _198_(parser_state)
3605
+ local function _201_(parser_state)
3570
3606
  if not done_3f then
3571
3607
  if (index <= #c) then
3572
3608
  local b = c:byte(index)
3573
3609
  index = (index + 1)
3574
3610
  return b
3575
3611
  else
3576
- local _199_0 = getchunk(parser_state)
3577
- local function _200_()
3578
- local char = _199_0
3612
+ local _202_0 = getchunk(parser_state)
3613
+ local function _203_()
3614
+ local char = _202_0
3579
3615
  return (char ~= "")
3580
3616
  end
3581
- if ((nil ~= _199_0) and _200_()) then
3582
- local char = _199_0
3617
+ if ((nil ~= _202_0) and _203_()) then
3618
+ local char = _202_0
3583
3619
  c = char
3584
3620
  index = 2
3585
3621
  return c:byte()
3586
3622
  else
3587
- local _ = _199_0
3623
+ local _ = _202_0
3588
3624
  done_3f = true
3589
3625
  return nil
3590
3626
  end
3591
3627
  end
3592
3628
  end
3593
3629
  end
3594
- local function _204_()
3630
+ local function _207_()
3595
3631
  c = ""
3596
3632
  return nil
3597
3633
  end
3598
- return _198_, _204_
3634
+ return _201_, _207_
3599
3635
  end
3600
3636
  local function string_stream(str, _3foptions)
3601
3637
  local str0 = str:gsub("^#!", ";;")
@@ -3603,12 +3639,12 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3603
3639
  _3foptions.source = str0
3604
3640
  end
3605
3641
  local index = 1
3606
- local function _206_()
3642
+ local function _209_()
3607
3643
  local r = str0:byte(index)
3608
3644
  index = (index + 1)
3609
3645
  return r
3610
3646
  end
3611
- return _206_
3647
+ return _209_
3612
3648
  end
3613
3649
  local delims = {[123] = 125, [125] = true, [40] = 41, [41] = true, [91] = 93, [93] = true}
3614
3650
  local function sym_char_3f(b)
@@ -3624,12 +3660,12 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3624
3660
  local function char_starter_3f(b)
3625
3661
  return (((1 < b) and (b < 127)) or ((192 < b) and (b < 247)))
3626
3662
  end
3627
- local function parser_fn(getbyte, filename, _208_0)
3628
- local _209_ = _208_0
3629
- local options = _209_
3630
- local comments = _209_["comments"]
3631
- local source = _209_["source"]
3632
- local unfriendly = _209_["unfriendly"]
3663
+ local function parser_fn(getbyte, filename, _211_0)
3664
+ local _212_ = _211_0
3665
+ local options = _212_
3666
+ local comments = _212_["comments"]
3667
+ local source = _212_["source"]
3668
+ local unfriendly = _212_["unfriendly"]
3633
3669
  local stack = {}
3634
3670
  local line, byteindex, col, prev_col, lastb = 1, 0, 0, 0, nil
3635
3671
  local function ungetb(ub)
@@ -3662,21 +3698,21 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3662
3698
  return r
3663
3699
  end
3664
3700
  local function whitespace_3f(b)
3665
- local function _217_()
3666
- local _216_0 = options.whitespace
3667
- if (nil ~= _216_0) then
3668
- _216_0 = _216_0[b]
3701
+ local function _220_()
3702
+ local _219_0 = options.whitespace
3703
+ if (nil ~= _219_0) then
3704
+ _219_0 = _219_0[b]
3669
3705
  end
3670
- return _216_0
3706
+ return _219_0
3671
3707
  end
3672
- return ((b == 32) or ((9 <= b) and (b <= 13)) or _217_())
3708
+ return ((b == 32) or ((9 <= b) and (b <= 13)) or _220_())
3673
3709
  end
3674
3710
  local function parse_error(msg, _3fcol_adjust)
3675
3711
  local col0 = (col + (_3fcol_adjust or -1))
3676
3712
  if (nil == utils["hook-opts"]("parse-error", options, msg, filename, (line or "?"), col0, source, utils.root.reset)) then
3677
3713
  utils.root.reset()
3678
3714
  if unfriendly then
3679
- return error(string.format("%s:%s:%s Parse error: %s", filename, (line or "?"), col0, msg), 0)
3715
+ return error(string.format("%s:%s:%s: Parse error: %s", filename, (line or "?"), col0, msg), 0)
3680
3716
  else
3681
3717
  return friend["parse-error"](msg, filename, (line or "?"), col0, source, options)
3682
3718
  end
@@ -3689,56 +3725,60 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3689
3725
  return nil
3690
3726
  end
3691
3727
  local function dispatch(v)
3692
- local _221_0 = stack[#stack]
3693
- if (_221_0 == nil) then
3728
+ local _224_0 = stack[#stack]
3729
+ if (_224_0 == nil) then
3694
3730
  retval, done_3f, whitespace_since_dispatch = v, true, false
3695
3731
  return nil
3696
- elseif ((_G.type(_221_0) == "table") and (nil ~= _221_0.prefix)) then
3697
- local prefix = _221_0.prefix
3732
+ elseif ((_G.type(_224_0) == "table") and (nil ~= _224_0.prefix)) then
3733
+ local prefix = _224_0.prefix
3698
3734
  local source0 = nil
3699
3735
  do
3700
- local _222_0 = table.remove(stack)
3701
- set_source_fields(_222_0)
3702
- source0 = _222_0
3736
+ local _225_0 = table.remove(stack)
3737
+ set_source_fields(_225_0)
3738
+ source0 = _225_0
3703
3739
  end
3704
3740
  local list = utils.list(utils.sym(prefix, source0), v)
3705
3741
  for k, v0 in pairs(source0) do
3706
3742
  list[k] = v0
3707
3743
  end
3708
3744
  return dispatch(list)
3709
- elseif (nil ~= _221_0) then
3710
- local top = _221_0
3745
+ elseif (nil ~= _224_0) then
3746
+ local top = _224_0
3711
3747
  whitespace_since_dispatch = false
3712
3748
  return table.insert(top, v)
3713
3749
  end
3714
3750
  end
3715
3751
  local function badend()
3716
3752
  local accum = utils.map(stack, "closer")
3717
- local _224_
3753
+ local _227_
3718
3754
  if (#stack == 1) then
3719
- _224_ = ""
3755
+ _227_ = ""
3720
3756
  else
3721
- _224_ = "s"
3757
+ _227_ = "s"
3722
3758
  end
3723
- return parse_error(string.format("expected closing delimiter%s %s", _224_, string.char(unpack(accum))))
3759
+ return parse_error(string.format("expected closing delimiter%s %s", _227_, string.char(unpack(accum))))
3724
3760
  end
3725
- local function skip_whitespace(b)
3761
+ local function skip_whitespace(b, close_table)
3726
3762
  if (b and whitespace_3f(b)) then
3727
3763
  whitespace_since_dispatch = true
3728
- return skip_whitespace(getb())
3729
- elseif (not b and (0 < #stack)) then
3730
- return badend()
3764
+ return skip_whitespace(getb(), close_table)
3765
+ elseif (not b and next(stack)) then
3766
+ badend()
3767
+ for i = #stack, 2, -1 do
3768
+ close_table(stack[i].closer)
3769
+ end
3770
+ return stack[1].closer
3731
3771
  else
3732
3772
  return b
3733
3773
  end
3734
3774
  end
3735
3775
  local function parse_comment(b, contents)
3736
3776
  if (b and (10 ~= b)) then
3737
- local function _227_()
3777
+ local function _230_()
3738
3778
  table.insert(contents, string.char(b))
3739
3779
  return contents
3740
3780
  end
3741
- return parse_comment(getb(), _227_())
3781
+ return parse_comment(getb(), _230_())
3742
3782
  elseif comments then
3743
3783
  ungetb(10)
3744
3784
  return dispatch(utils.comment(table.concat(contents), {filename = filename, line = line}))
@@ -3764,12 +3804,12 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3764
3804
  return dispatch(setmetatable(tbl, mt))
3765
3805
  end
3766
3806
  local function add_comment_at(comments0, index, node)
3767
- local _231_0 = comments0[index]
3768
- if (nil ~= _231_0) then
3769
- local existing = _231_0
3807
+ local _234_0 = comments0[index]
3808
+ if (nil ~= _234_0) then
3809
+ local existing = _234_0
3770
3810
  return table.insert(existing, node)
3771
3811
  else
3772
- local _ = _231_0
3812
+ local _ = _234_0
3773
3813
  comments0[index] = {node}
3774
3814
  return nil
3775
3815
  end
@@ -3848,16 +3888,16 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3848
3888
  end
3849
3889
  local state0 = nil
3850
3890
  do
3851
- local _242_0 = {state, b}
3852
- if ((_G.type(_242_0) == "table") and (_242_0[1] == "base") and (_242_0[2] == 92)) then
3891
+ local _245_0 = {state, b}
3892
+ if ((_G.type(_245_0) == "table") and (_245_0[1] == "base") and (_245_0[2] == 92)) then
3853
3893
  state0 = "backslash"
3854
- elseif ((_G.type(_242_0) == "table") and (_242_0[1] == "base") and (_242_0[2] == 34)) then
3894
+ elseif ((_G.type(_245_0) == "table") and (_245_0[1] == "base") and (_245_0[2] == 34)) then
3855
3895
  state0 = "done"
3856
- elseif ((_G.type(_242_0) == "table") and (_242_0[1] == "backslash") and (_242_0[2] == 10)) then
3896
+ elseif ((_G.type(_245_0) == "table") and (_245_0[1] == "backslash") and (_245_0[2] == 10)) then
3857
3897
  table.remove(chars, (#chars - 1))
3858
3898
  state0 = "base"
3859
3899
  else
3860
- local _ = _242_0
3900
+ local _ = _245_0
3861
3901
  state0 = "base"
3862
3902
  end
3863
3903
  end
@@ -3868,7 +3908,7 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3868
3908
  end
3869
3909
  end
3870
3910
  local function escape_char(c)
3871
- return ({nil, nil, nil, nil, nil, nil, "\\a", "\\b", "\\t", "\\n", "\\v", "\\f", "\\r"})[c:byte()]
3911
+ return ({[10] = "\\n", [11] = "\\v", [12] = "\\f", [13] = "\\r", [7] = "\\a", [8] = "\\b", [9] = "\\t"})[c:byte()]
3872
3912
  end
3873
3913
  local function parse_string()
3874
3914
  table.insert(stack, {closer = 34})
@@ -3879,11 +3919,11 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3879
3919
  table.remove(stack)
3880
3920
  local raw = table.concat(chars)
3881
3921
  local formatted = raw:gsub("[\7-\13]", escape_char)
3882
- local _246_0 = (rawget(_G, "loadstring") or load)(("return " .. formatted))
3883
- if (nil ~= _246_0) then
3884
- local load_fn = _246_0
3922
+ local _249_0 = (rawget(_G, "loadstring") or load)(("return " .. formatted))
3923
+ if (nil ~= _249_0) then
3924
+ local load_fn = _249_0
3885
3925
  return dispatch(load_fn())
3886
- elseif (_246_0 == nil) then
3926
+ elseif (_249_0 == nil) then
3887
3927
  return parse_error(("Invalid string: " .. raw))
3888
3928
  end
3889
3929
  end
@@ -3916,13 +3956,13 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3916
3956
  dispatch((tonumber(number_with_stripped_underscores) or parse_error(("could not read number \"" .. rawstr .. "\""))))
3917
3957
  return true
3918
3958
  else
3919
- local _252_0 = tonumber(number_with_stripped_underscores)
3920
- if (nil ~= _252_0) then
3921
- local x = _252_0
3959
+ local _255_0 = tonumber(number_with_stripped_underscores)
3960
+ if (nil ~= _255_0) then
3961
+ local x = _255_0
3922
3962
  dispatch(x)
3923
3963
  return true
3924
3964
  else
3925
- local _ = _252_0
3965
+ local _ = _255_0
3926
3966
  return false
3927
3967
  end
3928
3968
  end
@@ -3932,18 +3972,15 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3932
3972
  return (rawstr:find(pat) - utils.len(rawstr) - 1)
3933
3973
  end
3934
3974
  if (rawstr:match("^~") and (rawstr ~= "~=")) then
3935
- return parse_error("invalid character: ~")
3936
- elseif rawstr:match("%.[0-9]") then
3937
- return parse_error(("can't start multisym segment with a digit: " .. rawstr), col_adjust("%.[0-9]"))
3975
+ parse_error("invalid character: ~")
3938
3976
  elseif (rawstr:match("[%.:][%.:]") and (rawstr ~= "..") and (rawstr ~= "$...")) then
3939
- return parse_error(("malformed multisym: " .. rawstr), col_adjust("[%.:][%.:]"))
3977
+ parse_error(("malformed multisym: " .. rawstr), col_adjust("[%.:][%.:]"))
3940
3978
  elseif ((rawstr ~= ":") and rawstr:match(":$")) then
3941
- return parse_error(("malformed multisym: " .. rawstr), col_adjust(":$"))
3979
+ parse_error(("malformed multisym: " .. rawstr), col_adjust(":$"))
3942
3980
  elseif rawstr:match(":.+[%.:]") then
3943
- return parse_error(("method must be last component of multisym: " .. rawstr), col_adjust(":.+[%.:]"))
3944
- else
3945
- return rawstr
3981
+ parse_error(("method must be last component of multisym: " .. rawstr), col_adjust(":.+[%.:]"))
3946
3982
  end
3983
+ return rawstr
3947
3984
  end
3948
3985
  local function parse_sym(b)
3949
3986
  local source0 = {bytestart = byteindex, col = (col - 1), filename = filename, line = line}
@@ -3983,16 +4020,16 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3983
4020
  elseif done_3f then
3984
4021
  return true, retval
3985
4022
  else
3986
- return parse_loop(skip_whitespace(getb()))
4023
+ return parse_loop(skip_whitespace(getb(), close_table))
3987
4024
  end
3988
4025
  end
3989
- return parse_loop(skip_whitespace(getb()))
4026
+ return parse_loop(skip_whitespace(getb(), close_table))
3990
4027
  end
3991
- local function _259_()
3992
- stack, line, byteindex, col, lastb = {}, 1, 0, 0, nil
4028
+ local function _262_()
4029
+ stack, line, byteindex, col, lastb = {}, 1, 0, 0, ((lastb ~= 10) and lastb)
3993
4030
  return nil
3994
4031
  end
3995
- return parse_stream, _259_
4032
+ return parse_stream, _262_
3996
4033
  end
3997
4034
  local function parser(stream_or_string, _3ffilename, _3foptions)
3998
4035
  local filename = (_3ffilename or "unknown")
@@ -4618,14 +4655,14 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
4618
4655
  end
4619
4656
  end
4620
4657
  pp = _93_
4621
- local function view(x, _3foptions)
4658
+ local function _view(x, _3foptions)
4622
4659
  return pp(x, make_options(x, _3foptions), 0)
4623
4660
  end
4624
- return view
4661
+ return _view
4625
4662
  end
4626
4663
  package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(...)
4627
4664
  local view = require("fennel.view")
4628
- local version = "1.4.0"
4665
+ local version = "1.4.2"
4629
4666
  local function luajit_vm_3f()
4630
4667
  return ((nil ~= _G.jit) and (type(_G.jit) == "table") and (nil ~= _G.jit.on) and (nil ~= _G.jit.off) and (type(_G.jit.version_num) == "number"))
4631
4668
  end
@@ -4660,39 +4697,34 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4660
4697
  return ("Fennel " .. version .. " on " .. lua_vm_version())
4661
4698
  end
4662
4699
  end
4663
- local function warn(message)
4664
- if (_G.io and _G.io.stderr) then
4665
- return (_G.io.stderr):write(("--WARNING: %s\n"):format(tostring(message)))
4666
- end
4667
- end
4668
4700
  local len = nil
4669
4701
  do
4670
- local _104_0, _105_0 = pcall(require, "utf8")
4671
- if ((_104_0 == true) and (nil ~= _105_0)) then
4672
- local utf8 = _105_0
4702
+ local _103_0, _104_0 = pcall(require, "utf8")
4703
+ if ((_103_0 == true) and (nil ~= _104_0)) then
4704
+ local utf8 = _104_0
4673
4705
  len = utf8.len
4674
4706
  else
4675
- local _ = _104_0
4707
+ local _ = _103_0
4676
4708
  len = string.len
4677
4709
  end
4678
4710
  end
4679
4711
  local kv_order = {boolean = 2, number = 1, string = 3, table = 4}
4680
4712
  local function kv_compare(a, b)
4681
- local _107_0, _108_0 = type(a), type(b)
4682
- if (((_107_0 == "number") and (_108_0 == "number")) or ((_107_0 == "string") and (_108_0 == "string"))) then
4713
+ local _106_0, _107_0 = type(a), type(b)
4714
+ if (((_106_0 == "number") and (_107_0 == "number")) or ((_106_0 == "string") and (_107_0 == "string"))) then
4683
4715
  return (a < b)
4684
4716
  else
4685
- local function _109_()
4686
- local a_t = _107_0
4687
- local b_t = _108_0
4717
+ local function _108_()
4718
+ local a_t = _106_0
4719
+ local b_t = _107_0
4688
4720
  return (a_t ~= b_t)
4689
4721
  end
4690
- if (((nil ~= _107_0) and (nil ~= _108_0)) and _109_()) then
4691
- local a_t = _107_0
4692
- local b_t = _108_0
4722
+ if (((nil ~= _106_0) and (nil ~= _107_0)) and _108_()) then
4723
+ local a_t = _106_0
4724
+ local b_t = _107_0
4693
4725
  return ((kv_order[a_t] or 5) < (kv_order[b_t] or 5))
4694
4726
  else
4695
- local _ = _107_0
4727
+ local _ = _106_0
4696
4728
  return (tostring(a) < tostring(b))
4697
4729
  end
4698
4730
  end
@@ -4724,20 +4756,20 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4724
4756
  local function stablepairs(t)
4725
4757
  local mt_keys = nil
4726
4758
  do
4727
- local _113_0 = getmetatable(t)
4728
- if (nil ~= _113_0) then
4729
- _113_0 = _113_0.keys
4759
+ local _112_0 = getmetatable(t)
4760
+ if (nil ~= _112_0) then
4761
+ _112_0 = _112_0.keys
4730
4762
  end
4731
- mt_keys = _113_0
4763
+ mt_keys = _112_0
4732
4764
  end
4733
4765
  local succ, prev, first_mt = nil, nil, nil
4734
- local function _115_(_241)
4766
+ local function _114_(_241)
4735
4767
  return t[_241]
4736
4768
  end
4737
- succ, prev, first_mt = add_stable_keys({}, nil, (mt_keys or {}), _115_)
4769
+ succ, prev, first_mt = add_stable_keys({}, nil, (mt_keys or {}), _114_)
4738
4770
  local pairs_keys = nil
4739
4771
  do
4740
- local _116_0 = nil
4772
+ local _115_0 = nil
4741
4773
  do
4742
4774
  local tbl_17_ = {}
4743
4775
  local i_18_ = #tbl_17_
@@ -4748,10 +4780,10 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4748
4780
  tbl_17_[i_18_] = val_19_
4749
4781
  end
4750
4782
  end
4751
- _116_0 = tbl_17_
4783
+ _115_0 = tbl_17_
4752
4784
  end
4753
- table.sort(_116_0, kv_compare)
4754
- pairs_keys = _116_0
4785
+ table.sort(_115_0, kv_compare)
4786
+ pairs_keys = _115_0
4755
4787
  end
4756
4788
  local succ0, _, first_after_mt = add_stable_keys(succ, prev, pairs_keys)
4757
4789
  local first = nil
@@ -4761,19 +4793,19 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4761
4793
  first = first_mt
4762
4794
  end
4763
4795
  local function stablenext(tbl, key)
4764
- local _119_0 = nil
4796
+ local _118_0 = nil
4765
4797
  if (key == nil) then
4766
- _119_0 = first
4798
+ _118_0 = first
4767
4799
  else
4768
- _119_0 = succ0[key]
4800
+ _118_0 = succ0[key]
4769
4801
  end
4770
- if (nil ~= _119_0) then
4771
- local next_key = _119_0
4772
- local _121_0 = tbl[next_key]
4773
- if (_121_0 ~= nil) then
4774
- return next_key, _121_0
4802
+ if (nil ~= _118_0) then
4803
+ local next_key = _118_0
4804
+ local _120_0 = tbl[next_key]
4805
+ if (_120_0 ~= nil) then
4806
+ return next_key, _120_0
4775
4807
  else
4776
- return _121_0
4808
+ return _120_0
4777
4809
  end
4778
4810
  end
4779
4811
  end
@@ -4784,25 +4816,25 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4784
4816
  if (0 == #path) then
4785
4817
  return _3ffallback
4786
4818
  else
4787
- local _124_0 = nil
4819
+ local _123_0 = nil
4788
4820
  do
4789
4821
  local t = tbl
4790
4822
  for _, k in ipairs(path) do
4791
4823
  if (nil == t) then break end
4792
- local _125_0 = type(t)
4793
- if (_125_0 == "table") then
4824
+ local _124_0 = type(t)
4825
+ if (_124_0 == "table") then
4794
4826
  t = t[k]
4795
4827
  else
4796
4828
  t = nil
4797
4829
  end
4798
4830
  end
4799
- _124_0 = t
4831
+ _123_0 = t
4800
4832
  end
4801
- if (nil ~= _124_0) then
4802
- local res = _124_0
4833
+ if (nil ~= _123_0) then
4834
+ local res = _123_0
4803
4835
  return res
4804
4836
  else
4805
- local _ = _124_0
4837
+ local _ = _123_0
4806
4838
  return _3ffallback
4807
4839
  end
4808
4840
  end
@@ -4813,15 +4845,15 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4813
4845
  if (type(f) == "function") then
4814
4846
  f0 = f
4815
4847
  else
4816
- local function _129_(_241)
4848
+ local function _128_(_241)
4817
4849
  return _241[f]
4818
4850
  end
4819
- f0 = _129_
4851
+ f0 = _128_
4820
4852
  end
4821
4853
  for _, x in ipairs(t) do
4822
- local _131_0 = f0(x)
4823
- if (nil ~= _131_0) then
4824
- local v = _131_0
4854
+ local _130_0 = f0(x)
4855
+ if (nil ~= _130_0) then
4856
+ local v = _130_0
4825
4857
  table.insert(out, v)
4826
4858
  end
4827
4859
  end
@@ -4833,19 +4865,19 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4833
4865
  if (type(f) == "function") then
4834
4866
  f0 = f
4835
4867
  else
4836
- local function _133_(_241)
4868
+ local function _132_(_241)
4837
4869
  return _241[f]
4838
4870
  end
4839
- f0 = _133_
4871
+ f0 = _132_
4840
4872
  end
4841
4873
  for k, x in stablepairs(t) do
4842
- local _135_0, _136_0 = f0(k, x)
4843
- if ((nil ~= _135_0) and (nil ~= _136_0)) then
4844
- local key = _135_0
4845
- local value = _136_0
4846
- out[key] = value
4847
- elseif (nil ~= _135_0) then
4874
+ local _134_0, _135_0 = f0(k, x)
4875
+ if ((nil ~= _134_0) and (nil ~= _135_0)) then
4876
+ local key = _134_0
4848
4877
  local value = _135_0
4878
+ out[key] = value
4879
+ elseif (nil ~= _134_0) then
4880
+ local value = _134_0
4849
4881
  table.insert(out, value)
4850
4882
  end
4851
4883
  end
@@ -4862,13 +4894,13 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4862
4894
  return tbl_14_
4863
4895
  end
4864
4896
  local function member_3f(x, tbl, _3fn)
4865
- local _139_0 = tbl[(_3fn or 1)]
4866
- if (_139_0 == x) then
4897
+ local _138_0 = tbl[(_3fn or 1)]
4898
+ if (_138_0 == x) then
4867
4899
  return true
4868
- elseif (_139_0 == nil) then
4900
+ elseif (_138_0 == nil) then
4869
4901
  return nil
4870
4902
  else
4871
- local _ = _139_0
4903
+ local _ = _138_0
4872
4904
  return member_3f(x, tbl, ((_3fn or 1) + 1))
4873
4905
  end
4874
4906
  end
@@ -4903,9 +4935,9 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4903
4935
  seen[next_state] = true
4904
4936
  return next_state, value
4905
4937
  else
4906
- local _142_0 = getmetatable(t)
4907
- if ((_G.type(_142_0) == "table") and true) then
4908
- local __index = _142_0.__index
4938
+ local _141_0 = getmetatable(t)
4939
+ if ((_G.type(_141_0) == "table") and true) then
4940
+ local __index = _141_0.__index
4909
4941
  if ("table" == type(__index)) then
4910
4942
  t = __index
4911
4943
  return allpairs_next(t)
@@ -4923,10 +4955,10 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4923
4955
  local safe = {}
4924
4956
  local view0 = nil
4925
4957
  if _3fview then
4926
- local function _146_(_241)
4958
+ local function _145_(_241)
4927
4959
  return _3fview(_241, _3foptions, _3findent)
4928
4960
  end
4929
- view0 = _146_
4961
+ view0 = _145_
4930
4962
  else
4931
4963
  view0 = view
4932
4964
  end
@@ -4947,19 +4979,19 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4947
4979
  end
4948
4980
  local symbol_mt = {"SYMBOL", __eq = sym_3d, __fennelview = deref, __lt = sym_3c, __tostring = deref}
4949
4981
  local expr_mt = nil
4950
- local function _148_(x)
4982
+ local function _147_(x)
4951
4983
  return tostring(deref(x))
4952
4984
  end
4953
- expr_mt = {"EXPR", __tostring = _148_}
4985
+ expr_mt = {"EXPR", __tostring = _147_}
4954
4986
  local list_mt = {"LIST", __fennelview = list__3estring, __tostring = list__3estring}
4955
4987
  local comment_mt = {"COMMENT", __eq = sym_3d, __fennelview = comment_view, __lt = sym_3c, __tostring = deref}
4956
4988
  local sequence_marker = {"SEQUENCE"}
4957
4989
  local varg_mt = {"VARARG", __fennelview = deref, __tostring = deref}
4958
4990
  local getenv = nil
4959
- local function _149_()
4991
+ local function _148_()
4960
4992
  return nil
4961
4993
  end
4962
- getenv = ((os and os.getenv) or _149_)
4994
+ getenv = ((os and os.getenv) or _148_)
4963
4995
  local function debug_on_3f(flag)
4964
4996
  local level = (getenv("FENNEL_DEBUG") or "")
4965
4997
  return ((level == "all") or level:find(flag))
@@ -4968,7 +5000,7 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4968
5000
  return setmetatable({...}, list_mt)
4969
5001
  end
4970
5002
  local function sym(str, _3fsource)
4971
- local _150_
5003
+ local _149_
4972
5004
  do
4973
5005
  local tbl_14_ = {str}
4974
5006
  for k, v in pairs((_3fsource or {})) do
@@ -4982,13 +5014,13 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4982
5014
  tbl_14_[k_15_] = v_16_
4983
5015
  end
4984
5016
  end
4985
- _150_ = tbl_14_
5017
+ _149_ = tbl_14_
4986
5018
  end
4987
- return setmetatable(_150_, symbol_mt)
5019
+ return setmetatable(_149_, symbol_mt)
4988
5020
  end
4989
5021
  nil_sym = sym("nil")
4990
5022
  local function sequence(...)
4991
- local function _153_(seq, view0, inspector, indent)
5023
+ local function _152_(seq, view0, inspector, indent)
4992
5024
  local opts = nil
4993
5025
  do
4994
5026
  inspector["empty-as-sequence?"] = {after = inspector["empty-as-sequence?"], once = true}
@@ -4997,19 +5029,19 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
4997
5029
  end
4998
5030
  return view0(seq, opts, indent)
4999
5031
  end
5000
- return setmetatable({...}, {__fennelview = _153_, sequence = sequence_marker})
5032
+ return setmetatable({...}, {__fennelview = _152_, sequence = sequence_marker})
5001
5033
  end
5002
5034
  local function expr(strcode, etype)
5003
5035
  return setmetatable({strcode, type = etype}, expr_mt)
5004
5036
  end
5005
5037
  local function comment_2a(contents, _3fsource)
5006
- local _154_ = (_3fsource or {})
5007
- local filename = _154_["filename"]
5008
- local line = _154_["line"]
5038
+ local _153_ = (_3fsource or {})
5039
+ local filename = _153_["filename"]
5040
+ local line = _153_["line"]
5009
5041
  return setmetatable({contents, filename = filename, line = line}, comment_mt)
5010
5042
  end
5011
5043
  local function varg(_3fsource)
5012
- local _155_
5044
+ local _154_
5013
5045
  do
5014
5046
  local tbl_14_ = {"..."}
5015
5047
  for k, v in pairs((_3fsource or {})) do
@@ -5023,9 +5055,9 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
5023
5055
  tbl_14_[k_15_] = v_16_
5024
5056
  end
5025
5057
  end
5026
- _155_ = tbl_14_
5058
+ _154_ = tbl_14_
5027
5059
  end
5028
- return setmetatable(_155_, varg_mt)
5060
+ return setmetatable(_154_, varg_mt)
5029
5061
  end
5030
5062
  local function expr_3f(x)
5031
5063
  return ((type(x) == "table") and (getmetatable(x) == expr_mt) and x)
@@ -5063,7 +5095,11 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
5063
5095
  end
5064
5096
  end
5065
5097
  local function string_3f(x)
5066
- return (type(x) == "string")
5098
+ if (type(x) == "string") then
5099
+ return x
5100
+ else
5101
+ return false
5102
+ end
5067
5103
  end
5068
5104
  local function multi_sym_3f(str)
5069
5105
  if sym_3f(str) then
@@ -5074,19 +5110,19 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
5074
5110
  local function _160_()
5075
5111
  local parts = {}
5076
5112
  for part in str:gmatch("[^%.%:]+[%.%:]?") do
5077
- local last_char = part:sub(( - 1))
5113
+ local last_char = part:sub(-1)
5078
5114
  if (last_char == ":") then
5079
5115
  parts["multi-sym-method-call"] = true
5080
5116
  end
5081
5117
  if ((last_char == ":") or (last_char == ".")) then
5082
- parts[(#parts + 1)] = part:sub(1, ( - 2))
5118
+ parts[(#parts + 1)] = part:sub(1, -2)
5083
5119
  else
5084
5120
  parts[(#parts + 1)] = part
5085
5121
  end
5086
5122
  end
5087
- return ((0 < #parts) and parts)
5123
+ return (next(parts) and parts)
5088
5124
  end
5089
- return ((str:match("%.") or str:match(":")) and not str:match("%.%.") and (str:byte() ~= string.byte(".")) and (str:byte(( - 1)) ~= string.byte(".")) and _160_())
5125
+ return ((str:match("%.") or str:match(":")) and not str:match("%.%.") and (str:byte() ~= string.byte(".")) and (str:byte() ~= string.byte(":")) and (str:byte(-1) ~= string.byte(".")) and (str:byte(-1) ~= string.byte(":")) and _160_())
5090
5126
  end
5091
5127
  end
5092
5128
  local function quoted_3f(symbol)
@@ -5096,15 +5132,6 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
5096
5132
  local t = type(x)
5097
5133
  return ((t == "string") or (t == "integer") or (t == "number") or (t == "boolean") or (sym_3f(x) and not multi_sym_3f(x)))
5098
5134
  end
5099
- local function ast_source(ast)
5100
- if (table_3f(ast) or sequence_3f(ast)) then
5101
- return (getmetatable(ast) or {})
5102
- elseif ("table" == type(ast)) then
5103
- return ast
5104
- else
5105
- return {}
5106
- end
5107
- end
5108
5135
  local function walk_tree(root, f, _3fcustom_iterator)
5109
5136
  local function walk(iterfn, parent, idx, node)
5110
5137
  if f(idx, node, parent) then
@@ -5129,27 +5156,53 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
5129
5156
  return subopts
5130
5157
  end
5131
5158
  local root = nil
5132
- local function _166_()
5133
- end
5134
- root = {chunk = nil, options = nil, reset = _166_, scope = nil}
5135
- root["set-reset"] = function(_167_0)
5136
- local _168_ = _167_0
5137
- local chunk = _168_["chunk"]
5138
- local options = _168_["options"]
5139
- local reset = _168_["reset"]
5140
- local scope = _168_["scope"]
5159
+ local function _165_()
5160
+ end
5161
+ root = {chunk = nil, options = nil, reset = _165_, scope = nil}
5162
+ root["set-reset"] = function(_166_0)
5163
+ local _167_ = _166_0
5164
+ local chunk = _167_["chunk"]
5165
+ local options = _167_["options"]
5166
+ local reset = _167_["reset"]
5167
+ local scope = _167_["scope"]
5141
5168
  root.reset = function()
5142
5169
  root.chunk, root.scope, root.options, root.reset = chunk, scope, options, reset
5143
5170
  return nil
5144
5171
  end
5145
5172
  return root.reset
5146
5173
  end
5174
+ local function ast_source(ast)
5175
+ if (table_3f(ast) or sequence_3f(ast)) then
5176
+ return (getmetatable(ast) or {})
5177
+ elseif ("table" == type(ast)) then
5178
+ return ast
5179
+ else
5180
+ return {}
5181
+ end
5182
+ end
5183
+ local function warn(msg, _3fast)
5184
+ if (_G.io and _G.io.stderr) then
5185
+ local loc = nil
5186
+ do
5187
+ local _169_0 = ast_source(_3fast)
5188
+ if ((_G.type(_169_0) == "table") and (nil ~= _169_0.filename) and (nil ~= _169_0.line)) then
5189
+ local filename = _169_0.filename
5190
+ local line = _169_0.line
5191
+ loc = (filename .. ":" .. line .. ": ")
5192
+ else
5193
+ local _ = _169_0
5194
+ loc = ""
5195
+ end
5196
+ end
5197
+ return (_G.io.stderr):write(("--WARNING: %s%s\n"):format(loc, tostring(msg)))
5198
+ end
5199
+ end
5147
5200
  local warned = {}
5148
- local function check_plugin_version(_169_0)
5149
- local _170_ = _169_0
5150
- local plugin = _170_
5151
- local name = _170_["name"]
5152
- local versions = _170_["versions"]
5201
+ local function check_plugin_version(_172_0)
5202
+ local _173_ = _172_0
5203
+ local plugin = _173_
5204
+ local name = _173_["name"]
5205
+ local versions = _173_["versions"]
5153
5206
  if (not member_3f(version:gsub("-dev", ""), (versions or {})) and not warned[plugin]) then
5154
5207
  warned[plugin] = true
5155
5208
  return warn(string.format("plugin %s does not support Fennel version %s", (name or "unknown"), version))
@@ -5157,29 +5210,29 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
5157
5210
  end
5158
5211
  local function hook_opts(event, _3foptions, ...)
5159
5212
  local plugins = nil
5160
- local function _173_(...)
5161
- local _172_0 = _3foptions
5162
- if (nil ~= _172_0) then
5163
- _172_0 = _172_0.plugins
5164
- end
5165
- return _172_0
5166
- end
5167
5213
  local function _176_(...)
5168
- local _175_0 = root.options
5214
+ local _175_0 = _3foptions
5169
5215
  if (nil ~= _175_0) then
5170
5216
  _175_0 = _175_0.plugins
5171
5217
  end
5172
5218
  return _175_0
5173
5219
  end
5174
- plugins = (_173_(...) or _176_(...))
5220
+ local function _179_(...)
5221
+ local _178_0 = root.options
5222
+ if (nil ~= _178_0) then
5223
+ _178_0 = _178_0.plugins
5224
+ end
5225
+ return _178_0
5226
+ end
5227
+ plugins = (_176_(...) or _179_(...))
5175
5228
  if plugins then
5176
5229
  local result = nil
5177
5230
  for _, plugin in ipairs(plugins) do
5178
5231
  if result then break end
5179
5232
  check_plugin_version(plugin)
5180
- local _178_0 = plugin[event]
5181
- if (nil ~= _178_0) then
5182
- local f = _178_0
5233
+ local _181_0 = plugin[event]
5234
+ if (nil ~= _181_0) then
5235
+ local f = _181_0
5183
5236
  result = f(...)
5184
5237
  else
5185
5238
  result = nil
@@ -5191,7 +5244,7 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
5191
5244
  local function hook(event, ...)
5192
5245
  return hook_opts(event, root.options, ...)
5193
5246
  end
5194
- return {["ast-source"] = ast_source, ["comment?"] = comment_3f, ["debug-on?"] = debug_on_3f, ["every?"] = every_3f, ["expr?"] = expr_3f, ["get-in"] = get_in, ["hook-opts"] = hook_opts, ["idempotent-expr?"] = idempotent_expr_3f, ["kv-table?"] = kv_table_3f, ["list?"] = list_3f, ["lua-keywords"] = lua_keywords, ["macro-path"] = table.concat({"./?.fnl", "./?/init-macros.fnl", "./?/init.fnl", getenv("FENNEL_MACRO_PATH")}, ";"), ["member?"] = member_3f, ["multi-sym?"] = multi_sym_3f, ["propagate-options"] = propagate_options, ["quoted?"] = quoted_3f, ["runtime-version"] = runtime_version, ["sequence?"] = sequence_3f, ["string?"] = string_3f, ["sym?"] = sym_3f, ["table?"] = table_3f, ["valid-lua-identifier?"] = valid_lua_identifier_3f, ["varg?"] = varg_3f, ["walk-tree"] = walk_tree, allpairs = allpairs, comment = comment_2a, copy = copy, expr = expr, hook = hook, kvmap = kvmap, len = len, list = list, map = map, maxn = maxn, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), root = root, sequence = sequence, stablepairs = stablepairs, sym = sym, varg = varg, version = version, warn = warn}
5247
+ return {["ast-source"] = ast_source, ["comment?"] = comment_3f, ["debug-on?"] = debug_on_3f, ["every?"] = every_3f, ["expr?"] = expr_3f, ["fennel-module"] = nil, ["get-in"] = get_in, ["hook-opts"] = hook_opts, ["idempotent-expr?"] = idempotent_expr_3f, ["kv-table?"] = kv_table_3f, ["list?"] = list_3f, ["lua-keywords"] = lua_keywords, ["macro-path"] = table.concat({"./?.fnl", "./?/init-macros.fnl", "./?/init.fnl", getenv("FENNEL_MACRO_PATH")}, ";"), ["member?"] = member_3f, ["multi-sym?"] = multi_sym_3f, ["propagate-options"] = propagate_options, ["quoted?"] = quoted_3f, ["runtime-version"] = runtime_version, ["sequence?"] = sequence_3f, ["string?"] = string_3f, ["sym?"] = sym_3f, ["table?"] = table_3f, ["valid-lua-identifier?"] = valid_lua_identifier_3f, ["varg?"] = varg_3f, ["walk-tree"] = walk_tree, allpairs = allpairs, comment = comment_2a, copy = copy, expr = expr, hook = hook, kvmap = kvmap, len = len, list = list, map = map, maxn = maxn, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), root = root, sequence = sequence, stablepairs = stablepairs, sym = sym, varg = varg, version = version, warn = warn}
5195
5248
  end
5196
5249
  utils = require("fennel.utils")
5197
5250
  local parser = require("fennel.parser")
@@ -5228,14 +5281,14 @@ local function eval(str, _3foptions, ...)
5228
5281
  local env = eval_env(opts.env, opts)
5229
5282
  local lua_source = compiler["compile-string"](str, opts)
5230
5283
  local loader = nil
5231
- local function _745_(...)
5284
+ local function _750_(...)
5232
5285
  if opts.filename then
5233
5286
  return ("@" .. opts.filename)
5234
5287
  else
5235
5288
  return str
5236
5289
  end
5237
5290
  end
5238
- loader = specials["load-code"](lua_source, env, _745_(...))
5291
+ loader = specials["load-code"](lua_source, env, _750_(...))
5239
5292
  opts.filename = nil
5240
5293
  return loader(...)
5241
5294
  end
@@ -5251,25 +5304,28 @@ local function syntax()
5251
5304
  local body_3f = {"when", "with-open", "collect", "icollect", "fcollect", "lambda", "\206\187", "macro", "match", "match-try", "case", "case-try", "accumulate", "faccumulate", "doto"}
5252
5305
  local binding_3f = {"collect", "icollect", "fcollect", "each", "for", "let", "with-open", "accumulate", "faccumulate"}
5253
5306
  local define_3f = {"fn", "lambda", "\206\187", "var", "local", "macro", "macros", "global"}
5307
+ local deprecated = {"~=", "#", "global", "require-macros", "pick-args"}
5254
5308
  local out = {}
5255
5309
  for k, v in pairs(compiler.scopes.global.specials) do
5256
5310
  local metadata = (compiler.metadata[v] or {})
5257
- out[k] = {["binding-form?"] = utils["member?"](k, binding_3f), ["body-form?"] = metadata["fnl/body-form?"], ["define?"] = utils["member?"](k, define_3f), ["special?"] = true}
5311
+ out[k] = {["binding-form?"] = utils["member?"](k, binding_3f), ["body-form?"] = metadata["fnl/body-form?"], ["define?"] = utils["member?"](k, define_3f), ["deprecated?"] = utils["member?"](k, deprecated), ["special?"] = true}
5258
5312
  end
5259
- for k, v in pairs(compiler.scopes.global.macros) do
5313
+ for k in pairs(compiler.scopes.global.macros) do
5260
5314
  out[k] = {["binding-form?"] = utils["member?"](k, binding_3f), ["body-form?"] = utils["member?"](k, body_3f), ["define?"] = utils["member?"](k, define_3f), ["macro?"] = true}
5261
5315
  end
5262
5316
  for k, v in pairs(_G) do
5263
- local _746_0 = type(v)
5264
- if (_746_0 == "function") then
5317
+ local _751_0 = type(v)
5318
+ if (_751_0 == "function") then
5265
5319
  out[k] = {["function?"] = true, ["global?"] = true}
5266
- elseif (_746_0 == "table") then
5267
- for k2, v2 in pairs(v) do
5268
- if (("function" == type(v2)) and (k ~= "_G")) then
5269
- out[(k .. "." .. k2)] = {["function?"] = true, ["global?"] = true}
5320
+ elseif (_751_0 == "table") then
5321
+ if not k:find("^_") then
5322
+ for k2, v2 in pairs(v) do
5323
+ if ("function" == type(v2)) then
5324
+ out[(k .. "." .. k2)] = {["function?"] = true, ["global?"] = true}
5325
+ end
5270
5326
  end
5327
+ out[k] = {["global?"] = true}
5271
5328
  end
5272
- out[k] = {["global?"] = true}
5273
5329
  end
5274
5330
  end
5275
5331
  return out
@@ -5283,17 +5339,18 @@ utils["fennel-module"] = mod
5283
5339
  do
5284
5340
  local module_name = "fennel.macros"
5285
5341
  local _ = nil
5286
- local function _749_()
5342
+ local function _755_()
5287
5343
  return mod
5288
5344
  end
5289
- package.preload[module_name] = _749_
5345
+ package.preload[module_name] = _755_
5290
5346
  _ = nil
5291
5347
  local env = nil
5292
5348
  do
5293
- local _750_0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
5294
- _750_0["utils"] = utils
5295
- _750_0["fennel"] = mod
5296
- env = _750_0
5349
+ local _756_0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
5350
+ _756_0["utils"] = utils
5351
+ _756_0["fennel"] = mod
5352
+ _756_0["get-function-metadata"] = specials["get-function-metadata"]
5353
+ env = _756_0
5297
5354
  end
5298
5355
  local built_ins = eval([===[;; fennel-ls: macro-file
5299
5356
 
@@ -5398,7 +5455,8 @@ do
5398
5455
  ,...)
5399
5456
  closer `(fn close-handlers# [ok# ...]
5400
5457
  (if ok# ... (error ... 0)))
5401
- traceback `(. (or package.loaded.fennel debug) :traceback)]
5458
+ traceback `(. (or (. package.loaded ,(fennel-module-name)) debug)
5459
+ :traceback)]
5402
5460
  (for [i 1 (length closable-bindings) 2]
5403
5461
  (assert (sym? (. closable-bindings i))
5404
5462
  "with-open only allows symbols in bindings")
@@ -5461,7 +5519,8 @@ do
5461
5519
  (let [(into iter has-into?) (extract-into iter-tbl)]
5462
5520
  (if has-into?
5463
5521
  `(let [tbl# ,into]
5464
- (,how ,iter (table.insert tbl# ,value-expr))
5522
+ (,how ,iter (let [val# ,value-expr]
5523
+ (table.insert tbl# val#)))
5465
5524
  tbl#)
5466
5525
  ;; believe it or not, using a var here has a pretty good performance
5467
5526
  ;; boost: https://p.hagelb.org/icollect-performance.html
@@ -5622,19 +5681,16 @@ do
5622
5681
  has-internal-name? (sym? (. args 1))
5623
5682
  arglist (if has-internal-name? (. args 2) (. args 1))
5624
5683
  metadata-position (if has-internal-name? 3 2)
5625
- has-metadata? (and (< metadata-position args-len)
5626
- (or (= :string (type (. args metadata-position)))
5627
- (utils.kv-table? (. args metadata-position))))
5628
- arity-check-position (- 4 (if has-internal-name? 0 1)
5629
- (if has-metadata? 0 1))
5630
- empty-body? (< args-len arity-check-position)]
5684
+ (f-metadata check-position) (get-function-metadata [:lambda ...] arglist
5685
+ metadata-position)
5686
+ empty-body? (< args-len check-position)]
5631
5687
  (fn check! [a]
5632
5688
  (if (table? a)
5633
5689
  (each [_ a (pairs a)] (check! a))
5634
5690
  (let [as (tostring a)]
5635
5691
  (and (not (as:match "^?")) (not= as "&") (not= as "_")
5636
5692
  (not= as "...") (not= as "&as")))
5637
- (table.insert args arity-check-position
5693
+ (table.insert args check-position
5638
5694
  `(_G.assert (not= nil ,a)
5639
5695
  ,(: "Missing argument %s on %s:%s" :format
5640
5696
  (tostring a)
@@ -5643,8 +5699,7 @@ do
5643
5699
 
5644
5700
  (assert (= :table (type arglist)) "expected arg list")
5645
5701
  (each [_ a (ipairs arglist)] (check! a))
5646
- (if empty-body?
5647
- (table.insert args (sym :nil)))
5702
+ (if empty-body? (table.insert args (sym :nil)))
5648
5703
  `(fn ,(unpack args))))
5649
5704
 
5650
5705
  (fn macro* [name ...]
@@ -5692,29 +5747,31 @@ do
5692
5747
  (tset scope.macros import-key (. macros* macro-name))))))
5693
5748
  nil)
5694
5749
 
5695
- (fn assert-repl* [condition message ?opts]
5696
- "Drop into a debug repl and print the message when condition is false/nil.
5697
- Takes an optional table of arguments which will be passed to fennel.repl."
5750
+ (fn assert-repl* [condition ...]
5751
+ "Enter into a debug REPL and print the message when condition is false/nil.
5752
+ Works as a drop-in replacement for Lua's `assert`.
5753
+ REPL `,return` command returns values to assert in place to continue execution."
5754
+ {:fnl/arglist [condition ?message ...]}
5698
5755
  (fn add-locals [{: symmeta : parent} locals]
5699
5756
  (each [name (pairs symmeta)]
5700
5757
  (tset locals name (sym name)))
5701
5758
  (if parent (add-locals parent locals) locals))
5702
- `(let [condition# ,condition
5703
- message# (or ,message "assertion failed, entering repl.")]
5759
+ `(let [unpack# (or table.unpack _G.unpack)
5760
+ pack# (or table.pack #(doto [$...] (tset :n (select :# $...))))
5761
+ ;; need to pack/unpack input args to account for (assert (foo)),
5762
+ ;; because assert returns *all* arguments upon success
5763
+ vals# (pack# ,condition ,...)
5764
+ condition# (. vals# 1)
5765
+ message# (or (. vals# 2) "assertion failed, entering repl.")]
5704
5766
  (if (not condition#)
5705
- (let [opts# (or ,?opts {:assert-repl? true
5706
- :readChunk (?. _G :___repl___ :readChunk)
5707
- :onError (?. _G :___repl___ :onError)
5708
- :onValued (?. _G :___repl___ :onValued)})
5709
- fennel# (require (or opts#.moduleName :fennel))
5767
+ (let [opts# {:assert-repl? true}
5768
+ fennel# (require ,(fennel-module-name))
5710
5769
  locals# ,(add-locals (get-scope) [])]
5711
5770
  (set opts#.message (fennel#.traceback message#))
5712
5771
  (set opts#.env (collect [k# v# (pairs _G) &into locals#]
5713
5772
  (if (= nil (. locals# k#)) (values k# v#))))
5714
- (_G.assert (fennel#.repl opts#) message#))
5715
- ;; `assert` returns *all* params on success, but omitting opts# to
5716
- ;; defensively prevent accidental leakage of REPL opts into code
5717
- (values condition# message#))))
5773
+ (_G.assert (fennel#.repl opts#)))
5774
+ (values (unpack# vals# 1 vals#.n)))))
5718
5775
 
5719
5776
  {:-> ->*
5720
5777
  :->> ->>*
@@ -5861,13 +5918,12 @@ do
5861
5918
 
5862
5919
  (fn case-or [vals pattern guards unifications case-pattern opts]
5863
5920
  (let [pattern [(unpack pattern 2)]
5864
- bindings (symbols-in-every-pattern pattern opts.infer-unification?)] ;; TODO opts.infer-unification instead of opts.unification?
5921
+ bindings (symbols-in-every-pattern pattern opts.infer-unification?)]
5865
5922
  (if (= 0 (length bindings))
5866
5923
  ;; no bindings special case generates simple code
5867
5924
  (let [condition
5868
5925
  (icollect [_ subpattern (ipairs pattern) &into `(or)]
5869
- (let [(subcondition subbindings) (case-pattern vals subpattern unifications opts)]
5870
- subcondition))]
5926
+ (case-pattern vals subpattern unifications opts))]
5871
5927
  (values
5872
5928
  (if (= 0 (length guards))
5873
5929
  condition