nano-bots 1.0.0 → 1.1.0

Sign up to get free protection for your applications and to get access to all the features.
@@ -1,3 +1,5 @@
1
+ -- SPDX-License-Identifier: MIT
2
+ -- SPDX-FileCopyrightText: Calvin Rose and contributors
1
3
  package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
2
4
  local utils = require("fennel.utils")
3
5
  local parser = require("fennel.parser")
@@ -5,15 +7,16 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
5
7
  local specials = require("fennel.specials")
6
8
  local view = require("fennel.view")
7
9
  local unpack = (table.unpack or _G.unpack)
8
- local function default_read_chunk(parser_state)
9
- local function _604_()
10
- if (0 < parser_state["stack-size"]) then
11
- return ".."
12
- else
13
- return ">> "
14
- end
10
+ local depth = 0
11
+ local function prompt_for(top_3f)
12
+ if top_3f then
13
+ return (string.rep(">", (depth + 1)) .. " ")
14
+ else
15
+ return (string.rep(".", (depth + 1)) .. " ")
15
16
  end
16
- io.write(_604_())
17
+ end
18
+ local function default_read_chunk(parser_state)
19
+ io.write(prompt_for((0 == parser_state["stack-size"])))
17
20
  io.flush()
18
21
  local input = io.read()
19
22
  return (input and (input .. "\n"))
@@ -23,18 +26,18 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
23
26
  return io.write("\n")
24
27
  end
25
28
  local function default_on_error(errtype, err, lua_source)
26
- local function _606_()
27
- local _605_0 = errtype
28
- if (_605_0 == "Lua Compile") then
29
+ local function _612_()
30
+ local _611_0 = errtype
31
+ if (_611_0 == "Lua Compile") then
29
32
  return ("Bad code generated - likely a bug with the compiler:\n" .. "--- Generated Lua Start ---\n" .. lua_source .. "--- Generated Lua End ---\n")
30
- elseif (_605_0 == "Runtime") then
33
+ elseif (_611_0 == "Runtime") then
31
34
  return (compiler.traceback(tostring(err), 4) .. "\n")
32
35
  else
33
- local _ = _605_0
36
+ local _ = _611_0
34
37
  return ("%s error: %s\n"):format(errtype, tostring(err))
35
38
  end
36
39
  end
37
- return io.write(_606_())
40
+ return io.write(_612_())
38
41
  end
39
42
  local function splice_save_locals(env, lua_source, scope)
40
43
  local saves = nil
@@ -42,7 +45,7 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
42
45
  local tbl_17_ = {}
43
46
  local i_18_ = #tbl_17_
44
47
  for name in pairs(env.___replLocals___) do
45
- local val_19_ = ("local %s = ___replLocals___['%s']"):format((scope.manglings[name] or name), name)
48
+ local val_19_ = ("local %s = ___replLocals___[%q]"):format((scope.manglings[name] or name), name)
46
49
  if (nil ~= val_19_) then
47
50
  i_18_ = (i_18_ + 1)
48
51
  tbl_17_[i_18_] = val_19_
@@ -57,7 +60,7 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
57
60
  for raw, name in pairs(scope.manglings) do
58
61
  local val_19_ = nil
59
62
  if not scope.gensyms[name] then
60
- val_19_ = ("___replLocals___['%s'] = %s"):format(raw, name)
63
+ val_19_ = ("___replLocals___[%q] = %s"):format(raw, name)
61
64
  else
62
65
  val_19_ = nil
63
66
  end
@@ -74,25 +77,25 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
74
77
  else
75
78
  gap = " "
76
79
  end
77
- local function _612_()
80
+ local function _618_()
78
81
  if next(saves) then
79
82
  return (table.concat(saves, " ") .. gap)
80
83
  else
81
84
  return ""
82
85
  end
83
86
  end
84
- local function _615_()
85
- local _613_0, _614_0 = lua_source:match("^(.*)[\n ](return .*)$")
86
- if ((nil ~= _613_0) and (nil ~= _614_0)) then
87
- local body = _613_0
88
- local _return = _614_0
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
89
92
  return (body .. gap .. table.concat(binds, " ") .. gap .. _return)
90
93
  else
91
- local _ = _613_0
94
+ local _ = _619_0
92
95
  return lua_source
93
96
  end
94
97
  end
95
- return (_612_() .. _615_())
98
+ return (_618_() .. _621_())
96
99
  end
97
100
  local function completer(env, scope, text)
98
101
  local max_items = 2000
@@ -104,14 +107,14 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
104
107
  local scope_first_3f = ((tbl == env) or (tbl == env.___replLocals___))
105
108
  local tbl_17_ = matches
106
109
  local i_18_ = #tbl_17_
107
- local function _617_()
110
+ local function _623_()
108
111
  if scope_first_3f then
109
112
  return scope.manglings
110
113
  else
111
114
  return tbl
112
115
  end
113
116
  end
114
- for k, is_mangled in utils.allpairs(_617_()) do
117
+ for k, is_mangled in utils.allpairs(_623_()) do
115
118
  if (max_items <= #matches) then break end
116
119
  local val_19_ = nil
117
120
  do
@@ -179,7 +182,7 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
179
182
  return input:match("^%s*,")
180
183
  end
181
184
  local function command_docs()
182
- local _626_
185
+ local _632_
183
186
  do
184
187
  local tbl_17_ = {}
185
188
  local i_18_ = #tbl_17_
@@ -190,18 +193,18 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
190
193
  tbl_17_[i_18_] = val_19_
191
194
  end
192
195
  end
193
- _626_ = tbl_17_
196
+ _632_ = tbl_17_
194
197
  end
195
- return table.concat(_626_, "\n")
198
+ return table.concat(_632_, "\n")
196
199
  end
197
200
  commands.help = function(_, _0, on_values)
198
- return on_values({("Welcome to Fennel.\nThis is the REPL where you can enter code to be evaluated.\nYou can also run these repl commands:\n\n" .. command_docs() .. "\n ,exit - Leave the repl.\n\nUse ,doc something to see descriptions for individual macros and special forms.\n\nFor more information about the language, see https://fennel-lang.org/reference")})
201
+ 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")})
199
202
  end
200
203
  do end (compiler.metadata):set(commands.help, "fnl/docstring", "Show this message.")
201
204
  local function reload(module_name, env, on_values, on_error)
202
- local _628_0, _629_0 = pcall(specials["load-code"]("return require(...)", env), module_name)
203
- if ((_628_0 == true) and (nil ~= _629_0)) then
204
- local old = _629_0
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
205
208
  local _ = nil
206
209
  package.loaded[module_name] = nil
207
210
  _ = nil
@@ -226,8 +229,8 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
226
229
  package.loaded[module_name] = old
227
230
  end
228
231
  return on_values({"ok"})
229
- elseif ((_628_0 == false) and (nil ~= _629_0)) then
230
- local msg = _629_0
232
+ elseif ((_634_0 == false) and (nil ~= _635_0)) then
233
+ local msg = _635_0
231
234
  if msg:match("loop or previous error loading module") then
232
235
  package.loaded[module_name] = nil
233
236
  return reload(module_name, env, on_values, on_error)
@@ -235,32 +238,32 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
235
238
  specials["macro-loaded"][module_name] = nil
236
239
  return nil
237
240
  else
238
- local function _634_()
239
- local _633_0 = msg:gsub("\n.*", "")
240
- return _633_0
241
+ local function _640_()
242
+ local _639_0 = msg:gsub("\n.*", "")
243
+ return _639_0
241
244
  end
242
- return on_error("Runtime", _634_())
245
+ return on_error("Runtime", _640_())
243
246
  end
244
247
  end
245
248
  end
246
249
  local function run_command(read, on_error, f)
247
- local _637_0, _638_0, _639_0 = pcall(read)
248
- if ((_637_0 == true) and (_638_0 == true) and (nil ~= _639_0)) then
249
- local val = _639_0
250
- local _640_0, _641_0 = pcall(f, val)
251
- if ((_640_0 == false) and (nil ~= _641_0)) then
252
- local msg = _641_0
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
253
256
  return on_error("Runtime", msg)
254
257
  end
255
- elseif (_637_0 == false) then
258
+ elseif (_643_0 == false) then
256
259
  return on_error("Parse", "Couldn't parse input.")
257
260
  end
258
261
  end
259
262
  commands.reload = function(env, read, on_values, on_error)
260
- local function _644_(_241)
263
+ local function _650_(_241)
261
264
  return reload(tostring(_241), env, on_values, on_error)
262
265
  end
263
- return run_command(read, on_error, _644_)
266
+ return run_command(read, on_error, _650_)
264
267
  end
265
268
  do end (compiler.metadata):set(commands.reload, "fnl/docstring", "Reload the specified module.")
266
269
  commands.reset = function(env, _, on_values)
@@ -269,28 +272,28 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
269
272
  end
270
273
  do end (compiler.metadata):set(commands.reset, "fnl/docstring", "Erase all repl-local scope.")
271
274
  commands.complete = function(env, read, on_values, on_error, scope, chars)
272
- local function _645_()
275
+ local function _651_()
273
276
  return on_values(completer(env, scope, table.concat(chars):gsub(",complete +", ""):sub(1, -2)))
274
277
  end
275
- return run_command(read, on_error, _645_)
278
+ return run_command(read, on_error, _651_)
276
279
  end
277
280
  do end (compiler.metadata):set(commands.complete, "fnl/docstring", "Print all possible completions for a given input symbol.")
278
281
  local function apropos_2a(pattern, tbl, prefix, seen, names)
279
282
  for name, subtbl in pairs(tbl) do
280
283
  if (("string" == type(name)) and (package ~= subtbl)) then
281
- local _646_0 = type(subtbl)
282
- if (_646_0 == "function") then
284
+ local _652_0 = type(subtbl)
285
+ if (_652_0 == "function") then
283
286
  if ((prefix .. name)):match(pattern) then
284
287
  table.insert(names, (prefix .. name))
285
288
  end
286
- elseif (_646_0 == "table") then
289
+ elseif (_652_0 == "table") then
287
290
  if not seen[subtbl] then
288
- local _648_
291
+ local _654_
289
292
  do
290
293
  seen[subtbl] = true
291
- _648_ = seen
294
+ _654_ = seen
292
295
  end
293
- apropos_2a(pattern, subtbl, (prefix .. name:gsub("%.", "/") .. "."), _648_, names)
296
+ apropos_2a(pattern, subtbl, (prefix .. name:gsub("%.", "/") .. "."), _654_, names)
294
297
  end
295
298
  end
296
299
  end
@@ -311,10 +314,10 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
311
314
  return tbl_17_
312
315
  end
313
316
  commands.apropos = function(_env, read, on_values, on_error, _scope)
314
- local function _653_(_241)
317
+ local function _659_(_241)
315
318
  return on_values(apropos(tostring(_241)))
316
319
  end
317
- return run_command(read, on_error, _653_)
320
+ return run_command(read, on_error, _659_)
318
321
  end
319
322
  do end (compiler.metadata):set(commands.apropos, "fnl/docstring", "Print all functions matching a pattern in all loaded modules.")
320
323
  local function apropos_follow_path(path)
@@ -334,12 +337,12 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
334
337
  local tgt = package.loaded
335
338
  for _, path0 in ipairs(paths) do
336
339
  if (nil == tgt) then break end
337
- local _656_
340
+ local _662_
338
341
  do
339
- local _655_0 = path0:gsub("%/", ".")
340
- _656_ = _655_0
342
+ local _661_0 = path0:gsub("%/", ".")
343
+ _662_ = _661_0
341
344
  end
342
- tgt = tgt[_656_]
345
+ tgt = tgt[_662_]
343
346
  end
344
347
  return tgt
345
348
  end
@@ -351,9 +354,9 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
351
354
  do
352
355
  local tgt = apropos_follow_path(path)
353
356
  if ("function" == type(tgt)) then
354
- local _657_0 = (compiler.metadata):get(tgt, "fnl/docstring")
355
- if (nil ~= _657_0) then
356
- local docstr = _657_0
357
+ local _663_0 = (compiler.metadata):get(tgt, "fnl/docstring")
358
+ if (nil ~= _663_0) then
359
+ local docstr = _663_0
357
360
  val_19_ = (docstr:match(pattern) and path)
358
361
  else
359
362
  val_19_ = nil
@@ -370,125 +373,125 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
370
373
  return tbl_17_
371
374
  end
372
375
  commands["apropos-doc"] = function(_env, read, on_values, on_error, _scope)
373
- local function _661_(_241)
376
+ local function _667_(_241)
374
377
  return on_values(apropos_doc(tostring(_241)))
375
378
  end
376
- return run_command(read, on_error, _661_)
379
+ return run_command(read, on_error, _667_)
377
380
  end
378
381
  do end (compiler.metadata):set(commands["apropos-doc"], "fnl/docstring", "Print all functions that match the pattern in their docs")
379
382
  local function apropos_show_docs(on_values, pattern)
380
383
  for _, path in ipairs(apropos(pattern)) do
381
384
  local tgt = apropos_follow_path(path)
382
385
  if (("function" == type(tgt)) and (compiler.metadata):get(tgt, "fnl/docstring")) then
383
- on_values(specials.doc(tgt, path))
384
- on_values()
386
+ on_values({specials.doc(tgt, path)})
387
+ on_values({})
385
388
  end
386
389
  end
387
390
  return nil
388
391
  end
389
392
  commands["apropos-show-docs"] = function(_env, read, on_values, on_error)
390
- local function _663_(_241)
393
+ local function _669_(_241)
391
394
  return apropos_show_docs(on_values, tostring(_241))
392
395
  end
393
- return run_command(read, on_error, _663_)
396
+ return run_command(read, on_error, _669_)
394
397
  end
395
398
  do end (compiler.metadata):set(commands["apropos-show-docs"], "fnl/docstring", "Print all documentations matching a pattern in function name")
396
- local function resolve(identifier, _664_0, scope)
397
- local _665_ = _664_0
398
- local env = _665_
399
- local ___replLocals___ = _665_["___replLocals___"]
399
+ local function resolve(identifier, _670_0, scope)
400
+ local _671_ = _670_0
401
+ local env = _671_
402
+ local ___replLocals___ = _671_["___replLocals___"]
400
403
  local e = nil
401
- local function _666_(_241, _242)
404
+ local function _672_(_241, _242)
402
405
  return (___replLocals___[scope.unmanglings[_242]] or env[_242])
403
406
  end
404
- e = setmetatable({}, {__index = _666_})
405
- local function _667_(...)
406
- local _668_0, _669_0 = ...
407
- if ((_668_0 == true) and (nil ~= _669_0)) then
408
- local code = _669_0
409
- local function _670_(...)
410
- local _671_0, _672_0 = ...
411
- if ((_671_0 == true) and (nil ~= _672_0)) then
412
- local val = _672_0
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
413
416
  return val
414
417
  else
415
- local _ = _671_0
418
+ local _ = _677_0
416
419
  return nil
417
420
  end
418
421
  end
419
- return _670_(pcall(specials["load-code"](code, e)))
422
+ return _676_(pcall(specials["load-code"](code, e)))
420
423
  else
421
- local _ = _668_0
424
+ local _ = _674_0
422
425
  return nil
423
426
  end
424
427
  end
425
- return _667_(pcall(compiler["compile-string"], tostring(identifier), {scope = scope}))
428
+ return _673_(pcall(compiler["compile-string"], tostring(identifier), {scope = scope}))
426
429
  end
427
430
  commands.find = function(env, read, on_values, on_error, scope)
428
- local function _675_(_241)
429
- local _676_0 = nil
431
+ local function _681_(_241)
432
+ local _682_0 = nil
430
433
  do
431
- local _677_0 = utils["sym?"](_241)
432
- if (nil ~= _677_0) then
433
- local _678_0 = resolve(_677_0, env, scope)
434
- if (nil ~= _678_0) then
435
- _676_0 = debug.getinfo(_678_0)
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)
436
439
  else
437
- _676_0 = _678_0
440
+ _682_0 = _684_0
438
441
  end
439
442
  else
440
- _676_0 = _677_0
443
+ _682_0 = _683_0
441
444
  end
442
445
  end
443
- if ((_G.type(_676_0) == "table") and (nil ~= _676_0.linedefined) and (nil ~= _676_0.short_src) and (nil ~= _676_0.source) and (_676_0.what == "Lua")) then
444
- local line = _676_0.linedefined
445
- local src = _676_0.short_src
446
- local source = _676_0.source
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
447
450
  local fnlsrc = nil
448
451
  do
449
- local _681_0 = compiler.sourcemap
450
- if (nil ~= _681_0) then
451
- _681_0 = _681_0[source]
452
+ local _687_0 = compiler.sourcemap
453
+ if (nil ~= _687_0) then
454
+ _687_0 = _687_0[source]
452
455
  end
453
- if (nil ~= _681_0) then
454
- _681_0 = _681_0[line]
456
+ if (nil ~= _687_0) then
457
+ _687_0 = _687_0[line]
455
458
  end
456
- if (nil ~= _681_0) then
457
- _681_0 = _681_0[2]
459
+ if (nil ~= _687_0) then
460
+ _687_0 = _687_0[2]
458
461
  end
459
- fnlsrc = _681_0
462
+ fnlsrc = _687_0
460
463
  end
461
464
  return on_values({string.format("%s:%s", src, (fnlsrc or line))})
462
- elseif (_676_0 == nil) then
465
+ elseif (_682_0 == nil) then
463
466
  return on_error("Repl", "Unknown value")
464
467
  else
465
- local _ = _676_0
468
+ local _ = _682_0
466
469
  return on_error("Repl", "No source info")
467
470
  end
468
471
  end
469
- return run_command(read, on_error, _675_)
472
+ return run_command(read, on_error, _681_)
470
473
  end
471
474
  do end (compiler.metadata):set(commands.find, "fnl/docstring", "Print the filename and line number for a given function")
472
475
  commands.doc = function(env, read, on_values, on_error, scope)
473
- local function _686_(_241)
476
+ local function _692_(_241)
474
477
  local name = tostring(_241)
475
478
  local path = (utils["multi-sym?"](name) or {name})
476
479
  local ok_3f, target = nil, nil
477
- local function _687_()
480
+ local function _693_()
478
481
  return (utils["get-in"](scope.specials, path) or utils["get-in"](scope.macros, path) or resolve(name, env, scope))
479
482
  end
480
- ok_3f, target = pcall(_687_)
483
+ ok_3f, target = pcall(_693_)
481
484
  if ok_3f then
482
485
  return on_values({specials.doc(target, name)})
483
486
  else
484
487
  return on_error("Repl", ("Could not find " .. name .. " for docs."))
485
488
  end
486
489
  end
487
- return run_command(read, on_error, _686_)
490
+ return run_command(read, on_error, _692_)
488
491
  end
489
492
  do end (compiler.metadata):set(commands.doc, "fnl/docstring", "Print the docstring and arglist for a function, macro, or special form.")
490
493
  commands.compile = function(env, read, on_values, on_error, scope)
491
- local function _689_(_241)
494
+ local function _695_(_241)
492
495
  local allowedGlobals = specials["current-global-names"](env)
493
496
  local ok_3f, result = pcall(compiler.compile, _241, {allowedGlobals = allowedGlobals, env = env, scope = scope})
494
497
  if ok_3f then
@@ -497,16 +500,16 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
497
500
  return on_error("Repl", ("Error compiling expression: " .. result))
498
501
  end
499
502
  end
500
- return run_command(read, on_error, _689_)
503
+ return run_command(read, on_error, _695_)
501
504
  end
502
505
  do end (compiler.metadata):set(commands.compile, "fnl/docstring", "compiles the expression into lua and prints the result.")
503
506
  local function load_plugin_commands(plugins)
504
- for _, plugin in ipairs((plugins or {})) do
505
- for name, f in pairs(plugin) do
506
- local _691_0 = name:match("^repl%-command%-(.*)")
507
- if (nil ~= _691_0) then
508
- local cmd_name = _691_0
509
- commands[cmd_name] = (commands[cmd_name] or f)
507
+ for i = #(plugins or {}), 1, -1 do
508
+ 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
512
+ commands[cmd_name] = f
510
513
  end
511
514
  end
512
515
  end
@@ -515,19 +518,19 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
515
518
  local function run_command_loop(input, read, loop, env, on_values, on_error, scope, chars)
516
519
  local command_name = input:match(",([^%s/]+)")
517
520
  do
518
- local _693_0 = commands[command_name]
519
- if (nil ~= _693_0) then
520
- local command = _693_0
521
+ local _699_0 = commands[command_name]
522
+ if (nil ~= _699_0) then
523
+ local command = _699_0
521
524
  command(env, read, on_values, on_error, scope, chars)
522
525
  else
523
- local _ = _693_0
524
- if ("exit" ~= command_name) then
526
+ local _ = _699_0
527
+ if ((command_name ~= "exit") and (command_name ~= "return")) then
525
528
  on_values({"Unknown command", command_name})
526
529
  end
527
530
  end
528
531
  end
529
532
  if ("exit" ~= command_name) then
530
- return loop()
533
+ return loop((command_name == "return"))
531
534
  end
532
535
  end
533
536
  local function try_readline_21(opts, ok, readline)
@@ -570,9 +573,9 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
570
573
  end
571
574
  local function repl(_3foptions)
572
575
  local old_root_options = utils.root.options
573
- local _702_ = utils.copy(_3foptions)
574
- local opts = _702_
575
- local _3ffennelrc = _702_["fennelrc"]
576
+ local _708_ = utils.copy(_3foptions)
577
+ local opts = _708_
578
+ local _3ffennelrc = _708_["fennelrc"]
576
579
  local _ = nil
577
580
  opts.fennelrc = nil
578
581
  _ = nil
@@ -587,35 +590,42 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
587
590
  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)}
588
591
  local save_locals_3f = (opts.saveLocals ~= false)
589
592
  local byte_stream, clear_stream = nil, nil
590
- local function _704_(_241)
593
+ local function _710_(_241)
591
594
  return callbacks.readChunk(_241)
592
595
  end
593
- byte_stream, clear_stream = parser.granulate(_704_)
596
+ byte_stream, clear_stream = parser.granulate(_710_)
594
597
  local chars = {}
595
598
  local read, reset = nil, nil
596
- local function _705_(parser_state)
599
+ local function _711_(parser_state)
597
600
  local b = byte_stream(parser_state)
598
601
  if b then
599
602
  table.insert(chars, string.char(b))
600
603
  end
601
604
  return b
602
605
  end
603
- read, reset = parser.parser(_705_)
606
+ read, reset = parser.parser(_711_)
607
+ depth = (depth + 1)
608
+ if opts.message then
609
+ callbacks.onValues({opts.message})
610
+ end
604
611
  env.___repl___ = callbacks
605
612
  opts.env, opts.scope = env, compiler["make-scope"]()
606
613
  opts.useMetadata = (opts.useMetadata ~= false)
607
614
  if (opts.allowedGlobals == nil) then
608
615
  opts.allowedGlobals = specials["current-global-names"](env)
609
616
  end
617
+ if opts.init then
618
+ opts.init(opts, depth)
619
+ end
610
620
  if opts.registerCompleter then
611
- local function _709_()
612
- local _708_0 = opts.scope
613
- local function _710_(...)
614
- return completer(env, _708_0, ...)
621
+ local function _717_()
622
+ local _716_0 = opts.scope
623
+ local function _718_(...)
624
+ return completer(env, _716_0, ...)
615
625
  end
616
- return _710_
626
+ return _718_
617
627
  end
618
- opts.registerCompleter(_709_())
628
+ opts.registerCompleter(_717_())
619
629
  end
620
630
  load_plugin_commands(opts.plugins)
621
631
  if save_locals_3f then
@@ -636,12 +646,21 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
636
646
  end
637
647
  return callbacks.onValues(out)
638
648
  end
639
- local function loop()
649
+ local function save_value(...)
650
+ env.___replLocals___["*3"] = env.___replLocals___["*2"]
651
+ env.___replLocals___["*2"] = env.___replLocals___["*1"]
652
+ env.___replLocals___["*1"] = ...
653
+ return ...
654
+ end
655
+ opts.scope.manglings["*1"], opts.scope.unmanglings._1 = "_1", "*1"
656
+ opts.scope.manglings["*2"], opts.scope.unmanglings._2 = "_2", "*2"
657
+ opts.scope.manglings["*3"], opts.scope.unmanglings._3 = "_3", "*3"
658
+ local function loop(exit_next_3f)
640
659
  for k in pairs(chars) do
641
660
  chars[k] = nil
642
661
  end
643
662
  reset()
644
- local ok, parser_not_eof_3f, x = pcall(read)
663
+ local ok, parser_not_eof_3f, form = pcall(read)
645
664
  local src_string = table.concat(chars)
646
665
  local readline_not_eof_3f = (not readline or (src_string ~= "(null)"))
647
666
  local not_eof_3f = (readline_not_eof_3f and parser_not_eof_3f)
@@ -653,52 +672,66 @@ package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
653
672
  return run_command_loop(src_string, read, loop, env, callbacks.onValues, callbacks.onError, opts.scope, chars)
654
673
  else
655
674
  if not_eof_3f then
656
- do
657
- local _714_0, _715_0 = nil, nil
658
- local function _716_()
659
- opts["source"] = src_string
660
- return opts
661
- end
662
- _714_0, _715_0 = pcall(compiler.compile, x, _716_())
663
- if ((_714_0 == false) and (nil ~= _715_0)) then
664
- local msg = _715_0
665
- clear_stream()
666
- callbacks.onError("Compile", msg)
667
- elseif ((_714_0 == true) and (nil ~= _715_0)) then
668
- local src = _715_0
669
- local src0 = nil
670
- if save_locals_3f then
671
- src0 = splice_save_locals(env, src, opts.scope)
672
- else
673
- src0 = src
674
- end
675
- local _718_0, _719_0 = pcall(specials["load-code"], src0, env)
676
- if ((_718_0 == false) and (nil ~= _719_0)) then
677
- local msg = _719_0
678
- clear_stream()
679
- callbacks.onError("Lua Compile", msg, src0)
680
- elseif (true and (nil ~= _719_0)) then
681
- local _1 = _718_0
682
- local chunk = _719_0
683
- local function _720_()
684
- return print_values(chunk())
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_()
684
+ return print_values(save_value(chunk()))
685
+ end
686
+ local function _729_(...)
687
+ return callbacks.onError("Runtime", ...)
688
+ end
689
+ return xpcall(_728_, _729_)
690
+ elseif ((_726_0 == false) and (nil ~= _727_0)) then
691
+ local msg = _727_0
692
+ clear_stream()
693
+ return callbacks.onError("Compile", msg)
685
694
  end
686
- local function _721_(...)
687
- return callbacks.onError("Runtime", ...)
695
+ end
696
+ local function _732_(...)
697
+ local src0 = nil
698
+ if save_locals_3f then
699
+ src0 = splice_save_locals(env, src, opts.scope)
700
+ else
701
+ src0 = src
688
702
  end
689
- xpcall(_720_, _721_)
703
+ return pcall(specials["load-code"], src0, env)
690
704
  end
705
+ return _725_(_732_(...))
706
+ elseif ((_723_0 == false) and (nil ~= _724_0)) then
707
+ local msg = _724_0
708
+ clear_stream()
709
+ return callbacks.onError("Compile", msg)
691
710
  end
692
711
  end
712
+ local function _734_()
713
+ opts["source"] = src_string
714
+ return opts
715
+ end
716
+ _722_(pcall(compiler.compile, form, _734_()))
693
717
  utils.root.options = old_root_options
694
- return loop()
718
+ if exit_next_3f then
719
+ return env.___replLocals___["*1"]
720
+ else
721
+ return loop()
722
+ end
695
723
  end
696
724
  end
697
725
  end
698
- loop()
726
+ local value = loop()
727
+ depth = (depth - 1)
699
728
  if readline then
700
- return readline.save_history()
729
+ readline.save_history()
701
730
  end
731
+ if opts.exit then
732
+ opts.exit(opts, depth)
733
+ end
734
+ return value
702
735
  end
703
736
  return repl
704
737
  end
@@ -710,14 +743,14 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
710
743
  local unpack = (table.unpack or _G.unpack)
711
744
  local SPECIALS = compiler.scopes.global.specials
712
745
  local function wrap_env(env)
713
- local function _415_(_, key)
746
+ local function _417_(_, key)
714
747
  if utils["string?"](key) then
715
748
  return env[compiler["global-unmangling"](key)]
716
749
  else
717
750
  return env[key]
718
751
  end
719
752
  end
720
- local function _417_(_, key, value)
753
+ local function _419_(_, key, value)
721
754
  if utils["string?"](key) then
722
755
  env[compiler["global-unmangling"](key)] = value
723
756
  return nil
@@ -726,26 +759,26 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
726
759
  return nil
727
760
  end
728
761
  end
729
- local function _419_()
762
+ local function _421_()
730
763
  local function putenv(k, v)
731
- local _420_
764
+ local _422_
732
765
  if utils["string?"](k) then
733
- _420_ = compiler["global-unmangling"](k)
766
+ _422_ = compiler["global-unmangling"](k)
734
767
  else
735
- _420_ = k
768
+ _422_ = k
736
769
  end
737
- return _420_, v
770
+ return _422_, v
738
771
  end
739
772
  return next, utils.kvmap(env, putenv), nil
740
773
  end
741
- return setmetatable({}, {__index = _415_, __newindex = _417_, __pairs = _419_})
774
+ return setmetatable({}, {__index = _417_, __newindex = _419_, __pairs = _421_})
742
775
  end
743
776
  local function current_global_names(_3fenv)
744
777
  local mt = nil
745
778
  do
746
- local _422_0 = getmetatable(_3fenv)
747
- if ((_G.type(_422_0) == "table") and (nil ~= _422_0.__pairs)) then
748
- local mtpairs = _422_0.__pairs
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
749
782
  local tbl_14_ = {}
750
783
  for k, v in mtpairs(_3fenv) do
751
784
  local k_15_, v_16_ = k, v
@@ -754,7 +787,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
754
787
  end
755
788
  end
756
789
  mt = tbl_14_
757
- elseif (_422_0 == nil) then
790
+ elseif (_424_0 == nil) then
758
791
  mt = (_3fenv or _G)
759
792
  else
760
793
  mt = nil
@@ -764,15 +797,15 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
764
797
  end
765
798
  local function load_code(code, _3fenv, _3ffilename)
766
799
  local env = (_3fenv or rawget(_G, "_ENV") or _G)
767
- local _425_0, _426_0 = rawget(_G, "setfenv"), rawget(_G, "loadstring")
768
- if ((nil ~= _425_0) and (nil ~= _426_0)) then
769
- local setfenv = _425_0
770
- local loadstring = _426_0
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
771
804
  local f = assert(loadstring(code, _3ffilename))
772
805
  setfenv(f, env)
773
806
  return f
774
807
  else
775
- local _ = _425_0
808
+ local _ = _427_0
776
809
  return assert(load(code, _3ffilename, "t", env))
777
810
  end
778
811
  end
@@ -784,13 +817,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
784
817
  local mt = getmetatable(tgt)
785
818
  if ((type(tgt) == "function") or ((type(mt) == "table") and (type(mt.__call) == "function"))) then
786
819
  local arglist = table.concat(((compiler.metadata):get(tgt, "fnl/arglist") or {"#<unknown-arguments>"}), " ")
787
- local _428_
820
+ local _430_
788
821
  if (0 < #arglist) then
789
- _428_ = " "
822
+ _430_ = " "
790
823
  else
791
- _428_ = ""
824
+ _430_ = ""
792
825
  end
793
- return string.format("(%s%s%s)\n %s", name, _428_, arglist, docstring)
826
+ return string.format("(%s%s%s)\n %s", name, _430_, arglist, docstring)
794
827
  else
795
828
  return string.format("%s\n %s", name, docstring)
796
829
  end
@@ -816,16 +849,12 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
816
849
  local len = #ast
817
850
  local retexprs = {returned = true}
818
851
  local function compile_body(outer_target, outer_tail, outer_retexprs)
819
- if (len < start) then
820
- compiler.compile1(nil, sub_scope, chunk, {tail = outer_tail, target = outer_target})
821
- else
822
- for i = start, len do
823
- 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)}
824
- local _ = utils["propagate-options"](opts, subopts)
825
- local subexprs = compiler.compile1(ast[i], sub_scope, chunk, subopts)
826
- if (i ~= len) then
827
- compiler["keep-side-effects"](subexprs, parent, nil, ast[i])
828
- end
852
+ for i = start, len do
853
+ 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)}
854
+ local _ = utils["propagate-options"](opts, subopts)
855
+ local subexprs = compiler.compile1(ast[i], sub_scope, chunk, subopts)
856
+ if (i ~= len) then
857
+ compiler["keep-side-effects"](subexprs, parent, nil, ast[i])
829
858
  end
830
859
  end
831
860
  compiler.emit(parent, chunk, ast)
@@ -903,9 +932,9 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
903
932
  local opts = {nval = 1, tail = false}
904
933
  local scope = compiler["make-scope"]()
905
934
  local chunk = {}
906
- local _439_ = compiler.compile1(v, scope, chunk, opts)
907
- local _440_ = _439_[1]
908
- local v0 = _440_[1]
935
+ local _440_ = compiler.compile1(v, scope, chunk, opts)
936
+ local _441_ = _440_[1]
937
+ local v0 = _441_[1]
909
938
  return v0
910
939
  end
911
940
  local function insert_meta(meta, k, v)
@@ -913,23 +942,23 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
913
942
  compiler.assert((type(k) == "string"), ("expected string keys in metadata table, got: %s"):format(view(k, view_opts)))
914
943
  compiler.assert(literal_3f(v), ("expected literal value in metadata table, got: %s %s"):format(view(k, view_opts), view(v, view_opts)))
915
944
  table.insert(meta, view(k))
916
- local function _441_()
945
+ local function _442_()
917
946
  if ("string" == type(v)) then
918
947
  return view(v, view_opts)
919
948
  else
920
949
  return compile_value(v)
921
950
  end
922
951
  end
923
- table.insert(meta, _441_())
952
+ table.insert(meta, _442_())
924
953
  return meta
925
954
  end
926
955
  local function insert_arglist(meta, arg_list)
927
956
  local view_opts = {["escape-newlines?"] = true, ["line-length"] = math.huge, ["one-line?"] = true}
928
957
  table.insert(meta, "\"fnl/arglist\"")
929
- local function _442_(_241)
958
+ local function _443_(_241)
930
959
  return view(view(_241, view_opts))
931
960
  end
932
- table.insert(meta, ("{" .. table.concat(utils.map(arg_list, _442_), ", ") .. "}"))
961
+ table.insert(meta, ("{" .. table.concat(utils.map(arg_list, _443_), ", ") .. "}"))
933
962
  return meta
934
963
  end
935
964
  local function set_fn_metadata(f_metadata, parent, fn_name)
@@ -948,13 +977,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
948
977
  end
949
978
  local function get_fn_name(ast, scope, fn_name, multi)
950
979
  if (fn_name and (fn_name[1] ~= "nil")) then
951
- local _445_
980
+ local _446_
952
981
  if not multi then
953
- _445_ = compiler["declare-local"](fn_name, {}, scope, ast)
982
+ _446_ = compiler["declare-local"](fn_name, {}, scope, ast)
954
983
  else
955
- _445_ = compiler["symbol-to-expression"](fn_name, scope)[1]
984
+ _446_ = compiler["symbol-to-expression"](fn_name, scope)[1]
956
985
  end
957
- return _445_, not multi, 3
986
+ return _446_, not multi, 3
958
987
  else
959
988
  return nil, true, 2
960
989
  end
@@ -963,13 +992,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
963
992
  for i = (index + 1), #ast do
964
993
  compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
965
994
  end
966
- local _448_
995
+ local _449_
967
996
  if local_3f then
968
- _448_ = "local function %s(%s)"
997
+ _449_ = "local function %s(%s)"
969
998
  else
970
- _448_ = "%s = function(%s)"
999
+ _449_ = "%s = function(%s)"
971
1000
  end
972
- compiler.emit(parent, string.format(_448_, fn_name, table.concat(arg_name_list, ", ")), ast)
1001
+ compiler.emit(parent, string.format(_449_, fn_name, table.concat(arg_name_list, ", ")), ast)
973
1002
  compiler.emit(parent, f_chunk, ast)
974
1003
  compiler.emit(parent, "end", ast)
975
1004
  set_fn_metadata(f_metadata, parent, fn_name)
@@ -991,7 +1020,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
991
1020
  end
992
1021
  end
993
1022
  local function get_function_metadata(ast, arg_list, index)
994
- local function _451_(_241, _242)
1023
+ local function _452_(_241, _242)
995
1024
  local tbl_14_ = _241
996
1025
  for k, v in pairs(_242) do
997
1026
  local k_15_, v_16_ = k, v
@@ -1001,18 +1030,18 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1001
1030
  end
1002
1031
  return tbl_14_
1003
1032
  end
1004
- local function _453_(_241, _242)
1033
+ local function _454_(_241, _242)
1005
1034
  _241["fnl/docstring"] = _242
1006
1035
  return _241
1007
1036
  end
1008
- return maybe_metadata(ast, utils["kv-table?"], _451_, maybe_metadata(ast, utils["string?"], _453_, {["fnl/arglist"] = arg_list}, index))
1037
+ return maybe_metadata(ast, utils["kv-table?"], _452_, maybe_metadata(ast, utils["string?"], _454_, {["fnl/arglist"] = arg_list}, index))
1009
1038
  end
1010
1039
  SPECIALS.fn = function(ast, scope, parent)
1011
1040
  local f_scope = nil
1012
1041
  do
1013
- local _454_0 = compiler["make-scope"](scope)
1014
- _454_0["vararg"] = false
1015
- f_scope = _454_0
1042
+ local _455_0 = compiler["make-scope"](scope)
1043
+ _455_0["vararg"] = false
1044
+ f_scope = _455_0
1016
1045
  end
1017
1046
  local f_chunk = {}
1018
1047
  local fn_sym = utils["sym?"](ast[2])
@@ -1072,36 +1101,36 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1072
1101
  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)
1073
1102
  SPECIALS.lua = function(ast, _, parent)
1074
1103
  compiler.assert(((#ast == 2) or (#ast == 3)), "expected 1 or 2 arguments", ast)
1075
- local _459_
1104
+ local _460_
1076
1105
  do
1077
- local _458_0 = utils["sym?"](ast[2])
1078
- if (nil ~= _458_0) then
1079
- _459_ = tostring(_458_0)
1106
+ local _459_0 = utils["sym?"](ast[2])
1107
+ if (nil ~= _459_0) then
1108
+ _460_ = tostring(_459_0)
1080
1109
  else
1081
- _459_ = _458_0
1110
+ _460_ = _459_0
1082
1111
  end
1083
1112
  end
1084
- if ("nil" ~= _459_) then
1113
+ if ("nil" ~= _460_) then
1085
1114
  table.insert(parent, {ast = ast, leaf = tostring(ast[2])})
1086
1115
  end
1087
- local _463_
1116
+ local _464_
1088
1117
  do
1089
- local _462_0 = utils["sym?"](ast[3])
1090
- if (nil ~= _462_0) then
1091
- _463_ = tostring(_462_0)
1118
+ local _463_0 = utils["sym?"](ast[3])
1119
+ if (nil ~= _463_0) then
1120
+ _464_ = tostring(_463_0)
1092
1121
  else
1093
- _463_ = _462_0
1122
+ _464_ = _463_0
1094
1123
  end
1095
1124
  end
1096
- if ("nil" ~= _463_) then
1125
+ if ("nil" ~= _464_) then
1097
1126
  return tostring(ast[3])
1098
1127
  end
1099
1128
  end
1100
1129
  local function dot(ast, scope, parent)
1101
1130
  compiler.assert((1 < #ast), "expected table argument", ast)
1102
1131
  local len = #ast
1103
- local _466_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1104
- local lhs = _466_[1]
1132
+ local _467_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1133
+ local lhs = _467_[1]
1105
1134
  if (len == 2) then
1106
1135
  return tostring(lhs)
1107
1136
  else
@@ -1111,12 +1140,12 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1111
1140
  if (utils["string?"](index) and utils["valid-lua-identifier?"](index)) then
1112
1141
  table.insert(indices, ("." .. index))
1113
1142
  else
1114
- local _467_ = compiler.compile1(index, scope, parent, {nval = 1})
1115
- local index0 = _467_[1]
1143
+ local _468_ = compiler.compile1(index, scope, parent, {nval = 1})
1144
+ local index0 = _468_[1]
1116
1145
  table.insert(indices, ("[" .. tostring(index0) .. "]"))
1117
1146
  end
1118
1147
  end
1119
- if (tostring(lhs):find("[{\"0-9]") or ("nil" == tostring(lhs))) then
1148
+ if (not (utils["sym?"](ast[2]) or utils["list?"](ast[2])) or ("nil" == tostring(lhs))) then
1120
1149
  return ("(" .. tostring(lhs) .. ")" .. table.concat(indices))
1121
1150
  else
1122
1151
  return (tostring(lhs) .. table.concat(indices))
@@ -1157,7 +1186,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1157
1186
  end
1158
1187
  doc_special("var", {"name", "val"}, "Introduce new mutable local.")
1159
1188
  local function kv_3f(t)
1160
- local _471_
1189
+ local _472_
1161
1190
  do
1162
1191
  local tbl_17_ = {}
1163
1192
  local i_18_ = #tbl_17_
@@ -1173,9 +1202,9 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1173
1202
  tbl_17_[i_18_] = val_19_
1174
1203
  end
1175
1204
  end
1176
- _471_ = tbl_17_
1205
+ _472_ = tbl_17_
1177
1206
  end
1178
- return _471_[1]
1207
+ return _472_[1]
1179
1208
  end
1180
1209
  SPECIALS.let = function(ast, scope, parent, opts)
1181
1210
  local bindings = ast[2]
@@ -1202,22 +1231,22 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1202
1231
  end
1203
1232
  end
1204
1233
  local function disambiguate_3f(rootstr, parent)
1205
- local function _476_()
1206
- local _475_0 = get_prev_line(parent)
1207
- if (nil ~= _475_0) then
1208
- local prev_line = _475_0
1234
+ local function _477_()
1235
+ local _476_0 = get_prev_line(parent)
1236
+ if (nil ~= _476_0) then
1237
+ local prev_line = _476_0
1209
1238
  return prev_line:match("%)$")
1210
1239
  end
1211
1240
  end
1212
- return (rootstr:match("^{") or rootstr:match("^%(") or _476_())
1241
+ return (rootstr:match("^{") or rootstr:match("^%(") or _477_())
1213
1242
  end
1214
1243
  SPECIALS.tset = function(ast, scope, parent)
1215
1244
  compiler.assert((3 < #ast), "expected table, key, and value arguments", ast)
1216
1245
  local root = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
1217
1246
  local keys = {}
1218
1247
  for i = 3, (#ast - 1) do
1219
- local _478_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
1220
- local key = _478_[1]
1248
+ local _479_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
1249
+ local key = _479_[1]
1221
1250
  table.insert(keys, tostring(key))
1222
1251
  end
1223
1252
  local value = compiler.compile1(ast[#ast], scope, parent, {nval = 1})[1]
@@ -1231,7 +1260,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1231
1260
  return compiler.emit(parent, fmtstr:format(rootstr, table.concat(keys, "]["), tostring(value)), ast)
1232
1261
  end
1233
1262
  doc_special("tset", {"tbl", "key1", "...", "keyN", "val"}, "Set the value of a table field. Can take additional keys to set\nnested values, but all parents must contain an existing table.")
1234
- local function calculate_target(scope, opts)
1263
+ local function calculate_if_target(scope, opts)
1235
1264
  if not (opts.tail or opts.target or opts.nval) then
1236
1265
  return "iife", true, nil
1237
1266
  elseif (opts.nval and (opts.nval ~= 0) and not opts.target) then
@@ -1249,81 +1278,88 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1249
1278
  end
1250
1279
  local function if_2a(ast, scope, parent, opts)
1251
1280
  compiler.assert((2 < #ast), "expected condition and body", ast)
1252
- local do_scope = compiler["make-scope"](scope)
1253
- local branches = {}
1254
- local wrapper, inner_tail, inner_target, target_exprs = calculate_target(scope, opts)
1255
- local body_opts = {nval = opts.nval, tail = inner_tail, target = inner_target}
1256
- local function compile_body(i)
1257
- local chunk = {}
1258
- local cscope = compiler["make-scope"](do_scope)
1259
- compiler["keep-side-effects"](compiler.compile1(ast[i], cscope, chunk, body_opts), chunk, nil, ast[i])
1260
- return {chunk = chunk, scope = cscope}
1281
+ if ((1 == (#ast % 2)) and (ast[(#ast - 1)] == true)) then
1282
+ table.remove(ast, (#ast - 1))
1261
1283
  end
1262
1284
  if (1 == (#ast % 2)) then
1263
1285
  table.insert(ast, utils.sym("nil"))
1264
1286
  end
1265
- for i = 2, (#ast - 1), 2 do
1266
- local condchunk = {}
1267
- local res = compiler.compile1(ast[i], do_scope, condchunk, {nval = 1})
1268
- local cond = res[1]
1269
- local branch = compile_body((i + 1))
1270
- branch.cond = cond
1271
- branch.condchunk = condchunk
1272
- branch.nested = ((i ~= 2) and (next(condchunk, nil) == nil))
1273
- table.insert(branches, branch)
1274
- end
1275
- local else_branch = compile_body(#ast)
1276
- local s = compiler.gensym(scope)
1277
- local buffer = {}
1278
- local last_buffer = buffer
1279
- for i = 1, #branches do
1280
- local branch = branches[i]
1281
- local fstr = nil
1282
- if not branch.nested then
1283
- fstr = "if %s then"
1284
- else
1285
- fstr = "elseif %s then"
1286
- end
1287
- local cond = tostring(branch.cond)
1288
- local cond_line = fstr:format(cond)
1289
- if branch.nested then
1290
- compiler.emit(last_buffer, branch.condchunk, ast)
1291
- else
1292
- for _, v in ipairs(branch.condchunk) do
1293
- compiler.emit(last_buffer, v, ast)
1294
- end
1295
- end
1296
- compiler.emit(last_buffer, cond_line, ast)
1297
- compiler.emit(last_buffer, branch.chunk, ast)
1298
- if (i == #branches) then
1299
- compiler.emit(last_buffer, "else", ast)
1300
- compiler.emit(last_buffer, else_branch.chunk, ast)
1301
- compiler.emit(last_buffer, "end", ast)
1302
- elseif not branches[(i + 1)].nested then
1303
- local next_buffer = {}
1304
- compiler.emit(last_buffer, "else", ast)
1305
- compiler.emit(last_buffer, next_buffer, ast)
1306
- compiler.emit(last_buffer, "end", ast)
1307
- last_buffer = next_buffer
1308
- end
1309
- end
1310
- if (wrapper == "iife") then
1311
- local iifeargs = ((scope.vararg and "...") or "")
1312
- compiler.emit(parent, ("local function %s(%s)"):format(tostring(s), iifeargs), ast)
1313
- compiler.emit(parent, buffer, ast)
1314
- compiler.emit(parent, "end", ast)
1315
- return utils.expr(("%s(%s)"):format(tostring(s), iifeargs), "statement")
1316
- elseif (wrapper == "none") then
1317
- for i = 1, #buffer do
1318
- compiler.emit(parent, buffer[i], ast)
1319
- end
1320
- return {returned = true}
1287
+ if (#ast == 2) then
1288
+ return SPECIALS["do"](utils.list(utils.sym("do"), ast[2]), scope, parent, opts)
1321
1289
  else
1322
- compiler.emit(parent, ("local %s"):format(inner_target), ast)
1323
- for i = 1, #buffer do
1324
- compiler.emit(parent, buffer[i], ast)
1290
+ local do_scope = compiler["make-scope"](scope)
1291
+ local branches = {}
1292
+ local wrapper, inner_tail, inner_target, target_exprs = calculate_if_target(scope, opts)
1293
+ local body_opts = {nval = opts.nval, tail = inner_tail, target = inner_target}
1294
+ local function compile_body(i)
1295
+ local chunk = {}
1296
+ local cscope = compiler["make-scope"](do_scope)
1297
+ compiler["keep-side-effects"](compiler.compile1(ast[i], cscope, chunk, body_opts), chunk, nil, ast[i])
1298
+ return {chunk = chunk, scope = cscope}
1299
+ end
1300
+ for i = 2, (#ast - 1), 2 do
1301
+ local condchunk = {}
1302
+ local res = compiler.compile1(ast[i], do_scope, condchunk, {nval = 1})
1303
+ local cond = res[1]
1304
+ local branch = compile_body((i + 1))
1305
+ branch.cond = cond
1306
+ branch.condchunk = condchunk
1307
+ branch.nested = ((i ~= 2) and (next(condchunk, nil) == nil))
1308
+ table.insert(branches, branch)
1309
+ end
1310
+ local else_branch = compile_body(#ast)
1311
+ local s = compiler.gensym(scope)
1312
+ local buffer = {}
1313
+ local last_buffer = buffer
1314
+ for i = 1, #branches do
1315
+ local branch = branches[i]
1316
+ local fstr = nil
1317
+ if not branch.nested then
1318
+ fstr = "if %s then"
1319
+ else
1320
+ fstr = "elseif %s then"
1321
+ end
1322
+ local cond = tostring(branch.cond)
1323
+ local cond_line = fstr:format(cond)
1324
+ if branch.nested then
1325
+ compiler.emit(last_buffer, branch.condchunk, ast)
1326
+ else
1327
+ for _, v in ipairs(branch.condchunk) do
1328
+ compiler.emit(last_buffer, v, ast)
1329
+ end
1330
+ end
1331
+ compiler.emit(last_buffer, cond_line, ast)
1332
+ compiler.emit(last_buffer, branch.chunk, ast)
1333
+ if (i == #branches) then
1334
+ compiler.emit(last_buffer, "else", ast)
1335
+ compiler.emit(last_buffer, else_branch.chunk, ast)
1336
+ compiler.emit(last_buffer, "end", ast)
1337
+ elseif not branches[(i + 1)].nested then
1338
+ local next_buffer = {}
1339
+ compiler.emit(last_buffer, "else", ast)
1340
+ compiler.emit(last_buffer, next_buffer, ast)
1341
+ compiler.emit(last_buffer, "end", ast)
1342
+ last_buffer = next_buffer
1343
+ end
1344
+ end
1345
+ if (wrapper == "iife") then
1346
+ local iifeargs = ((scope.vararg and "...") or "")
1347
+ compiler.emit(parent, ("local function %s(%s)"):format(tostring(s), iifeargs), ast)
1348
+ compiler.emit(parent, buffer, ast)
1349
+ compiler.emit(parent, "end", ast)
1350
+ return utils.expr(("%s(%s)"):format(tostring(s), iifeargs), "statement")
1351
+ elseif (wrapper == "none") then
1352
+ for i = 1, #buffer do
1353
+ compiler.emit(parent, buffer[i], ast)
1354
+ end
1355
+ return {returned = true}
1356
+ else
1357
+ compiler.emit(parent, ("local %s"):format(inner_target), ast)
1358
+ for i = 1, #buffer do
1359
+ compiler.emit(parent, buffer[i], ast)
1360
+ end
1361
+ return target_exprs
1325
1362
  end
1326
- return target_exprs
1327
1363
  end
1328
1364
  end
1329
1365
  SPECIALS["if"] = if_2a
@@ -1337,15 +1373,14 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1337
1373
  end
1338
1374
  local function compile_until(condition, scope, chunk)
1339
1375
  if condition then
1340
- local _487_ = compiler.compile1(condition, scope, chunk, {nval = 1})
1341
- local condition_lua = _487_[1]
1376
+ local _490_ = compiler.compile1(condition, scope, chunk, {nval = 1})
1377
+ local condition_lua = _490_[1]
1342
1378
  return compiler.emit(chunk, ("if %s then break end"):format(tostring(condition_lua)), utils.expr(condition, "expression"))
1343
1379
  end
1344
1380
  end
1345
1381
  SPECIALS.each = function(ast, scope, parent)
1346
1382
  compiler.assert((3 <= #ast), "expected body expression", ast[1])
1347
1383
  compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
1348
- compiler.assert((2 <= #ast[2]), "expected binding and iterator", ast)
1349
1384
  local binding = setmetatable(utils.copy(ast[2]), getmetatable(ast[2]))
1350
1385
  local until_condition = remove_until_condition(binding)
1351
1386
  local iter = table.remove(binding, #binding)
@@ -1366,6 +1401,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1366
1401
  local vals = compiler.compile1(iter, scope, parent)
1367
1402
  local val_names = utils.map(vals, tostring)
1368
1403
  local chunk = {}
1404
+ compiler.assert(bind_vars[1], "expected binding and iterator", ast)
1369
1405
  compiler.emit(parent, ("for %s in %s do"):format(table.concat(bind_vars, ", "), table.concat(val_names, ", ")), ast)
1370
1406
  for raw, args in utils.stablepairs(destructures) do
1371
1407
  compiler.destructure(args, raw, ast, sub_scope, chunk, {declaration = true, nomulti = true, symtype = "each"})
@@ -1422,10 +1458,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1422
1458
  SPECIALS["for"] = for_2a
1423
1459
  doc_special("for", {"[index start stop step?]", "..."}, "Numeric loop construct.\nEvaluates body once for each value between start and stop (inclusive).", true)
1424
1460
  local function native_method_call(ast, _scope, _parent, target, args)
1425
- local _491_ = ast
1426
- local _ = _491_[1]
1427
- local _0 = _491_[2]
1428
- local method_string = _491_[3]
1461
+ local _494_ = ast
1462
+ local _ = _494_[1]
1463
+ local _0 = _494_[2]
1464
+ local method_string = _494_[3]
1429
1465
  local call_string = nil
1430
1466
  if ((target.type == "literal") or (target.type == "varg") or (target.type == "expression")) then
1431
1467
  call_string = "(%s):%s(%s)"
@@ -1447,18 +1483,18 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1447
1483
  end
1448
1484
  local function method_call(ast, scope, parent)
1449
1485
  compiler.assert((2 < #ast), "expected at least 2 arguments", ast)
1450
- local _493_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1451
- local target = _493_[1]
1486
+ local _496_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1487
+ local target = _496_[1]
1452
1488
  local args = {}
1453
1489
  for i = 4, #ast do
1454
1490
  local subexprs = nil
1455
- local _494_
1491
+ local _497_
1456
1492
  if (i ~= #ast) then
1457
- _494_ = 1
1493
+ _497_ = 1
1458
1494
  else
1459
- _494_ = nil
1495
+ _497_ = nil
1460
1496
  end
1461
- subexprs = compiler.compile1(ast[i], scope, parent, {nval = _494_})
1497
+ subexprs = compiler.compile1(ast[i], scope, parent, {nval = _497_})
1462
1498
  utils.map(subexprs, tostring, args)
1463
1499
  end
1464
1500
  if (utils["string?"](ast[3]) and utils["valid-lua-identifier?"](ast[3])) then
@@ -1473,14 +1509,14 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1473
1509
  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.")
1474
1510
  SPECIALS.comment = function(ast, _, parent)
1475
1511
  local c = nil
1476
- local _497_
1512
+ local _500_
1477
1513
  do
1478
1514
  local tbl_17_ = {}
1479
1515
  local i_18_ = #tbl_17_
1480
1516
  for i, elt in ipairs(ast) do
1481
1517
  local val_19_ = nil
1482
1518
  if (i ~= 1) then
1483
- val_19_ = view(ast[i], {["one-line?"] = true})
1519
+ val_19_ = view(elt, {["one-line?"] = true})
1484
1520
  else
1485
1521
  val_19_ = nil
1486
1522
  end
@@ -1489,9 +1525,9 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1489
1525
  tbl_17_[i_18_] = val_19_
1490
1526
  end
1491
1527
  end
1492
- _497_ = tbl_17_
1528
+ _500_ = tbl_17_
1493
1529
  end
1494
- c = table.concat(_497_, " "):gsub("%]%]", "]\\]")
1530
+ c = table.concat(_500_, " "):gsub("%]%]", "]\\]")
1495
1531
  return compiler.emit(parent, ("--[[ " .. c .. " ]]"), ast)
1496
1532
  end
1497
1533
  doc_special("comment", {"..."}, "Comment which will be emitted in Lua output.", true)
@@ -1512,10 +1548,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1512
1548
  compiler.assert((#ast == 2), "expected one argument", ast)
1513
1549
  local f_scope = nil
1514
1550
  do
1515
- local _502_0 = compiler["make-scope"](scope)
1516
- _502_0["vararg"] = false
1517
- _502_0["hashfn"] = true
1518
- f_scope = _502_0
1551
+ local _505_0 = compiler["make-scope"](scope)
1552
+ _505_0["vararg"] = false
1553
+ _505_0["hashfn"] = true
1554
+ f_scope = _505_0
1519
1555
  end
1520
1556
  local f_chunk = {}
1521
1557
  local name = compiler.gensym(scope)
@@ -1556,17 +1592,17 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1556
1592
  return utils.expr(name, "sym")
1557
1593
  end
1558
1594
  doc_special("hashfn", {"..."}, "Function literal shorthand; args are either $... OR $1, $2, etc.")
1559
- local function maybe_short_circuit_protect(ast, i, name, _507_0)
1560
- local _508_ = _507_0
1561
- local mac = _508_["macros"]
1595
+ local function maybe_short_circuit_protect(ast, i, name, _510_0)
1596
+ local _511_ = _510_0
1597
+ local mac = _511_["macros"]
1562
1598
  local call = (utils["list?"](ast) and tostring(ast[1]))
1563
1599
  if ((("or" == name) or ("and" == name)) and (1 < i) and (mac[call] or ("set" == call) or ("tset" == call) or ("global" == call))) then
1564
- return utils.list(utils.sym("do"), ast)
1600
+ return utils.list(utils.list(utils.sym("fn"), utils.sequence(utils.varg()), ast))
1565
1601
  else
1566
1602
  return ast
1567
1603
  end
1568
1604
  end
1569
- local function arithmetic_special(name, zero_arity, unary_prefix, ast, scope, parent)
1605
+ local function operator_special(name, zero_arity, unary_prefix, ast, scope, parent)
1570
1606
  local len = #ast
1571
1607
  local operands = {}
1572
1608
  local padded_op = (" " .. name .. " ")
@@ -1579,15 +1615,15 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1579
1615
  table.insert(operands, tostring(subexprs[1]))
1580
1616
  end
1581
1617
  end
1582
- local _511_0 = #operands
1583
- if (_511_0 == 0) then
1584
- local _512_
1618
+ local _514_0 = #operands
1619
+ if (_514_0 == 0) then
1620
+ local _515_
1585
1621
  do
1586
1622
  compiler.assert(zero_arity, "Expected more than 0 arguments", ast)
1587
- _512_ = zero_arity
1623
+ _515_ = zero_arity
1588
1624
  end
1589
- return utils.expr(_512_, "literal")
1590
- elseif (_511_0 == 1) then
1625
+ return utils.expr(_515_, "literal")
1626
+ elseif (_514_0 == 1) then
1591
1627
  if utils["varg?"](ast[2]) then
1592
1628
  return compiler.assert(false, "tried to use vararg with operator", ast)
1593
1629
  elseif unary_prefix then
@@ -1596,20 +1632,20 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1596
1632
  return operands[1]
1597
1633
  end
1598
1634
  else
1599
- local _ = _511_0
1635
+ local _ = _514_0
1600
1636
  return ("(" .. table.concat(operands, padded_op) .. ")")
1601
1637
  end
1602
1638
  end
1603
1639
  local function define_arithmetic_special(name, zero_arity, unary_prefix, _3flua_name)
1604
- local _516_
1640
+ local _519_
1605
1641
  do
1606
- local _515_0 = (_3flua_name or name)
1607
- local function _517_(...)
1608
- return arithmetic_special(_515_0, zero_arity, unary_prefix, ...)
1642
+ local _518_0 = (_3flua_name or name)
1643
+ local function _520_(...)
1644
+ return operator_special(_518_0, zero_arity, unary_prefix, ...)
1609
1645
  end
1610
- _516_ = _517_
1646
+ _519_ = _520_
1611
1647
  end
1612
- SPECIALS[name] = _516_
1648
+ SPECIALS[name] = _519_
1613
1649
  return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.")
1614
1650
  end
1615
1651
  define_arithmetic_special("+", "0")
@@ -1621,10 +1657,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1621
1657
  define_arithmetic_special("/", nil, "1")
1622
1658
  define_arithmetic_special("//", nil, "1")
1623
1659
  SPECIALS["or"] = function(ast, scope, parent)
1624
- return arithmetic_special("or", "false", nil, ast, scope, parent)
1660
+ return operator_special("or", "false", nil, ast, scope, parent)
1625
1661
  end
1626
1662
  SPECIALS["and"] = function(ast, scope, parent)
1627
- return arithmetic_special("and", "true", nil, ast, scope, parent)
1663
+ return operator_special("and", "true", nil, ast, scope, parent)
1628
1664
  end
1629
1665
  doc_special("and", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.")
1630
1666
  doc_special("or", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.")
@@ -1638,13 +1674,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1638
1674
  local prefixed_lib_name = ("bit." .. lib_name)
1639
1675
  for i = 2, len do
1640
1676
  local subexprs = nil
1641
- local _518_
1677
+ local _521_
1642
1678
  if (i ~= len) then
1643
- _518_ = 1
1679
+ _521_ = 1
1644
1680
  else
1645
- _518_ = nil
1681
+ _521_ = nil
1646
1682
  end
1647
- subexprs = compiler.compile1(ast[i], scope, parent, {nval = _518_})
1683
+ subexprs = compiler.compile1(ast[i], scope, parent, {nval = _521_})
1648
1684
  utils.map(subexprs, tostring, operands)
1649
1685
  end
1650
1686
  if (#operands == 1) then
@@ -1663,10 +1699,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1663
1699
  end
1664
1700
  end
1665
1701
  local function define_bitop_special(name, zero_arity, unary_prefix, native)
1666
- local function _524_(...)
1702
+ local function _527_(...)
1667
1703
  return bitop_special(native, name, zero_arity, unary_prefix, ...)
1668
1704
  end
1669
- SPECIALS[name] = _524_
1705
+ SPECIALS[name] = _527_
1670
1706
  return nil
1671
1707
  end
1672
1708
  define_bitop_special("lshift", nil, "1", "<<")
@@ -1681,8 +1717,8 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1681
1717
  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.")
1682
1718
  SPECIALS.bnot = function(ast, scope, parent)
1683
1719
  compiler.assert((#ast == 2), "expected one argument", ast)
1684
- local _525_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1685
- local value = _525_[1]
1720
+ local _528_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1721
+ local value = _528_[1]
1686
1722
  if utils.root.options.useBitLib then
1687
1723
  return ("bit.bnot(" .. tostring(value) .. ")")
1688
1724
  else
@@ -1691,15 +1727,15 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1691
1727
  end
1692
1728
  doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
1693
1729
  doc_special("..", {"a", "b", "..."}, "String concatenation operator; works the same as Lua but accepts more arguments.")
1694
- local function native_comparator(op, _527_0, scope, parent)
1695
- local _528_ = _527_0
1696
- local _ = _528_[1]
1697
- local lhs_ast = _528_[2]
1698
- local rhs_ast = _528_[3]
1699
- local _529_ = compiler.compile1(lhs_ast, scope, parent, {nval = 1})
1700
- local lhs = _529_[1]
1701
- local _530_ = compiler.compile1(rhs_ast, scope, parent, {nval = 1})
1702
- local rhs = _530_[1]
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]
1703
1739
  return string.format("(%s %s %s)", tostring(lhs), op, tostring(rhs))
1704
1740
  end
1705
1741
  local function idempotent_comparator(op, chain_op, ast, scope, parent)
@@ -1812,21 +1848,21 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1812
1848
  end
1813
1849
  local safe_require = nil
1814
1850
  local function safe_compiler_env()
1815
- local _537_
1851
+ local _540_
1816
1852
  do
1817
- local _536_0 = rawget(_G, "utf8")
1818
- if (nil ~= _536_0) then
1819
- _537_ = utils.copy(_536_0)
1853
+ local _539_0 = rawget(_G, "utf8")
1854
+ if (nil ~= _539_0) then
1855
+ _540_ = utils.copy(_539_0)
1820
1856
  else
1821
- _537_ = _536_0
1857
+ _540_ = _539_0
1822
1858
  end
1823
1859
  end
1824
- 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 = _537_, xpcall = xpcall}
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}
1825
1861
  end
1826
1862
  local function combined_mt_pairs(env)
1827
1863
  local combined = {}
1828
- local _539_ = getmetatable(env)
1829
- local __index = _539_["__index"]
1864
+ local _542_ = getmetatable(env)
1865
+ local __index = _542_["__index"]
1830
1866
  if ("table" == type(__index)) then
1831
1867
  for k, v in pairs(__index) do
1832
1868
  combined[k] = v
@@ -1840,40 +1876,40 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1840
1876
  local function make_compiler_env(ast, scope, parent, _3fopts)
1841
1877
  local provided = nil
1842
1878
  do
1843
- local _541_0 = (_3fopts or utils.root.options)
1844
- if ((_G.type(_541_0) == "table") and (_541_0["compiler-env"] == "strict")) then
1879
+ local _544_0 = (_3fopts or utils.root.options)
1880
+ if ((_G.type(_544_0) == "table") and (_544_0["compiler-env"] == "strict")) then
1845
1881
  provided = safe_compiler_env()
1846
- elseif ((_G.type(_541_0) == "table") and (nil ~= _541_0.compilerEnv)) then
1847
- local compilerEnv = _541_0.compilerEnv
1882
+ elseif ((_G.type(_544_0) == "table") and (nil ~= _544_0.compilerEnv)) then
1883
+ local compilerEnv = _544_0.compilerEnv
1848
1884
  provided = compilerEnv
1849
- elseif ((_G.type(_541_0) == "table") and (nil ~= _541_0["compiler-env"])) then
1850
- local compiler_env = _541_0["compiler-env"]
1885
+ elseif ((_G.type(_544_0) == "table") and (nil ~= _544_0["compiler-env"])) then
1886
+ local compiler_env = _544_0["compiler-env"]
1851
1887
  provided = compiler_env
1852
1888
  else
1853
- local _ = _541_0
1854
- provided = safe_compiler_env(false)
1889
+ local _ = _544_0
1890
+ provided = safe_compiler_env()
1855
1891
  end
1856
1892
  end
1857
1893
  local env = nil
1858
- local function _543_()
1894
+ local function _546_()
1859
1895
  return compiler.scopes.macro
1860
1896
  end
1861
- local function _544_(symbol)
1897
+ local function _547_(symbol)
1862
1898
  compiler.assert(compiler.scopes.macro, "must call from macro", ast)
1863
1899
  return compiler.scopes.macro.manglings[tostring(symbol)]
1864
1900
  end
1865
- local function _545_(base)
1901
+ local function _548_(base)
1866
1902
  return utils.sym(compiler.gensym((compiler.scopes.macro or scope), base))
1867
1903
  end
1868
- local function _546_(form)
1904
+ local function _549_(form)
1869
1905
  compiler.assert(compiler.scopes.macro, "must call from macro", ast)
1870
1906
  return compiler.macroexpand(form, compiler.scopes.macro)
1871
1907
  end
1872
- env = {["assert-compile"] = compiler.assert, ["ast-source"] = utils["ast-source"], ["comment?"] = utils["comment?"], ["get-scope"] = _543_, ["in-scope?"] = _544_, ["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 = _545_, list = utils.list, macroexpand = _546_, metadata = compiler.metadata, sequence = utils.sequence, sym = utils.sym, unpack = unpack, version = utils.version, view = view}
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}
1873
1909
  env._G = env
1874
1910
  return setmetatable(env, {__index = provided, __newindex = provided, __pairs = combined_mt_pairs})
1875
1911
  end
1876
- local function _547_(...)
1912
+ local function _550_(...)
1877
1913
  local tbl_17_ = {}
1878
1914
  local i_18_ = #tbl_17_
1879
1915
  for c in string.gmatch((package.config or ""), "([^\n]+)") do
@@ -1885,10 +1921,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1885
1921
  end
1886
1922
  return tbl_17_
1887
1923
  end
1888
- local _549_ = _547_(...)
1889
- local dirsep = _549_[1]
1890
- local pathsep = _549_[2]
1891
- local pathmark = _549_[3]
1924
+ local _552_ = _550_(...)
1925
+ local dirsep = _552_[1]
1926
+ local pathsep = _552_[2]
1927
+ local pathmark = _552_[3]
1892
1928
  local pkg_config = {dirsep = (dirsep or "/"), pathmark = (pathmark or "?"), pathsep = (pathsep or ";")}
1893
1929
  local function escapepat(str)
1894
1930
  return string.gsub(str, "[^%w]", "%%%1")
@@ -1901,36 +1937,36 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1901
1937
  local function try_path(path)
1902
1938
  local filename = path:gsub(escapepat(pkg_config.pathmark), no_dot_module)
1903
1939
  local filename2 = path:gsub(escapepat(pkg_config.pathmark), modulename)
1904
- local _550_0 = (io.open(filename) or io.open(filename2))
1905
- if (nil ~= _550_0) then
1906
- local file = _550_0
1940
+ local _553_0 = (io.open(filename) or io.open(filename2))
1941
+ if (nil ~= _553_0) then
1942
+ local file = _553_0
1907
1943
  file:close()
1908
1944
  return filename
1909
1945
  else
1910
- local _ = _550_0
1946
+ local _ = _553_0
1911
1947
  return nil, ("no file '" .. filename .. "'")
1912
1948
  end
1913
1949
  end
1914
1950
  local function find_in_path(start, _3ftried_paths)
1915
- local _552_0 = fullpath:match(pattern, start)
1916
- if (nil ~= _552_0) then
1917
- local path = _552_0
1918
- local _553_0, _554_0 = try_path(path)
1919
- if (nil ~= _553_0) then
1920
- local filename = _553_0
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
1921
1957
  return filename
1922
- elseif ((_553_0 == nil) and (nil ~= _554_0)) then
1923
- local error = _554_0
1924
- local function _556_()
1925
- local _555_0 = (_3ftried_paths or {})
1926
- table.insert(_555_0, error)
1927
- return _555_0
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
1928
1964
  end
1929
- return find_in_path((start + #path + 1), _556_())
1965
+ return find_in_path((start + #path + 1), _559_())
1930
1966
  end
1931
1967
  else
1932
- local _ = _552_0
1933
- local function _558_()
1968
+ local _ = _555_0
1969
+ local function _561_()
1934
1970
  local tried_paths = table.concat((_3ftried_paths or {}), "\n\9")
1935
1971
  if (_VERSION < "Lua 5.4") then
1936
1972
  return ("\n\9" .. tried_paths)
@@ -1938,31 +1974,31 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1938
1974
  return tried_paths
1939
1975
  end
1940
1976
  end
1941
- return nil, _558_()
1977
+ return nil, _561_()
1942
1978
  end
1943
1979
  end
1944
1980
  return find_in_path(1)
1945
1981
  end
1946
1982
  local function make_searcher(_3foptions)
1947
- local function _561_(module_name)
1983
+ local function _564_(module_name)
1948
1984
  local opts = utils.copy(utils.root.options)
1949
1985
  for k, v in pairs((_3foptions or {})) do
1950
1986
  opts[k] = v
1951
1987
  end
1952
1988
  opts["module-name"] = module_name
1953
- local _562_0, _563_0 = search_module(module_name)
1954
- if (nil ~= _562_0) then
1955
- local filename = _562_0
1956
- local function _564_(...)
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_(...)
1957
1993
  return utils["fennel-module"].dofile(filename, opts, ...)
1958
1994
  end
1959
- return _564_, filename
1960
- elseif ((_562_0 == nil) and (nil ~= _563_0)) then
1961
- local error = _563_0
1995
+ return _567_, filename
1996
+ elseif ((_565_0 == nil) and (nil ~= _566_0)) then
1997
+ local error = _566_0
1962
1998
  return error
1963
1999
  end
1964
2000
  end
1965
- return _561_
2001
+ return _564_
1966
2002
  end
1967
2003
  local function dofile_with_searcher(fennel_macro_searcher, filename, opts, ...)
1968
2004
  local searchers = (package.loaders or package.searchers or {})
@@ -1974,35 +2010,35 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
1974
2010
  local function fennel_macro_searcher(module_name)
1975
2011
  local opts = nil
1976
2012
  do
1977
- local _566_0 = utils.copy(utils.root.options)
1978
- _566_0["module-name"] = module_name
1979
- _566_0["env"] = "_COMPILER"
1980
- _566_0["requireAsInclude"] = false
1981
- _566_0["allowedGlobals"] = nil
1982
- opts = _566_0
1983
- end
1984
- local _567_0 = search_module(module_name, utils["fennel-module"]["macro-path"])
1985
- if (nil ~= _567_0) then
1986
- local filename = _567_0
1987
- local _568_
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_
1988
2024
  if (opts["compiler-env"] == _G) then
1989
- local function _569_(...)
2025
+ local function _572_(...)
1990
2026
  return dofile_with_searcher(fennel_macro_searcher, filename, opts, ...)
1991
2027
  end
1992
- _568_ = _569_
2028
+ _571_ = _572_
1993
2029
  else
1994
- local function _570_(...)
2030
+ local function _573_(...)
1995
2031
  return utils["fennel-module"].dofile(filename, opts, ...)
1996
2032
  end
1997
- _568_ = _570_
2033
+ _571_ = _573_
1998
2034
  end
1999
- return _568_, filename
2035
+ return _571_, filename
2000
2036
  end
2001
2037
  end
2002
2038
  local function lua_macro_searcher(module_name)
2003
- local _573_0 = search_module(module_name, package.path)
2004
- if (nil ~= _573_0) then
2005
- local filename = _573_0
2039
+ local _576_0 = search_module(module_name, package.path)
2040
+ if (nil ~= _576_0) then
2041
+ local filename = _576_0
2006
2042
  local code = nil
2007
2043
  do
2008
2044
  local f = io.open(filename)
@@ -2014,10 +2050,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2014
2050
  return error(..., 0)
2015
2051
  end
2016
2052
  end
2017
- local function _575_()
2053
+ local function _578_()
2018
2054
  return assert(f:read("*a"))
2019
2055
  end
2020
- code = close_handlers_10_(_G.xpcall(_575_, (package.loaded.fennel or debug).traceback))
2056
+ code = close_handlers_10_(_G.xpcall(_578_, (package.loaded.fennel or debug).traceback))
2021
2057
  end
2022
2058
  local chunk = load_code(code, make_compiler_env(), filename)
2023
2059
  return chunk, filename
@@ -2025,35 +2061,38 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2025
2061
  end
2026
2062
  local macro_searchers = {fennel_macro_searcher, lua_macro_searcher}
2027
2063
  local function search_macro_module(modname, n)
2028
- local _577_0 = macro_searchers[n]
2029
- if (nil ~= _577_0) then
2030
- local f = _577_0
2031
- local _578_0, _579_0 = f(modname)
2032
- if ((nil ~= _578_0) and true) then
2033
- local loader = _578_0
2034
- local _3ffilename = _579_0
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
2035
2071
  return loader, _3ffilename
2036
2072
  else
2037
- local _ = _578_0
2073
+ local _ = _581_0
2038
2074
  return search_macro_module(modname, (n + 1))
2039
2075
  end
2040
2076
  end
2041
2077
  end
2042
2078
  local function sandbox_fennel_module(modname)
2043
2079
  if ((modname == "fennel.macros") or (package and package.loaded and ("table" == type(package.loaded[modname])) and (package.loaded[modname].metadata == compiler.metadata))) then
2044
- return {metadata = compiler.metadata, view = view}
2080
+ local function _585_(_, ...)
2081
+ return (compiler.metadata):setall(...)
2082
+ end
2083
+ return {metadata = {setall = _585_}, view = view}
2045
2084
  end
2046
2085
  end
2047
- local function _583_(modname)
2048
- local function _584_()
2086
+ local function _587_(modname)
2087
+ local function _588_()
2049
2088
  local loader, filename = search_macro_module(modname, 1)
2050
2089
  compiler.assert(loader, (modname .. " module not found."))
2051
2090
  macro_loaded[modname] = loader(modname, filename)
2052
2091
  return macro_loaded[modname]
2053
2092
  end
2054
- return (macro_loaded[modname] or sandbox_fennel_module(modname) or _584_())
2093
+ return (macro_loaded[modname] or sandbox_fennel_module(modname) or _588_())
2055
2094
  end
2056
- safe_require = _583_
2095
+ safe_require = _587_
2057
2096
  local function add_macros(macros_2a, ast, scope)
2058
2097
  compiler.assert(utils["table?"](macros_2a), "expected macros to be table", ast)
2059
2098
  for k, v in pairs(macros_2a) do
@@ -2063,10 +2102,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2063
2102
  end
2064
2103
  return nil
2065
2104
  end
2066
- local function resolve_module_name(_585_0, _scope, _parent, opts)
2067
- local _586_ = _585_0
2068
- local second = _586_[2]
2069
- local filename = _586_["filename"]
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"]
2070
2109
  local filename0 = (filename or (utils["table?"](second) and second.filename))
2071
2110
  local module_name = utils.root.options["module-name"]
2072
2111
  local modexpr = compiler.compile(second, opts)
@@ -2085,7 +2124,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2085
2124
  if ("import-macros" == tostring(ast[1])) then
2086
2125
  return macro_loaded[modname]
2087
2126
  else
2088
- return add_macros(macro_loaded[modname], ast, scope, parent)
2127
+ return add_macros(macro_loaded[modname], ast, scope)
2089
2128
  end
2090
2129
  end
2091
2130
  doc_special("require-macros", {"macro-module-name"}, "Load given module and use its contents as macro definitions in current scope.\nMacro module should return a table of macro functions with string keys.\nConsider using import-macros instead as it is more flexible.")
@@ -2123,10 +2162,10 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2123
2162
  return error(..., 0)
2124
2163
  end
2125
2164
  end
2126
- local function _592_()
2165
+ local function _596_()
2127
2166
  return assert(f:read("*all")):gsub("[\13\n]*$", "")
2128
2167
  end
2129
- src = close_handlers_10_(_G.xpcall(_592_, (package.loaded.fennel or debug).traceback))
2168
+ src = close_handlers_10_(_G.xpcall(_596_, (package.loaded.fennel or debug).traceback))
2130
2169
  end
2131
2170
  local ret = utils.expr(("require(\"" .. mod .. "\")"), "statement")
2132
2171
  local target = ("package.preload[%q]"):format(mod)
@@ -2156,12 +2195,12 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2156
2195
  compiler.assert((#ast == 2), "expected one argument", ast)
2157
2196
  local modexpr = nil
2158
2197
  do
2159
- local _595_0, _596_0 = pcall(resolve_module_name, ast, scope, parent, opts)
2160
- if ((_595_0 == true) and (nil ~= _596_0)) then
2161
- local modname = _596_0
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
2162
2201
  modexpr = utils.expr(string.format("%q", modname), "literal")
2163
2202
  else
2164
- local _ = _595_0
2203
+ local _ = _599_0
2165
2204
  modexpr = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
2166
2205
  end
2167
2206
  end
@@ -2178,13 +2217,13 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2178
2217
  utils.root.options["module-name"] = mod
2179
2218
  _ = nil
2180
2219
  local res = nil
2181
- local function _600_()
2182
- local _599_0 = search_module(mod)
2183
- if (nil ~= _599_0) then
2184
- local fennel_path = _599_0
2220
+ local function _604_()
2221
+ local _603_0 = search_module(mod)
2222
+ if (nil ~= _603_0) then
2223
+ local fennel_path = _603_0
2185
2224
  return include_path(ast, opts, fennel_path, mod, true)
2186
2225
  else
2187
- local _0 = _599_0
2226
+ local _0 = _603_0
2188
2227
  local lua_path = search_module(mod, package.path)
2189
2228
  if lua_path then
2190
2229
  return include_path(ast, opts, lua_path, mod, false)
@@ -2195,7 +2234,7 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2195
2234
  end
2196
2235
  end
2197
2236
  end
2198
- 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 _600_())
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_())
2199
2238
  utils.root.options["module-name"] = oldmod
2200
2239
  return res
2201
2240
  end
@@ -2212,9 +2251,18 @@ package.preload["fennel.specials"] = package.preload["fennel.specials"] or funct
2212
2251
  compiler.assert((#ast == 2), "Expected one table argument", ast)
2213
2252
  local macro_tbl = eval_compiler_2a(ast[2], scope, parent)
2214
2253
  compiler.assert(utils["table?"](macro_tbl), "Expected one table argument", ast)
2215
- return add_macros(macro_tbl, ast, scope, parent)
2254
+ return add_macros(macro_tbl, ast, scope)
2216
2255
  end
2217
2256
  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"]
2260
+ 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})
2264
+ end
2265
+ doc_special("tail!", {"body"}, "Assert that the body being called is in tail position.")
2218
2266
  SPECIALS["eval-compiler"] = function(ast, scope, parent)
2219
2267
  local old_first = ast[1]
2220
2268
  ast[1] = utils.sym("do")
@@ -2237,13 +2285,13 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2237
2285
  local scopes = {}
2238
2286
  local function make_scope(_3fparent)
2239
2287
  local parent = (_3fparent or scopes.global)
2240
- local _260_
2288
+ local _261_
2241
2289
  if parent then
2242
- _260_ = ((parent.depth or 0) + 1)
2290
+ _261_ = ((parent.depth or 0) + 1)
2243
2291
  else
2244
- _260_ = 0
2292
+ _261_ = 0
2245
2293
  end
2246
- return {["gensym-base"] = setmetatable({}, {__index = (parent and parent["gensym-base"])}), autogensyms = setmetatable({}, {__index = (parent and parent.autogensyms)}), depth = _260_, 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)}
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)}
2247
2295
  end
2248
2296
  local function assert_msg(ast, msg)
2249
2297
  local ast_tbl = nil
@@ -2261,10 +2309,10 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2261
2309
  end
2262
2310
  local function assert_compile(condition, msg, ast, _3ffallback_ast)
2263
2311
  if not condition then
2264
- local _263_ = (utils.root.options or {})
2265
- local error_pinpoint = _263_["error-pinpoint"]
2266
- local source = _263_["source"]
2267
- local unfriendly = _263_["unfriendly"]
2312
+ local _264_ = (utils.root.options or {})
2313
+ local error_pinpoint = _264_["error-pinpoint"]
2314
+ local source = _264_["source"]
2315
+ local unfriendly = _264_["unfriendly"]
2268
2316
  local ast0 = nil
2269
2317
  if next(utils["ast-source"](ast)) then
2270
2318
  ast0 = ast
@@ -2288,33 +2336,33 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2288
2336
  scopes.macro = scopes.global
2289
2337
  local serialize_subst = {["\11"] = "\\v", ["\12"] = "\\f", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "n"}
2290
2338
  local function serialize_string(str)
2291
- local function _268_(_241)
2339
+ local function _269_(_241)
2292
2340
  return ("\\" .. _241:byte())
2293
2341
  end
2294
- return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _268_)
2342
+ return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _269_)
2295
2343
  end
2296
2344
  local function global_mangling(str)
2297
2345
  if utils["valid-lua-identifier?"](str) then
2298
2346
  return str
2299
2347
  else
2300
- local function _269_(_241)
2348
+ local function _270_(_241)
2301
2349
  return string.format("_%02x", _241:byte())
2302
2350
  end
2303
- return ("__fnl_global__" .. str:gsub("[^%w]", _269_))
2351
+ return ("__fnl_global__" .. str:gsub("[^%w]", _270_))
2304
2352
  end
2305
2353
  end
2306
2354
  local function global_unmangling(identifier)
2307
- local _271_0 = string.match(identifier, "^__fnl_global__(.*)$")
2308
- if (nil ~= _271_0) then
2309
- local rest = _271_0
2310
- local _272_0 = nil
2311
- local function _273_(_241)
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)
2312
2360
  return string.char(tonumber(_241:sub(2), 16))
2313
2361
  end
2314
- _272_0 = string.gsub(rest, "_[%da-f][%da-f]", _273_)
2315
- return _272_0
2362
+ _273_0 = string.gsub(rest, "_[%da-f][%da-f]", _274_)
2363
+ return _273_0
2316
2364
  else
2317
- local _ = _271_0
2365
+ local _ = _272_0
2318
2366
  return identifier
2319
2367
  end
2320
2368
  end
@@ -2338,10 +2386,10 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2338
2386
  raw = str
2339
2387
  end
2340
2388
  local mangling = nil
2341
- local function _277_(_241)
2389
+ local function _278_(_241)
2342
2390
  return string.format("_%02x", _241:byte())
2343
2391
  end
2344
- mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _277_)
2392
+ mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _278_)
2345
2393
  local unique = unique_mangling(mangling, mangling, scope, 0)
2346
2394
  scope.unmanglings[unique] = (scope["gensym-base"][str] or str)
2347
2395
  do
@@ -2396,29 +2444,29 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2396
2444
  return table.concat(parts, ".")
2397
2445
  end
2398
2446
  local function autogensym(base, scope)
2399
- local _281_0 = utils["multi-sym?"](base)
2400
- if (nil ~= _281_0) then
2401
- local parts = _281_0
2447
+ local _282_0 = utils["multi-sym?"](base)
2448
+ if (nil ~= _282_0) then
2449
+ local parts = _282_0
2402
2450
  return combine_auto_gensym(parts, autogensym(parts[1], scope))
2403
2451
  else
2404
- local _ = _281_0
2405
- local function _282_()
2452
+ local _ = _282_0
2453
+ local function _283_()
2406
2454
  local mangling = gensym(scope, base:sub(1, ( - 2)), "auto")
2407
2455
  scope.autogensyms[base] = mangling
2408
2456
  return mangling
2409
2457
  end
2410
- return (scope.autogensyms[base] or _282_())
2458
+ return (scope.autogensyms[base] or _283_())
2411
2459
  end
2412
2460
  end
2413
2461
  local function check_binding_valid(symbol, scope, ast, _3fopts)
2414
2462
  local name = tostring(symbol)
2415
2463
  local macro_3f = nil
2416
2464
  do
2417
- local _284_0 = _3fopts
2418
- if (nil ~= _284_0) then
2419
- _284_0 = _284_0["macro?"]
2465
+ local _285_0 = _3fopts
2466
+ if (nil ~= _285_0) then
2467
+ _285_0 = _285_0["macro?"]
2420
2468
  end
2421
- macro_3f = _284_0
2469
+ macro_3f = _285_0
2422
2470
  end
2423
2471
  assert_compile(not name:find("&"), "invalid character: &", symbol)
2424
2472
  assert_compile(not name:find("^%."), "invalid character: .", symbol)
@@ -2516,22 +2564,22 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2516
2564
  end
2517
2565
  local function flatten_chunk(file_sourcemap, chunk, tab, depth)
2518
2566
  if chunk.leaf then
2519
- local _296_ = utils["ast-source"](chunk.ast)
2520
- local filename = _296_["filename"]
2521
- local line = _296_["line"]
2567
+ local _297_ = utils["ast-source"](chunk.ast)
2568
+ local filename = _297_["filename"]
2569
+ local line = _297_["line"]
2522
2570
  table.insert(file_sourcemap, {filename, line})
2523
2571
  return chunk.leaf
2524
2572
  else
2525
2573
  local tab0 = nil
2526
2574
  do
2527
- local _297_0 = tab
2528
- if (_297_0 == true) then
2575
+ local _298_0 = tab
2576
+ if (_298_0 == true) then
2529
2577
  tab0 = " "
2530
- elseif (_297_0 == false) then
2578
+ elseif (_298_0 == false) then
2531
2579
  tab0 = ""
2532
- elseif (_297_0 == tab) then
2580
+ elseif (_298_0 == tab) then
2533
2581
  tab0 = tab
2534
- elseif (_297_0 == nil) then
2582
+ elseif (_298_0 == nil) then
2535
2583
  tab0 = ""
2536
2584
  else
2537
2585
  tab0 = nil
@@ -2577,7 +2625,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2577
2625
  end
2578
2626
  end
2579
2627
  local function make_metadata()
2580
- local function _305_(self, tgt, _3fkey)
2628
+ local function _306_(self, tgt, _3fkey)
2581
2629
  if self[tgt] then
2582
2630
  if (nil ~= _3fkey) then
2583
2631
  return self[tgt][_3fkey]
@@ -2586,12 +2634,12 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2586
2634
  end
2587
2635
  end
2588
2636
  end
2589
- local function _308_(self, tgt, key, value)
2637
+ local function _309_(self, tgt, key, value)
2590
2638
  self[tgt] = (self[tgt] or {})
2591
2639
  self[tgt][key] = value
2592
2640
  return tgt
2593
2641
  end
2594
- local function _309_(self, tgt, ...)
2642
+ local function _310_(self, tgt, ...)
2595
2643
  local kv_len = select("#", ...)
2596
2644
  local kvs = {...}
2597
2645
  if ((kv_len % 2) ~= 0) then
@@ -2603,7 +2651,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2603
2651
  end
2604
2652
  return tgt
2605
2653
  end
2606
- return setmetatable({}, {__index = {get = _305_, set = _308_, setall = _309_}, __mode = "k"})
2654
+ return setmetatable({}, {__index = {get = _306_, set = _309_, setall = _310_}, __mode = "k"})
2607
2655
  end
2608
2656
  local function exprs1(exprs)
2609
2657
  return table.concat(utils.map(exprs, tostring), ", ")
@@ -2649,14 +2697,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2649
2697
  end
2650
2698
  if opts.target then
2651
2699
  local result = exprs1(exprs)
2652
- local function _317_()
2700
+ local function _318_()
2653
2701
  if (result == "") then
2654
2702
  return "nil"
2655
2703
  else
2656
2704
  return result
2657
2705
  end
2658
2706
  end
2659
- emit(parent, string.format("%s = %s", opts.target, _317_()), ast)
2707
+ emit(parent, string.format("%s = %s", opts.target, _318_()), ast)
2660
2708
  end
2661
2709
  if (opts.tail or opts.target) then
2662
2710
  return {returned = true}
@@ -2668,16 +2716,16 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2668
2716
  local function find_macro(ast, scope)
2669
2717
  local macro_2a = nil
2670
2718
  do
2671
- local _320_0 = utils["sym?"](ast[1])
2672
- if (_320_0 ~= nil) then
2673
- local _321_0 = tostring(_320_0)
2674
- if (_321_0 ~= nil) then
2675
- macro_2a = scope.macros[_321_0]
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]
2676
2724
  else
2677
- macro_2a = _321_0
2725
+ macro_2a = _322_0
2678
2726
  end
2679
2727
  else
2680
- macro_2a = _320_0
2728
+ macro_2a = _321_0
2681
2729
  end
2682
2730
  end
2683
2731
  local multi_sym_parts = utils["multi-sym?"](ast[1])
@@ -2689,12 +2737,12 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2689
2737
  return macro_2a
2690
2738
  end
2691
2739
  end
2692
- local function propagate_trace_info(_325_0, _index, node)
2693
- local _326_ = _325_0
2694
- local byteend = _326_["byteend"]
2695
- local bytestart = _326_["bytestart"]
2696
- local filename = _326_["filename"]
2697
- local line = _326_["line"]
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"]
2698
2746
  do
2699
2747
  local src = utils["ast-source"](node)
2700
2748
  if (("table" == type(node)) and (filename ~= src.filename)) then
@@ -2707,8 +2755,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2707
2755
  local function quote_literal_nils(index, node, parent)
2708
2756
  if (parent and utils["list?"](parent)) then
2709
2757
  for i = 1, utils.maxn(parent) do
2710
- local _328_0 = parent[i]
2711
- if (_328_0 == nil) then
2758
+ local _329_0 = parent[i]
2759
+ if (_329_0 == nil) then
2712
2760
  parent[i] = utils.sym("nil")
2713
2761
  end
2714
2762
  end
@@ -2716,10 +2764,10 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2716
2764
  return index, node, parent
2717
2765
  end
2718
2766
  local function comp(f, g)
2719
- local function _331_(...)
2767
+ local function _332_(...)
2720
2768
  return f(g(...))
2721
2769
  end
2722
- return _331_
2770
+ return _332_
2723
2771
  end
2724
2772
  local function built_in_3f(m)
2725
2773
  local found_3f = false
@@ -2730,36 +2778,36 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2730
2778
  return found_3f
2731
2779
  end
2732
2780
  local function macroexpand_2a(ast, scope, _3fonce)
2733
- local _332_0 = nil
2781
+ local _333_0 = nil
2734
2782
  if utils["list?"](ast) then
2735
- _332_0 = find_macro(ast, scope)
2783
+ _333_0 = find_macro(ast, scope)
2736
2784
  else
2737
- _332_0 = nil
2785
+ _333_0 = nil
2738
2786
  end
2739
- if (_332_0 == false) then
2787
+ if (_333_0 == false) then
2740
2788
  return ast
2741
- elseif (nil ~= _332_0) then
2742
- local macro_2a = _332_0
2789
+ elseif (nil ~= _333_0) then
2790
+ local macro_2a = _333_0
2743
2791
  local old_scope = scopes.macro
2744
2792
  local _ = nil
2745
2793
  scopes.macro = scope
2746
2794
  _ = nil
2747
2795
  local ok, transformed = nil, nil
2748
- local function _334_()
2796
+ local function _335_()
2749
2797
  return macro_2a(unpack(ast, 2))
2750
2798
  end
2751
- local function _335_()
2799
+ local function _336_()
2752
2800
  if built_in_3f(macro_2a) then
2753
2801
  return tostring
2754
2802
  else
2755
2803
  return debug.traceback
2756
2804
  end
2757
2805
  end
2758
- ok, transformed = xpcall(_334_, _335_())
2759
- local function _336_(...)
2806
+ ok, transformed = xpcall(_335_, _336_())
2807
+ local function _337_(...)
2760
2808
  return propagate_trace_info(ast, ...)
2761
2809
  end
2762
- utils["walk-tree"](transformed, comp(_336_, quote_literal_nils))
2810
+ utils["walk-tree"](transformed, comp(_337_, quote_literal_nils))
2763
2811
  scopes.macro = old_scope
2764
2812
  assert_compile(ok, transformed, ast)
2765
2813
  if (_3fonce or not transformed) then
@@ -2768,7 +2816,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2768
2816
  return macroexpand_2a(transformed, scope)
2769
2817
  end
2770
2818
  else
2771
- local _ = _332_0
2819
+ local _ = _333_0
2772
2820
  return ast
2773
2821
  end
2774
2822
  end
@@ -2800,13 +2848,13 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2800
2848
  assert_compile((utils["sym?"](ast[1]) or utils["list?"](ast[1]) or ("string" == type(ast[1]))), ("cannot call literal value " .. tostring(ast[1])), ast)
2801
2849
  for i = 2, len do
2802
2850
  local subexprs = nil
2803
- local _342_
2851
+ local _343_
2804
2852
  if (i ~= len) then
2805
- _342_ = 1
2853
+ _343_ = 1
2806
2854
  else
2807
- _342_ = nil
2855
+ _343_ = nil
2808
2856
  end
2809
- subexprs = compile1(ast[i], scope, parent, {nval = _342_})
2857
+ subexprs = compile1(ast[i], scope, parent, {nval = _343_})
2810
2858
  table.insert(fargs, subexprs[1])
2811
2859
  if (i == len) then
2812
2860
  for j = 2, #subexprs do
@@ -2844,13 +2892,13 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2844
2892
  end
2845
2893
  end
2846
2894
  local function compile_varg(ast, scope, parent, opts)
2847
- local _347_
2895
+ local _348_
2848
2896
  if scope.hashfn then
2849
- _347_ = "use $... in hashfn"
2897
+ _348_ = "use $... in hashfn"
2850
2898
  else
2851
- _347_ = "unexpected vararg"
2899
+ _348_ = "unexpected vararg"
2852
2900
  end
2853
- assert_compile(scope.vararg, _347_, ast)
2901
+ assert_compile(scope.vararg, _348_, ast)
2854
2902
  return handle_compile_opts({utils.expr("...", "varg")}, parent, opts, ast)
2855
2903
  end
2856
2904
  local function compile_sym(ast, scope, parent, opts)
@@ -2865,20 +2913,20 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2865
2913
  return handle_compile_opts({e}, parent, opts, ast)
2866
2914
  end
2867
2915
  local function serialize_number(n)
2868
- local _350_0 = string.gsub(tostring(n), ",", ".")
2869
- return _350_0
2916
+ local _351_0 = string.gsub(tostring(n), ",", ".")
2917
+ return _351_0
2870
2918
  end
2871
2919
  local function compile_scalar(ast, _scope, parent, opts)
2872
2920
  local serialize = nil
2873
2921
  do
2874
- local _351_0 = type(ast)
2875
- if (_351_0 == "nil") then
2922
+ local _352_0 = type(ast)
2923
+ if (_352_0 == "nil") then
2876
2924
  serialize = tostring
2877
- elseif (_351_0 == "boolean") then
2925
+ elseif (_352_0 == "boolean") then
2878
2926
  serialize = tostring
2879
- elseif (_351_0 == "string") then
2927
+ elseif (_352_0 == "string") then
2880
2928
  serialize = serialize_string
2881
- elseif (_351_0 == "number") then
2929
+ elseif (_352_0 == "number") then
2882
2930
  serialize = serialize_number
2883
2931
  else
2884
2932
  serialize = nil
@@ -2891,8 +2939,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2891
2939
  if ((type(k) == "string") and utils["valid-lua-identifier?"](k)) then
2892
2940
  return k
2893
2941
  else
2894
- local _353_ = compile1(k, scope, parent, {nval = 1})
2895
- local compiled = _353_[1]
2942
+ local _354_ = compile1(k, scope, parent, {nval = 1})
2943
+ local compiled = _354_[1]
2896
2944
  return ("[" .. tostring(compiled) .. "]")
2897
2945
  end
2898
2946
  end
@@ -2918,12 +2966,12 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2918
2966
  do
2919
2967
  local tbl_17_ = buffer
2920
2968
  local i_18_ = #tbl_17_
2921
- for k, v in utils.stablepairs(ast) do
2969
+ for k in utils.stablepairs(ast) do
2922
2970
  local val_19_ = nil
2923
2971
  if not keys[k] then
2924
- local _356_ = compile1(ast[k], scope, parent, {nval = 1})
2925
- local v0 = _356_[1]
2926
- val_19_ = string.format("%s = %s", escape_key(k), tostring(v0))
2972
+ local _357_ = compile1(ast[k], scope, parent, {nval = 1})
2973
+ local v = _357_[1]
2974
+ val_19_ = string.format("%s = %s", escape_key(k), tostring(v))
2927
2975
  else
2928
2976
  val_19_ = nil
2929
2977
  end
@@ -2954,12 +3002,12 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2954
3002
  end
2955
3003
  local function destructure(to, from, ast, scope, parent, opts)
2956
3004
  local opts0 = (opts or {})
2957
- local _360_ = opts0
2958
- local declaration = _360_["declaration"]
2959
- local forceglobal = _360_["forceglobal"]
2960
- local forceset = _360_["forceset"]
2961
- local isvar = _360_["isvar"]
2962
- local symtype = _360_["symtype"]
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"]
2963
3011
  local symtype0 = ("_" .. (symtype or "dst"))
2964
3012
  local setter = nil
2965
3013
  if declaration then
@@ -2975,8 +3023,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2975
3023
  return declare_local(symbol, nil, scope, symbol, new_manglings)
2976
3024
  else
2977
3025
  local parts = (utils["multi-sym?"](raw) or {raw})
2978
- local _362_ = parts
2979
- local first = _362_[1]
3026
+ local _363_ = parts
3027
+ local first = _363_[1]
2980
3028
  local meta = scope.symmeta[first]
2981
3029
  assert_compile(not raw:find(":"), "cannot set method sym", symbol)
2982
3030
  if ((#parts == 1) and not forceset) then
@@ -2997,14 +3045,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
2997
3045
  end
2998
3046
  local function compile_top_target(lvalues)
2999
3047
  local inits = nil
3000
- local function _367_(_241)
3048
+ local function _368_(_241)
3001
3049
  if scope.manglings[_241] then
3002
3050
  return _241
3003
3051
  else
3004
3052
  return "nil"
3005
3053
  end
3006
3054
  end
3007
- inits = utils.map(lvalues, _367_)
3055
+ inits = utils.map(lvalues, _368_)
3008
3056
  local init = table.concat(inits, ", ")
3009
3057
  local lvalue = table.concat(lvalues, ", ")
3010
3058
  local plast = parent[#parent]
@@ -3042,7 +3090,7 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3042
3090
  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"
3043
3091
  local function destructure_kv_rest(s, v, left, excluded_keys, destructure1)
3044
3092
  local exclude_str = nil
3045
- local _374_
3093
+ local _375_
3046
3094
  do
3047
3095
  local tbl_17_ = {}
3048
3096
  local i_18_ = #tbl_17_
@@ -3053,9 +3101,9 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3053
3101
  tbl_17_[i_18_] = val_19_
3054
3102
  end
3055
3103
  end
3056
- _374_ = tbl_17_
3104
+ _375_ = tbl_17_
3057
3105
  end
3058
- exclude_str = table.concat(_374_, ", ")
3106
+ exclude_str = table.concat(_375_, ", ")
3059
3107
  local subexpr = utils.expr(string.format(string.gsub(("(" .. unpack_fn .. ")(%s, %s, {%s})"), "\n%s*", " "), s, tostring(v), exclude_str), "expression")
3060
3108
  return destructure1(v, {subexpr}, left)
3061
3109
  end
@@ -3070,16 +3118,16 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3070
3118
  local s = gensym(scope, symtype0)
3071
3119
  local right = nil
3072
3120
  do
3073
- local _376_0 = nil
3121
+ local _377_0 = nil
3074
3122
  if top_3f then
3075
- _376_0 = exprs1(compile1(from, scope, parent))
3123
+ _377_0 = exprs1(compile1(from, scope, parent))
3076
3124
  else
3077
- _376_0 = exprs1(rightexprs)
3125
+ _377_0 = exprs1(rightexprs)
3078
3126
  end
3079
- if (_376_0 == "") then
3127
+ if (_377_0 == "") then
3080
3128
  right = "nil"
3081
- elseif (nil ~= _376_0) then
3082
- local right0 = _376_0
3129
+ elseif (nil ~= _377_0) then
3130
+ local right0 = _377_0
3083
3131
  right = right0
3084
3132
  else
3085
3133
  right = nil
@@ -3184,8 +3232,11 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3184
3232
  if opts.requireAsInclude then
3185
3233
  scope.specials.require = require_include
3186
3234
  end
3187
- local _390_ = utils.root
3188
- _390_["set-reset"](_390_)
3235
+ if opts.assertAsRepl then
3236
+ scope.macros.assert = scope.macros["assert-repl"]
3237
+ end
3238
+ local _392_ = utils.root
3239
+ _392_["set-reset"](_392_)
3189
3240
  utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts
3190
3241
  for i = 1, #asts do
3191
3242
  local exprs = compile1(asts[i], scope, chunk, {nval = (((i < #asts) and 0) or nil), tail = (i == #asts)})
@@ -3236,14 +3287,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3236
3287
  info.currentline = (remap[info.currentline][2] or -1)
3237
3288
  end
3238
3289
  if (info.what == "Lua") then
3239
- local function _395_()
3290
+ local function _397_()
3240
3291
  if info.name then
3241
3292
  return ("'" .. info.name .. "'")
3242
3293
  else
3243
3294
  return "?"
3244
3295
  end
3245
3296
  end
3246
- return string.format(" %s:%d: in function %s", info.short_src, info.currentline, _395_())
3297
+ return string.format(" %s:%d: in function %s", info.short_src, info.currentline, _397_())
3247
3298
  elseif (info.short_src == "(tail call)") then
3248
3299
  return " (tail call)"
3249
3300
  else
@@ -3267,11 +3318,11 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3267
3318
  local done_3f, level = false, (_3fstart or 2)
3268
3319
  while not done_3f do
3269
3320
  do
3270
- local _399_0 = debug.getinfo(level, "Sln")
3271
- if (_399_0 == nil) then
3321
+ local _401_0 = debug.getinfo(level, "Sln")
3322
+ if (_401_0 == nil) then
3272
3323
  done_3f = true
3273
- elseif (nil ~= _399_0) then
3274
- local info = _399_0
3324
+ elseif (nil ~= _401_0) then
3325
+ local info = _401_0
3275
3326
  table.insert(lines, traceback_frame(info))
3276
3327
  end
3277
3328
  end
@@ -3281,14 +3332,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3281
3332
  end
3282
3333
  end
3283
3334
  local function entry_transform(fk, fv)
3284
- local function _402_(k, v)
3335
+ local function _404_(k, v)
3285
3336
  if (type(k) == "number") then
3286
3337
  return k, fv(v)
3287
3338
  else
3288
3339
  return fk(k), fv(v)
3289
3340
  end
3290
3341
  end
3291
- return _402_
3342
+ return _404_
3292
3343
  end
3293
3344
  local function mixed_concat(t, joiner)
3294
3345
  local seen = {}
@@ -3333,10 +3384,10 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3333
3384
  return res[1]
3334
3385
  elseif utils["list?"](form) then
3335
3386
  local mapped = nil
3336
- local function _407_()
3387
+ local function _409_()
3337
3388
  return nil
3338
3389
  end
3339
- mapped = utils.kvmap(form, entry_transform(_407_, q))
3390
+ mapped = utils.kvmap(form, entry_transform(_409_, q))
3340
3391
  local filename = nil
3341
3392
  if form.filename then
3342
3393
  filename = string.format("%q", form.filename)
@@ -3354,13 +3405,13 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3354
3405
  else
3355
3406
  filename = "nil"
3356
3407
  end
3357
- local _410_
3408
+ local _412_
3358
3409
  if source then
3359
- _410_ = source.line
3410
+ _412_ = source.line
3360
3411
  else
3361
- _410_ = "nil"
3412
+ _412_ = "nil"
3362
3413
  end
3363
- return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _410_, "(getmetatable(sequence()))['sequence']")
3414
+ return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _412_, "(getmetatable(sequence()))['sequence']")
3364
3415
  elseif (type(form) == "table") then
3365
3416
  local mapped = utils.kvmap(form, entry_transform(q, q))
3366
3417
  local source = getmetatable(form)
@@ -3370,14 +3421,14 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
3370
3421
  else
3371
3422
  filename = "nil"
3372
3423
  end
3373
- local function _413_()
3424
+ local function _415_()
3374
3425
  if source then
3375
3426
  return source.line
3376
3427
  else
3377
3428
  return "nil"
3378
3429
  end
3379
3430
  end
3380
- return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _413_())
3431
+ return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _415_())
3381
3432
  elseif (type(form) == "string") then
3382
3433
  return serialize_string(form)
3383
3434
  else
@@ -3599,7 +3650,9 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3599
3650
  else
3600
3651
  r = getbyte({["stack-size"] = #stack})
3601
3652
  end
3602
- byteindex = (byteindex + 1)
3653
+ if r then
3654
+ byteindex = (byteindex + 1)
3655
+ end
3603
3656
  if (r and char_starter_3f(r)) then
3604
3657
  col = (col + 1)
3605
3658
  end
@@ -3609,14 +3662,14 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3609
3662
  return r
3610
3663
  end
3611
3664
  local function whitespace_3f(b)
3612
- local function _216_()
3613
- local _215_0 = options.whitespace
3614
- if (nil ~= _215_0) then
3615
- _215_0 = _215_0[b]
3665
+ local function _217_()
3666
+ local _216_0 = options.whitespace
3667
+ if (nil ~= _216_0) then
3668
+ _216_0 = _216_0[b]
3616
3669
  end
3617
- return _215_0
3670
+ return _216_0
3618
3671
  end
3619
- return ((b == 32) or ((9 <= b) and (b <= 13)) or _216_())
3672
+ return ((b == 32) or ((9 <= b) and (b <= 13)) or _217_())
3620
3673
  end
3621
3674
  local function parse_error(msg, _3fcol_adjust)
3622
3675
  local col0 = (col + (_3fcol_adjust or -1))
@@ -3636,38 +3689,38 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3636
3689
  return nil
3637
3690
  end
3638
3691
  local function dispatch(v)
3639
- local _220_0 = stack[#stack]
3640
- if (_220_0 == nil) then
3692
+ local _221_0 = stack[#stack]
3693
+ if (_221_0 == nil) then
3641
3694
  retval, done_3f, whitespace_since_dispatch = v, true, false
3642
3695
  return nil
3643
- elseif ((_G.type(_220_0) == "table") and (nil ~= _220_0.prefix)) then
3644
- local prefix = _220_0.prefix
3696
+ elseif ((_G.type(_221_0) == "table") and (nil ~= _221_0.prefix)) then
3697
+ local prefix = _221_0.prefix
3645
3698
  local source0 = nil
3646
3699
  do
3647
- local _221_0 = table.remove(stack)
3648
- set_source_fields(_221_0)
3649
- source0 = _221_0
3700
+ local _222_0 = table.remove(stack)
3701
+ set_source_fields(_222_0)
3702
+ source0 = _222_0
3650
3703
  end
3651
3704
  local list = utils.list(utils.sym(prefix, source0), v)
3652
3705
  for k, v0 in pairs(source0) do
3653
3706
  list[k] = v0
3654
3707
  end
3655
3708
  return dispatch(list)
3656
- elseif (nil ~= _220_0) then
3657
- local top = _220_0
3709
+ elseif (nil ~= _221_0) then
3710
+ local top = _221_0
3658
3711
  whitespace_since_dispatch = false
3659
3712
  return table.insert(top, v)
3660
3713
  end
3661
3714
  end
3662
3715
  local function badend()
3663
3716
  local accum = utils.map(stack, "closer")
3664
- local _223_
3717
+ local _224_
3665
3718
  if (#stack == 1) then
3666
- _223_ = ""
3719
+ _224_ = ""
3667
3720
  else
3668
- _223_ = "s"
3721
+ _224_ = "s"
3669
3722
  end
3670
- return parse_error(string.format("expected closing delimiter%s %s", _223_, string.char(unpack(accum))))
3723
+ return parse_error(string.format("expected closing delimiter%s %s", _224_, string.char(unpack(accum))))
3671
3724
  end
3672
3725
  local function skip_whitespace(b)
3673
3726
  if (b and whitespace_3f(b)) then
@@ -3681,11 +3734,11 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3681
3734
  end
3682
3735
  local function parse_comment(b, contents)
3683
3736
  if (b and (10 ~= b)) then
3684
- local function _226_()
3737
+ local function _227_()
3685
3738
  table.insert(contents, string.char(b))
3686
3739
  return contents
3687
3740
  end
3688
- return parse_comment(getb(), _226_())
3741
+ return parse_comment(getb(), _227_())
3689
3742
  elseif comments then
3690
3743
  ungetb(10)
3691
3744
  return dispatch(utils.comment(table.concat(contents), {filename = filename, line = line}))
@@ -3711,12 +3764,12 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3711
3764
  return dispatch(setmetatable(tbl, mt))
3712
3765
  end
3713
3766
  local function add_comment_at(comments0, index, node)
3714
- local _230_0 = comments0[index]
3715
- if (nil ~= _230_0) then
3716
- local existing = _230_0
3767
+ local _231_0 = comments0[index]
3768
+ if (nil ~= _231_0) then
3769
+ local existing = _231_0
3717
3770
  return table.insert(existing, node)
3718
3771
  else
3719
- local _ = _230_0
3772
+ local _ = _231_0
3720
3773
  comments0[index] = {node}
3721
3774
  return nil
3722
3775
  end
@@ -3795,16 +3848,16 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3795
3848
  end
3796
3849
  local state0 = nil
3797
3850
  do
3798
- local _241_0 = {state, b}
3799
- if ((_G.type(_241_0) == "table") and (_241_0[1] == "base") and (_241_0[2] == 92)) then
3851
+ local _242_0 = {state, b}
3852
+ if ((_G.type(_242_0) == "table") and (_242_0[1] == "base") and (_242_0[2] == 92)) then
3800
3853
  state0 = "backslash"
3801
- elseif ((_G.type(_241_0) == "table") and (_241_0[1] == "base") and (_241_0[2] == 34)) then
3854
+ elseif ((_G.type(_242_0) == "table") and (_242_0[1] == "base") and (_242_0[2] == 34)) then
3802
3855
  state0 = "done"
3803
- elseif ((_G.type(_241_0) == "table") and (_241_0[1] == "backslash") and (_241_0[2] == 10)) then
3856
+ elseif ((_G.type(_242_0) == "table") and (_242_0[1] == "backslash") and (_242_0[2] == 10)) then
3804
3857
  table.remove(chars, (#chars - 1))
3805
3858
  state0 = "base"
3806
3859
  else
3807
- local _ = _241_0
3860
+ local _ = _242_0
3808
3861
  state0 = "base"
3809
3862
  end
3810
3863
  end
@@ -3826,11 +3879,11 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3826
3879
  table.remove(stack)
3827
3880
  local raw = table.concat(chars)
3828
3881
  local formatted = raw:gsub("[\7-\13]", escape_char)
3829
- local _245_0 = (rawget(_G, "loadstring") or load)(("return " .. formatted))
3830
- if (nil ~= _245_0) then
3831
- local load_fn = _245_0
3882
+ local _246_0 = (rawget(_G, "loadstring") or load)(("return " .. formatted))
3883
+ if (nil ~= _246_0) then
3884
+ local load_fn = _246_0
3832
3885
  return dispatch(load_fn())
3833
- elseif (_245_0 == nil) then
3886
+ elseif (_246_0 == nil) then
3834
3887
  return parse_error(("Invalid string: " .. raw))
3835
3888
  end
3836
3889
  end
@@ -3863,13 +3916,13 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3863
3916
  dispatch((tonumber(number_with_stripped_underscores) or parse_error(("could not read number \"" .. rawstr .. "\""))))
3864
3917
  return true
3865
3918
  else
3866
- local _251_0 = tonumber(number_with_stripped_underscores)
3867
- if (nil ~= _251_0) then
3868
- local x = _251_0
3919
+ local _252_0 = tonumber(number_with_stripped_underscores)
3920
+ if (nil ~= _252_0) then
3921
+ local x = _252_0
3869
3922
  dispatch(x)
3870
3923
  return true
3871
3924
  else
3872
- local _ = _251_0
3925
+ local _ = _252_0
3873
3926
  return false
3874
3927
  end
3875
3928
  end
@@ -3917,7 +3970,7 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3917
3970
  elseif delims[b] then
3918
3971
  close_table(b)
3919
3972
  elseif (b == 34) then
3920
- parse_string(b)
3973
+ parse_string()
3921
3974
  elseif prefixes[b] then
3922
3975
  parse_prefix(b)
3923
3976
  elseif (sym_char_3f(b) or (b == string.byte("~"))) then
@@ -3935,11 +3988,11 @@ package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(
3935
3988
  end
3936
3989
  return parse_loop(skip_whitespace(getb()))
3937
3990
  end
3938
- local function _258_()
3991
+ local function _259_()
3939
3992
  stack, line, byteindex, col, lastb = {}, 1, 0, 0, nil
3940
3993
  return nil
3941
3994
  end
3942
- return parse_stream, _258_
3995
+ return parse_stream, _259_
3943
3996
  end
3944
3997
  local function parser(stream_or_string, _3ffilename, _3foptions)
3945
3998
  local filename = (_3ffilename or "unknown")
@@ -4572,7 +4625,7 @@ package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
4572
4625
  end
4573
4626
  package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(...)
4574
4627
  local view = require("fennel.view")
4575
- local version = "1.3.1"
4628
+ local version = "1.4.0"
4576
4629
  local function luajit_vm_3f()
4577
4630
  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"))
4578
4631
  end
@@ -5040,7 +5093,8 @@ package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(..
5040
5093
  return symbol.quoted
5041
5094
  end
5042
5095
  local function idempotent_expr_3f(x)
5043
- return ((type(x) == "string") or (type(x) == "integer") or (type(x) == "number") or (sym_3f(x) and not multi_sym_3f(x)))
5096
+ local t = type(x)
5097
+ return ((t == "string") or (t == "integer") or (t == "number") or (t == "boolean") or (sym_3f(x) and not multi_sym_3f(x)))
5044
5098
  end
5045
5099
  local function ast_source(ast)
5046
5100
  if (table_3f(ast) or sequence_3f(ast)) then
@@ -5174,14 +5228,14 @@ local function eval(str, _3foptions, ...)
5174
5228
  local env = eval_env(opts.env, opts)
5175
5229
  local lua_source = compiler["compile-string"](str, opts)
5176
5230
  local loader = nil
5177
- local function _732_(...)
5231
+ local function _745_(...)
5178
5232
  if opts.filename then
5179
5233
  return ("@" .. opts.filename)
5180
5234
  else
5181
5235
  return str
5182
5236
  end
5183
5237
  end
5184
- loader = specials["load-code"](lua_source, env, _732_(...))
5238
+ loader = specials["load-code"](lua_source, env, _745_(...))
5185
5239
  opts.filename = nil
5186
5240
  return loader(...)
5187
5241
  end
@@ -5206,10 +5260,10 @@ local function syntax()
5206
5260
  out[k] = {["binding-form?"] = utils["member?"](k, binding_3f), ["body-form?"] = utils["member?"](k, body_3f), ["define?"] = utils["member?"](k, define_3f), ["macro?"] = true}
5207
5261
  end
5208
5262
  for k, v in pairs(_G) do
5209
- local _733_0 = type(v)
5210
- if (_733_0 == "function") then
5263
+ local _746_0 = type(v)
5264
+ if (_746_0 == "function") then
5211
5265
  out[k] = {["function?"] = true, ["global?"] = true}
5212
- elseif (_733_0 == "table") then
5266
+ elseif (_746_0 == "table") then
5213
5267
  for k2, v2 in pairs(v) do
5214
5268
  if (("function" == type(v2)) and (k ~= "_G")) then
5215
5269
  out[(k .. "." .. k2)] = {["function?"] = true, ["global?"] = true}
@@ -5229,19 +5283,21 @@ utils["fennel-module"] = mod
5229
5283
  do
5230
5284
  local module_name = "fennel.macros"
5231
5285
  local _ = nil
5232
- local function _736_()
5286
+ local function _749_()
5233
5287
  return mod
5234
5288
  end
5235
- package.preload[module_name] = _736_
5289
+ package.preload[module_name] = _749_
5236
5290
  _ = nil
5237
5291
  local env = nil
5238
5292
  do
5239
- local _737_0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
5240
- _737_0["utils"] = utils
5241
- _737_0["fennel"] = mod
5242
- env = _737_0
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
5243
5297
  end
5244
- local built_ins = eval([===[;; These macros are awkward because their definition cannot rely on the any
5298
+ local built_ins = eval([===[;; fennel-ls: macro-file
5299
+
5300
+ ;; These macros are awkward because their definition cannot rely on the any
5245
5301
  ;; built-in macros, only special forms. (no when, no icollect, etc)
5246
5302
 
5247
5303
  (fn copy [t]
@@ -5364,7 +5420,7 @@ do
5364
5420
  (table.remove iter-out i)))))
5365
5421
  (assert (or (not found?) (sym? into) (table? into) (list? into))
5366
5422
  "expected table, function call, or symbol in &into clause")
5367
- (values into iter-out))
5423
+ (values into iter-out found?))
5368
5424
 
5369
5425
  (fn collect* [iter-tbl key-expr value-expr ...]
5370
5426
  "Return a table made by running an iterator and evaluating an expression that
@@ -5402,17 +5458,22 @@ do
5402
5458
  (assert (not= nil value-expr) "expected table value expression")
5403
5459
  (assert (= nil ...)
5404
5460
  "expected exactly one body expression. Wrap multiple expressions in do")
5405
- (let [(into iter) (extract-into iter-tbl)]
5406
- `(let [tbl# ,into]
5407
- ;; believe it or not, using a var here has a pretty good performance
5408
- ;; boost: https://p.hagelb.org/icollect-performance.html
5409
- (var i# (length tbl#))
5410
- (,how ,iter
5411
- (let [val# ,value-expr]
5412
- (when (not= nil val#)
5413
- (set i# (+ i# 1))
5414
- (tset tbl# i# val#))))
5415
- tbl#)))
5461
+ (let [(into iter has-into?) (extract-into iter-tbl)]
5462
+ (if has-into?
5463
+ `(let [tbl# ,into]
5464
+ (,how ,iter (table.insert tbl# ,value-expr))
5465
+ tbl#)
5466
+ ;; believe it or not, using a var here has a pretty good performance
5467
+ ;; boost: https://p.hagelb.org/icollect-performance.html
5468
+ ;; but it doesn't always work with &into clauses, so skip if that's used
5469
+ `(let [tbl# []]
5470
+ (var i# 0)
5471
+ (,how ,iter
5472
+ (let [val# ,value-expr]
5473
+ (when (not= nil val#)
5474
+ (set i# (+ i# 1))
5475
+ (tset tbl# i# val#))))
5476
+ tbl#))))
5416
5477
 
5417
5478
  (fn icollect* [iter-tbl value-expr ...]
5418
5479
  "Return a sequential table made by running an iterator and evaluating an
@@ -5546,7 +5607,7 @@ do
5546
5607
  (.. "Expected n to be an integer >= 0, got " (tostring n)))
5547
5608
  (let [let-syms (list)
5548
5609
  let-values (if (= 1 (select "#" ...)) ... `(values ,...))]
5549
- (for [i 1 n]
5610
+ (for [_ 1 n]
5550
5611
  (table.insert let-syms (gensym)))
5551
5612
  (if (= n 0) `(values)
5552
5613
  `(let [,let-syms ,let-values]
@@ -5631,6 +5692,30 @@ do
5631
5692
  (tset scope.macros import-key (. macros* macro-name))))))
5632
5693
  nil)
5633
5694
 
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."
5698
+ (fn add-locals [{: symmeta : parent} locals]
5699
+ (each [name (pairs symmeta)]
5700
+ (tset locals name (sym name)))
5701
+ (if parent (add-locals parent locals) locals))
5702
+ `(let [condition# ,condition
5703
+ message# (or ,message "assertion failed, entering repl.")]
5704
+ (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))
5710
+ locals# ,(add-locals (get-scope) [])]
5711
+ (set opts#.message (fennel#.traceback message#))
5712
+ (set opts#.env (collect [k# v# (pairs _G) &into locals#]
5713
+ (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#))))
5718
+
5634
5719
  {:-> ->*
5635
5720
  :->> ->>*
5636
5721
  :-?> -?>*
@@ -5651,14 +5736,17 @@ do
5651
5736
  :pick-values pick-values*
5652
5737
  :macro macro*
5653
5738
  :macrodebug macrodebug*
5654
- :import-macros import-macros*}
5739
+ :import-macros import-macros*
5740
+ :assert-repl assert-repl*}
5655
5741
  ]===], {env = env, filename = "src/fennel/macros.fnl", moduleName = module_name, scope = compiler.scopes.compiler, useMetadata = true})
5656
5742
  local _0 = nil
5657
5743
  for k, v in pairs(built_ins) do
5658
5744
  compiler.scopes.global.macros[k] = v
5659
5745
  end
5660
5746
  _0 = nil
5661
- local match_macros = eval([===[;;; Pattern matching
5747
+ local match_macros = eval([===[;; fennel-ls: macro-file
5748
+
5749
+ ;;; Pattern matching
5662
5750
  ;; This is separated out so we can use the "core" macros during the
5663
5751
  ;; implementation of pattern matching.
5664
5752
 
@@ -5761,7 +5849,7 @@ do
5761
5849
  (let [in-pattern (symbols-in-pattern pattern)]
5762
5850
  (if ?symbols
5763
5851
  (do
5764
- (each [name symbol (pairs ?symbols)]
5852
+ (each [name (pairs ?symbols)]
5765
5853
  (when (not (. in-pattern name))
5766
5854
  (tset ?symbols name nil)))
5767
5855
  ?symbols)
@@ -5777,7 +5865,7 @@ do
5777
5865
  (if (= 0 (length bindings))
5778
5866
  ;; no bindings special case generates simple code
5779
5867
  (let [condition
5780
- (icollect [i subpattern (ipairs pattern) &into `(or)]
5868
+ (icollect [_ subpattern (ipairs pattern) &into `(or)]
5781
5869
  (let [(subcondition subbindings) (case-pattern vals subpattern unifications opts)]
5782
5870
  subcondition))]
5783
5871
  (values
@@ -5790,7 +5878,7 @@ do
5790
5878
  bindings-mangled (icollect [_ binding (ipairs bindings)]
5791
5879
  (gensym (tostring binding)))
5792
5880
  pre-bindings `(if)]
5793
- (each [i subpattern (ipairs pattern)]
5881
+ (each [_ subpattern (ipairs pattern)]
5794
5882
  (let [(subcondition subbindings) (case-guard vals subpattern guards {} case-pattern opts)]
5795
5883
  (table.insert pre-bindings subcondition)
5796
5884
  (table.insert pre-bindings `(let ,subbindings
@@ -5956,7 +6044,7 @@ do
5956
6044
  (case-condition (list val) clauses match?)
5957
6045
  ;; protect against multiple evaluation of the value, bind against as
5958
6046
  ;; many values as we ever match against in the clauses.
5959
- (let [vals (fcollect [i 1 vals-count &into (list)] (gensym))]
6047
+ (let [vals (fcollect [_ 1 vals-count &into (list)] (gensym))]
5960
6048
  (list `let [vals val] (case-condition vals clauses match?))))))
5961
6049
 
5962
6050
  (fn case* [val ...]