computable-pandoc/dist/literate.min.lua

--[[
Literate Pandoc & Fennel Bundle:
  A Pandoc filter for literate and natural programming
Fennel:
  (C) 2016-2023 Calvin Rose and contributors
  License: MIT License https://git.sr.ht/~technomancy/fennel/tree/main/item/LICENSE
  Source: https://sr.ht/~technomancy/fennel or https://github.com/bakpakin/Fennel/issues
  Website: https://fennel-lang.org
Literate Pandoc:
  (C) 2023 perro hi@perrotuerto.blog
  License: GPLv3 https://git.cuates.net/perro/literate-pandoc/src/branch/no-masters/LICENSE.txt
  Source: https://git.cuates.net/perro/literate-pandoc
The following code is minified, check Literate Pandoc source for a readable version
]]--

package.preload["fennel.repl"]=package.preload["fennel.repl"]or
function(...)
local o=require("fennel.utils")local UesS=require("fennel.parser")
local CZ=require("fennel.compiler")local iD90MK=require("fennel.specials")
local ZuYO=require("fennel.view")local j=(table.unpack or _G.unpack)
local function t(aBv0K6z)
local function GI()if(0 <
aBv0K6z["stack-size"])then return".."else return">> "end end;io.write(GI())io.flush()local nsm9=io.read()return
(nsm9 and(nsm9 .."\n"))end;local function NChC(kO)io.write(table.concat(kO,"\9"))
return io.write("\n")end
local function Z4(FIHZeLmK,Gho7Jfcz,pi3tYW)
local function nt()local R7iAD=FIHZeLmK
if
(R7iAD=="Lua Compile")then return
("Bad code generated - likely a bug with the compiler:\n".."--- Generated Lua Start ---\n"..
pi3tYW.."--- Generated Lua End ---\n")elseif(R7iAD==
"Runtime")then return
(CZ.traceback(tostring(Gho7Jfcz),4).."\n")elseif true then local Re6P_=R7iAD;return
("%s error: %s\n"):format(FIHZeLmK,tostring(Gho7Jfcz))else return nil end end;return io.write(nt())end
local function I13Z9(VNtfqHq,wB,cmQxB1bj)local aozwWK
do local G0AXlB={}local Pv=#G0AXlB
for HW in pairs(VNtfqHq.___replLocals___)do
local cWzY=("local %s = ___replLocals___['%s']"):format(HW,HW)
if(nil~=cWzY)then Pv=(Pv+1)do end(G0AXlB)[Pv]=cWzY else end end;aozwWK=G0AXlB end;local GbnuD
do local ESO={}local DEb=#ESO
for Uzk3,LVrOH0 in pairs(cmQxB1bj.manglings)do local YLRWb;if not
cmQxB1bj.gensyms[LVrOH0]then
YLRWb=("___replLocals___['%s'] = %s"):format(LVrOH0,LVrOH0)else YLRWb=nil end;if
(nil~=YLRWb)then DEb=(DEb+1)do end(ESO)[DEb]=YLRWb else end end;GbnuD=ESO end;local CW2;if wB:find("\n")then CW2="\n"else CW2=" "end;local function vlSSXJ()
if next(aozwWK)then return(
table.concat(aozwWK," ")..CW2)else return""end end
local function k()
local u6sl,F=wB:match("^(.*)[\n ](return .*)$")
if((nil~=u6sl)and(nil~=F))then local fgPC0lUc=u6sl;local oRfi=F;return
(fgPC0lUc..CW2 ..
table.concat(GbnuD," ")..CW2 ..oRfi)elseif true then local CrAGWh=u6sl;return wB else return nil end end;return(vlSSXJ()..k())end
local function tj(d,sCjf4,y)local P=2000;local Av={}local nw={}local OVuV52eb=y:gsub(".*[%s)(]+","")local c=false
local function Td(yqTH,gcTeY,Ce)
local QzyH5hCR=(
(gcTeY==d)or(gcTeY==d.___replLocals___))local hYkd7=nw;local UKZpzj=#hYkd7;local function Fniffr()
if QzyH5hCR then return sCjf4.manglings else return gcTeY end end
for FMt_pX,ouz in o.allpairs(Fniffr())do if
(P<=#nw)then break end;local K1TX5
do local BYnM1VtZ
if QzyH5hCR then BYnM1VtZ=ouz else BYnM1VtZ=FMt_pX end
if
(
(type(FMt_pX)=="string")and
(yqTH==FMt_pX:sub(0,#yqTH))and not Av[FMt_pX]and((":"~=Ce:sub(-1))or
("function"==type(gcTeY[BYnM1VtZ]))))then Av[FMt_pX]=true;K1TX5=(Ce..FMt_pX)else K1TX5=nil end end
if(nil~=K1TX5)then UKZpzj=(UKZpzj+1)do end(hYkd7)[UKZpzj]=K1TX5 else end end;return hYkd7 end
local function KlzsEvn(djzP,b_,Q1w1zKw,a5F,Ue0N)local L99;if Ue0N then L99="^([^:]+):(.*)"else L99="^([^.]+)%.(.*)"end
local B3,PL7_Dl=djzP:match(L99)local N8V=(sCjf4.manglings[B3]or B3)
if(
type(b_[N8V])=="table")then c=true;if Ue0N then return
Td(PL7_Dl,b_[N8V],(Q1w1zKw..B3 ..":"))else
return a5F(PL7_Dl,b_[N8V],(Q1w1zKw..B3))end else return nil end end
local function eOfvjl1(b,kCfK5,TJ5Kz5NO)local Pke1T8
if TJ5Kz5NO then Pke1T8=(TJ5Kz5NO..".")else Pke1T8=""end
if(not b:find("%.")and b:find(":"))then return
KlzsEvn(b,kCfK5,Pke1T8,eOfvjl1,true)elseif not b:find("%.")then return Td(b,kCfK5,Pke1T8)else return
KlzsEvn(b,kCfK5,Pke1T8,eOfvjl1,false)end end
for HKyO,mx in
ipairs({sCjf4.specials,sCjf4.macros,(d.___replLocals___ or{}),d,d._G})do if c then break end;eOfvjl1(OVuV52eb,mx)end;return nw end;local EgG={}local function YgsJ(od)return od:match("^%s*,")end
local function aV1Rus()local iRgs
do
local KYSkMOxM9={}local m1=#KYSkMOxM9
for L,uApola2 in pairs(EgG)do
local jbLeA=("  ,%s - %s"):format(L,(
(CZ.metadata):get(uApola2,"fnl/docstring")or"undocumented"))
if(nil~=jbLeA)then m1=(m1+1)do end(KYSkMOxM9)[m1]=jbLeA else end end;iRgs=KYSkMOxM9 end;return table.concat(iRgs,"\n")end
EgG.help=function(Jy,KDEqSly,w2hBXVO)
return
w2hBXVO({("Welcome to Fennel.\nThis is the REPL where you can enter code to be evaluated.\nYou can also run these repl commands:\n\n"..

aV1Rus()..
"\n  ,exit - Leave the repl.\n\nUse ,doc something to see descriptions for individual macros and special forms.\n\nFor more information about the language, see https://fennel-lang.org/reference")})end;do end
(CZ.metadata):set(EgG.help,"fnl/docstring","Show this message.")
local function Gsx955(Q,c9MGuH,aOuScj,XXtE6Ji)
local J,oyvqbnx=pcall(iD90MK["load-code"]("return require(...)",c9MGuH),Q)
if((J==true)and(nil~=oyvqbnx))then local YdCSDvl=oyvqbnx;local Cum;package.loaded[Q]=
nil;Cum=nil;local Je_,x=pcall(require,Q)local _nbhL;if not Je_ then aOuScj({x})
_nbhL=YdCSDvl else _nbhL=x end
iD90MK["macro-loaded"][Q]=nil
if
((type(YdCSDvl)=="table")and(type(_nbhL)=="table"))then
for VJ_RQcYw,bgDxqiW in pairs(_nbhL)do YdCSDvl[VJ_RQcYw]=bgDxqiW end;for u in pairs(YdCSDvl)do
if(nil== (_nbhL)[u])then YdCSDvl[u]=nil else end end;package.loaded[Q]=YdCSDvl else end;return aOuScj({"ok"})elseif
((J==false)and(nil~=oyvqbnx))then local n_=oyvqbnx
if n_:match("loop or previous error loading module")then package.loaded[Q]=
nil;return Gsx955(Q,c9MGuH,aOuScj,XXtE6Ji)elseif
(iD90MK["macro-loaded"])[Q]then iD90MK["macro-loaded"][Q]=nil;return nil else local function a()
local xei=n_:gsub("\n.*","")return xei end;return XXtE6Ji("Runtime",a())end else return nil end end
local function _bh_k(zHHW,H,OQYu)local k9,bRREug,R_RJfoeP=pcall(zHHW)
if((k9 ==true)and(bRREug==true)and(nil~=
R_RJfoeP))then
local HuvPsV=R_RJfoeP;return OQYu(HuvPsV)elseif(k9 ==false)then
return H("Parse","Couldn't parse input.")else return nil end end
EgG.reload=function(pZ8,J12U,jzU,nrU)
local function Bi7(EW4bXR)return Gsx955(tostring(EW4bXR),pZ8,jzU,nrU)end;return _bh_k(J12U,nrU,Bi7)end;do end
(CZ.metadata):set(EgG.reload,"fnl/docstring","Reload the specified module.")
EgG.reset=function(vL_Vj_v,fi3,hbfOHU)vL_Vj_v.___replLocals___={}return hbfOHU({"ok"})end;do end
(CZ.metadata):set(EgG.reset,"fnl/docstring","Erase all repl-local scope.")
EgG.complete=function(GpItItxe,O,Equz,dsN,HzKU,Zbl8)
local function I_iWZE2I()return
Equz(tj(GpItItxe,HzKU,string.char(j(Zbl8)):gsub(",complete +",""):sub(1,
-2)))end;return _bh_k(O,dsN,I_iWZE2I)end;do end
(CZ.metadata):set(EgG.complete,"fnl/docstring","Print all possible completions for a given input symbol.")
local function w7(c5q,iXFMywMG,a,RgyIZgQm,Kz)
for hncJ5,oMSPa in pairs(iXFMywMG)do
if
(("string"==type(hncJ5))and(package~=oMSPa))then local _pJ7=type(oMSPa)
if(_pJ7 =="function")then
if
((a..hncJ5)):match(c5q)then table.insert(Kz,(a..hncJ5))else end elseif(_pJ7 =="table")then if not RgyIZgQm[oMSPa]then local sa6R;do local gH=RgyIZgQm
gH[oMSPa]=true;sa6R=gH end
w7(c5q,oMSPa,(a..hncJ5:gsub("%.","/").."."),sa6R,Kz)else end else end else end end;return Kz end
local function drEf10P(mRsiV)local PbSET=w7(mRsiV,package.loaded,"",{},{})local hpVB={}
local YWvn1scCO=#hpVB
for _u9Y,_BGX in ipairs(PbSET)do local m4bfrLhD=_BGX:gsub("^_G%.","")
if(nil~=m4bfrLhD)then YWvn1scCO=(
YWvn1scCO+1)do end(hpVB)[YWvn1scCO]=m4bfrLhD else end end;return hpVB end
EgG.apropos=function(phlgUmyq,y1uQkA,n_b,X5Kb,IjSJ6)
local function nDieWGG(P)return n_b(drEf10P(tostring(P)))end;return _bh_k(y1uQkA,X5Kb,nDieWGG)end;do end
(CZ.metadata):set(EgG.apropos,"fnl/docstring","Print all functions matching a pattern in all loaded modules.")
local function U9bX9Qj(_li)local VgksUV
do local egVOS={}local L7hI7N16=#egVOS;for d in _li:gmatch("[^%.]+")do local H0J=d
if(nil~=H0J)then L7hI7N16=(
L7hI7N16+1)do end(egVOS)[L7hI7N16]=H0J else end end;VgksUV=egVOS end;local lD8E0=package.loaded
for oLsc,qXd in ipairs(VgksUV)do if(nil==lD8E0)then break end;local cZ8mW;do
local U=qXd:gsub("%/",".")cZ8mW=U end;lD8E0=lD8E0[cZ8mW]end;return lD8E0 end
local function F3vF(MA)local RmPOf3Wl={}local ROso3G=#RmPOf3Wl
for AaZVi3,A in ipairs(drEf10P(".*"))do local X7eznY
do
local nui3w2g=U9bX9Qj(A)
if("function"==type(nui3w2g))then
local TyY1TP=(CZ.metadata):get(nui3w2g,"fnl/docstring")if(nil~=TyY1TP)then local I=TyY1TP;X7eznY=(I:match(MA)and A)else
X7eznY=nil end else X7eznY=nil end end;if(nil~=X7eznY)then ROso3G=(ROso3G+1)do end
(RmPOf3Wl)[ROso3G]=X7eznY else end end;return RmPOf3Wl end
EgG["apropos-doc"]=function(p,nWwv,U5,SSRIM2dF,TQ)local function PZd(lp2390NG)
return U5(F3vF(tostring(lp2390NG)))end;return _bh_k(nWwv,SSRIM2dF,PZd)end;do end
(CZ.metadata):set(EgG["apropos-doc"],"fnl/docstring","Print all functions that match the pattern in their docs")
local function l1YXXES(Vc,NV)
for f_qSS3,jkNMk in ipairs(drEf10P(NV))do local C4yJBj5=U9bX9Qj(jkNMk)
if
(
("function"==type(C4yJBj5))and(CZ.metadata):get(C4yJBj5,"fnl/docstring"))then Vc(iD90MK.doc(C4yJBj5,jkNMk))Vc()else end end;return nil end
EgG["apropos-show-docs"]=function(Kdb,A8f,f,bvP)local function fRpw3tSl(Wj3o4LNJ)
return l1YXXES(f,tostring(Wj3o4LNJ))end;return _bh_k(A8f,bvP,fRpw3tSl)end;do end
(CZ.metadata):set(EgG["apropos-show-docs"],"fnl/docstring","Print all documentations matching a pattern in function name")
local function QO9Kq(aq67Ya3,x,LJVh6)local pqvpad=x;local pA=pqvpad["___replLocals___"]local BU1O2_L=pqvpad;local uZM;local function ZcEsZ(pwz7,Kt_w)return(pA[Kt_w]or
BU1O2_L[Kt_w])end
uZM=setmetatable({},{__index=ZcEsZ})
local Q56iTd,no8ruIR=pcall(CZ["compile-string"],tostring(aq67Ya3),{scope=LJVh6})
if((Q56iTd==true)and(nil~=no8ruIR))then
local F=no8ruIR;return iD90MK["load-code"](F,uZM)()else return nil end end
EgG.find=function(S0,Sm,hViv5C_,jh,Pwq)
local function q16(k1oD)local P7WPKR
do local O=o["sym?"](k1oD)if(nil~=O)then
local nZ0YB=QO9Kq(O,S0,Pwq)
if(nil~=nZ0YB)then P7WPKR=debug.getinfo(nZ0YB)else P7WPKR=nZ0YB end else P7WPKR=O end end
if
(

(_G.type(P7WPKR)=="table")and
((P7WPKR).what=="Lua")and(nil~= (P7WPKR).source)and(nil~= (P7WPKR).linedefined)and(nil~= (P7WPKR).short_src))then local p6e=(P7WPKR).source;local po8N=(P7WPKR).linedefined
local a7=(P7WPKR).short_src;local U6w
do local Irt=CZ.sourcemap;if(nil~=Irt)then Irt=(Irt)[p6e]else end;if(nil~=
Irt)then Irt=(Irt)[po8N]else end;if(nil~=Irt)then
Irt=(Irt)[2]else end;U6w=Irt end;return
hViv5C_({string.format("%s:%s",a7,(U6w or po8N))})elseif(P7WPKR==nil)then
return jh("Repl","Unknown value")elseif true then local khsuDn=P7WPKR;return jh("Repl","No source info")else return nil end end;return _bh_k(Sm,jh,q16)end;do end
(CZ.metadata):set(EgG.find,"fnl/docstring","Print the filename and line number for a given function")
EgG.doc=function(iDQAM,dJEEzHLA,VhIhDh,rSwA,IuZ)
local function uQBNaZ8L(amTY)local YbIZJ=tostring(amTY)
local kVCVg=(o["multi-sym?"](YbIZJ)or{YbIZJ})local E5J5PpiD,yxld=nil,nil
local function rn0()return
(o["get-in"](IuZ.specials,kVCVg)or
o["get-in"](IuZ.macros,kVCVg)or QO9Kq(YbIZJ,iDQAM,IuZ))end;E5J5PpiD,yxld=pcall(rn0)
if E5J5PpiD then return
VhIhDh({iD90MK.doc(yxld,YbIZJ)})else return
rSwA("Repl","Could not resolve value for docstring lookup")end end;return _bh_k(dJEEzHLA,rSwA,uQBNaZ8L)end;do end
(CZ.metadata):set(EgG.doc,"fnl/docstring","Print the docstring and arglist for a function, macro, or special form.")
EgG.compile=function(Kz3Upt,FNcg,ip1Y,SNe51hiO,nbh)
local function xyD5eM3(dvQC_Q)
local w7pQl=iD90MK["current-global-names"](Kz3Upt)
local F4cjGy,D5=pcall(CZ.compile,dvQC_Q,{env=Kz3Upt,scope=nbh,allowedGlobals=w7pQl})
if F4cjGy then return ip1Y({D5})else return
SNe51hiO("Repl",("Error compiling expression: "..D5))end end;return _bh_k(FNcg,SNe51hiO,xyD5eM3)end;do end
(CZ.metadata):set(EgG.compile,"fnl/docstring","compiles the expression into lua and prints the result.")
local function eG8QRxg(K46A)
for B,DIW in ipairs((K46A or{}))do
for mcrg,zg74G in pairs(DIW)do
local C4Qpi_bm=mcrg:match("^repl%-command%-(.*)")if(nil~=C4Qpi_bm)then local nsBJr=C4Qpi_bm
EgG[nsBJr]=(EgG[nsBJr]or zg74G)else end end end;return nil end
local function YjH(y0,KkoR7,rs,l8eg,YAV,F_XBNQq,QTmbwc,Qa95Sy)local M8OIL=y0:match(",([^%s/]+)")
do local aeH=EgG[M8OIL]
if(nil~=aeH)then
local LPJB=aeH;LPJB(l8eg,KkoR7,YAV,F_XBNQq,QTmbwc,Qa95Sy)elseif true then local zwqy0k=aeH
if("exit"~=
M8OIL)then YAV({"Unknown command",M8OIL})else end else end end;if("exit"~=M8OIL)then return rs()else return nil end end
local function C(_5SaCc,ywU,vd2O)
if ywU then
if vd2O.set_readline_name then vd2O.set_readline_name("fennel")else end;vd2O.set_options({keeplines=1000,histfile=""})
_5SaCc.readChunk=function(L)
local hlKRv
if(0 <L["stack-size"])then hlKRv=".. "else hlKRv=">> "end;local hkB=vd2O.readline(hlKRv)
if hkB then return(hkB.."\n")else return nil end end;local DS=nil
_5SaCc.registerCompleter=function(zz7LdNp)DS=zz7LdNp;return nil end
local function JoHY0u(hn,JyiDC,HNfI3)if DS then vd2O.set_completion_append_character("")return
DS(hn:sub(JyiDC,HNfI3))else return{}end end;vd2O.set_complete_function(JoHY0u)return vd2O else return nil end end
local function YmhoTRx(vCj849a)return
(
("dumb"~=os.getenv("TERM"))and not vCj849a.readChunk and not vCj849a.registerCompleter)end
local function TlXcZ1(Weyl3)local SPQWFq=o.root.options;local iKW_cPpO=o.copy(Weyl3)
local YS4T=iKW_cPpO["fennelrc"]local Q_=iKW_cPpO;local Un;Q_.fennelrc=nil;Un=nil
local CvX=(YmhoTRx(Q_)and
C(Q_,pcall(require,"readline")))local Mum;if YS4T then Mum=YS4T()else Mum=nil end
local HBCtgC=iD90MK["wrap-env"]((Q_.env or
rawget(_G,"_ENV")or _G))local zV=(Q_.saveLocals~=false)
local xz7=(Q_.readChunk or t)local k0jnx9=(Q_.onValues or NChC)
local WQG=(Q_.onError or Z4)local FApYEt=(Q_.pp or ZuYO)local Tv94e,LhzI8e3Y=UesS.granulate(xz7)
local YGa={}local IYYREqB,Ghy=nil,nil
local function Cdb(V)local VL=Tv94e(V)table.insert(YGa,VL)return VL end;IYYREqB,Ghy=UesS.parser(Cdb)
Q_.env,Q_.scope=HBCtgC,CZ["make-scope"]()Q_.useMetadata=(Q_.useMetadata~=false)if
(Q_.allowedGlobals==nil)then
Q_.allowedGlobals=iD90MK["current-global-names"](HBCtgC)else end
if Q_.registerCompleter then
local function hXei3()local yiXQIkB7=HBCtgC
local ccRfT=Q_.scope;local function _(...)return tj(yiXQIkB7,ccRfT,...)end;return _ end;Q_.registerCompleter(hXei3())else end;eG8QRxg(Q_.plugins)
if zV then
local function sUj(ubOT,Q,ddrN)if Q_.scope.unmanglings[Q]then
return rawset(ubOT,Q,ddrN)else return nil end end
HBCtgC.___replLocals___=setmetatable({},{__newindex=sUj})else end
local function GelE3uPj(...)local BqFbTyTP={...}local uQS1={}HBCtgC._,HBCtgC.__=BqFbTyTP[1],BqFbTyTP;for m6qA=1,select("#",...)
do
table.insert(uQS1,FApYEt(BqFbTyTP[m6qA]))end;return k0jnx9(uQS1)end
local function dTeimz()for EpoQUjJ in pairs(YGa)do YGa[EpoQUjJ]=nil end;Ghy()
local rRzTAof,Yw,vWiYYutP=pcall(IYYREqB)local uL5iEiVf=string.char(j(YGa))
local IUBPM=(not CvX or(uL5iEiVf~="(null)"))local dP1Jx=(IUBPM and Yw)
if not rRzTAof then WQG("Parse",dP1Jx)
LhzI8e3Y()return dTeimz()elseif YgsJ(uL5iEiVf)then return
YjH(uL5iEiVf,IYYREqB,dTeimz,HBCtgC,k0jnx9,WQG,Q_.scope,YGa)else
if dP1Jx then
do local iehY,Ljtmwa1=nil,nil;local function f4uVo()local KR=Q_
KR["source"]=uL5iEiVf;return KR end
iehY,Ljtmwa1=pcall(CZ.compile,vWiYYutP,f4uVo())
if((iehY==false)and(nil~=Ljtmwa1))then
local eV4iiyUX=Ljtmwa1;LhzI8e3Y()WQG("Compile",eV4iiyUX)elseif((iehY==true)and
(nil~=Ljtmwa1))then local FjS2u2tJ=Ljtmwa1;local k_;if zV then
k_=I13Z9(HBCtgC,FjS2u2tJ,Q_.scope)else k_=FjS2u2tJ end
local s,QJHR8OCl=pcall(iD90MK["load-code"],k_,HBCtgC)
if((s==false)and(nil~=QJHR8OCl))then local tS=QJHR8OCl
LhzI8e3Y()WQG("Lua Compile",tS,k_)elseif
(true and(nil~=QJHR8OCl))then local p=s;local QCN=QJHR8OCl;local function WQyVRxD()return GelE3uPj(QCN())end
local function xW()local function TC3eID8n(...)return
WQG("Runtime",...)end;return TC3eID8n end;xpcall(WQyVRxD,xW())else end else end end;o.root.options=SPQWFq;return dTeimz()else return nil end end end;dTeimz()
if CvX then return CvX.save_history()else return nil end end;return TlXcZ1 end
package.preload["fennel.specials"]=package.preload["fennel.specials"]or
function(...)
local Jzh=require("fennel.utils")local fNDs=require("fennel.view")
local S=require("fennel.parser")local AHA=require("fennel.compiler")
local cI0i=(table.unpack or _G.unpack)local O11E=AHA.scopes.global.specials
local function LhQHR(qhPco)local function Id(uoOlhf,e)
if Jzh["string?"](e)then return
qhPco[AHA["global-unmangling"](e)]else return qhPco[e]end end
local function WL(uTc6g,Zn4fIs,Ppx)
if
Jzh["string?"](Zn4fIs)then
qhPco[AHA["global-unmangling"](Zn4fIs)]=Ppx;return nil else qhPco[Zn4fIs]=Ppx;return nil end end
local function w()
local function kAU(LL82TJ5q,wdM5AGuw)local _Y;if Jzh["string?"](LL82TJ5q)then
_Y=AHA["global-unmangling"](LL82TJ5q)else _Y=LL82TJ5q end;return _Y,wdM5AGuw end;return next,Jzh.kvmap(qhPco,kAU),nil end
return setmetatable({},{__index=Id,__newindex=WL,__pairs=w})end
local function V(AUwG6)local x5_xK
do local KOHj1O=getmetatable(AUwG6)
if
(
(_G.type(KOHj1O)=="table")and(nil~= (KOHj1O).__pairs))then local TAF_rrY=(KOHj1O).__pairs;local zYUy={}for Dw5,yRGXM in TAF_rrY(AUwG6)do local L,qqjD4e=Dw5,yRGXM
if(
(L~=nil)and(qqjD4e~=nil))then zYUy[L]=qqjD4e else end end;x5_xK=zYUy elseif
(KOHj1O==nil)then x5_xK=(AUwG6 or _G)else x5_xK=nil end end;return
(x5_xK and Jzh.kvmap(x5_xK,AHA["global-unmangling"]))end
local function WpQBPz(dhfvbed,qoLSvP,lUV1Y)
local dg5N=(qoLSvP or rawget(_G,"_ENV")or _G)local wwx,Pohtng=rawget(_G,"setfenv"),rawget(_G,"loadstring")
if(
(nil~=wwx)and(nil~=Pohtng))then local t=wwx;local _H=Pohtng
local hLbS=assert(_H(dhfvbed,lUV1Y))local qTkqZM=hLbS;t(qTkqZM,dg5N)return qTkqZM elseif true then local JalgRqs=wwx;return
assert(load(dhfvbed,lUV1Y,"t",dg5N))else return nil end end
local function YMl(_qwQtun2,HJ)
if not _qwQtun2 then return(HJ.." not found")else
local lEZKOn=((
(AHA.metadata):get(_qwQtun2,"fnl/docstring")or"#<undocumented>")):gsub("\n$",""):gsub("\n","\n  ")local BhRI=getmetatable(_qwQtun2)
if
(
(type(_qwQtun2)=="function")or((type(BhRI)=="table")and
(type(BhRI.__call)=="function")))then
local Hnykp=table.concat(((AHA.metadata):get(_qwQtun2,"fnl/arglist")or
{"#<unknown-arguments>"})," ")local KVZGVS;if(0 <#Hnykp)then KVZGVS=" "else KVZGVS=""end;return
string.format("(%s%s%s)\n  %s",HJ,KVZGVS,Hnykp,lEZKOn)else
return string.format("%s\n  %s",HJ,lEZKOn)end end end
local function qh0m(W,l,YtJ3Vld,gesxk)
AHA.metadata[O11E[W]]={["fnl/arglist"]=l,["fnl/docstring"]=YtJ3Vld,["fnl/body-form?"]=gesxk}return nil end
local function T1pL(RPBF,MA,cQiY,mi0Su5)local RSbaegr=(mi0Su5 or 2)local D_XnV=#RPBF
local T5b=AHA["make-scope"](MA)
for Pzvq9=RSbaegr,D_XnV do AHA.compile1(RPBF[Pzvq9],T5b,cQiY,{nval=0})end;return nil end
O11E["do"]=function(xWDqizI,lLfybj,kfv75hSt,L,QtUzJA8W,vyg,i,iu)local AQAZ71dv=(QtUzJA8W or 2)
local hnm7wW0=(i or AHA["make-scope"](lLfybj))local UM52=(vyg or{})local D_=#xWDqizI;local rVtCZOT={returned=true}
local function zXaijdUvQ(RZ7Pv3B4,utllnvh,Cy)
if
(D_<AQAZ71dv)then
AHA.compile1(nil,hnm7wW0,UM52,{tail=utllnvh,target=RZ7Pv3B4})else
for Sc=AQAZ71dv,D_ do
local Ilv={nval=(((Sc~=D_)and 0)or L.nval),tail=(
((Sc==D_)and utllnvh)or nil),target=(((Sc==D_)and RZ7Pv3B4)or nil)}local HiEsql=Jzh["propagate-options"](L,Ilv)
local IB3=AHA.compile1(xWDqizI[Sc],hnm7wW0,UM52,Ilv)if(Sc~=D_)then
AHA["keep-side-effects"](IB3,kfv75hSt,nil,xWDqizI[Sc])else end end end;AHA.emit(kfv75hSt,UM52,xWDqizI)
AHA.emit(kfv75hSt,"end",xWDqizI)Jzh.hook("do",xWDqizI,hnm7wW0)return(Cy or rVtCZOT)end
if(L.target or(L.nval==0)or L.tail)then
AHA.emit(kfv75hSt,"do",xWDqizI)return zXaijdUvQ(L.target,L.tail)elseif L.nval then local GO9cd={}for puiZj=1,L.nval do
local cRj7Bs6=(
(iu and(iu)[puiZj])or AHA.gensym(lLfybj))do end(GO9cd)[puiZj]=cRj7Bs6
rVtCZOT[puiZj]=Jzh.expr(cRj7Bs6,"sym")end
local shT=table.concat(GO9cd,", ")
AHA.emit(kfv75hSt,string.format("local %s",shT),xWDqizI)AHA.emit(kfv75hSt,"do",xWDqizI)
return zXaijdUvQ(shT,L.tail)else local LRdW=AHA.gensym(lLfybj)local Nao8
if lLfybj.vararg then Nao8="..."else Nao8=""end
AHA.emit(kfv75hSt,string.format("local function %s(%s)",LRdW,Nao8),xWDqizI)return
zXaijdUvQ(nil,true,Jzh.expr((LRdW.."("..Nao8 ..")"),"statement"))end end
qh0m("do",{"..."},"Evaluate multiple forms; return last value.",true)
O11E.values=function(wx,KPk,vHVswxQg)local O8sHnXSb=#wx;local vRuSKT={}
for yNM=2,O8sHnXSb do
local uQKBCL=AHA.compile1(wx[yNM],KPk,vHVswxQg,{nval=((yNM~=O8sHnXSb)and 1)})table.insert(vRuSKT,uQKBCL[1])if(yNM==O8sHnXSb)then
for U=2,#uQKBCL
do table.insert(vRuSKT,uQKBCL[U])end else end end;return vRuSKT end
qh0m("values",{"..."},"Return multiple values from a function. Must be in tail position.")
local function x(i1U2ZgP1,eaa)for qt7CqAhB,Sut in pairs(eaa)do local uXZKm=i1U2ZgP1;table.insert(uXZKm,qt7CqAhB)
table.insert(uXZKm,Sut)end;return i1U2ZgP1 end
local function SM(RrqZ)local j2vFDP=true
if Jzh["list?"](RrqZ)then j2vFDP=false elseif Jzh["table?"](RrqZ)then
local ULRN_=x({},RrqZ)
for SO4d,PEj in ipairs(ULRN_)do if not j2vFDP then break end;if Jzh["list?"](PEj)then j2vFDP=false elseif
Jzh["table?"](PEj)then x(ULRN_,PEj)else end end else end;return j2vFDP end
local function mz725oTF(ghM3GY)local LA={nval=1,tail=false}local XsfY=AHA["make-scope"]()local PHZn={}
local gPKGb=AHA.compile1(ghM3GY,XsfY,PHZn,LA)local wp_V=gPKGb[1]local lZIs5NY=wp_V[1]return lZIs5NY end
local function a(uYH7X,VwUT43myq,ZB)
local x87MJd0={["escape-newlines?"]=true,["line-length"]=math.huge,["one-line?"]=true}
AHA.assert((type(VwUT43myq)=="string"),("expected string keys in metadata table, got: %s"):format(fNDs(VwUT43myq,x87MJd0)))
AHA.assert(SM(ZB),("expected literal value in metadata table, got: %s %s"):format(fNDs(VwUT43myq,x87MJd0),fNDs(ZB,x87MJd0)))local NOf=uYH7X;table.insert(NOf,fNDs(VwUT43myq))local function sksgyG()
if("string"==
type(ZB))then return fNDs(ZB,x87MJd0)else return mz725oTF(ZB)end end
table.insert(NOf,sksgyG())return NOf end
local function rx(WO8me2,S1)
local ejeeWF={["one-line?"]=true,["escape-newlines?"]=true,["line-length"]=math.huge}local SUqZnH=WO8me2;table.insert(SUqZnH,"\"fnl/arglist\"")local function gKJj(sidQs)return
fNDs(fNDs(sidQs,ejeeWF))end
table.insert(SUqZnH,("{"..
table.concat(Jzh.map(S1,gKJj),", ").."}"))return SUqZnH end
local function t4X(GYH_v,KEOG,toEWCo)
if Jzh.root.options.useMetadata then local Xy2rqD={}for Tk,PyoiZ34 in Jzh.stablepairs(GYH_v)do
if
(Tk=="fnl/arglist")then rx(Xy2rqD,PyoiZ34)else a(Xy2rqD,Tk,PyoiZ34)end end
local f1g01=("require(\"%s\").metadata"):format((
Jzh.root.options.moduleName or"fennel"))return
AHA.emit(KEOG,("pcall(function() %s:setall(%s, %s) end)"):format(f1g01,toEWCo,table.concat(Xy2rqD,", ")))else return nil end end
local function Bt8c_K(Ri,h8Kdnxlz,uULb49,Yw)
if(uULb49 and(uULb49[1]~="nil"))then local Ny1;if not Yw then
Ny1=AHA["declare-local"](uULb49,{},h8Kdnxlz,Ri)else
Ny1=(AHA["symbol-to-expression"](uULb49,h8Kdnxlz))[1]end
return Ny1,not Yw,3 else return nil,true,2 end end
local function Ytae(_dvf1W51,Ve,WF,laWJ0,yavQNo,J8QVv4,fC,_HE3xI6g,KY)
for _IhpETSL=(yavQNo+1),#_dvf1W51 do
AHA.compile1(_dvf1W51[_IhpETSL],Ve,WF,{nval=((
(_IhpETSL~=#_dvf1W51)and 0)or nil),tail=(_IhpETSL==
#_dvf1W51)})end;local _I4E0r7
if fC then _I4E0r7="local function %s(%s)"else _I4E0r7="%s = function(%s)"end
AHA.emit(laWJ0,string.format(_I4E0r7,J8QVv4,table.concat(_HE3xI6g,", ")),_dvf1W51)AHA.emit(laWJ0,WF,_dvf1W51)
AHA.emit(laWJ0,"end",_dvf1W51)t4X(KY,laWJ0,J8QVv4)Jzh.hook("fn",_dvf1W51,Ve)return
Jzh.expr(J8QVv4,"sym")end
local function lce(LSCe,p5,B8Suwl,XARyK,ODqlVU,n,koXJCN4L,de)local QoqS9_YO=AHA.gensym(de)return
Ytae(LSCe,p5,B8Suwl,XARyK,ODqlVU,QoqS9_YO,true,n,koXJCN4L)end
local function oKL2U4fJ(OdYG6Ap)local YpFQMbmN=#OdYG6Ap;local t3cE9NzG,Sci787H,QNz8ZORV=pairs(OdYG6Ap)
local function KUeDP()if(YpFQMbmN==0)then return
QNz8ZORV else return YpFQMbmN end end
return(nil~=t3cE9NzG(Sci787H,KUeDP()))end
local function QcKEbkF(aH,H0vWTA,Zt4vZRsD)local Q={["fnl/arglist"]=H0vWTA}local Vl=(Zt4vZRsD+1)
local Z4=aH[Vl]
if(Jzh["string?"](Z4)and(Vl<#aH))then local mOmsyRAV
do
local SGToljD=Q;SGToljD["fnl/docstring"]=Z4;mOmsyRAV=SGToljD end;return mOmsyRAV,Vl elseif
(Jzh["table?"](Z4)and(Vl<#aH)and oKL2U4fJ(Z4))then local nDI;do local QO=Q
for hN,yU in pairs(Z4)do local umHu,Zk=hN,yU;if
((umHu~=nil)and(Zk~=nil))then QO[umHu]=Zk else end end;nDI=QO end
return nDI,Vl else return Q,Zt4vZRsD end end
O11E.fn=function(foUvUPWx,x_NZCXZ,lbkcp)local Kz5L;do local PCPu=AHA["make-scope"](x_NZCXZ)do end
(PCPu)["vararg"]=false;Kz5L=PCPu end;local WKXgQ={}
local vQicu=Jzh["sym?"](foUvUPWx[2])
local wWqc1=(vQicu and Jzh["multi-sym?"](vQicu[1]))local L,O,UNE1=Bt8c_K(foUvUPWx,x_NZCXZ,vQicu,wWqc1)
local C=AHA.assert(Jzh["table?"](foUvUPWx[UNE1]),"expected parameters table",foUvUPWx)
AHA.assert((not wWqc1 or not wWqc1["multi-sym-method-call"]),(
"unexpected multi symbol "..tostring(L)),vQicu)
local function FAcgh(_LmNV)local mi2=Jzh.sym(AHA.gensym(x_NZCXZ))
local wtZMPRlR=AHA["declare-local"](mi2,{},Kz5L,foUvUPWx)
AHA.destructure(_LmNV,mi2,foUvUPWx,Kz5L,WKXgQ,{declaration=true,nomulti=true,symtype="arg"})return wtZMPRlR end
local function t9nNfj(epbNPkw)
AHA.assert((epbNPkw== (#C-1)),"expected rest argument before last parameter",C[(epbNPkw+1)],C)Kz5L.vararg=true
AHA.destructure(C[#C],{Jzh.varg()},foUvUPWx,Kz5L,WKXgQ,{declaration=true,nomulti=true,symtype="arg"})return"..."end
local function XRZLOso(LW,sFtYbPYh9)
if Kz5L.vararg then return nil elseif Jzh["varg?"](LW)then
AHA.assert((LW==C[#C]),"expected vararg as last parameter",foUvUPWx)Kz5L.vararg=true;return"..."elseif(Jzh.sym("&")==LW)then
return t9nNfj(sFtYbPYh9)elseif
(Jzh["sym?"](LW)and(tostring(LW)~="nil")and not
Jzh["multi-sym?"](tostring(LW)))then return AHA["declare-local"](LW,{},Kz5L,foUvUPWx)elseif
Jzh["table?"](LW)then return FAcgh(LW)else return
AHA.assert(false,("expected symbol for function parameter: %s"):format(tostring(LW)),foUvUPWx[UNE1])end end;local ktQi8H
do local qZ4gSk={}local v9OIHvZ=#qZ4gSk;for Au,z8 in ipairs(C)do local rfFHu6=XRZLOso(z8,Au)
if
(nil~=rfFHu6)then v9OIHvZ=(v9OIHvZ+1)do end(qZ4gSk)[v9OIHvZ]=rfFHu6 else end end
ktQi8H=qZ4gSk end;local XtwfE,tdtJB=QcKEbkF(foUvUPWx,C,UNE1)
if L then return
Ytae(foUvUPWx,Kz5L,WKXgQ,lbkcp,tdtJB,L,O,ktQi8H,XtwfE)else return
lce(foUvUPWx,Kz5L,WKXgQ,lbkcp,tdtJB,ktQi8H,XtwfE,x_NZCXZ)end end
qh0m("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)
O11E.lua=function(rVKBG,YYZ,D)
AHA.assert(((#rVKBG==2)or(#rVKBG==3)),"expected 1 or 2 arguments",rVKBG)local vy
do local peLm=Jzh["sym?"](rVKBG[2])if(nil~=peLm)then
vy=tostring(peLm)else vy=peLm end end;if("nil"~=vy)then
table.insert(D,{ast=rVKBG,leaf=tostring(rVKBG[2])})else end;local kt8sWFAZ;do
local ljkJc4X=Jzh["sym?"](rVKBG[3])
if(nil~=ljkJc4X)then kt8sWFAZ=tostring(ljkJc4X)else kt8sWFAZ=ljkJc4X end end;if
("nil"~=kt8sWFAZ)then return tostring(rVKBG[3])else return nil end end
local function VtWtn6ES(dKPTqbD,fWMAuVe_,RsGV8)
AHA.assert((1 <#dKPTqbD),"expected table argument",dKPTqbD)local dwy=#dKPTqbD
local dsskdo1=AHA.compile1(dKPTqbD[2],fWMAuVe_,RsGV8,{nval=1})local RwcXVp9t=dsskdo1[1]
if(dwy==2)then return tostring(RwcXVp9t)else local Wj9plOE={}
for Z=3,dwy do
local F_=dKPTqbD[Z]
if
(Jzh["string?"](F_)and Jzh["valid-lua-identifier?"](F_))then table.insert(Wj9plOE,("."..F_))else
local Ce=AHA.compile1(F_,fWMAuVe_,RsGV8,{nval=1})local gjI84l9=Ce[1]
table.insert(Wj9plOE,("["..tostring(gjI84l9).."]"))end end
if(tostring(RwcXVp9t):find("[{\"0-9]")or
("nil"==tostring(RwcXVp9t)))then return
("("..
tostring(RwcXVp9t)..")"..table.concat(Wj9plOE))else return
(tostring(RwcXVp9t)..table.concat(Wj9plOE))end end end;O11E["."]=VtWtn6ES
qh0m(".",{"tbl","key1","..."},"Look up key1 in tbl table. If more args are provided, do a nested lookup.")
O11E.global=function(ZVokSV,VH,hyn)
AHA.assert((#ZVokSV==3),"expected name and value",ZVokSV)
AHA.destructure(ZVokSV[2],ZVokSV[3],ZVokSV,VH,hyn,{forceglobal=true,nomulti=true,symtype="global"})return nil end
qh0m("global",{"name","val"},"Set name as a global with val.")
O11E.set=function(n5IarGf,EMbzMM6,Vd5F9a)
AHA.assert((#n5IarGf==3),"expected name and value",n5IarGf)
AHA.destructure(n5IarGf[2],n5IarGf[3],n5IarGf,EMbzMM6,Vd5F9a,{noundef=true,symtype="set"})return nil end
qh0m("set",{"name","val"},"Set a local variable to a new value. Only works on locals using var.")
local function QkuEC(b,OFgu,bi28)AHA.assert((#b==3),"expected name and value",b)
AHA.destructure(b[2],b[3],b,OFgu,bi28,{forceset=true,symtype="set"})return nil end;O11E["set-forcibly!"]=QkuEC
local function Dg3M(bWN,ppTbLuHA,H7SAeS)
AHA.assert((#bWN==3),"expected name and value",bWN)
AHA.destructure(bWN[2],bWN[3],bWN,ppTbLuHA,H7SAeS,{declaration=true,nomulti=true,symtype="local"})return nil end;O11E["local"]=Dg3M
qh0m("local",{"name","val"},"Introduce new top-level immutable local.")
O11E.var=function(tjH7RRxU,IS,NAeI)
AHA.assert((#tjH7RRxU==3),"expected name and value",tjH7RRxU)
AHA.destructure(tjH7RRxU[2],tjH7RRxU[3],tjH7RRxU,IS,NAeI,{declaration=true,isvar=true,nomulti=true,symtype="var"})return nil end
qh0m("var",{"name","val"},"Introduce new mutable local.")
local function u(M9Fz82D)local sajQQWk
do local NNXy={}local geeYJ5=#NNXy
for sdL in pairs(M9Fz82D)do local qjIDvx3o;if
("number"~=type(sdL))then qjIDvx3o=sdL else qjIDvx3o=nil end
if(nil~=qjIDvx3o)then geeYJ5=(
geeYJ5+1)do end(NNXy)[geeYJ5]=qjIDvx3o else end end;sajQQWk=NNXy end;return(sajQQWk)[1]end
O11E.let=function(Dvm,f7etxLRX,SjSDwyLj,L)local MzKuRgHx=Dvm[2]local VtXX={}
AHA.assert((Jzh["table?"](MzKuRgHx)and
not u(MzKuRgHx)),"expected binding sequence",MzKuRgHx)
AHA.assert(((#MzKuRgHx%2)==0),"expected even number of name/value bindings",Dvm[2])
AHA.assert((3 <=#Dvm),"expected body expression",Dvm[1])for SpYtj4r=1,(L.nval or 0)do
table.insert(VtXX,AHA.gensym(f7etxLRX))end
local JDBN=AHA["make-scope"](f7etxLRX)local OQUWt={}for ywFen=1,#MzKuRgHx,2 do
AHA.destructure(MzKuRgHx[ywFen],MzKuRgHx[(ywFen+1)],Dvm,JDBN,OQUWt,{declaration=true,nomulti=true,symtype="let"})end;return
O11E["do"](Dvm,f7etxLRX,SjSDwyLj,L,3,OQUWt,JDBN,VtXX)end
qh0m("let",{"[name1 val1 ... nameN valN]","..."},"Introduces a new scope in which a given set of local bindings are used.",true)local function Pr0Efo(BA31JLSR)
if("table"==type(BA31JLSR))then
return Pr0Efo((BA31JLSR.leaf or
BA31JLSR[#BA31JLSR]))else return(BA31JLSR or"")end end
local function yv(uhTac3rOu,iifM1a)local function i()
local BdD0A=Pr0Efo(iifM1a)
if(nil~=BdD0A)then local Z2=BdD0A;return Z2:match("%)$")else return nil end end;return(
uhTac3rOu:match("^{")or i())end
O11E.tset=function(NZj,dz,Nvs7)
AHA.assert((3 <#NZj),"expected table, key, and value arguments",NZj)
local k=(AHA.compile1(NZj[2],dz,Nvs7,{nval=1}))[1]local SUy4={}for W=3,(#NZj-1)do
local Oc=AHA.compile1(NZj[W],dz,Nvs7,{nval=1})local bK9fBMf=Oc[1]
table.insert(SUy4,tostring(bK9fBMf))end
local DQu5s=(AHA.compile1(NZj[#NZj],dz,Nvs7,{nval=1}))[1]local kn=tostring(k)local TmhRKP55;if yv(kn,Nvs7)then TmhRKP55="do end (%s)[%s] = %s"else
TmhRKP55="%s[%s] = %s"end;return
AHA.emit(Nvs7,TmhRKP55:format(kn,table.concat(SUy4,"]["),tostring(DQu5s)),NZj)end
qh0m("tset",{"tbl","key1","...","keyN","val"},"Set the value of a table field. Can take additional keys to set\nnested values, but all parents must contain an existing table.")
local function jRkGV(N,zuqP56)
if not
(zuqP56.tail or zuqP56.target or zuqP56.nval)then return"iife",true,nil elseif(
zuqP56.nval and(zuqP56.nval~=0)and not zuqP56.target)then
local yioYK={}local K0T={}for rgUL=1,zuqP56.nval do local VEQy4L=AHA.gensym(N)do end(yioYK)[rgUL]=VEQy4L
K0T[rgUL]=Jzh.expr(VEQy4L,"sym")end;return"target",zuqP56.tail,
table.concat(yioYK,", "),K0T else return"none",zuqP56.tail,zuqP56.target end end
local function BA8Q(Z,Cf8U8i,zr,g0z)
AHA.assert((2 <#Z),"expected condition and body",Z)local c=AHA["make-scope"](Cf8U8i)local ax={}
local aT,Ot,Fuo_RrjU,dhy4az=jRkGV(Cf8U8i,g0z)local eDibIv={nval=g0z.nval,tail=Ot,target=Fuo_RrjU}
local function FdmMeSe(JkxKEV)local cMWL9={}
local KR03kcA=AHA["make-scope"](c)
AHA["keep-side-effects"](AHA.compile1(Z[JkxKEV],KR03kcA,cMWL9,eDibIv),cMWL9,nil,Z[JkxKEV])return{chunk=cMWL9,scope=KR03kcA}end
if(1 == (#Z%2))then table.insert(Z,Jzh.sym("nil"))else end
for gyFZNQR4=2,(#Z-1),2 do local MMS={}
local j0DhME8=AHA.compile1(Z[gyFZNQR4],c,MMS,{nval=1})local c4k3j=j0DhME8[1]local T1NA=FdmMeSe((gyFZNQR4+1))
T1NA.cond=c4k3j;T1NA.condchunk=MMS;T1NA.nested=((gyFZNQR4 ~=2)and
(next(MMS,nil)==nil))
table.insert(ax,T1NA)end;local Ap27=FdmMeSe(#Z)local bGBwaz=AHA.gensym(Cf8U8i)local aC_9FxPv={}
local Xo64In4=aC_9FxPv
for iMog_q_v=1,#ax do local SINHwL9=ax[iMog_q_v]local JWBR;if not SINHwL9.nested then JWBR="if %s then"else
JWBR="elseif %s then"end
local nAmOHr=tostring(SINHwL9.cond)local rB=JWBR:format(nAmOHr)if SINHwL9.nested then
AHA.emit(Xo64In4,SINHwL9.condchunk,Z)else
for yFwmVrC,eV0V8e in ipairs(SINHwL9.condchunk)do AHA.emit(Xo64In4,eV0V8e,Z)end end
AHA.emit(Xo64In4,rB,Z)AHA.emit(Xo64In4,SINHwL9.chunk,Z)
if(iMog_q_v==#ax)then
AHA.emit(Xo64In4,"else",Z)AHA.emit(Xo64In4,Ap27.chunk,Z)
AHA.emit(Xo64In4,"end",Z)elseif not(ax[(iMog_q_v+1)]).nested then local RQ7Fx={}
AHA.emit(Xo64In4,"else",Z)AHA.emit(Xo64In4,RQ7Fx,Z)AHA.emit(Xo64In4,"end",Z)
Xo64In4=RQ7Fx else end end
if(aT=="iife")then
local YT=((Cf8U8i.vararg and"...")or"")
AHA.emit(zr,("local function %s(%s)"):format(tostring(bGBwaz),YT),Z)AHA.emit(zr,aC_9FxPv,Z)AHA.emit(zr,"end",Z)return
Jzh.expr(("%s(%s)"):format(tostring(bGBwaz),YT),"statement")elseif(aT=="none")then for VD=1,#aC_9FxPv do
AHA.emit(zr,aC_9FxPv[VD],Z)end;return{returned=true}else
AHA.emit(zr,("local %s"):format(Fuo_RrjU),Z)
for Dhsrul35=1,#aC_9FxPv do AHA.emit(zr,aC_9FxPv[Dhsrul35],Z)end;return dhy4az end end;O11E["if"]=BA8Q
qh0m("if",{"cond1","body1","...","condN","bodyN"},"Conditional form.\nTakes any number of condition/body pairs and evaluates the first body where\nthe condition evaluates to truthy. Similar to cond in other lisps.")
local function Qat(mExbKwNw)local lH=mExbKwNw[(#mExbKwNw-1)]
if
((Jzh["sym?"](lH)and(
tostring(lH)=="&until"))or(
"until"==lH))then table.remove(mExbKwNw,(#mExbKwNw-1))return
table.remove(mExbKwNw)else return nil end end
local function StR7(CnKBj0I,LeYS7ST,n03R5Kx)
if CnKBj0I then
local hPPA=AHA.compile1(CnKBj0I,LeYS7ST,n03R5Kx,{nval=1})local Cj8R=hPPA[1]return
AHA.emit(n03R5Kx,("if %s then break end"):format(tostring(Cj8R)),Jzh.expr(CnKBj0I,"expression"))else return nil end end
O11E.each=function(ab,xuQ6HJG_,vEZ)
AHA.assert((3 <=#ab),"expected body expression",ab[1])
local oVsWEZ_J=AHA.assert(Jzh["table?"](ab[2]),"expected binding table",ab)
local Kvh=AHA.assert((2 <=#oVsWEZ_J),"expected binding and iterator",oVsWEZ_J)local TO12C4w_=Qat(oVsWEZ_J)
local gzIL4Hp=table.remove(oVsWEZ_J,#oVsWEZ_J)local E30Dza={}local JNQC8C={}local n1x=AHA["make-scope"](xuQ6HJG_)
local function Xf0A(AsRzIY)
AHA.assert(
not Jzh["string?"](AsRzIY),("unexpected iterator clause "..tostring(AsRzIY)),oVsWEZ_J)
if Jzh["sym?"](AsRzIY)then
return AHA["declare-local"](AsRzIY,{},n1x,ab,JNQC8C)else local qE=Jzh.sym(AHA.gensym(n1x))do end
(E30Dza)[qE]=AsRzIY;return AHA["declare-local"](qE,{},n1x,ab)end end;local k=Jzh.map(oVsWEZ_J,Xf0A)
local Xz=AHA.compile1(gzIL4Hp,xuQ6HJG_,vEZ)local ab7qjN6I=Jzh.map(Xz,tostring)local qWCmS={}
AHA.emit(vEZ,("for %s in %s do"):format(table.concat(k,", "),table.concat(ab7qjN6I,", ")),ab)for mCn,tAn6 in Jzh.stablepairs(E30Dza)do
AHA.destructure(tAn6,mCn,ab,n1x,qWCmS,{declaration=true,nomulti=true,symtype="each"})end
AHA["apply-manglings"](n1x,JNQC8C,ab)StR7(TO12C4w_,n1x,qWCmS)T1pL(ab,n1x,qWCmS,3)
AHA.emit(vEZ,qWCmS,ab)return AHA.emit(vEZ,"end",ab)end
qh0m("each",{"[key value (iterator)]","..."},"Runs the body once for each set of values provided by the given iterator.\nMost commonly used with ipairs for sequential tables or pairs for  undefined\norder, but can be used with any iterator.",true)
local function WwJGWL(z__i,Us5,O)local yVWnyOMv=#O
local wZnDs=(AHA.compile1(z__i[2],Us5,O,{nval=1}))[1]local Q4HLWP=#O;local t={}
if(yVWnyOMv~=Q4HLWP)then for RxPL=(yVWnyOMv+1),Q4HLWP do
table.insert(t,O[RxPL])do end(O)[RxPL]=nil end
AHA.emit(O,"while true do",z__i)
AHA.emit(t,("if not %s then break end"):format(wZnDs[1]),z__i)else
AHA.emit(O,("while "..tostring(wZnDs).." do"),z__i)end;T1pL(z__i,AHA["make-scope"](Us5),t,3)
AHA.emit(O,t,z__i)return AHA.emit(O,"end",z__i)end;O11E["while"]=WwJGWL
qh0m("while",{"condition","..."},"The classic while loop. Evaluates body until a condition is non-truthy.",true)
local function OchUF(QiT,y04JgdK,KycZksD)
local a4Y2fq=AHA.assert(Jzh["table?"](QiT[2]),"expected binding table",QiT)local kI=Qat(QiT[2])local fLoVQQlK=table.remove(QiT[2],1)
local CpQ5Gl=AHA["make-scope"](y04JgdK)local GVtZS={}local IYamaS={}
AHA.assert(Jzh["sym?"](fLoVQQlK),("unable to bind %s %s"):format(type(fLoVQQlK),tostring(fLoVQQlK)),QiT[2])
AHA.assert((3 <=#QiT),"expected body expression",QiT[1])
AHA.assert((#a4Y2fq<=3),"unexpected arguments",a4Y2fq[4])for iKh6Y=1,math.min(#a4Y2fq,3)do
GVtZS[iKh6Y]=tostring((AHA.compile1(a4Y2fq[iKh6Y],y04JgdK,KycZksD,{nval=1}))[1])end
AHA.emit(KycZksD,("for %s = %s do"):format(AHA["declare-local"](fLoVQQlK,{},CpQ5Gl,QiT),table.concat(GVtZS,", ")),QiT)StR7(kI,CpQ5Gl,IYamaS)T1pL(QiT,CpQ5Gl,IYamaS,3)
AHA.emit(KycZksD,IYamaS,QiT)return AHA.emit(KycZksD,"end",QiT)end;O11E["for"]=OchUF
qh0m("for",{"[index start stop step?]","..."},"Numeric loop construct.\nEvaluates body once for each value between start and stop (inclusive).",true)
local function q(oY8_Tb,jFXC6,TZdfAnc,wI4_E,au)local rAZNBKRL=oY8_Tb;local lEJ=rAZNBKRL[1]local fxJx49=rAZNBKRL[2]
local ad=rAZNBKRL[3]local D
if
(
(wI4_E.type=="literal")or(wI4_E.type=="varg")or(wI4_E.type=="expression"))then D="(%s):%s(%s)"else D="%s:%s(%s)"end;return
Jzh.expr(string.format(D,tostring(wI4_E),ad,table.concat(au,", ")),"statement")end
local function nWpL(BRN7oER,YCR,yj8ras,m,dx30orp)
local Z6w=tostring((AHA.compile1(BRN7oER[3],YCR,yj8ras,{nval=1}))[1])local IOYI6={tostring(m),cI0i(dx30orp)}return
Jzh.expr(string.format("%s[%s](%s)",tostring(m),Z6w,table.concat(IOYI6,", ")),"statement")end
local function OusWpn(cC,PM,m,m7dTfnqh,SwvAq)
local cO=tostring((AHA.compile1(cC[3],PM,m,{nval=1}))[1])local BoIL5A="(function(tgt, m, ...) return tgt[m](tgt, ...) end)(%s, %s)"
table.insert(SwvAq,1,cO)return
Jzh.expr(string.format(BoIL5A,tostring(m7dTfnqh),table.concat(SwvAq,", ")),"statement")end
local function mZ(xwOo,UN16W3,YHNf3RY)
AHA.assert((2 <#xwOo),"expected at least 2 arguments",xwOo)
local GJOS_Cb=AHA.compile1(xwOo[2],UN16W3,YHNf3RY,{nval=1})local c1Vq9=GJOS_Cb[1]local VzQwM={}
for iewIc=4,#xwOo do local b4;local EH61_oC;if(iewIc~=#xwOo)then EH61_oC=1 else EH61_oC=
nil end
b4=AHA.compile1(xwOo[iewIc],UN16W3,YHNf3RY,{nval=EH61_oC})Jzh.map(b4,tostring,VzQwM)end
if(Jzh["string?"](xwOo[3])and
Jzh["valid-lua-identifier?"](xwOo[3]))then return
q(xwOo,UN16W3,YHNf3RY,c1Vq9,VzQwM)elseif(c1Vq9.type=="sym")then return
nWpL(xwOo,UN16W3,YHNf3RY,c1Vq9,VzQwM)else
return OusWpn(xwOo,UN16W3,YHNf3RY,c1Vq9,VzQwM)end end;O11E[":"]=mZ
qh0m(":",{"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.")
O11E.comment=function(Og,ufAz3Vl,lTx)local bi={}for r=2,#Og do
table.insert(bi,fNDs(Og[r],{["one-line?"]=true}))end
return AHA.emit(lTx,("--[[ "..
table.concat(bi," ").." ]]"),Og)end
qh0m("comment",{"..."},"Comment which will be emitted in Lua output.",true)
local function sNoOf(KDGWmz,U,E70y)local f68Mn
if KDGWmz.symmeta[("$"..U)].used then f68Mn=U else f68Mn=E70y end
if(U<9)then return sNoOf(KDGWmz,(U+1),f68Mn)else return f68Mn end end
O11E.hashfn=function(if3,I3iKXOp,XJU38yi)
AHA.assert((#if3 ==2),"expected one argument",if3)local EJGvy
do local Vq=AHA["make-scope"](I3iKXOp)do end
(Vq)["vararg"]=false;Vq["hashfn"]=true;EJGvy=Vq end;local GMnE={}local hBd=AHA.gensym(I3iKXOp)local XE=Jzh.sym(hBd)local w={}
AHA["declare-local"](XE,{},I3iKXOp,if3)for bRC2=1,9 do
w[bRC2]=AHA["declare-local"](Jzh.sym(("$"..bRC2)),{},EJGvy,if3)end
local function Xur(M,UlXv,Qdj0Vkr)
if(Jzh["sym?"](UlXv)and(tostring(UlXv)==
"$..."))then
Qdj0Vkr[M]=Jzh.varg()EJGvy.vararg=true;return nil else return
(("table"==type(UlXv))and(
Jzh.sym("hashfn")~=UlXv[1])and(
Jzh["list?"](UlXv)or Jzh["table?"](UlXv)))end end;Jzh["walk-tree"](if3[2],Xur)
AHA.compile1(if3[2],EJGvy,GMnE,{tail=true})local YOkLhtrKM=sNoOf(EJGvy,1,0)if EJGvy.vararg then
AHA.assert((YOkLhtrKM==0),"$ and $... in hashfn are mutually exclusive",if3)else end;local gz1GyL
if EJGvy.vararg then
gz1GyL=tostring(Jzh.varg())else gz1GyL=table.concat(w,", ",1,YOkLhtrKM)end
AHA.emit(XJU38yi,string.format("local function %s(%s)",hBd,gz1GyL),if3)AHA.emit(XJU38yi,GMnE,if3)
AHA.emit(XJU38yi,"end",if3)return Jzh.expr(hBd,"sym")end
qh0m("hashfn",{"..."},"Function literal shorthand; args are either $... OR $1, $2, etc.")
local function B(cy3D1h,MV_v2fC,NS,UhBp)local VuHhF=UhBp;local pC0CuBZ=VuHhF["macros"]local FpoZTyWt=(Jzh["list?"](cy3D1h)and
tostring(cy3D1h[1]))
if
(
((
"or"==NS)or("and"==NS))and(1 <MV_v2fC)and
(pC0CuBZ[FpoZTyWt]or("set"==FpoZTyWt)or
("tset"==FpoZTyWt)or("global"==FpoZTyWt)))then return Jzh.list(Jzh.sym("do"),cy3D1h)else return cy3D1h end end
local function z(H,lGEkcoW,YTnQP,zT2pXxMG,xXB4,gIlW)local uwPip7=#zT2pXxMG;local idFw7={}local h1mcWj=(" "..H.." ")
for TN3I4w=2,uwPip7 do
local sln2J=B(zT2pXxMG[TN3I4w],TN3I4w,H,xXB4)local Vl0PD=AHA.compile1(sln2J,xXB4,gIlW)
if(TN3I4w==uwPip7)then
Jzh.map(Vl0PD,tostring,idFw7)else table.insert(idFw7,tostring(Vl0PD[1]))end end;local HY9zZy=#idFw7
if(HY9zZy==0)then local OGzIarca;do local O78YKA=lGEkcoW
AHA.assert(O78YKA,"Expected more than 0 arguments",zT2pXxMG)OGzIarca=O78YKA end;return
Jzh.expr(OGzIarca,"literal")elseif(HY9zZy==1)then
if YTnQP then return("("..
YTnQP..h1mcWj..idFw7[1]..")")else return idFw7[1]end elseif true then local M=HY9zZy;return
("("..table.concat(idFw7,h1mcWj)..")")else return nil end end
local function qFF(_Np3dAW,Pj3,ze6YJtgk,WqVbDxm)local AaH
do local Q8Ws_=(WqVbDxm or _Np3dAW)local WOb7pdqL=Pj3;local _t4B=ze6YJtgk;local function xuteFE9(...)return
z(Q8Ws_,WOb7pdqL,_t4B,...)end;AaH=xuteFE9 end;O11E[_Np3dAW]=AaH;return
qh0m(_Np3dAW,{"a","b","..."},"Arithmetic operator; works the same as Lua but accepts more arguments.")end;qFF("+","0")qFF("..","''")qFF("^")qFF("-",nil,"")
qFF("*","1")qFF("%")qFF("/",nil,"1")qFF("//",nil,"1")
O11E["or"]=function(f19Zp2yI,y,SwkB6)return
z("or","false",nil,f19Zp2yI,y,SwkB6)end
O11E["and"]=function(dxIUQX,alGFT,r)return z("and","true",nil,dxIUQX,alGFT,r)end
qh0m("and",{"a","b","..."},"Boolean operator; works the same as Lua but accepts more arguments.")
qh0m("or",{"a","b","..."},"Boolean operator; works the same as Lua but accepts more arguments.")
local function MhA6757(jfh,Yoy0,IxXnO,HAbNWq,G,qJNgN,cI)
if(#G==1)then
return AHA.assert(IxXnO,"Expected more than 0 arguments.",G)else local A5V=#G;local Q2RJxTQ_={}local SNK=(" "..jfh.." ")
local BgdP8C=("bit."..Yoy0)
for KdR0B94B=2,A5V do local Kq2b;local g0s;if(KdR0B94B~=A5V)then g0s=1 else g0s=nil end
Kq2b=AHA.compile1(G[KdR0B94B],qJNgN,cI,{nval=g0s})Jzh.map(Kq2b,tostring,Q2RJxTQ_)end
if(#Q2RJxTQ_==1)then
if Jzh.root.options.useBitLib then return
(BgdP8C.."("..HAbNWq..", "..
Q2RJxTQ_[1]..")")else return("("..
HAbNWq..SNK..Q2RJxTQ_[1]..")")end else
if Jzh.root.options.useBitLib then
return(BgdP8C.."("..
table.concat(Q2RJxTQ_,", ")..")")else return
("("..table.concat(Q2RJxTQ_,SNK)..")")end end end end
local function fB2Vks(ElLmtD,Wq9Fsh,PvCAI1i,sM6C)local KqV1
do local X=sM6C;local KV8sZEaH=ElLmtD;local omL2A=Wq9Fsh;local nh=PvCAI1i;local function Y9(...)return
MhA6757(X,KV8sZEaH,omL2A,nh,...)end;KqV1=Y9 end;O11E[ElLmtD]=KqV1;return nil end;fB2Vks("lshift",nil,"1","<<")
fB2Vks("rshift",nil,"1",">>")fB2Vks("band","0","0","&")fB2Vks("bor","0","0","|")
fB2Vks("bxor","0","0","~")
qh0m("lshift",{"x","n"},"Bitwise logical left shift of x by n bits.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
qh0m("rshift",{"x","n"},"Bitwise logical right shift of x by n bits.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
qh0m("band",{"x1","x2","..."},"Bitwise AND of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
qh0m("bor",{"x1","x2","..."},"Bitwise OR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
qh0m("bxor",{"x1","x2","..."},"Bitwise XOR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
qh0m("..",{"a","b","..."},"String concatenation operator; works the same as Lua but accepts more arguments.")
local function KEar3_f(D7CGKmb8,uLyz97,BWkW1j,yZA)local WXYCK=uLyz97;local ifeZY=WXYCK[1]local hAzmuHjD=WXYCK[2]local wOpIPj=WXYCK[3]
local ezsAVF9Y=AHA.compile1(hAzmuHjD,BWkW1j,yZA,{nval=1})local wMf1B=ezsAVF9Y[1]
local b=AHA.compile1(wOpIPj,BWkW1j,yZA,{nval=1})local lObXzZtF=b[1]return
string.format("(%s %s %s)",tostring(wMf1B),D7CGKmb8,tostring(lObXzZtF))end
local function Bp(gXOgxVqi,aEAOdyb,aANaGdmD,gJ,I)local Iuy
do local CGX={}local YOdo=#CGX
for Ts=2,#aANaGdmD do
local Xoxdbm=tostring((AHA.compile1(aANaGdmD[Ts],gJ,I,{nval=1}))[1])
if(nil~=Xoxdbm)then YOdo=(YOdo+1)do end(CGX)[YOdo]=Xoxdbm else end end;Iuy=CGX end;local xpU0HjP5
do local v={}local TpRHAsM=#v
for O872Y=1,(#Iuy-1)do
local Fhc=string.format("(%s %s %s)",Iuy[O872Y],gXOgxVqi,Iuy[(O872Y+1)])
if(nil~=Fhc)then TpRHAsM=(TpRHAsM+1)do end(v)[TpRHAsM]=Fhc else end end;xpU0HjP5=v end
local E8GAk=string.format(" %s ",(aEAOdyb or"and"))return table.concat(xpU0HjP5,E8GAk)end
local function WRTH(Q19nu,tG,v7Zovu3S,R8Mr,E7pBdDI)local f5qj={}local bY={}local hi1fT={}
local d=string.format(" %s ",(tG or"and"))
for Ev=2,#v7Zovu3S do
table.insert(f5qj,tostring(AHA.gensym(R8Mr)))
table.insert(hi1fT,tostring((AHA.compile1(v7Zovu3S[Ev],R8Mr,E7pBdDI,{nval=1}))[1]))end
do local PinF3=bY;local Fl=#PinF3
for _RHbBQe_=1,(#f5qj-1)do
local csZGJji=string.format("(%s %s %s)",f5qj[_RHbBQe_],Q19nu,f5qj[(_RHbBQe_+1)])
if(nil~=csZGJji)then Fl=(Fl+1)do end(PinF3)[Fl]=csZGJji else end end end;return
string.format("(function(%s) return %s end)(%s)",table.concat(f5qj,","),table.concat(bY,d),table.concat(hi1fT,","))end
local function s(_IQM21V,c8S3fu,Z0)
do local cAn=(c8S3fu or _IQM21V)
local function zdq3gf(h574,nrS48GsH,VA8mi)
AHA.assert((2 <#h574),"expected at least two arguments",h574)
if(3 ==#h574)then return KEar3_f(cAn,h574,nrS48GsH,VA8mi)elseif
Jzh["every?"](Jzh["idempotent-expr?"],{cI0i(h574,2)})then return Bp(cAn,Z0,h574,nrS48GsH,VA8mi)else
return WRTH(cAn,Z0,h574,nrS48GsH,VA8mi)end end;O11E[_IQM21V]=zdq3gf end;return
qh0m(_IQM21V,{"a","b","..."},"Comparison operator; works the same as Lua but accepts more arguments.")end;s(">")s("<")s(">=")s("<=")s("=","==")
s("not=","~=","or")
local function gPVgI8V(pva,orki)
local function RqeYK(ojg0_C,mgD1,Bc)
AHA.assert((#ojg0_C==2),"expected one argument",ojg0_C)local bJwiKR=AHA.compile1(ojg0_C[2],mgD1,Bc,{nval=1})
return(
(orki or pva)..tostring(bJwiKR[1]))end;O11E[pva]=RqeYK;return nil end;gPVgI8V("not","not ")
qh0m("not",{"x"},"Logical operator; works the same as Lua.")gPVgI8V("bnot","~")
qh0m("bnot",{"x"},"Bitwise negation; only works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")gPVgI8V("length","#")
qh0m("length",{"x"},"Returns the length of a table or string.")do end(O11E)["~="]=O11E["not="]O11E["#"]=O11E.length
O11E.quote=function(fCYOnUn,z5VJbT,I8OjNIh)
AHA.assert((
#fCYOnUn==2),"expected one argument",fCYOnUn)local BTxuZzK,qdtphyF=true,z5VJbT
while qdtphyF do qdtphyF=qdtphyF.parent;if
(qdtphyF==AHA.scopes.compiler)then BTxuZzK=false else end end
return AHA["do-quote"](fCYOnUn[2],z5VJbT,I8OjNIh,BTxuZzK)end
qh0m("quote",{"x"},"Quasiquote the following form. Only works in macro/compiler scope.")local uA5vZEb={}
local function ZNbFB(F)local qDcOp4_=getmetatable(F)
assert((qDcOp4_~=getmetatable("")),"Illegal metatable access!")return qDcOp4_ end;local SE0lo2=nil
local function GaxZqb()local Rafg8;do local N=rawget(_G,"utf8")if(nil~=N)then Rafg8=Jzh.copy(N)else
Rafg8=N end end
return
{table=Jzh.copy(table),math=Jzh.copy(math),string=Jzh.copy(string),pairs=Jzh.stablepairs,ipairs=ipairs,select=select,tostring=tostring,tonumber=tonumber,bit=rawget(_G,"bit"),pcall=pcall,xpcall=xpcall,next=next,print=print,type=type,assert=assert,error=error,setmetatable=setmetatable,getmetatable=ZNbFB,require=SE0lo2,rawlen=rawget(_G,"rawlen"),rawget=rawget,rawset=rawset,rawequal=rawequal,_VERSION=_VERSION,utf8=Rafg8}end
local function ZPz3(_5CGI6PZ)local Z={}local ipJKYa=getmetatable(_5CGI6PZ)
local dPQffKj=ipJKYa["__index"]if("table"==type(dPQffKj))then
for JSQ,JhH in pairs(dPQffKj)do Z[JSQ]=JhH end else end
for uh,gWvKWBjLE in next,_5CGI6PZ,nil do Z[uh]=gWvKWBjLE end;return next,Z,nil end
local function gwje(RsymxL,Iz,xzf,EgCB_nf)local P
do local vQoZJVom=(EgCB_nf or Jzh.root.options)
if((
_G.type(vQoZJVom)=="table")and
((vQoZJVom)["compiler-env"]=="strict"))then
P=GaxZqb()elseif((_G.type(vQoZJVom)=="table")and
(nil~= (vQoZJVom).compilerEnv))then
local ftq9dIXI=(vQoZJVom).compilerEnv;P=ftq9dIXI elseif
((_G.type(vQoZJVom)=="table")and(nil~=
(vQoZJVom)["compiler-env"]))then local FX=(vQoZJVom)["compiler-env"]P=FX elseif true then local zGwGt3E=vQoZJVom
P=GaxZqb(false)else P=nil end end;local kViUhgj;local function UyTq(vm7_I)return
Jzh.sym(AHA.gensym((AHA.scopes.macro or Iz),vm7_I))end;local function p()return
AHA.scopes.macro end;local function u6_LlQ46(L6C5NIeG)
AHA.assert(AHA.scopes.macro,"must call from macro",RsymxL)
return AHA.scopes.macro.manglings[tostring(L6C5NIeG)]end
local function GAPJTX(sgg_50x)
AHA.assert(AHA.scopes.macro,"must call from macro",RsymxL)return AHA.macroexpand(sgg_50x,AHA.scopes.macro)end
kViUhgj={_AST=RsymxL,_CHUNK=xzf,_IS_COMPILER=true,_SCOPE=Iz,_SPECIALS=AHA.scopes.global.specials,_VARARG=Jzh.varg(),["macro-loaded"]=uA5vZEb,unpack=cI0i,["assert-compile"]=AHA.assert,view=fNDs,version=Jzh.version,metadata=AHA.metadata,["ast-source"]=Jzh["ast-source"],list=Jzh.list,["list?"]=Jzh["list?"],["table?"]=Jzh["table?"],sequence=Jzh.sequence,["sequence?"]=Jzh["sequence?"],sym=Jzh.sym,["sym?"]=Jzh["sym?"],["multi-sym?"]=Jzh["multi-sym?"],comment=Jzh.comment,["comment?"]=Jzh["comment?"],["varg?"]=Jzh["varg?"],gensym=UyTq,["get-scope"]=p,["in-scope?"]=u6_LlQ46,macroexpand=GAPJTX}kViUhgj._G=kViUhgj;return
setmetatable(kViUhgj,{__index=P,__newindex=P,__pairs=ZPz3})end
local function lidmlMiV(...)local bWlu={}local aS=#bWlu
for a3KhFIf in
string.gmatch((package.config or""),"([^\n]+)")do local sAPG6y=a3KhFIf
if(nil~=sAPG6y)then aS=(aS+1)do end(bWlu)[aS]=sAPG6y else end end;return bWlu end;local qr0C1=lidmlMiV(...)local g=qr0C1[1]local o=qr0C1[2]local gAN1v8=qr0C1[3]
local pL4fol={dirsep=(g or"/"),pathmark=(
gAN1v8 or";"),pathsep=(o or"?")}
local function nmhV(m)return string.gsub(m,"[^%w]","%%%1")end
local function Wd1a_i(A,fd2H)local zQ5=nmhV(pL4fol.pathsep)
local xhs=("([^%s]*)%s"):format(zQ5,zQ5)local Bd=A:gsub("%.",pL4fol.dirsep)
local n4Rf=((fd2H or
Jzh["fennel-module"].path)..pL4fol.pathsep)
local function QT(vGQaEDQ)
local HpHT=vGQaEDQ:gsub(nmhV(pL4fol.pathmark),Bd)local e=vGQaEDQ:gsub(nmhV(pL4fol.pathmark),A)local OiRV=(
io.open(HpHT)or io.open(e))
if(nil~=OiRV)then
local kV=OiRV;kV:close()return HpHT elseif true then local Ieet0=OiRV
return nil, ("no file '"..HpHT.."'")else return nil end end
local function hjd(IZMQx0rC,BrM2hYPE)local igszykf=n4Rf:match(xhs,IZMQx0rC)
if(nil~=igszykf)then local q_v=igszykf
local I,H=QT(q_v)
if(nil~=I)then local aTdQOCcy=I;return aTdQOCcy elseif((I==nil)and(nil~=H))then local zSyor=H;local function HB()local fuSiMn=(
BrM2hYPE or{})table.insert(fuSiMn,zSyor)
return fuSiMn end;return
hjd((IZMQx0rC+#q_v+1),HB())else return nil end elseif true then local ZsrTm=igszykf;local function v7Q()
local oWrDs=table.concat((BrM2hYPE or{}),"\n\9")
if(_VERSION<"Lua 5.4")then return("\n\9"..oWrDs)else return oWrDs end end;return nil,
v7Q()else return nil end end;return hjd(1)end
local function ur(C9m4)
local function dVKfuf(ulHu)local kIuvqs_z=Jzh.copy(Jzh.root.options)for WXKWwF,nGfnz9aW in
pairs((C9m4 or{}))do kIuvqs_z[WXKWwF]=nGfnz9aW end
kIuvqs_z["module-name"]=ulHu;local DiibeTp,VE=Wd1a_i(ulHu)
if(nil~=DiibeTp)then local Jpkn2x2L=DiibeTp;local qIGM
do
local zd=Jpkn2x2L;local aIh=kIuvqs_z;local function Ox(...)
return Jzh["fennel-module"].dofile(zd,aIh,...)end;qIGM=Ox end;return qIGM,Jpkn2x2L elseif((DiibeTp==nil)and(nil~=VE))then
local T5K7=VE;return T5K7 else return nil end end;return dVKfuf end
local function IAEw(VXa0K,EcGb,GFIjpl,...)
local CXtt1l9J=(package.loaders or package.searchers or{})local MIJA=table.insert(CXtt1l9J,1,VXa0K)
local _rbAfa=Jzh["fennel-module"].dofile(EcGb,GFIjpl,...)table.remove(CXtt1l9J,1)return _rbAfa end
local function HkFs_(WC)local dpl5Qr8i
do local vdrp=Jzh.copy(Jzh.root.options)do end
(vdrp)["module-name"]=WC;vdrp["env"]="_COMPILER"vdrp["requireAsInclude"]=false;vdrp["allowedGlobals"]=
nil;dpl5Qr8i=vdrp end
local VhWZl_=Wd1a_i(WC,Jzh["fennel-module"]["macro-path"])
if(nil~=VhWZl_)then local xB=VhWZl_;local qtSF2kh
if
(dpl5Qr8i["compiler-env"]==_G)then local Bu=HkFs_;local ja=xB;local glp=dpl5Qr8i
local function oP(...)return IAEw(Bu,ja,glp,...)end;qtSF2kh=oP else local J92nyajw=xB;local wBBO=dpl5Qr8i;local function k3gZQQ(...)return
Jzh["fennel-module"].dofile(J92nyajw,wBBO,...)end
qtSF2kh=k3gZQQ end;return qtSF2kh,xB else return nil end end
local function a6y99PLZ(TW5ElhE)local ytAdXO=Wd1a_i(TW5ElhE,package.path)
if(nil~=ytAdXO)then
local QzBDtoL=ytAdXO;local Wh5WXYH
do local BIqcT3KO=io.open(QzBDtoL)
local function Ggug(as,...)BIqcT3KO:close()if as then return...else return
error(...,0)end end
local function D4()return assert(BIqcT3KO:read("*a"))end
Wh5WXYH=Ggug(_G.xpcall(D4,(package.loaded.fennel or debug).traceback))end;local _j=WpQBPz(Wh5WXYH,gwje(),QzBDtoL)return _j,QzBDtoL else return nil end end;local Maun0kCg={HkFs_,a6y99PLZ}
local function X1okTW(bKRB,bqOmBw)local UlRBdf2T=Maun0kCg[bqOmBw]
if
(nil~=UlRBdf2T)then local WqG=UlRBdf2T;local jQ6ByW,hI=WqG(bKRB)
if((nil~=jQ6ByW)and true)then
local X=jQ6ByW;local fvOp=hI;return X,fvOp elseif true then local xIB=jQ6ByW;return X1okTW(bKRB,(bqOmBw+1))else
return nil end else return nil end end
local function IL(MJ)
if
((MJ=="fennel.macros")or
(package and package.loaded and("table"==
type(package.loaded[MJ]))and(
package.loaded[MJ].metadata==AHA.metadata)))then return{metadata=AHA.metadata,view=fNDs}else return nil end end
local function Txnp(gk4oh)
local function drQ()local WxqsgF,B7=X1okTW(gk4oh,1)
AHA.assert(WxqsgF,(gk4oh.." module not found."))do end(uA5vZEb)[gk4oh]=WxqsgF(gk4oh,B7)
return uA5vZEb[gk4oh]end
return(uA5vZEb[gk4oh]or IL(gk4oh)or drQ())end;SE0lo2=Txnp
local function k7(DRaen,cOdno7,Q7NwnLvM)
AHA.assert(Jzh["table?"](DRaen),"expected macros to be table",cOdno7)
for b55dl,vv7Mbm in pairs(DRaen)do
AHA.assert((type(vv7Mbm)=="function"),"expected each macro to be function",cOdno7)
AHA["check-binding-valid"](Jzh.sym(b55dl),Q7NwnLvM,cOdno7,{["macro?"]=true})do end(Q7NwnLvM.macros)[b55dl]=vv7Mbm end;return nil end
local function i4bMH(iHFG,mbY,klPjHrEL,fT)local iRHgEZ1=iHFG;local qe3O8z=iRHgEZ1["filename"]local _qk=iRHgEZ1[2]
local WwYOV=(qe3O8z or(
Jzh["table?"](_qk)and _qk.filename))local TzOhP=Jzh.root.options["module-name"]
local DYbu7=AHA.compile(_qk,fT)local cW=WpQBPz(DYbu7)return cW(TzOhP,WwYOV)end
O11E["require-macros"]=function(DzAYbnQN,v,iX,xTWLsd)
AHA.assert((#DzAYbnQN==2),"Expected one module name argument",(xTWLsd or DzAYbnQN))local et4qFvy=i4bMH(DzAYbnQN,v,iX,{})
AHA.assert(Jzh["string?"](et4qFvy),"module name must compile to string",(
xTWLsd or DzAYbnQN))
if not uA5vZEb[et4qFvy]then local j,u3d=X1okTW(et4qFvy,1)
AHA.assert(j,(et4qFvy..
" module not found."),DzAYbnQN)do end
(uA5vZEb)[et4qFvy]=AHA.assert(Jzh["table?"](j(et4qFvy,u3d)),"expected macros to be table",(
xTWLsd or DzAYbnQN))else end
if("import-macros"==tostring(DzAYbnQN[1]))then return
uA5vZEb[et4qFvy]else return k7(uA5vZEb[et4qFvy],DzAYbnQN,v,iX)end end
qh0m("require-macros",{"macro-module-name"},"Load given module and use its contents as macro definitions in current scope.\nMacro module should return a table of macro functions with string keys.\nConsider using import-macros instead as it is more flexible.")
local function o4u(Zk,IJlAF,PtNV,vGN)
local AmjRAd75=AHA["make-scope"](Jzh.root.scope.parent)local PmbHJr={}if Jzh.root.options.requireAsInclude then
AmjRAd75.specials.require=AHA["require-include"]else end
for Gyrd1C,SU2WbXNN in
S.parser(S["string-stream"](Zk),IJlAF)do table.insert(PmbHJr,SU2WbXNN)end
for oC5=1,#PmbHJr do local ZDm
if(oC5 ==#PmbHJr)then ZDm={tail=true}else ZDm={nval=0}end;Jzh["propagate-options"](PtNV,ZDm)
AHA.compile1(PmbHJr[oC5],AmjRAd75,vGN,ZDm)end;return nil end
local function XB(EauWm_Mc,hF5AiG,CaPHn8,kR,DeA)Jzh.root.scope.includes[kR]="fnl/loading"local dKC3Vzv
do
local cN=assert(io.open(CaPHn8))
local function lDwx(Ki,...)cN:close()if Ki then return...else return error(...,0)end end;local function oA()
return assert(cN:read("*all")):gsub("[\13\n]*$","")end
dKC3Vzv=lDwx(_G.xpcall(oA,(package.loaded.fennel or debug).traceback))end
local G=Jzh.expr(("require(\""..kR.."\")"),"statement")
local qx6M=("package.preload[%q]"):format(kR)
local q43=(qx6M.." = "..qx6M.." or function(...)")local CEjbsJ,XL={},{}AHA.emit(CEjbsJ,q43,EauWm_Mc)
AHA.emit(CEjbsJ,XL)AHA.emit(CEjbsJ,"end",EauWm_Mc)for cxdelc,YxaPQgT in ipairs(CEjbsJ)do
table.insert(Jzh.root.chunk,YxaPQgT)end
if DeA then
o4u(dKC3Vzv,CaPHn8,hF5AiG,XL)else AHA.emit(XL,dKC3Vzv,EauWm_Mc)end;Jzh.root.scope.includes[kR]=G;return G end
local function l38u_I3T(lZT0q,PSOCXW8,mJ47Xs,pttAKe)
if
(Jzh.root.scope.includes[lZT0q]=="fnl/loading")then
AHA.assert(mJ47Xs,"circular include detected",pttAKe)return mJ47Xs(PSOCXW8)else return nil end end
O11E.include=function(Qpnu6Q,BS_TVtF,AsPHBFDJ,Aedxu)
AHA.assert((#Qpnu6Q==2),"expected one argument",Qpnu6Q)local oUneh9
do
local Lz_usB,ljsvn5Qz=pcall(i4bMH,Qpnu6Q,BS_TVtF,AsPHBFDJ,Aedxu)
if((Lz_usB==true)and(nil~=ljsvn5Qz))then
local GgNU6=ljsvn5Qz
oUneh9=Jzh.expr(string.format("%q",GgNU6),"literal")elseif true then local NPz6M=Lz_usB
oUneh9=(AHA.compile1(Qpnu6Q[2],BS_TVtF,AsPHBFDJ,{nval=1}))[1]else oUneh9=nil end end
if((oUneh9.type~="literal")or
((oUneh9[1]):byte()~=34))then if Aedxu.fallback then return
Aedxu.fallback(oUneh9)else
return AHA.assert(false,"module name must be string literal",Qpnu6Q)end else local sY=WpQBPz(("return "..
oUneh9[1]))()
local eD2N=Jzh.root.options["module-name"]local lHWMtRj;Jzh.root.options["module-name"]=sY;lHWMtRj=nil
local ooD_xGt
local function b()local Zb2=Wd1a_i(sY)
if(nil~=Zb2)then local NWZMp=Zb2
return XB(Qpnu6Q,Aedxu,NWZMp,sY,true)elseif true then local pYT=Zb2;local tZED=Wd1a_i(sY,package.path)
if tZED then return
XB(Qpnu6Q,Aedxu,tZED,sY,false)elseif Aedxu.fallback then return Aedxu.fallback(oUneh9)else
return AHA.assert(false,(
"module not found "..sY),Qpnu6Q)end else return nil end end
ooD_xGt=(


(
Jzh["member?"](sY,(Jzh.root.options.skipInclude or{}))and Aedxu.fallback(oUneh9,true))or l38u_I3T(sY,oUneh9,Aedxu.fallback,Qpnu6Q)or Jzh.root.scope.includes[sY]or b())Jzh.root.options["module-name"]=eD2N;return ooD_xGt end end
qh0m("include",{"module-name-literal"},"Like require but load the target module during compilation and embed it in the\nLua output. The module must be a string literal and resolvable at compile time.")
local function ti5b(tNb4,CUAxP,HX6Kb86)local LIG=gwje(tNb4,CUAxP,HX6Kb86)
local oLlSHKfJ=Jzh.copy(Jzh.root.options)
oLlSHKfJ.scope=AHA["make-scope"](AHA.scopes.compiler)oLlSHKfJ.allowedGlobals=V(LIG)return
assert(WpQBPz(AHA.compile(tNb4,oLlSHKfJ),LhQHR(LIG)),oLlSHKfJ["module-name"],tNb4.filename)()end
O11E.macros=function(bpr7l0,EMna5yqq,d6Ctwa)
AHA.assert(((#bpr7l0 ==2)and Jzh["table?"](bpr7l0[2])),"Expected one table argument",bpr7l0)
return k7(ti5b(bpr7l0[2],EMna5yqq,d6Ctwa),bpr7l0,EMna5yqq,d6Ctwa)end
qh0m("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.")
O11E["eval-compiler"]=function(VYLNRk,_yp,k8)local l=VYLNRk[1]VYLNRk[1]=Jzh.sym("do")
local fdIV=ti5b(VYLNRk,_yp,k8)do end(VYLNRk)[1]=l;return fdIV end
qh0m("eval-compiler",{"..."},"Evaluate the body at compile-time. Use the macro system instead if possible.",true)
return
{doc=YMl,["current-global-names"]=V,["load-code"]=WpQBPz,["macro-loaded"]=uA5vZEb,["macro-searchers"]=Maun0kCg,["make-compiler-env"]=gwje,["search-module"]=Wd1a_i,["make-searcher"]=ur,["wrap-env"]=LhQHR}end
package.preload["fennel.compiler"]=package.preload["fennel.compiler"]or
function(...)
local c=require("fennel.utils")local o=require("fennel.parser")
local yK=require("fennel.friend")local MAKgn=(table.unpack or _G.unpack)local x9FArgz={}
local function GmcCQbi(cx5uK)local uo=(cx5uK or
x9FArgz.global)local ZAia0D6l;if uo then
ZAia0D6l=((uo.depth or 0)+1)else ZAia0D6l=0 end
return
{includes=setmetatable({},{__index=(uo and uo.includes)}),macros=setmetatable({},{__index=(
uo and uo.macros)}),manglings=setmetatable({},{__index=(uo and
uo.manglings)}),specials=setmetatable({},{__index=(uo and uo.specials)}),symmeta=setmetatable({},{__index=(
uo and uo.symmeta)}),unmanglings=setmetatable({},{__index=(uo and
uo.unmanglings)}),gensyms=setmetatable({},{__index=(uo and
uo.gensyms)}),autogensyms=setmetatable({},{__index=(uo and uo.autogensyms)}),vararg=(
uo and uo.vararg),depth=ZAia0D6l,hashfn=(uo and uo.hashfn),refedglobals={},parent=uo}end
local function jtHWFj7(DjicYU,aX)local griKc
if("table"==type(DjicYU))then griKc=DjicYU else griKc={}end;local oPlKdB=getmetatable(DjicYU)
local ithf=(
(oPlKdB and oPlKdB.filename)or griKc.filename or"unknown")
local EOxrAqR=((oPlKdB and oPlKdB.line)or griKc.line or"?")
local W4MTO=((oPlKdB and oPlKdB.col)or griKc.col or"?")
local uzkTxapi=tostring((c["sym?"](griKc[1])or griKc[1]or"()"))return
string.format("%s:%s:%s Compile error in '%s': %s",ithf,EOxrAqR,W4MTO,uzkTxapi,aX)end
local function NV(m2e,Id1VK,j2NNb,kiRfka8)
if not m2e then local uteD3RU=(c.root.options or{})
local _yAm0f0Y=uteD3RU["source"]local UF=uteD3RU["unfriendly"]
local gV3vGZ4X=uteD3RU["error-pinpoint"]local NGrp;if next(c["ast-source"](j2NNb))then NGrp=j2NNb else
NGrp=(kiRfka8 or{})end
if(nil==
c.hook("assert-compile",m2e,Id1VK,NGrp,c.root.reset))then
c.root.reset()
if
(UF or not yK or not _G.io or not _G.io.read)then error(jtHWFj7(NGrp,Id1VK),0)else
yK["assert-compile"](m2e,Id1VK,NGrp,_yAm0f0Y,{["error-pinpoint"]=gV3vGZ4X})end else end else end;return m2e end;x9FArgz.global=GmcCQbi()x9FArgz.global.vararg=true
x9FArgz.compiler=GmcCQbi(x9FArgz.global)x9FArgz.macro=x9FArgz.global
local tQX2JQ3q={["\7"]="\\a",["\8"]="\\b",["\9"]="\\t",["\n"]="n",["\11"]="\\v",["\12"]="\\f"}
local function iIyPus(tQpA)local function V(x799K)return("\\"..x799K:byte())end;return
string.gsub(string.gsub(string.format("%q",tQpA),".",tQX2JQ3q),"[\128-\255]",V)end
local function UDoYdga(jZ)
if c["valid-lua-identifier?"](jZ)then return jZ else local function OmVG8lf(CgZsZTK)return
string.format("_%02x",CgZsZTK:byte())end;return("__fnl_global__"..
jZ:gsub("[^%w]",OmVG8lf))end end
local function u_URqAyP(lEc)local YaAvE=string.match(lEc,"^__fnl_global__(.*)$")
if
(nil~=YaAvE)then local yf3=YaAvE;local Bcs;local function vh77(Gq)
return string.char(tonumber(Gq:sub(2),16))end
Bcs=string.gsub(yf3,"_[%da-f][%da-f]",vh77)return Bcs elseif true then local IhMea=YaAvE;return lEc else return nil end end;local nxZZC=nil;local function DMZ(JfP4Aohm)return
(not nxZZC or c["member?"](JfP4Aohm,nxZZC))end
local function ebmBtt(F6q,K0,WSUP53i,f8pHDS)if
(
WSUP53i.unmanglings[K0]and not WSUP53i.gensyms[K0])then
return ebmBtt(F6q,(F6q..f8pHDS),WSUP53i,(f8pHDS+1))else return K0 end end
local function F6(r1hTTS,WaWBNK,e4qPh_,M1)
NV(not c["multi-sym?"](r1hTTS),("unexpected multi symbol "..r1hTTS),e4qPh_)local Fe
if
((c["lua-keywords"])[r1hTTS]or r1hTTS:match("^%d"))then Fe=("_"..r1hTTS)else Fe=r1hTTS end;local RK
local function p(eXTmm)return string.format("_%02x",eXTmm:byte())end
RK=string.gsub(string.gsub(Fe,"-","_"),"[^%w_]",p)local P0VL2vrZ=ebmBtt(RK,RK,WaWBNK,0)do end
(WaWBNK.unmanglings)[P0VL2vrZ]=r1hTTS;do local xy0J=(M1 or WaWBNK.manglings)do end
(xy0J)[r1hTTS]=P0VL2vrZ end;return P0VL2vrZ end
local function Mcv4zh(kN,Je,lbp)
for qc,SnR in pairs(Je)do
NV(not kN.refedglobals[SnR],("use of global "..
qc.." is aliased by a local"),lbp)do end(kN.manglings)[qc]=SnR end;return nil end
local function Aanl(uREm,sYd4vJv)
local Tp=(sYd4vJv.manglings[uREm[1]]or UDoYdga(uREm[1]))
for dL=2,#uREm do
if c["valid-lua-identifier?"](uREm[dL])then if(
uREm["multi-sym-method-call"]and(dL==#uREm))then Tp=(Tp..
":"..uREm[dL])else
Tp=(Tp.."."..uREm[dL])end else Tp=(Tp.."["..iIyPus(uREm[dL])..
"]")end end;return Tp end
local function VvZoG6()c.root.scope["gensym-append"]=(
(c.root.scope["gensym-append"]or 0)+1)return
(
"_"..c.root.scope["gensym-append"].."_")end
local function AjTaG(cv,YQ,f)
local yDOTU=((YQ or"")..VvZoG6().. (f or""))while cv.unmanglings[yDOTU]do
yDOTU=((YQ or"")..VvZoG6().. (f or""))end
cv.unmanglings[yDOTU]=(YQ or true)do end(cv.gensyms)[yDOTU]=true;return yDOTU end
local function oJv55vky(xs3HoM,CPt)xs3HoM[1]=CPt;local x25XhH=table.remove(xs3HoM)
local gdJk_iMs=table.remove(xs3HoM)
local I=((xs3HoM["multi-sym-method-call"]and":")or".")
table.insert(xs3HoM,(gdJk_iMs..I..x25XhH))return table.concat(xs3HoM,".")end
local function ecvFfcqw(sRldmKE8,J4S6iy)local e5Hi=c["multi-sym?"](sRldmKE8)
if(nil~=e5Hi)then local glqD=e5Hi;return
oJv55vky(glqD,ecvFfcqw(glqD[1],J4S6iy))elseif true then local HndLYXOs=e5Hi;local function hFfZ()
local _jVsRVIY=AjTaG(J4S6iy,sRldmKE8:sub(1,(-2)),"auto")do end(J4S6iy.autogensyms)[sRldmKE8]=_jVsRVIY
return _jVsRVIY end;return(
J4S6iy.autogensyms[sRldmKE8]or hFfZ())else return nil end end
local function giqEv(eF5jN,BMmEIl,co,tZQ)local YplB=tostring(eF5jN)local iuAKOawa
do local Y9ajqGT8=tZQ;if(nil~=Y9ajqGT8)then
Y9ajqGT8=(Y9ajqGT8)["macro?"]else end;iuAKOawa=Y9ajqGT8 end
NV(not YplB:find("&"),"invalid character: &",eF5jN)
NV(not YplB:find("^%."),"invalid character: .",eF5jN)
NV(not(BMmEIl.specials[YplB]or
(not iuAKOawa and BMmEIl.macros[YplB])),("local %s was overshadowed by a special form or macro"):format(YplB),co)return
NV(not c["quoted?"](eF5jN),string.format("macro tried to bind %s without gensym",YplB),eF5jN)end
local function DX(z,l,ed,WipOX,GepSAE)giqEv(z,ed,WipOX)local fVwL=tostring(z)
NV(not c["multi-sym?"](fVwL),(
"unexpected multi symbol "..fVwL),WipOX)do end(ed.symmeta)[fVwL]=l;return F6(fVwL,ed,WipOX,GepSAE)end
local function Ymc47(Vdr5iR,kSubWX2,TJFj3cha)
if not TJFj3cha.hashfn then return nil elseif(Vdr5iR=="$")then return"$1"elseif kSubWX2 then
if(kSubWX2 and
(kSubWX2[1]=="$"))then kSubWX2[1]="$1"else end;return table.concat(kSubWX2,".")else return nil end end
local function KU1TZ(epF2,e,w2rce)c.hook("symbol-to-expression",epF2,e,w2rce)
local SoO=epF2[1]local cvVVLDX=c["multi-sym?"](SoO)
local adFOO=(Ymc47(SoO,cvVVLDX,e)or SoO)local hq=(cvVVLDX or{adFOO})local qhy=(
((1 <#hq)and"expression")or"sym")
local YqkxFq=e.manglings[hq[1]]if(YqkxFq and e.symmeta[hq[1]])then
e.symmeta[hq[1]]["used"]=true else end
NV(not e.macros[hq[1]],"tried to reference a macro without calling it",epF2)
NV((not e.specials[hq[1]]or("require"==hq[1])),"tried to reference a special form without calling it",epF2)
NV((not w2rce or YqkxFq or("_ENV"==hq[1])or DMZ(hq[1])),(
"unknown identifier: "..tostring(hq[1])),epF2)if(nxZZC and not YqkxFq and e.parent)then
e.parent.refedglobals[hq[1]]=true else end
return c.expr(Aanl(hq,e),qhy)end
local function InEPht(RC1zQfj,tw7,Ia)
if(type(tw7)=="table")then return table.insert(RC1zQfj,tw7)else return
table.insert(RC1zQfj,{ast=Ia,leaf=tw7})end end
local function dAkZ7FOa(cO)
if cO.leaf then return cO elseif
(
(3 <=#cO)and(cO[(#cO-2)].leaf=="do")and not cO[(#cO-1)].leaf and(
cO[#cO].leaf=="end"))then local Yim0=dAkZ7FOa(cO[(#cO-1)])local KEgdrEJ={ast=cO.ast}
for cvE=1,(#cO-3)
do table.insert(KEgdrEJ,dAkZ7FOa(cO[cvE]))end
for _ZaOK6=1,#Yim0 do table.insert(KEgdrEJ,Yim0[_ZaOK6])end;return KEgdrEJ else return c.map(cO,dAkZ7FOa)end end
local function kUC7(cnMUYf,DAbP_w)
local function IsHliUG5(x63,GD,tZs8,ECC)local Wj8Z7ASU=tZs8
if x63.leaf then
GD[Wj8Z7ASU]=((GD[Wj8Z7ASU]or"").." "..x63.leaf)else
for DPBC0cEs,L3OyIW5 in ipairs(x63)do
if(L3OyIW5.leaf or(0 <#L3OyIW5))then
local IA=c["ast-source"](L3OyIW5.ast)if(ECC==IA.filename)then
Wj8Z7ASU=math.max(Wj8Z7ASU,(IA.line or 0))else end
Wj8Z7ASU=IsHliUG5(L3OyIW5,GD,Wj8Z7ASU,ECC)else end end end;return Wj8Z7ASU end;local onTM6={}
local wmHyhAu=IsHliUG5(cnMUYf,onTM6,1,DAbP_w.filename)for ZXlUnI=1,wmHyhAu do
if(onTM6[ZXlUnI]==nil)then onTM6[ZXlUnI]=""else end end
return table.concat(onTM6,"\n")end
local function PkKH(Yzt3,A3nycin,_AEiRFt,jA)
if A3nycin.leaf then local DthGg=c["ast-source"](A3nycin.ast)
local nAh1PSh=DthGg["filename"]local U3vmAAPu=DthGg["line"]
table.insert(Yzt3,{nAh1PSh,U3vmAAPu})return A3nycin.leaf else local QSzXH
do local CD7qMWN=_AEiRFt
if(CD7qMWN==true)then QSzXH="  "elseif
(CD7qMWN==false)then QSzXH=""elseif(CD7qMWN==_AEiRFt)then QSzXH=_AEiRFt elseif(CD7qMWN==nil)then QSzXH=""else
QSzXH=nil end end
local function ruKe(n3vXu)
if(n3vXu.leaf or(0 <#n3vXu))then
local dFb_c5=PkKH(Yzt3,n3vXu,QSzXH,(jA+1))if(0 <jA)then return
(QSzXH..dFb_c5:gsub("\n",("\n"..QSzXH)))else return dFb_c5 end else return
nil end end;return table.concat(c.map(A3nycin,ruKe),"\n")end end;local GMU={}
local function RW1e(qvF9jB)local iCXsXfm=qvF9jB:gsub("\n"," ")if(#iCXsXfm<=49)then return("[fennel \""..
iCXsXfm.."\"]")else
return("[fennel \""..
iCXsXfm:sub(1,46).."...\"]")end end
local function RNgBFEJ(N3,_m6NeL)local F=dAkZ7FOa(N3)
if _m6NeL.correlate then return kUC7(F,_m6NeL),{}else local knSWmSCb={}
local hlAd5h=PkKH(knSWmSCb,F,_m6NeL.indent,0)
knSWmSCb.short_src=(_m6NeL.filename or
RW1e((_m6NeL.source or hlAd5h)))if _m6NeL.filename then knSWmSCb.key=("@".._m6NeL.filename)else
knSWmSCb.key=hlAd5h end
GMU[knSWmSCb.key]=knSWmSCb;return hlAd5h,knSWmSCb end end
local function RHynDt()local function b2W(Rws,bGa2mOf,bashk)
if Rws[bGa2mOf]then return Rws[bGa2mOf][bashk]else return nil end end
local function iJl45Gyi(fv,Feb5,rL,jpwnVCCw)
fv[Feb5]=(fv[Feb5]or{})do end(fv[Feb5])[rL]=jpwnVCCw;return Feb5 end
local function vFAMs7(uyFX,I9,...)local Hp5P=select("#",...)local nEEflJ={...}if((Hp5P%2)~=0)then
error("metadata:setall() expected even number of k/v pairs")else end
uyFX[I9]=(uyFX[I9]or{})
for dVk8=1,Hp5P,2 do uyFX[I9][nEEflJ[dVk8]]=nEEflJ[(dVk8+1)]end;return I9 end;return
setmetatable({},{__index={get=b2W,set=iJl45Gyi,setall=vFAMs7},__mode="k"})end
local function vlZT(h)return table.concat(c.map(h,tostring),", ")end
local function J4(N5jk,yKMj,h0AHFeQ,hdCy)local D=(h0AHFeQ or 1)
for DK9u0YCb=D,#N5jk do local U=N5jk[DK9u0YCb]
if(
(U.type=="expression")and(U[1]~="nil"))then
InEPht(yKMj,string.format("do local _ = %s end",tostring(U)),hdCy)elseif(U.type=="statement")then local h11S=tostring(U)local aog;if
(h11S:byte()==40)then aog=("do end "..h11S)else aog=h11S end
InEPht(yKMj,aog,hdCy)else end end;return nil end
local function LJ25_(Upy_Mt,XJUBj,h_P,qzvtR)
if h_P.nval then local ht9=h_P.nval;local zF4A=#Upy_Mt
if(ht9 ~=zF4A)then
if(ht9 <zF4A)then
J4(Upy_Mt,XJUBj,(ht9+1),qzvtR)for oH0K6DZg=(ht9+1),zF4A do Upy_Mt[oH0K6DZg]=nil end else
for AEY7dKrs=(#Upy_Mt+1),ht9
do Upy_Mt[AEY7dKrs]=c.expr("nil","literal")end end else end else end;if h_P.tail then
InEPht(XJUBj,string.format("return %s",vlZT(Upy_Mt)),qzvtR)else end
if h_P.target then local Q5=vlZT(Upy_Mt)local function x()if
(Q5 =="")then return"nil"else return Q5 end end
InEPht(XJUBj,string.format("%s = %s",h_P.target,x()),qzvtR)else end;if(h_P.tail or h_P.target)then return{returned=true}else local dVi6_P=Upy_Mt
dVi6_P["returned"]=true;return dVi6_P end end
local function OLj4enm5(M2fQsJF,tddLbjM)local t6Q6pok
do local vvXwPCvj=c["sym?"](M2fQsJF[1])
if(vvXwPCvj~=nil)then
local b_=tostring(vvXwPCvj)
if(b_~=nil)then t6Q6pok=tddLbjM.macros[b_]else t6Q6pok=b_ end else t6Q6pok=vvXwPCvj end end;local G=c["multi-sym?"](M2fQsJF[1])
if
(not t6Q6pok and G)then local yl7conr=c["get-in"](tddLbjM.macros,G)
NV((not
tddLbjM.macros[G[1]]or(type(yl7conr)=="function")),"macro not found in imported macro module",M2fQsJF)return yl7conr else return t6Q6pok end end
local function FQg2K(FWAIkjT,eWL7fHK2,S79K1)local fhfqGa2_=FWAIkjT;local dQc=fhfqGa2_["filename"]
local I86srgkM=fhfqGa2_["line"]local v=fhfqGa2_["bytestart"]local EK32N4wh=fhfqGa2_["byteend"]
do
local MwQfI=c["ast-source"](S79K1)
if
(("table"==type(S79K1))and(dQc~=MwQfI.filename))then
MwQfI.filename,MwQfI.line,MwQfI["from-macro?"]=dQc,I86srgkM,true;MwQfI.bytestart,MwQfI.byteend=v,EK32N4wh else end end;return("table"==type(S79K1))end
local function OLgj(BT_T,JC,q2rs9pTJ)
if(q2rs9pTJ and c["list?"](q2rs9pTJ))then for g=1,c.maxn(q2rs9pTJ)
do local T=q2rs9pTJ[g]
if(T==nil)then q2rs9pTJ[g]=c.sym("nil")else end end else end;return BT_T,JC,q2rs9pTJ end
local function rYNRAyG(HIg,eI)local function _T(...)return HIg(eI(...))end;return _T end
local function NocqXl(qK)local mnkmJQ=false;for nMao_eYE,d12vfJ in pairs(x9FArgz.global.macros)do if mnkmJQ then break end
mnkmJQ=(d12vfJ==qK)end;return mnkmJQ end
local function yQ(tytmwlxc,OA,uQHs)local M
if c["list?"](tytmwlxc)then M=OLj4enm5(tytmwlxc,OA)else M=nil end
if(M==false)then return tytmwlxc elseif(nil~=M)then local Xwnj=M;local X=x9FArgz.macro;local q0u
x9FArgz.macro=OA;q0u=nil;local zp7rS,pQk=nil,nil
local function tGaZiY()return Xwnj(MAKgn(tytmwlxc,2))end;local function YDlJrk()
if NocqXl(Xwnj)then return tostring else return debug.traceback end end
zp7rS,pQk=xpcall(tGaZiY,YDlJrk())local NQBP
do local q=tytmwlxc;local function tUAV(...)return FQg2K(q,...)end;NQBP=tUAV end;c["walk-tree"](pQk,rYNRAyG(NQBP,OLgj))
x9FArgz.macro=X;NV(zp7rS,pQk,tytmwlxc)if(uQHs or not pQk)then return pQk else
return yQ(pQk,OA)end elseif true then local xv=M;return tytmwlxc else return nil end end
local function EwFK(ginI,Wlq9,ecX,sX3K5d,RUn)
local p0=(RUn(ginI,Wlq9,ecX,sX3K5d)or c.expr("nil","literal"))local L
if("table"~=type(p0))then L=c.expr(p0,"expression")else L=p0 end;local J;if c["expr?"](L)then J={L}else J=L end;if not J.returned then return
LJ25_(J,ecX,sX3K5d,ginI)elseif(sX3K5d.tail or sX3K5d.target)then
return{returned=true}else return J end end
local function hktG(FK8Vu,af6z,qwS5Kv8Y,qHLkk,RHbe,fr)local x5rjM79={}
local gHZ4=(RHbe(FK8Vu[1],af6z,qwS5Kv8Y,{nval=1}))[1]
NV((c["sym?"](FK8Vu[1])or c["list?"](FK8Vu[1])or(
"string"==type(FK8Vu[1]))),(
"cannot call literal value "..tostring(FK8Vu[1])),FK8Vu)
for cDCm3L=2,fr do local qIrrbtNR;local f;if(cDCm3L~=fr)then f=1 else f=nil end
qIrrbtNR=RHbe(FK8Vu[cDCm3L],af6z,qwS5Kv8Y,{nval=f})table.insert(x5rjM79,qIrrbtNR[1])
if(cDCm3L==fr)then
for wMlh=2,#qIrrbtNR
do table.insert(x5rjM79,qIrrbtNR[wMlh])end else J4(qIrrbtNR,qwS5Kv8Y,2,FK8Vu[cDCm3L])end end;local qzzd2;if("string"==type(FK8Vu[1]))then qzzd2="(%s)(%s)"else
qzzd2="%s(%s)"end
local a55z=string.format(qzzd2,tostring(gHZ4),vlZT(x5rjM79))
return LJ25_({c.expr(a55z,"statement")},qwS5Kv8Y,qHLkk,FK8Vu)end
local function mdnF1t7H(vqUAUF,XyUcN2,b,e,kRR0gCs)c.hook("call",vqUAUF,XyUcN2)local NaPmL1D0=#vqUAUF
local dSaums=vqUAUF[1]local S=c["multi-sym?"](dSaums)
local i=(c["sym?"](dSaums)and
XyUcN2.specials[tostring(dSaums)])
NV((0 <NaPmL1D0),"expected a function, macro, or special to call",vqUAUF)
if i then return EwFK(vqUAUF,XyUcN2,b,e,i)elseif
(S and S["multi-sym-method-call"])then
local lG=table.concat({MAKgn(S,1,(#S-1))},".")local z_Tcg40=S[#S]
local v99Eubm_=c.list(c.sym(":",vqUAUF),c.sym(lG,vqUAUF),z_Tcg40,select(2,MAKgn(vqUAUF)))return kRR0gCs(v99Eubm_,XyUcN2,b,e)else return
hktG(vqUAUF,XyUcN2,b,e,kRR0gCs,NaPmL1D0)end end
local function Ipu2m(L,OW,Pk,jZC)local aANg
if OW.hashfn then aANg="use $... in hashfn"else aANg="unexpected vararg"end;NV(OW.vararg,aANg,L)return
LJ25_({c.expr("...","varg")},Pk,jZC,L)end
local function pw(gJERvk,C,ulnCs,I1PompP)local kFfd=c["multi-sym?"](gJERvk)
NV(not(kFfd and
kFfd["multi-sym-method-call"]),"multisym method calls may only be in call position",gJERvk)local ptZu;if(gJERvk[1]=="nil")then ptZu=c.expr("nil","literal")else
ptZu=KU1TZ(gJERvk,C,true)end;return
LJ25_({ptZu},ulnCs,I1PompP,gJERvk)end
local function bEVb7wKP(DE)local Du4=string.gsub(tostring(DE),",",".")return Du4 end
local function t5(SSAn4IhM,hAc48KE,ar,Ba)local CEJh
do local y=type(SSAn4IhM)
if(y=="nil")then CEJh=tostring elseif(y=="boolean")then
CEJh=tostring elseif(y=="string")then CEJh=iIyPus elseif(y=="number")then CEJh=bEVb7wKP else CEJh=nil end end;return
LJ25_({c.expr(CEJh(SSAn4IhM),"literal")},ar,Ba)end
local function W(n,R,smU7,c5AhRP,g6eSS)
local function iSB4(PspqBYWi)
if((type(PspqBYWi)=="string")and
c["valid-lua-identifier?"](PspqBYWi))then
return PspqBYWi else local aKa=g6eSS(PspqBYWi,R,smU7,{nval=1})local aB50mWe=aKa[1]return("["..
tostring(aB50mWe).."]")end end;local t3={}local fK9GSH1H
do local r={}local kij3KeD=#r
for Am,hTuL in ipairs(n)do local gNb4;do
local KiIGeo=((nil~=n[(Am+1)])and 1)do end(t3)[Am]=true
gNb4=vlZT(g6eSS(hTuL,R,smU7,{nval=KiIGeo}))end;if(nil~=gNb4)then
kij3KeD=(kij3KeD+1)do end(r)[kij3KeD]=gNb4 else end end;fK9GSH1H=r end
do local mF1ld_=fK9GSH1H;local X=#mF1ld_
for U8k,k_chsz6 in c.stablepairs(n)do local iUxhGdT
if not t3[U8k]then
local rPKPQif_=g6eSS(n[U8k],R,smU7,{nval=1})local J0j1SU=rPKPQif_[1]
iUxhGdT=string.format("%s = %s",iSB4(U8k),tostring(J0j1SU))else iUxhGdT=nil end
if(nil~=iUxhGdT)then X=(X+1)do end(mF1ld_)[X]=iUxhGdT else end end end;return
LJ25_({c.expr(("{"..table.concat(fK9GSH1H,", ").."}"),"expression")},smU7,c5AhRP,n)end
local function bR(DCDWGkDl,E5Nj,llO8EB,Jvnrey)local owikY=(Jvnrey or{})local N=yQ(DCDWGkDl,E5Nj)
if c["list?"](N)then return
mdnF1t7H(N,E5Nj,llO8EB,owikY,bR)elseif c["varg?"](N)then
return Ipu2m(N,E5Nj,llO8EB,owikY)elseif c["sym?"](N)then return pw(N,E5Nj,llO8EB,owikY)elseif
(type(N)=="table")then return W(N,E5Nj,llO8EB,owikY,bR)elseif
(
(type(N)=="nil")or
(type(N)=="boolean")or(type(N)=="number")or(type(N)=="string"))then return t5(N,E5Nj,llO8EB,owikY)else return
NV(false,("could not compile value of type "..type(N)),N)end end
local function j(t020SI,y5,Oo3,cg2kN,zCRI,Cv)local lTO4YUOr=(Cv or{})local O=lTO4YUOr;local Ct=O["isvar"]
local h9c8Ovm=O["declaration"]local IYPxIPBY=O["forceglobal"]local jYuK=O["forceset"]
local co=O["symtype"]local ak_o86=("_".. (co or"dst"))local _kZceDj;if h9c8Ovm then
_kZceDj="local %s = %s"else _kZceDj="%s = %s"end;local x6lv={}
local function zPB2j5(heekSOxE,hfFER4)
local wKVPCR=heekSOxE[1]
NV(not
(lTO4YUOr.nomulti and c["multi-sym?"](wKVPCR)),("unexpected multi symbol "..wKVPCR),hfFER4)
if h9c8Ovm then return DX(heekSOxE,nil,cg2kN,heekSOxE,x6lv)else local kLzrcX=(
c["multi-sym?"](wKVPCR)or{wKVPCR})
local T0t27=cg2kN.symmeta[kLzrcX[1]]
NV(not wKVPCR:find(":"),"cannot set method sym",heekSOxE)
if((#kLzrcX==1)and not jYuK)then
NV(not
(IYPxIPBY and T0t27),string.format("global %s conflicts with local",tostring(heekSOxE)),heekSOxE)
NV(not(T0t27 and not T0t27.var),("expected var "..wKVPCR),heekSOxE)else end
NV((T0t27 or not lTO4YUOr.noundef or DMZ(kLzrcX[1])),(
"expected local "..kLzrcX[1]),heekSOxE)
if IYPxIPBY then
NV(not cg2kN.symmeta[cg2kN.unmanglings[wKVPCR]],(
"global "..wKVPCR.." conflicts with local"),heekSOxE)do end(cg2kN.manglings)[wKVPCR]=UDoYdga(wKVPCR)do end
(cg2kN.unmanglings)[UDoYdga(wKVPCR)]=wKVPCR;if nxZZC then table.insert(nxZZC,wKVPCR)else end else end;return KU1TZ(heekSOxE,cg2kN)[1]end end
local function Vbha15(hH7AQO8)local oKL
local function xkSmP6pc(eKu)if cg2kN.manglings[eKu]then return eKu else return"nil"end end;oKL=c.map(hH7AQO8,xkSmP6pc)
local TWh=table.concat(oKL,", ")local iKtr1rn=table.concat(hH7AQO8,", ")local lIpLR=zCRI[#zCRI]
local itYH_s=#zCRI;local auwI=bR(y5,cg2kN,zCRI,{target=iKtr1rn})
if h9c8Ovm then
for EJkoz9TG=itYH_s,#zCRI do if(
zCRI[EJkoz9TG]==lIpLR)then itYH_s=EJkoz9TG else end end
if
((#zCRI== (itYH_s+1))and zCRI[#zCRI].leaf)then
zCRI[#zCRI]["leaf"]=("local "..zCRI[#zCRI].leaf)elseif(TWh=="nil")then
table.insert(zCRI,(itYH_s+1),{ast=Oo3,leaf=("local "..iKtr1rn)})else
table.insert(zCRI,(itYH_s+1),{ast=Oo3,leaf=("local "..iKtr1rn.." = "..TWh)})end else end;return auwI end
local function ed87(PFts,Kmx8KY,u,Sw)local h=zPB2j5(PFts,u)giqEv(PFts,cg2kN,PFts)if Sw then Vbha15({h})else
InEPht(zCRI,_kZceDj:format(h,vlZT(Kmx8KY)),PFts)end;if h9c8Ovm then
cg2kN.symmeta[tostring(PFts)]={var=Ct}return nil else return nil end end
local cQpXgEU="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"
local function Un(YAGQ,QpbS,X,zMYQn,e44sGdEP)local JiNz;local g6f0msRL
do local zCIa={}local JGaFbCP=#zCIa
for jS,qqwBy in ipairs(zMYQn)do
local tkXDi5H=string.format("[%s] = true",iIyPus(qqwBy))if(nil~=tkXDi5H)then JGaFbCP=(JGaFbCP+1)do end
(zCIa)[JGaFbCP]=tkXDi5H else end end;g6f0msRL=zCIa end;JiNz=table.concat(g6f0msRL,", ")
local RN=c.expr(string.format(string.gsub(("("..cQpXgEU..
")(%s, %s, {%s})"),"\n%s*"," "),YAGQ,tostring(QpbS),JiNz),"expression")return e44sGdEP(QpbS,{RN},X)end
local function D20xd6lP(aZ,GUV6o,Ryrka,Dv0ij)local Zq3F=("("..cQpXgEU..")(%s, %s)")
local jTc7jO=string.format(string.gsub(Zq3F,"\n%s*"," "),aZ,GUV6o)local VJvN=c.expr(jTc7jO,"expression")
NV((c["sequence?"](Ryrka)and(nil==Ryrka[(
GUV6o+2)])),"expected rest argument before last parameter",Ryrka)return Dv0ij(Ryrka[(GUV6o+1)],{VJvN},Ryrka)end
local function wp(d5GIIXgv,KI,KzaQmB,GmzMFiB)local q7EKMsXa=AjTaG(cg2kN,ak_o86)local q
do local QeuDq;if KzaQmB then
QeuDq=vlZT(bR(y5,cg2kN,zCRI))else QeuDq=vlZT(KI)end;if(QeuDq=="")then q="nil"elseif
(nil~=QeuDq)then local WKxwJ3v=QeuDq;q=WKxwJ3v else q=nil end end;local pgSM2={}
InEPht(zCRI,string.format("local %s = %s",q7EKMsXa,q),d5GIIXgv)
for e5k35Eaj,ciF6Ity7 in c.stablepairs(d5GIIXgv)do
if
not(("number"==type(e5k35Eaj))and
tostring(d5GIIXgv[(
e5k35Eaj-1)]):find("^&"))then
if
(c["sym?"](e5k35Eaj)and(tostring(e5k35Eaj)=="&"))then Un(q7EKMsXa,ciF6Ity7,d5GIIXgv,pgSM2,GmzMFiB)elseif
(
c["sym?"](ciF6Ity7)and(tostring(ciF6Ity7)=="&"))then D20xd6lP(q7EKMsXa,e5k35Eaj,d5GIIXgv,GmzMFiB)elseif
(
c["sym?"](e5k35Eaj)and(tostring(e5k35Eaj)=="&as"))then
ed87(ciF6Ity7,{c.expr(tostring(q7EKMsXa))},d5GIIXgv)elseif
(c["sequence?"](d5GIIXgv)and(tostring(ciF6Ity7)=="&as"))then local Yioa,jqmrXZN,rrhjem=select(e5k35Eaj,MAKgn(d5GIIXgv))
NV((nil==rrhjem),"expected &as argument before last parameter",d5GIIXgv)
ed87(jqmrXZN,{c.expr(tostring(q7EKMsXa))},d5GIIXgv)else local LuhmtOo;if(type(e5k35Eaj)=="string")then
LuhmtOo=iIyPus(e5k35Eaj)else LuhmtOo=e5k35Eaj end
local KoVtk1=c.expr(string.format("%s[%s]",q7EKMsXa,LuhmtOo),"expression")if(type(e5k35Eaj)=="string")then
table.insert(pgSM2,e5k35Eaj)else end
GmzMFiB(ciF6Ity7,{KoVtk1},d5GIIXgv)end else end end;return nil end
local function ex0q(GA35ewy,Go,woCOxKH6,WE_F3BIp)local Zi6U,yPu={},{}
for avu,AZEX5w in ipairs(GA35ewy)do
if c["sym?"](AZEX5w)then
table.insert(Zi6U,zPB2j5(AZEX5w,Go))else local yy0EEYQ=AjTaG(cg2kN,ak_o86)table.insert(Zi6U,yy0EEYQ)
do end(yPu)[avu]={AZEX5w,c.expr(yy0EEYQ,"sym")}end end
NV(GA35ewy[1],"must provide at least one value",GA35ewy)
NV(woCOxKH6,"can't nest multi-value destructuring",GA35ewy)Vbha15(Zi6U)if h9c8Ovm then
for vR8xV,JXNn in ipairs(GA35ewy)do if c["sym?"](JXNn)then
cg2kN.symmeta[tostring(JXNn)]={var=Ct}else end end else end;for QJ,u4tU3kYo in
c.stablepairs(yPu)do
WE_F3BIp(u4tU3kYo[1],{u4tU3kYo[2]},GA35ewy)end;return nil end
local function Q(q5gGB,m,CnC_MjCI,X7r)
if
(c["sym?"](q5gGB)and(q5gGB[1]~="nil"))then ed87(q5gGB,m,CnC_MjCI,X7r)elseif c["table?"](q5gGB)then
wp(q5gGB,m,X7r,Q)elseif c["list?"](q5gGB)then ex0q(q5gGB,CnC_MjCI,X7r,Q)else
NV(false,string.format("unable to bind %s %s",type(q5gGB),tostring(q5gGB)),(
((
type((CnC_MjCI)[2])=="table")and(CnC_MjCI)[2])or CnC_MjCI))end;if X7r then return{returned=true}else return nil end end;local LJLY=Q(t020SI,nil,Oo3,true)
c.hook("destructure",y5,t020SI,cg2kN,lTO4YUOr)Mcv4zh(cg2kN,x6lv,Oo3)return LJLY end
local function vj8X8(v1M,jMZowtY,F2Ag,B5)
B5.fallback=function(t7JvZV8,YkP6u)if
(not YkP6u and("literal"==t7JvZV8.type))then
c.warn(("include module not found, falling back to require: %s"):format(tostring(t7JvZV8)))else end;return
c.expr(string.format("require(%s)",tostring(t7JvZV8)),"statement")end
return x9FArgz.global.specials.include(v1M,jMZowtY,F2Ag,B5)end
local function yEPu9(SFR,Pbo)local qmUhVMk=c.copy(Pbo)local cp=nxZZC
local YsQ6AR=(qmUhVMk.scope or GmcCQbi(x9FArgz.global))local MHzfC8Da={}local GP6v={}do end
(function(fLu_u8rB,K7kcm09M,...)
return fLu_u8rB[K7kcm09M](fLu_u8rB,...)end)(c.root,"set-reset")nxZZC=qmUhVMk.allowedGlobals;if(qmUhVMk.indent==nil)then
qmUhVMk.indent="  "else end;if qmUhVMk.requireAsInclude then
YsQ6AR.specials.require=vj8X8 else end
c.root.chunk,c.root.scope,c.root.options=GP6v,YsQ6AR,qmUhVMk;for l,LSQ44 in o.parser(SFR,qmUhVMk.filename,qmUhVMk)do
table.insert(MHzfC8Da,LSQ44)end
for MQ=1,#MHzfC8Da do
local Kqs=bR(MHzfC8Da[MQ],YsQ6AR,GP6v,{nval=(((MQ<
#MHzfC8Da)and 0)or nil),tail=(MQ==
#MHzfC8Da)})J4(Kqs,GP6v,nil,MHzfC8Da[MQ])if(MQ==#MHzfC8Da)then
c.hook("chunk",MHzfC8Da[MQ],YsQ6AR)else end end;nxZZC=cp;c.root.reset()return RNgBFEJ(GP6v,qmUhVMk)end
local function quzRC6(_83FZ,fCIdb)local g6O=(fCIdb or{})return
yEPu9(o["string-stream"](_83FZ,g6O),g6O)end
local function iEYTX(HDh,iTiEO)local VJW6T=c.copy(iTiEO)local fb6Qq=nxZZC;local RfOt={}local SN6a=(VJW6T.scope or
GmcCQbi(x9FArgz.global))do end
(function(OqTYUcdr,J,...)return
OqTYUcdr[J](OqTYUcdr,...)end)(c.root,"set-reset")nxZZC=VJW6T.allowedGlobals
if(VJW6T.indent==nil)then VJW6T.indent="  "else end
if VJW6T.requireAsInclude then SN6a.specials.require=vj8X8 else end;c.root.chunk,c.root.scope,c.root.options=RfOt,SN6a,VJW6T
local WcA3=bR(HDh,SN6a,RfOt,{tail=true})J4(WcA3,RfOt,nil,HDh)c.hook("chunk",HDh,SN6a)nxZZC=fb6Qq
c.root.reset()return RNgBFEJ(RfOt,VJW6T)end
local function Sp(S0DENK1F)
if
((S0DENK1F.what=="C")and S0DENK1F.name)then
return string.format("  [C]: in function '%s'",S0DENK1F.name)elseif(S0DENK1F.what=="C")then return"  [C]: in ?"else
local J=GMU[S0DENK1F.source]
if(J and J[S0DENK1F.currentline])then
if
((
J[S0DENK1F.currentline][1]or"unknown")~="unknown")then
S0DENK1F.short_src=GMU[("@"..J[S0DENK1F.currentline][1])].short_src else S0DENK1F.short_src=J.short_src end
S0DENK1F.currentline=(J[S0DENK1F.currentline][2]or-1)else end
if(S0DENK1F.what=="Lua")then
local function e5()if S0DENK1F.name then return
("'"..S0DENK1F.name.."'")else return"?"end end;return
string.format("  %s:%d: in function %s",S0DENK1F.short_src,S0DENK1F.currentline,e5())elseif
(S0DENK1F.short_src=="(tail call)")then return"  (tail call)"else return
string.format("  %s:%d: in main chunk",S0DENK1F.short_src,S0DENK1F.currentline)end end end
local function AwIAH(vQu79UOU,N)local S0vTJW=tostring((vQu79UOU or""))
if
(
(
S0vTJW:find("^%g+:%d+:%d+ Compile error:.*")or S0vTJW:find("^%g+:%d+:%d+ Parse error:.*"))and not c["debug-on?"]("trace"))then return S0vTJW else local UABGh_2={}
if
(S0vTJW:find("^%g+:%d+:%d+ Compile error:")or
S0vTJW:find("^%g+:%d+:%d+ Parse error:"))then table.insert(UABGh_2,S0vTJW)else
local PHzMfa=S0vTJW:gsub("^[^:]*:%d+:%s+","runtime error: ")table.insert(UABGh_2,PHzMfa)end;table.insert(UABGh_2,"stack traceback:")
local r,GS4d49=false,(N or 2)
while not r do
do local pW5znfH=debug.getinfo(GS4d49,"Sln")if(pW5znfH==nil)then r=true elseif(
nil~=pW5znfH)then local OVcB0=pW5znfH
table.insert(UABGh_2,Sp(OVcB0))else end end;GS4d49=(GS4d49+1)end;return table.concat(UABGh_2,"\n")end end
local function U2q(qCFu_,q)
local function S(t4xJg,_F)if(type(t4xJg)=="number")then return t4xJg,q(_F)else
return qCFu_(t4xJg),q(_F)end end;return S end
local function NPXkKDrL(pagqb,jP)local KukhqhF={}local tbFyKhq,ItPQjEL1="",""
for uKeh,BPf in ipairs(pagqb)do
table.insert(KukhqhF,uKeh)tbFyKhq=(tbFyKhq..ItPQjEL1 ..BPf)ItPQjEL1=jP end
for Qz020OHY,s9g in c.stablepairs(pagqb)do if not KukhqhF[Qz020OHY]then
tbFyKhq=(tbFyKhq..ItPQjEL1 .."["..Qz020OHY..
"]".."="..s9g)ItPQjEL1=jP else end end;return tbFyKhq end
local function B5GZm(N4bio,aYX,x,HZL9a)local function KE(m)return B5GZm(m,aYX,x,HZL9a)end
if
c["varg?"](N4bio)then
NV(not HZL9a,"quoted ... may only be used at compile time",N4bio)return"_VARARG"elseif c["sym?"](N4bio)then local A9L5;if N4bio.filename then
A9L5=string.format("%q",N4bio.filename)else A9L5="nil"end
local l95c=tostring(N4bio)
NV(not HZL9a,"symbols may only be used at compile time",N4bio)
if(l95c:find("#$")or l95c:find("#[:.]"))then
return string.format("sym('%s', {filename=%s, line=%s})",ecvFfcqw(l95c,aYX),A9L5,(
N4bio.line or"nil"))else return
string.format("sym('%s', {quoted=true, filename=%s, line=%s})",l95c,A9L5,(N4bio.line or"nil"))end elseif
(c["list?"](N4bio)and c["sym?"](N4bio[1])and(
tostring(N4bio[1])=="unquote"))then local Xy4=N4bio[2]local Ij868=MAKgn(bR(Xy4,aYX,x))return Ij868[1]elseif
c["list?"](N4bio)then local N3R3hAdM;local function nh()return nil end
N3R3hAdM=c.kvmap(N4bio,U2q(nh,KE))local KPYd;if N4bio.filename then KPYd=string.format("%q",N4bio.filename)else
KPYd="nil"end
NV(not HZL9a,"lists may only be used at compile time",N4bio)
return
string.format(("setmetatable({filename=%s, line=%s, bytestart=%s, %s}"..", getmetatable(list()))"),KPYd,(
N4bio.line or"nil"),(N4bio.bytestart or"nil"),NPXkKDrL(N3R3hAdM,", "))elseif c["sequence?"](N4bio)then local HAXKQ=c.kvmap(N4bio,U2q(KE,KE))
local On=getmetatable(N4bio)local doWI
if On.filename then doWI=string.format("%q",On.filename)else doWI="nil"end;local ZLVJZ;if On then ZLVJZ=On.line else ZLVJZ="nil"end
return
string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})",NPXkKDrL(HAXKQ,", "),doWI,ZLVJZ,"(getmetatable(sequence()))['sequence']")elseif(type(N4bio)=="table")then
local ULZrlPf=c.kvmap(N4bio,U2q(KE,KE))local L5x1dCG=getmetatable(N4bio)local XPAFqHX;if L5x1dCG.filename then
XPAFqHX=string.format("%q",L5x1dCG.filename)else XPAFqHX="nil"end
local function yMPEU05()if L5x1dCG then
return L5x1dCG.line else return"nil"end end;return
string.format("setmetatable({%s}, {filename=%s, line=%s})",NPXkKDrL(ULZrlPf,", "),XPAFqHX,yMPEU05())elseif
(type(N4bio)=="string")then return iIyPus(N4bio)else return tostring(N4bio)end end
return
{compile=iEYTX,compile1=bR,["compile-stream"]=yEPu9,["compile-string"]=quzRC6,["check-binding-valid"]=giqEv,emit=InEPht,destructure=j,["require-include"]=vj8X8,autogensym=ecvFfcqw,gensym=AjTaG,["do-quote"]=B5GZm,["global-mangling"]=UDoYdga,["global-unmangling"]=u_URqAyP,["apply-manglings"]=Mcv4zh,macroexpand=yQ,["declare-local"]=DX,["make-scope"]=GmcCQbi,["keep-side-effects"]=J4,["symbol-to-expression"]=KU1TZ,assert=NV,scopes=x9FArgz,traceback=AwIAH,metadata=RHynDt(),sourcemap=GMU}end
package.preload["fennel.friend"]=package.preload["fennel.friend"]or
function(...)
local FA=require("fennel.utils")local PRn,x3Iv=pcall(require,"utf8")
local PUNI={["unexpected multi symbol (.*)"]={"removing periods or colons from %s"},["use of global (.*) is aliased by a local"]={"renaming local %s","refer to the global using _G.%s instead of directly"},["local (.*) was overshadowed by a special form or macro"]={"renaming local %s"},["global (.*) conflicts with local"]={"renaming local %s"},["expected var (.*)"]={"declaring %s using var instead of let/local","introducing a new local instead of changing the value of %s"},["expected macros to be table"]={"ensuring your macro definitions return a table"},["expected each macro to be function"]={"ensuring that the value for each key in your macros table contains a function","avoid defining nested macro tables"},["macro not found in macro module"]={"checking the keys of the imported macro module's returned table"},["macro tried to bind (.*) without gensym"]={"changing to %s# when introducing identifiers inside macros"},["unknown identifier: (.*)"]={"looking to see if there's a typo","using the _G table instead, eg. _G.%s if you really want a global","moving this code to somewhere that %s is in scope","binding %s as a local in the scope of this code"},["expected a function.* to call"]={"removing the empty parentheses","using square brackets if you want an empty table"},["cannot call literal value"]={"checking for typos","checking for a missing function name","making sure to use prefix operators, not infix"},["unexpected vararg"]={"putting \"...\" at the end of the fn parameters if the vararg was intended"},["multisym method calls may only be in call position"]={"using a period instead of a colon to reference a table's fields","putting parens around this"},["unused local (.*)"]={"renaming the local to _%s if it is meant to be unused","fixing a typo so %s is used","disabling the linter which checks for unused locals"},["expected parameters"]={"adding function parameters as a list of identifiers in brackets"},["unable to bind (.*)"]={"replacing the %s with an identifier"},["expected rest argument before last parameter"]={"moving & to right before the final identifier when destructuring"},["expected vararg as last parameter"]={"moving the \"...\" to the end of the parameter list"},["expected symbol for function parameter: (.*)"]={"changing %s to an identifier instead of a literal value"},["could not compile value of type "]={"debugging the macro you're calling to return a list or table"},["expected local"]={"looking for a typo","looking for a local which is used out of its scope"},["expected body expression"]={"putting some code in the body of this form after the bindings"},["expected binding and iterator"]={"making sure you haven't omitted a local name or iterator"},["expected binding sequence"]={"placing a table here in square brackets containing identifiers to bind"},["expected even number of name/value bindings"]={"finding where the identifier or value is missing"},["may only be used at compile time"]={"moving this to inside a macro if you need to manipulate symbols/lists","using square brackets instead of parens to construct a table"},["unexpected closing delimiter (.)"]={"deleting %s","adding matching opening delimiter earlier"},["mismatched closing delimiter (.), expected (.)"]={"replacing %s with %s","deleting %s","adding matching opening delimiter earlier"},["expected even number of values in table literal"]={"removing a key","adding a value"},["expected whitespace before opening delimiter"]={"adding whitespace"},["invalid character: (.)"]={"deleting or replacing %s","avoiding reserved characters like \", \\, ', ~, ;, @, `, and comma"},["could not read number (.*)"]={"removing the non-digit character","beginning the identifier with a non-digit if it is not meant to be a number"},["can't start multisym segment with a digit"]={"removing the digit","adding a non-digit before the digit"},["malformed multisym"]={"ensuring each period or colon is not followed by another period or colon"},["method must be last component"]={"using a period instead of a colon for field access","removing segments after the colon","making the method call, then looking up the field on the result"},["$ and $... in hashfn are mutually exclusive"]={"modifying the hashfn so it only contains $... or $, $1, $2, $3, etc"},["tried to reference a macro without calling it"]={"renaming the macro so as not to conflict with locals"},["tried to reference a special form without calling it"]={"making sure to use prefix operators, not infix","wrapping the special in a function if you need it to be first class"},["missing subject"]={"adding an item to operate on"},["expected even number of pattern/body pairs"]={"checking that every pattern has a body to go with it","adding _ before the final body"},["expected at least one pattern/body pair"]={"adding a pattern and a body to execute when the pattern matches"},["unexpected arguments"]={"removing an argument","checking for typos"},["unexpected iterator clause"]={"removing an argument","checking for typos"}}local yglXRC=(table.unpack or _G.unpack)
local function mL(BJAK9Ks)local G2f6K0ep=nil
for O,s5h1F in
pairs(PUNI)do if G2f6K0ep then break end;local MNKK={BJAK9Ks:match(O)}
if
(0 <#MNKK)then local c={}local WH_XN=#c;for TZ,cTLR in ipairs(s5h1F)do
local dyWt=cTLR:format(yglXRC(MNKK))
if(nil~=dyWt)then WH_XN=(WH_XN+1)do end(c)[WH_XN]=dyWt else end end
G2f6K0ep=c else G2f6K0ep=nil end end;return G2f6K0ep end
local function Yri1Q(HssZ,E8Y8nr,Djh)
if Djh then
local xwn07_=string.gmatch((Djh.."\n"),"(.-)(\13?\n)")for dSxSJBHV=2,E8Y8nr do xwn07_()end;return xwn07_()else
local DvX4m=assert(io.open(HssZ))
local function EHkocd4(TF,...)DvX4m:close()if TF then return...else return error(...,0)end end
local function _fppKHWE()for G=2,E8Y8nr do DvX4m:read()end;return DvX4m:read()end;return
EHkocd4(_G.xpcall(_fppKHWE,(package.loaded.fennel or debug).traceback))end end
local function GI(DD7M1,Yd7Ju,F8undt)
if((F8undt<Yd7Ju)or(#DD7M1 <Yd7Ju)or
(#DD7M1 <F8undt))then return""elseif PRn then return
string.sub(DD7M1,x3Iv.offset(DD7M1,Yd7Ju),(
(x3Iv.offset(DD7M1,(
F8undt+1))or(x3Iv.len(DD7M1)+1))-1))else return
string.sub(DD7M1,Yd7Ju,math.min(F8undt,DD7M1:len()))end end
local function D(EFurB,fu76gq,l,YoBDM)
if
(
(YoBDM and(false==YoBDM["error-pinpoint"]))or
(os and os.getenv and os.getenv("NO_COLOR")))then return EFurB else local pL3X=(YoBDM or{})local VE4b=pL3X["error-pinpoint"]local r=(l or
fu76gq)local A7KNyC;if PRn then A7KNyC=x3Iv.len(EFurB)else
A7KNyC=string.len(EFurB)end
local vlF=(VE4b or{"\27[7m","\27[0m"})local A2x77Y=vlF[1]local TQz_=vlF[2]return
(GI(EFurB,1,fu76gq)..
A2x77Y..
GI(EFurB,(fu76gq+1),(r+1))..TQz_..GI(EFurB,(r+2),A7KNyC))end end
local function az(wLu6,MKSXwx,e76S8esN,X)local RAV=MKSXwx;local PbAL=RAV["filename"]local R_sPv=RAV["line"]
local eW=RAV["col"]local A3qe=RAV["endcol"]
local Y0y3jy9,HVk=pcall(Yri1Q,PbAL,R_sPv,e76S8esN)local Zy={wLu6,""}
if(Y0y3jy9 and HVk)then if eW then
table.insert(Zy,D(HVk,eW,A3qe,X))else table.insert(Zy,HVk)end else end;for DAty,oGG6AgYL in ipairs((mL(wLu6)or{}))do
table.insert(Zy,("* Try %s."):format(oGG6AgYL))end
return table.concat(Zy,"\n")end
local function HH(Ii,Jlhri4nq,jEuzZr,ATTgv,ajs26)
if not Ii then local qepF=FA["ast-source"](jEuzZr)
local DH4e=qepF["filename"]local XDtCsQ=qepF["line"]local Ky=qepF["col"]
error(az(("%s:%s:%s Compile error: %s"):format((
DH4e or"unknown"),(XDtCsQ or"?"),(Ky or"?"),Jlhri4nq),FA["ast-source"](jEuzZr),ATTgv,ajs26),0)else end;return Ii end
local function H(OibFuU,M1,j9bvMVL,BW,pfjF_e,fMF)return
error(az(("%s:%s:%s Parse error: %s"):format(M1,j9bvMVL,BW,OibFuU),{filename=M1,line=j9bvMVL,col=BW},pfjF_e,fMF),0)end;return{["assert-compile"]=HH,["parse-error"]=H}end
package.preload["fennel.parser"]=package.preload["fennel.parser"]or
function(...)
local A0ui_xDj=require("fennel.utils")local RtYZO=require("fennel.friend")
local ytsM1v=(table.unpack or _G.unpack)
local function vUM(QqBGI)local Ea1Ji,upw,ljxE8="",1,false
local function a0(pzJ)
if not ljxE8 then
if(upw<=#Ea1Ji)then
local v18fj=Ea1Ji:byte(upw)upw=(upw+1)return v18fj else local zpl=QqBGI(pzJ)local function IAA()local YgPmARR=zpl
return(YgPmARR~="")end
if((nil~=zpl)and IAA())then local M_eB5=zpl
Ea1Ji=M_eB5;upw=2;return Ea1Ji:byte()elseif true then local xny=zpl;ljxE8=true;return nil else return nil end end else return nil end end;local function BOvRs()Ea1Ji=""return nil end;return a0,BOvRs end
local function oh(mA0vj,x_Xh6D4u)local t=mA0vj:gsub("^#!",";;")
if x_Xh6D4u then x_Xh6D4u.source=t else end;local HEdMn87=1
local function J38BR2Q()local _g=t:byte(HEdMn87)HEdMn87=(HEdMn87+1)return _g end;return J38BR2Q end
local rnqUUVeM={[40]=41,[41]=true,[91]=93,[93]=true,[123]=125,[125]=true}
local function rOWFI0fU(J)local UrkN
if("number"==type(J))then UrkN=J else UrkN=string.byte(J)end
return
(


(32 <UrkN)and not rnqUUVeM[UrkN]and(UrkN~=127)and(UrkN~=34)and(UrkN~=39)and(UrkN~=126)and(UrkN~=59)and(UrkN~=44)and
(UrkN~=64)and
(UrkN~=96))end
local o3c6Rl={[35]="hashfn",[39]="quote",[44]="unquote",[96]="quote"}
local function T79c3QKh(tQZqIO1Q)
return
(
(function(NKHrge,mtkunlsA,jX4E)
return(NKHrge<mtkunlsA)and(mtkunlsA<jX4E)end)(1,tQZqIO1Q,127)or
(function(FI,j3P2lF2s,Xjco)return(FI<j3P2lF2s)and(j3P2lF2s<Xjco)end)(192,tQZqIO1Q,247))end
local function YBYPED(Gfcij3U,mS,y8A5iORL)local YE7pNsM=y8A5iORL;local GMXQ9pjP=YE7pNsM["source"]
local sPo=YE7pNsM["unfriendly"]local Cw2=YE7pNsM["comments"]local rSfPYb=YE7pNsM;local vUI={}
local W,Dvm,ThzhHC8,oD,jBA=1,0,0,0,nil
local function NUH(dJU6X6US)if T79c3QKh(dJU6X6US)then ThzhHC8=(ThzhHC8-1)else end;if(dJU6X6US==
10)then W,ThzhHC8=(W-1),oD else end;Dvm=(Dvm-1)
jBA=dJU6X6US;return nil end
local function xUshN()local WR=nil;if jBA then WR,jBA=jBA,nil else
WR=Gfcij3U({["stack-size"]=#vUI})end;Dvm=(Dvm+1)if
(WR and T79c3QKh(WR))then ThzhHC8=(ThzhHC8+1)else end;if(WR==10)then
W,ThzhHC8,oD=(W+1),0,ThzhHC8 else end;return WR end
local function oqTajz2H(XBTYDl)
local function i_Q5oQcn()local RSQH_ps=rSfPYb.whitespace;if(nil~=RSQH_ps)then
RSQH_ps=(RSQH_ps)[XBTYDl]else end;return RSQH_ps end;return
((XBTYDl==32)or
(function(xxZyIs,V,n8MwvK)return(xxZyIs<=V)and(V<=n8MwvK)end)(9,XBTYDl,13)or i_Q5oQcn())end
local function u(rs7w,z)local RSx=(ThzhHC8+ (z or-1))
if
(nil==
A0ui_xDj["hook-opts"]("parse-error",rSfPYb,rs7w,mS,(
W or"?"),RSx,GMXQ9pjP,A0ui_xDj.root.reset))then A0ui_xDj.root.reset()
if
(sPo or not _G.io or not _G.io.read)then return
error(string.format("%s:%s:%s Parse error: %s",mS,(W or"?"),RSx,rs7w),0)else return
RtYZO["parse-error"](rs7w,mS,(W or"?"),RSx,GMXQ9pjP,rSfPYb)end else return nil end end
local function GqRU()local Y9SrT,KgjuC5D,dLXo=true;local function a(pDWGL)pDWGL.byteend,pDWGL.endcol=Dvm,(ThzhHC8-1)
return nil end
local function e30(owl)local xuZmDL=vUI[#vUI]
if
(xuZmDL==nil)then dLXo,KgjuC5D,Y9SrT=owl,true,false;return nil elseif
(
(_G.type(xuZmDL)=="table")and(nil~= (xuZmDL).prefix))then local k3dt=(xuZmDL).prefix;local FbsHOx;do local eRFA=table.remove(vUI)
a(eRFA)FbsHOx=eRFA end
local Nmpf7Y=A0ui_xDj.list(A0ui_xDj.sym(k3dt,FbsHOx),owl)for N,e in pairs(FbsHOx)do Nmpf7Y[N]=e end;return e30(Nmpf7Y)elseif
(nil~=xuZmDL)then local pMSHZVp=xuZmDL;Y9SrT=false;return table.insert(pMSHZVp,owl)else return nil end end
local function d()local sRHJY=A0ui_xDj.map(vUI,"closer")local O6T9;if(#vUI==1)then O6T9=""else
O6T9="s"end;return
u(string.format("expected closing delimiter%s %s",O6T9,string.char(ytsM1v(sRHJY))))end
local function LU(bIMk4I)
if(bIMk4I and oqTajz2H(bIMk4I))then Y9SrT=true
return LU(xUshN())elseif(not bIMk4I and(0 <#vUI))then return d()else return bIMk4I end end
local function se(yw,U_)
if(yw and(10 ~=yw))then local function Mly4wFY()local T=U_
table.insert(T,string.char(yw))return T end
return se(xUshN(),Mly4wFY())elseif Cw2 then NUH(10)return
e30(A0ui_xDj.comment(table.concat(U_),{line=W,filename=mS}))else return nil end end
local function TDDCrC(b5HOXLHA)if not Y9SrT then
u(("expected whitespace before opening delimiter "..string.char(b5HOXLHA)))else end;return
table.insert(vUI,{bytestart=Dvm,closer=rnqUUVeM[b5HOXLHA],filename=mS,line=W,col=(
ThzhHC8-1)})end;local function ju(RgjJr)return
e30(setmetatable(RgjJr,getmetatable(A0ui_xDj.list())))end
local function VqvcJ4y(NqDxE)
local V=A0ui_xDj.sequence(ytsM1v(NqDxE))
for qKl_GZlm,nVn_8 in pairs(NqDxE)do getmetatable(V)[qKl_GZlm]=nVn_8 end;return e30(V)end
local function i(Xnk9Je,Oq1Dc,Av7Qv47)local y7LV0xwa=(Xnk9Je)[Oq1Dc]
if(nil~=y7LV0xwa)then local HDBjSc=y7LV0xwa;return
table.insert(HDBjSc,Av7Qv47)elseif true then local GX_f=y7LV0xwa;Xnk9Je[Oq1Dc]={Av7Qv47}return nil else
return nil end end
local function SM3OK(VdAu,dm)
if A0ui_xDj["comment?"](VdAu[dm])then return SM3OK(VdAu,(dm+1))elseif(
A0ui_xDj.sym(":")==VdAu[dm])then
return tostring(VdAu[(dm+1)])else return VdAu[dm]end end
local function E(S4nF)local ZZUqo={keys={},values={},last={}}while
A0ui_xDj["comment?"](S4nF[#S4nF])do
table.insert(ZZUqo.last,1,table.remove(S4nF))end;local YFHpCTL=false
for i7xH25eD,ndx in ipairs(S4nF)do
if not
A0ui_xDj["comment?"](ndx)then YFHpCTL=not YFHpCTL elseif YFHpCTL then
i(ZZUqo.values,SM3OK(S4nF,i7xH25eD),ndx)else i(ZZUqo.keys,SM3OK(S4nF,i7xH25eD),ndx)end end
for kNwL4W3Z=#S4nF,1,-1 do if A0ui_xDj["comment?"](S4nF[kNwL4W3Z])then
table.remove(S4nF,kNwL4W3Z)else end end;return ZZUqo end
local function cfbT(CmZ)local vOkOVV=E(CmZ)local TS={}local L54qaLo4={}if((#CmZ%2)~=0)then Dvm=(Dvm-1)
u("expected even number of values in table literal")else end
setmetatable(L54qaLo4,CmZ)
for GmQ=1,#CmZ,2 do
if
((tostring(CmZ[GmQ])==":")and
A0ui_xDj["sym?"](CmZ[(GmQ+1)])and A0ui_xDj["sym?"](CmZ[GmQ]))then CmZ[GmQ]=tostring(CmZ[(GmQ+1)])else end;L54qaLo4[CmZ[GmQ]]=CmZ[(GmQ+1)]
table.insert(TS,CmZ[GmQ])end;CmZ.comments=vOkOVV;CmZ.keys=TS;return e30(L54qaLo4)end
local function Oc0(GUtSmak1)local CjH=table.remove(vUI)if(CjH==nil)then
u(("unexpected closing delimiter "..
string.char(GUtSmak1)))else end
if(CjH.closer and
(CjH.closer~=GUtSmak1))then
u(("mismatched closing delimiter "..

string.char(GUtSmak1)..", expected "..string.char(CjH.closer)))else end;a(CjH)if(GUtSmak1 ==41)then return ju(CjH)elseif(GUtSmak1 ==93)then
return VqvcJ4y(CjH)else return cfbT(CjH)end end
local function kDAL(OQvQV,Fq5,RdWG30y)table.insert(OQvQV,Fq5)local ya6fjL5s
do local Yaqj6a1U={RdWG30y,Fq5}
if
(
(
_G.type(Yaqj6a1U)=="table")and((Yaqj6a1U)[1]=="base")and((Yaqj6a1U)[2]==92))then ya6fjL5s="backslash"elseif
((_G.type(Yaqj6a1U)=="table")and(
(Yaqj6a1U)[1]=="base")and
((Yaqj6a1U)[2]==34))then ya6fjL5s="done"elseif
((_G.type(Yaqj6a1U)=="table")and(
(Yaqj6a1U)[1]=="backslash")and(
(Yaqj6a1U)[2]==10))then table.remove(OQvQV,(#OQvQV-1))ya6fjL5s="base"elseif true then
local JRmILN12=Yaqj6a1U;ya6fjL5s="base"else ya6fjL5s=nil end end;if(Fq5 and(ya6fjL5s~="done"))then return
kDAL(OQvQV,xUshN(),ya6fjL5s)else return Fq5 end end
local function t0B6TI5G(lKkTr)return
({[7]="\\a",[8]="\\b",[9]="\\t",[10]="\\n",[11]="\\v",[12]="\\f",[13]="\\r"})[lKkTr:byte()]end
local function R()table.insert(vUI,{closer=34})local uAXL8_j_={34}if not
kDAL(uAXL8_j_,xUshN(),"base")then d()else end;table.remove(vUI)
local yFO69so=string.char(ytsM1v(uAXL8_j_))local gA7xA3=yFO69so:gsub("[\7-\13]",t0B6TI5G)
local SRnCezB=(
rawget(_G,"loadstring")or load)(("return "..gA7xA3))
if(nil~=SRnCezB)then local CDE8lC1=SRnCezB;return e30(CDE8lC1())elseif
(SRnCezB==nil)then
return u(("Invalid string: "..yFO69so))else return nil end end
local function sPnDE(pj)
table.insert(vUI,{prefix=o3c6Rl[pj],filename=mS,line=W,bytestart=Dvm,col=(ThzhHC8-1)})local hB=xUshN()
if
(oqTajz2H(hB)or(true==rnqUUVeM[hB]))then
if(pj~=35)then u("invalid whitespace after quoting prefix")else end;table.remove(vUI)e30(A0ui_xDj.sym("#"))else end;return NUH(hB)end
local function WWX(cNoUE6,Vd_v5M3)
if(Vd_v5M3 and rOWFI0fU(Vd_v5M3))then
table.insert(cNoUE6,Vd_v5M3)return WWX(cNoUE6,xUshN())else if Vd_v5M3 then NUH(Vd_v5M3)else end
return cNoUE6 end end
local function Ox(IK4Wj8_)
local RZG3T=(not IK4Wj8_:find("^_")and IK4Wj8_:gsub("_",""))
if IK4Wj8_:match("^%d")then
e30((tonumber(RZG3T)or
u(("could not read number \""..IK4Wj8_.."\""))))return true else local TCtx2=tonumber(RZG3T)
if(nil~=TCtx2)then local It7Dy=TCtx2;e30(It7Dy)return
true elseif true then local NJ8=TCtx2;return false else return nil end end end
local function G(N)local function n(S)
return(N:find(S)-A0ui_xDj.len(N)-1)end
if
(N:match("^~")and(N~="~="))then return u("invalid character: ~")elseif N:match("%.[0-9]")then return
u((
"can't start multisym segment with a digit: "..N),n("%.[0-9]"))elseif(
N:match("[%.:][%.:]")and(N~="..")and(N~="$..."))then return
u(("malformed multisym: "..N),n("[%.:][%.:]"))elseif((N~=":")and N:match(":$"))then
return u((
"malformed multisym: "..N),n(":$"))elseif N:match(":.+[%.:]")then return
u(("method must be last component of multisym: "..N),n(":.+[%.:]"))else return N end end
local function Hqp(IXch)local A1={bytestart=Dvm,filename=mS,line=W,col=(ThzhHC8-1)}
local k=string.char(ytsM1v(WWX({IXch},xUshN())))a(A1)
if(k=="true")then return e30(true)elseif(k=="false")then return e30(false)elseif
(k=="...")then return e30(A0ui_xDj.varg(A1))elseif k:match("^:.+$")then return
e30(k:sub(2))elseif not Ox(k)then return e30(A0ui_xDj.sym(G(k),A1))else return
nil end end
local function t(duCs0)
if not duCs0 then elseif(duCs0 ==59)then se(xUshN(),{";"})elseif(
type(rnqUUVeM[duCs0])=="number")then TDDCrC(duCs0)elseif rnqUUVeM[duCs0]then
Oc0(duCs0)elseif(duCs0 ==34)then R(duCs0)elseif o3c6Rl[duCs0]then sPnDE(duCs0)elseif(rOWFI0fU(duCs0)or(duCs0 ==
string.byte("~")))then
Hqp(duCs0)elseif
not A0ui_xDj["hook-opts"]("illegal-char",rSfPYb,duCs0,xUshN,NUH,e30)then
u(("invalid character: "..string.char(duCs0)))else end
if not duCs0 then return nil elseif KgjuC5D then return true,dLXo else return t(LU(xUshN()))end end;return t(LU(xUshN()))end;local function xthjd62S()vUI,W,Dvm,ThzhHC8,jBA={},1,0,0,nil;return nil end;return GqRU,
xthjd62S end
local function HXSQj(Bc,q7,Z)local Tq1rEK=(q7 or"unknown")
local LtX=(Z or A0ui_xDj.root.options or{})
assert(("string"==type(Tq1rEK)),"expected filename as second argument to parser")
if("string"==type(Bc))then
return YBYPED(oh(Bc,LtX),Tq1rEK,LtX)else return YBYPED(Bc,Tq1rEK,LtX)end end
return{granulate=vUM,parser=HXSQj,["string-stream"]=oh,["sym-char?"]=rOWFI0fU}end;local MrHR4XLm
package.preload["fennel.view"]=package.preload["fennel.view"]or
function(...)
local rvqZ={number=1,boolean=2,string=3,table=4,["function"]=5,userdata=6,thread=7}
local Q={["one-line?"]=false,["detect-cycles?"]=true,["empty-as-sequence?"]=false,["metamethod?"]=true,["prefer-colon?"]=false,["escape-newlines?"]=false,["utf8?"]=true,["line-length"]=80,depth=128,["max-sparse-gap"]=10}local DBscvI=pairs;local QYSYtlA7D=ipairs
local function wXFw(J9EX6KR)local US=getmetatable(J9EX6KR)
if
(
(_G.type(US)=="table")and(nil~= (US).__pairs))then local IqpOgU=(US).__pairs;return IqpOgU(J9EX6KR)elseif true then local mIp=US
return DBscvI(J9EX6KR)else return nil end end
local function qvEX8(ngnH4)local gGN=getmetatable(ngnH4)
if((_G.type(gGN)=="table")and(nil~=
(gGN).__ipairs))then
local Ir=(gGN).__ipairs;return Ir(ngnH4)elseif true then local R11=gGN;return QYSYtlA7D(ngnH4)else return nil end end
local function B(bK)local c=getmetatable(bK)
if((_G.type(c)=="table")and
(nil~= (c).__len))then local wb27heKC=(c).__len
return wb27heKC(bK)elseif true then local gP=c;return#bK else return nil end end
local function FITD(ONBn8)local zniyb=Q[ONBn8]
if(zniyb==nil)then return
error(("option '%s' doesn't have a default value, use the :after key to set it"):format(tostring(ONBn8)))elseif(nil~=zniyb)then
local j6aujQ=zniyb;return j6aujQ else return nil end end
local function sF(E80TCIY,e6np)local wjDpD=E80TCIY[e6np]local nX_qpC=wjDpD
if
(
(_G.type(nX_qpC)=="table")and(nil~= (nX_qpC).once))then local BS=(nX_qpC).once;return BS elseif true then local y_rvNds=nX_qpC;return wjDpD else return nil end end
local function YBNTETc8(q4uUj28)local Bcw={}
for F,VElp in wXFw(q4uUj28)do local OR,wYy=nil,nil
local function Y5c1Gsjp()local BtO_Z=VElp
if
(
(_G.type(BtO_Z)=="table")and(nil~= (BtO_Z).after))then local u4=(BtO_Z).after;return u4 else local function mZWfn44Y()return VElp.once end
if
((
_G.type(BtO_Z)=="table")and mZWfn44Y())then return FITD(F)elseif true then local mVua=BtO_Z;return VElp else return nil end end end;OR,wYy=F,Y5c1Gsjp()if((OR~=nil)and(wYy~=nil))then
Bcw[OR]=wYy else end end;return Bcw end
local function x(UL,DP)local _=UL;local YRJ_EUS5=_[1]local Wj=DP;local jq8Qkr9=Wj[1]local u2zyZTi=type(YRJ_EUS5)
local PVt=type(jq8Qkr9)
if((u2zyZTi==PVt)and
((u2zyZTi=="string")or(u2zyZTi=="number")))then return
(YRJ_EUS5 <jq8Qkr9)else local A=rvqZ[u2zyZTi]local IC2fit8f=rvqZ[PVt]
if(A and IC2fit8f)then return(
A<IC2fit8f)elseif A then return true elseif IC2fit8f then return false else return(u2zyZTi<PVt)end end end
local function fs2GTy(xK)local M=0
if(0 <B(xK))then local RAC5_q=0
for mDqsw,lGhscR0 in qvEX8(xK)do local N=lGhscR0;local I1w=N[1]if
(M< (I1w-RAC5_q))then M=(I1w-RAC5_q)else end;RAC5_q=I1w end else end;return M end
local function jbng(AmrR8)local MAtU9tFR={}local y9xoTS=0
for wuJFkK2,OCx in qvEX8(AmrR8)do local K95=OCx;local tYN=K95[1]y9xoTS=(y9xoTS+1)while(
y9xoTS<tYN)do table.insert(MAtU9tFR,y9xoTS)
y9xoTS=(y9xoTS+1)end end
for e84YWET,yegq in qvEX8(MAtU9tFR)do table.insert(AmrR8,yegq,{yegq})end;return nil end
local function l(bzjvciby,Rxul)local hI=false;local nb_7={}local _Qke_JB=table.insert
for dWbXq,eybr1_af in wXFw(bzjvciby)do
if(
(type(dWbXq)~="number")or(dWbXq<1))then hI=true else end;_Qke_JB(nb_7,{dWbXq,eybr1_af})end;table.sort(nb_7,x)
if not hI then if
(Rxul["max-sparse-gap"]<fs2GTy(nb_7))then hI=true else jbng(nb_7)end else end
if(B(nb_7)==0)then return nb_7,"empty"else
local function dpblsOQ1()if hI then return"table"else return"seq"end end;return nb_7,dpblsOQ1()end end
local function _KX1(IGR4x,kaHCl)
if(type(IGR4x)=="table")then
if not kaHCl[IGR4x]then kaHCl[IGR4x]=1
for hFj,L3IPm5 in
wXFw(IGR4x)do _KX1(hFj,kaHCl)_KX1(L3IPm5,kaHCl)end else
kaHCl[IGR4x]=((kaHCl[IGR4x]or 0)+1)end else end;return kaHCl end
local function P9G1_4TY(eFkbXT5,YwT)local ElF7xZnB=(YwT or{len=0})local sHuwdku=(ElF7xZnB.len+1)
if not
(ElF7xZnB)[eFkbXT5]then ElF7xZnB[eFkbXT5]=sHuwdku;ElF7xZnB.len=sHuwdku else end;return ElF7xZnB end
local function pD5w88(WxP,cCZLvI,Nk5)
if("table"==type(WxP))then cCZLvI[WxP]=true
local cUbIFh,S=next(WxP,Nk5)
if((nil~=cUbIFh)and(nil~=S))then local k3sjc1x0=cUbIFh;local lrrG=S;return
(

cCZLvI[k3sjc1x0]or pD5w88(k3sjc1x0,cCZLvI)or cCZLvI[lrrG]or pD5w88(lrrG,cCZLvI)or
pD5w88(WxP,cCZLvI,k3sjc1x0))else return nil end else return nil end end
local function uU8uhAPI(f2cg0k3,i5DJoU)return
(sF(i5DJoU,"detect-cycles?")and pD5w88(f2cg0k3,{})and
P9G1_4TY(f2cg0k3,i5DJoU.seen)and(1 <
(i5DJoU.appearances[f2cg0k3]or 0)))end
local function WYtvTGIw(MulH,q)local PLoy4usv
if q then PLoy4usv=(B(tostring(q))+2)else PLoy4usv=1 end;return(MulH+PLoy4usv)end;local VPVZ=nil
local function mCXoek(kEW02m,e6Huazc,Qdun,vzP,vb,Jt,AbX3)
local Cbn=("\n"..string.rep(" ",vzP))local E
local function wprCKD0()if("seq"==vb)then return"["else return"{"end end;E=((Jt or"")..wprCKD0())local R;if("seq"==vb)then R="]"else
R="}"end
local SE2mQB=(E..table.concat(kEW02m," ")..R)
if
(not sF(e6Huazc,"one-line?")and
(Qdun or(e6Huazc["line-length"]<
(vzP+B(SE2mQB)))or AbX3))then local function AyiyY()if AbX3 then return Cbn else return""end end
return(E..
table.concat(kEW02m,Cbn)..AyiyY()..R)else return SE2mQB end end
local function UmceFQB1(g)local MAuWbkoO=0;for cbA in string.gmatch(g,"[%z\1-\127\192-\247]")do
MAuWbkoO=(MAuWbkoO+1)end;return MAuWbkoO end
local function _Pr(e9)if("table"==type(e9))then local M6=e9[1]
return(("string"==type(M6))and(nil~=
M6:find("^;")))else return false end end
local function j_K0s(KBcj4Yv8,LJGx,ajLL,ZF)local lK0Ti0LJ=false;local rwzqpmi=ajLL.seen[KBcj4Yv8]
if
(ajLL.depth<=ajLL.level)then return"{...}"elseif(rwzqpmi and sF(ajLL,"detect-cycles?"))then return(
"@"..rwzqpmi.."{...}")else
local bMVOVayW=uU8uhAPI(KBcj4Yv8,ajLL)
local WLF=(bMVOVayW and ajLL.seen[KBcj4Yv8])local Ot=WYtvTGIw(ZF,WLF)local uOyc7;if sF(ajLL,"utf8?")then uOyc7=UmceFQB1 else
local function Ssqzca(B67TL11)return#B67TL11 end;uOyc7=Ssqzca end;local aXOURvRZ;if
bMVOVayW then aXOURvRZ=("@"..WLF)else aXOURvRZ=""end;local raCdp
do
local m5uAxF=YBNTETc8(ajLL)local F={}local C=#F
for zMlYy,HAOHW in qvEX8(LJGx)do local H=HAOHW;local nde=H[1]local Bq=H[2]local kWEEiV6g
do
local TDqhP=VPVZ(nde,m5uAxF,(Ot+1),true)
local C0lZsXfi=VPVZ(Bq,m5uAxF,(Ot+uOyc7(TDqhP)+1))
lK0Ti0LJ=(lK0Ti0LJ or TDqhP:find("\n")or C0lZsXfi:find("\n"))kWEEiV6g=(TDqhP.." "..C0lZsXfi)end
if(nil~=kWEEiV6g)then C=(C+1)do end(F)[C]=kWEEiV6g else end end;raCdp=F end
return mCXoek(raCdp,ajLL,lK0Ti0LJ,Ot,"table",aXOURvRZ,false)end end
local function qhWPu(m,DyW,WpvT5m98,emkAp)local _XRPNjK=false;local eII=WpvT5m98.seen[m]
if
(WpvT5m98.depth<=WpvT5m98.level)then return"[...]"elseif
(eII and sF(WpvT5m98,"detect-cycles?"))then return("@"..eII.."[...]")else
local Vsl0=uU8uhAPI(m,WpvT5m98)local fMppEj7=(Vsl0 and WpvT5m98.seen[m])
local V0yuyaY=WYtvTGIw(emkAp,fMppEj7)local L;if Vsl0 then L=("@"..fMppEj7)else L=""end
local EvZ6=_Pr(m[#m])local g
do local fdOPRM1=YBNTETc8(WpvT5m98)local FHT91={}local PpK8F=#FHT91
for J,pZY in qvEX8(DyW)do
local z2=pZY;local M=z2[1]local sXW=z2[2]local CznVN;do local y5q=VPVZ(sXW,fdOPRM1,V0yuyaY)
_XRPNjK=(_XRPNjK or
y5q:find("\n")or y5q:find("^;"))CznVN=y5q end
if
(nil~=CznVN)then PpK8F=(PpK8F+1)do end(FHT91)[PpK8F]=CznVN else end end;g=FHT91 end;return mCXoek(g,WpvT5m98,_XRPNjK,V0yuyaY,"seq",L,EvZ6)end end
local function Qa8Bfz(sqN,b,z,p6)
if(B(sqN)==0)then
if sF(b,"empty-as-sequence?")then return"[]"else return"{}"end else local DrFC;local HgV
do local Fldd={}local atAab=#Fldd;for h,X in qvEX8(sqN)do local uVc=X:gsub("^%s+","")
if
(nil~=uVc)then atAab=(atAab+1)do end(Fldd)[atAab]=uVc else end end;HgV=Fldd end;DrFC=table.concat(HgV," ")
if
(not sF(b,"one-line?")and
(p6 or
DrFC:find("\n")or(b["line-length"]< (z+B(DrFC)))))then return
table.concat(sqN,("\n"..string.rep(" ",z)))else return DrFC end end end
local function b0(HZM4DFRJ,UcP,b,w)
if(b.depth<=b.level)then
if sF(b,"empty-as-sequence?")then return"[...]"else return"{...}"end else local koFmC;local function I(li)return uU8uhAPI(li,b)end
b["visible-cycle?"]=I;koFmC=nil;local Dcu,Ndm1xBYc=nil,nil;do local phqeo=YBNTETc8(b)
Dcu,Ndm1xBYc=UcP(HZM4DFRJ,VPVZ,phqeo,w)end;b["visible-cycle?"]=nil
local GH0tzvu=type(Dcu)
if(GH0tzvu=="string")then return Dcu elseif(GH0tzvu=="table")then return
Qa8Bfz(Dcu,b,w,Ndm1xBYc)elseif true then local U=GH0tzvu;return
error("__fennelview metamethod must return a table of lines")else return nil end end end
local function b81Fw(SFFm,TE,Th5BpD4B)TE.level=(TE.level+1)local gaWBjVL9
do local v
if sF(TE,"metamethod?")then local TmJv1=SFFm
if
(nil~=TmJv1)then local ZRapQFix=getmetatable(TmJv1)if(nil~=ZRapQFix)then
v=(ZRapQFix).__fennelview else v=ZRapQFix end else v=TmJv1 end else v=nil end
if(nil~=v)then local bHQ4G=v;gaWBjVL9=b0(SFFm,bHQ4G,TE,Th5BpD4B)elseif true then local dR96ZM=v
local mA3DdzFd,CE0prxRC=l(SFFm,TE)
if(true and(CE0prxRC=="empty"))then local Bff=mA3DdzFd;if
sF(TE,"empty-as-sequence?")then gaWBjVL9="[]"else gaWBjVL9="{}"end elseif(
(nil~=mA3DdzFd)and(CE0prxRC=="table"))then
local wE7=mA3DdzFd;gaWBjVL9=j_K0s(SFFm,wE7,TE,Th5BpD4B)elseif((nil~=mA3DdzFd)and
(CE0prxRC=="seq"))then local H2rM5=mA3DdzFd
gaWBjVL9=qhWPu(SFFm,H2rM5,TE,Th5BpD4B)else gaWBjVL9=nil end else gaWBjVL9=nil end end;TE.level=(TE.level-1)return gaWBjVL9 end
local function umz(TKmgwuo)local q=string.gsub(tostring(TKmgwuo),",",".")return q end
local function JXCg(n2R)return n2R:find("^[-%w?^_!$%&*+./@|<=>]+$")end
local K9fi_VCl={{["min-byte"]=0,["max-byte"]=127,["min-code"]=0,["max-code"]=127,len=1},{["min-byte"]=192,["max-byte"]=223,["min-code"]=128,["max-code"]=2047,len=2},{["min-byte"]=224,["max-byte"]=239,["min-code"]=2048,["max-code"]=65535,len=3},{["min-byte"]=240,["max-byte"]=247,["min-code"]=65536,["max-code"]=1114111,len=4}}
local function xknmF(nM1Z9cl)
local function w(UcyAum,dYsjmqdo)local k=K9fi_VCl;local Ur_nfNU=string.byte(UcyAum,dYsjmqdo)local YF8Nredr
do
local tyx_Qk=nil
for urZP,ayXNm in qvEX8(k)do if tyx_Qk then break end
tyx_Qk=(Ur_nfNU and
(function(Iq9D_7Yo,OMesxhmz,Q9BrppG)return(Iq9D_7Yo<=OMesxhmz)and
(OMesxhmz<=Q9BrppG)end)(ayXNm["min-byte"],Ur_nfNU,ayXNm["max-byte"])and
ayXNm)end;YF8Nredr=tyx_Qk end;local wFF9q_B
local function KLNU()local D9E4D;if YF8Nredr then
D9E4D=(Ur_nfNU-YF8Nredr["min-byte"])else D9E4D=nil end
for hhiP24bV=(dYsjmqdo+1),(
dYsjmqdo+YF8Nredr.len+-1)do
local O34P1h=string.byte(UcyAum,hhiP24bV)
D9E4D=(O34P1h and D9E4D and
(function(M,oW2YQpc,EX1c04A)
return(M<=oW2YQpc)and(oW2YQpc<=EX1c04A)end)(128,O34P1h,191)and((D9E4D*64)+
(O34P1h-128)))end;return D9E4D end;wFF9q_B=(YF8Nredr and KLNU())
if
(wFF9q_B and
(function(svWLk,H6V,vZece1k)return(svWLk<=H6V)and
(H6V<=vZece1k)end)(YF8Nredr["min-code"],wFF9q_B,YF8Nredr["max-code"])and not
(function(ZUrs,cJ9n_wGv,oNrtf_)return
(ZUrs<=cJ9n_wGv)and(cJ9n_wGv<=oNrtf_)end)(55296,wFF9q_B,57343))then return YF8Nredr.len else return nil end end;local UTW=1;local hYYhQ={}
while(UTW<=#nM1Z9cl)do
local HtgpP=(
string.find(nM1Z9cl,"[\128-\255]",UTW)or(#nM1Z9cl+1))local lyBbtwn=w(nM1Z9cl,HtgpP)
table.insert(hYYhQ,string.sub(nM1Z9cl,UTW,(
HtgpP+ (lyBbtwn or 0)+-1)))if(not lyBbtwn and(HtgpP<=#nM1Z9cl))then
table.insert(hYYhQ,string.format("\\%03d",string.byte(nM1Z9cl,HtgpP)))else end;if lyBbtwn then
UTW=(HtgpP+lyBbtwn)else UTW=(HtgpP+1)end end;return table.concat(hYYhQ)end
local function Z69(biFy,Kp,o4A)local M9=B(biFy)
local rzBY2CSb=((M9 <2)or
(sF(Kp,"escape-newlines?")and(M9 <
(Kp["line-length"]-o4A))))local eJbv;local BUVM8;if rzBY2CSb then BUVM8="\\n"else BUVM8="\n"end;local function k(Kl1YC,b8)return
("\\%03d"):format(b8:byte())end
eJbv=setmetatable({["\7"]="\\a",["\8"]="\\b",["\12"]="\\f",["\11"]="\\v",["\13"]="\\r",["\9"]="\\t",["\\"]="\\\\",["\""]="\\\"",["\n"]=BUVM8},{__index=k})
local x5=("\""..biFy:gsub("[%c\\\"]",eJbv).."\"")if sF(Kp,"utf8?")then return xknmF(x5)else return x5 end end
local function i(bGdXdZ,iIoI)local F
do local UFS7={}
for rsqKt,e in wXFw(Q)do local qIYmlZUV,ae8WUke=rsqKt,e;if
((qIYmlZUV~=nil)and(ae8WUke~=nil))then UFS7[qIYmlZUV]=ae8WUke else end end;F=UFS7 end;local qRV={level=0,appearances=_KX1(bGdXdZ,{}),seen={len=0}}for EU8,B6 in wXFw((
iIoI or{}))do F[EU8]=B6 end;for KJgE8hd,ufBK in wXFw(qRV)do
F[KJgE8hd]=ufBK end;return F end
local function IDjuB(cZ,maaag,Bi35M,ZjzhK)local tihCL=(Bi35M or 0)local r=(maaag or i(cZ))local ZDeC;if r.preprocess then
ZDeC=r.preprocess(cZ,r)else ZDeC=cZ end;local HZlrFcs=type(ZDeC)
local function O()
local QD=getmetatable(ZDeC)if(nil~=QD)then return(QD).__fennelview else return QD end end
if((HZlrFcs=="table")or
((HZlrFcs=="userdata")and O()))then
return b81Fw(ZDeC,r,tihCL)elseif(HZlrFcs=="number")then return umz(ZDeC)else
local function hcbBcU()
if(ZjzhK~=nil)then return ZjzhK elseif("function"==
type(r["prefer-colon?"]))then
return r["prefer-colon?"](ZDeC)else return sF(r,"prefer-colon?")end end
if
((HZlrFcs=="string")and JXCg(ZDeC)and hcbBcU())then return(":"..ZDeC)elseif(HZlrFcs=="string")then return Z69(ZDeC,r,tihCL)elseif
((
HZlrFcs=="boolean")or(HZlrFcs=="nil"))then return tostring(ZDeC)else return
("#<"..tostring(ZDeC)..">")end end end;VPVZ=IDjuB
local function xoF(OkdSp2,zO7D8g2)return VPVZ(OkdSp2,i(OkdSp2,zO7D8g2),0)end;return xoF end
package.preload["fennel.utils"]=package.preload["fennel.utils"]or
function(...)
local ywRB55Y3=require("fennel.view")local uUc5YN="1.3.0"
local function tBlx5J()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"))end
local function BJLlq()local ZfJ
if(_G.jit.os=="OSX")then ZfJ="macOS"else ZfJ=_G.jit.os end;return
(_G.jit.version.." "..ZfJ.."/".._G.jit.arch)end
local function DsnW()return
(

(nil~=_G.fengari)and(type(_G.fengari)=="table")and(nil~=_G.fengari.VERSION)and
(type(_G.fengari.VERSION_NUM)=="number"))end;local function f0qgvqD()return
(_G.fengari.RELEASE.." (".._VERSION..")")end;local function r()
if tBlx5J()then
return BJLlq()elseif DsnW()then return f0qgvqD()else return("PUC ".._VERSION)end end
local function IYCyS()return("Fennel "..uUc5YN..
" on "..r())end;local function rgNe(kZ)
if(_G.io and _G.io.stderr)then return
(_G.io.stderr):write(("--WARNING: %s\n"):format(tostring(kZ)))else return nil end end
local wMf06P3R
do local G,UV=pcall(require,"utf8")
if
((G==true)and(nil~=UV))then local Vmk7fAg=UV;wMf06P3R=Vmk7fAg.len elseif true then local kDtxd5=G;wMf06P3R=string.len else wMf06P3R=nil end end
local function dzghhciK(CR5bl6Nk,BjIQON,MLLs29h)
for Umpt,NVyj in ipairs(getmetatable(CR5bl6Nk).keys)do if(CR5bl6Nk[NVyj]and not
MLLs29h[NVyj])then MLLs29h[NVyj]=true
table.insert(BjIQON,NVyj)else end end;for Nt3 in pairs(CR5bl6Nk)do
if not MLLs29h[Nt3]then table.insert(BjIQON,Nt3)else end end;return BjIQON end
local function PwmycU9j(UPRQV)local OuKZ9r5_b;local AE;do local ZXC=getmetatable(UPRQV)
if(nil~=ZXC)then ZXC=(ZXC).keys else end;AE=ZXC end
if AE then
OuKZ9r5_b=dzghhciK(UPRQV,{},{})else local mPFtR
do local cwH={}local L8qe=#cwH
for w0n in pairs(UPRQV)do local Fulc=w0n;if(nil~=Fulc)then L8qe=(L8qe+1)
do end(cwH)[L8qe]=Fulc else end end;mPFtR=cwH end;local function NK3P(ZEnxqQUU,vKS)
return(tostring(ZEnxqQUU)<tostring(vKS))end;table.sort(mPFtR,NK3P)
OuKZ9r5_b=mPFtR end;local NrE
do local i={}
for dLf2jPq,i8Md in ipairs(OuKZ9r5_b)do
local qEYllmGl,kidu9L1=i8Md,OuKZ9r5_b[(dLf2jPq+1)]if((qEYllmGl~=nil)and(kidu9L1 ~=nil))then
i[qEYllmGl]=kidu9L1 else end end;NrE=i end;local function gAxTFh(h,YTj)local f;if(YTj==nil)then f=OuKZ9r5_b[1]else f=NrE[YTj]end
return f,h[f]end;return gAxTFh,UPRQV,nil end
local function RALLLsy(szuBLiJ,lldG,YQTxGz)
assert(("table"==type(szuBLiJ)),"get-in expects path to be a table")
if(0 ==#lldG)then return YQTxGz else local niC
do local noG=szuBLiJ;for njXSViBs,ppmAJ in ipairs(lldG)do
if(nil==noG)then break end;local h1=type(noG)
if(h1 =="table")then noG=noG[ppmAJ]else noG=nil end end
niC=noG end
if(nil~=niC)then local RwJd=niC;return RwJd elseif true then local geS0=niC;return YQTxGz else return nil end end end
local function eUVcEqV3(yYbGcrR,qOa_Ko,aeT)local GVDHI=(aeT or{})local F5qHLf
if(type(qOa_Ko)=="function")then
F5qHLf=qOa_Ko else local function O_F(_R7vx)return(_R7vx)[qOa_Ko]end;F5qHLf=O_F end
for UUsIt,PeXzzb in ipairs(yYbGcrR)do local PS=F5qHLf(PeXzzb)if(nil~=PS)then local HjTf4=PS
table.insert(GVDHI,HjTf4)else end end;return GVDHI end
local function J9A3WWhJ(kq1wF,oJ,jbu_UOWn)local Un3W=(jbu_UOWn or{})local gb
if(type(oJ)=="function")then gb=oJ else local function s(CLqUm)return
(CLqUm)[oJ]end;gb=s end
for C,AAY in PwmycU9j(kq1wF)do local H,s=gb(C,AAY)if((nil~=H)and(nil~=s))then
local Zk6TOK=H;local L51e=s;Un3W[Zk6TOK]=L51e elseif(nil~=H)then local rK067tHi=H
table.insert(Un3W,rK067tHi)else end end;return Un3W end
local function O(KKXynV,QfEQ)local j=(QfEQ or{})for b31H,q2e in pairs((KKXynV or{}))do local LmtHYt,YL=b31H,q2e
if(
(LmtHYt~=nil)and(YL~=nil))then j[LmtHYt]=YL else end end;return j end
local function wt4K(KPpwX,dhMu65,xIEL0)local c=dhMu65[(xIEL0 or 1)]
if(c==KPpwX)then return true elseif(c==nil)then
return nil elseif true then local YNJ=c
return wt4K(KPpwX,dhMu65,((xIEL0 or 1)+1))else return nil end end
local function Zz(PRI)local MK08=0
for TWuTU_S in pairs(PRI)do if("number"==type(TWuTU_S))then
MK08=math.max(MK08,TWuTU_S)else MK08=MK08 end end;return MK08 end;local function t(i_,gByFT)local vj=true
for S,Oj in ipairs(gByFT)do if not vj then break end;vj=i_(Oj)end;return vj end
local function qveu(TAK01)
assert((
type(TAK01)=="table"),"allpairs expects a table")local BhME7zKa=TAK01;local hW={}
local function d(fDTdRtv,wOUo)local Z,REZciXm=next(BhME7zKa,wOUo)
if hW[Z]then return d(nil,Z)elseif Z then
hW[Z]=true;return Z,REZciXm else local vet06dX=getmetatable(BhME7zKa)
if(
(_G.type(vet06dX)=="table")and true)then local LSJ=(vet06dX).__index
if("table"==
type(LSJ))then BhME7zKa=LSJ;return d(BhME7zKa)else return nil end else return nil end end end;return d end;local function r33Uk(TX7wgl2)return TX7wgl2[1]end;local K8pEP=nil
local function ZzS4pmQf(nLhs,BePns,a,YAaqAxth)local Kv1={}local GBq2DiO
if BePns then local function tZwJ5kGy(n)return
BePns(n,a,YAaqAxth)end;GBq2DiO=tZwJ5kGy else GBq2DiO=ywRB55Y3 end;local YuK=Zz(nLhs)
for nKd=1,YuK do Kv1[nKd]=(
((nLhs[nKd]==nil)and K8pEP)or nLhs[nKd])end
return("("..
table.concat(eUVcEqV3(Kv1,GBq2DiO)," ",1,YuK)..")")end;local function HlqK3O(_ix1)return _ix1,true end
local function ak(dTQygQp,G0jFU0N)return
(
(r33Uk(dTQygQp)==r33Uk(G0jFU0N))and
(getmetatable(dTQygQp)==getmetatable(G0jFU0N)))end
local function nJAHY(_pcAkYZw,k)return(_pcAkYZw[1]<tostring(k))end
local gdwDZ7K8={__fennelview=r33Uk,__tostring=r33Uk,__eq=ak,__lt=nJAHY,"SYMBOL"}local n8;local function Abj_oS(h7dX)return tostring(r33Uk(h7dX))end
n8={__tostring=Abj_oS,"EXPR"}local y={__fennelview=ZzS4pmQf,__tostring=ZzS4pmQf,"LIST"}
local N={__fennelview=HlqK3O,__tostring=r33Uk,__eq=ak,__lt=nJAHY,"COMMENT"}local It78KVqm={"SEQUENCE"}
local eVtr7R={__fennelview=r33Uk,__tostring=r33Uk,"VARARG"}local PK;local function xwvh9TWh()return nil end
PK=((os and os.getenv)or xwvh9TWh)
local function nao(m)local YQEy=(PK("FENNEL_DEBUG")or"")return((YQEy=="all")or
YQEy:find(m))end;local function hshvQ4(...)return setmetatable({...},y)end
local function zkEfU2aq(b,BpzDEg)local BpCsj
do
local A={b}
for WmxYa4Y,FzCqUI in pairs((BpzDEg or{}))do local jc,BYw=nil,nil;if
(type(WmxYa4Y)=="string")then jc,BYw=WmxYa4Y,FzCqUI else jc,BYw=nil end;if(
(jc~=nil)and(BYw~=nil))then A[jc]=BYw else end end;BpCsj=A end;return setmetatable(BpCsj,gdwDZ7K8)end;K8pEP=zkEfU2aq("nil")
local function g(...)
local function Wc819r(KuR,ExwYzLq,h8DoQ,IKSbGTVl)local OmFTJ_x5
do local NF=h8DoQ
NF["empty-as-sequence?"]={once=true,after=h8DoQ["empty-as-sequence?"]}
NF["metamethod?"]={once=false,after=h8DoQ["metamethod?"]}OmFTJ_x5=NF end;return ExwYzLq(KuR,OmFTJ_x5,IKSbGTVl)end
return setmetatable({...},{sequence=It78KVqm,__fennelview=Wc819r})end
local function xPkHq(os0TDkQC,uqBQ9dTh)return setmetatable({type=uqBQ9dTh,os0TDkQC},n8)end
local function RzY6je9(u,YnP)local Eg=(YnP or{})local KgxF=Eg["filename"]local j_cIt=Eg["line"]return
setmetatable({filename=KgxF,line=j_cIt,u},N)end
local function DgN(i)local o
do local YqXHrgg={"..."}
for RqhnbJhs,eFI in pairs((i or{}))do local iL27y2w,o9=nil,nil;if
(type(RqhnbJhs)=="string")then iL27y2w,o9=RqhnbJhs,eFI else iL27y2w,o9=nil end;if((
iL27y2w~=nil)and(o9 ~=nil))then
YqXHrgg[iL27y2w]=o9 else end end;o=YqXHrgg end;return setmetatable(o,eVtr7R)end
local function az(_Prk6Jm_)return
((type(_Prk6Jm_)=="table")and
(getmetatable(_Prk6Jm_)==n8)and _Prk6Jm_)end
local function FMQ(HfLnH2m)return
((type(HfLnH2m)=="table")and
(getmetatable(HfLnH2m)==eVtr7R)and HfLnH2m)end
local function xHs(NYPzbv6hL)return
((type(NYPzbv6hL)=="table")and
(getmetatable(NYPzbv6hL)==y)and NYPzbv6hL)end;local function epujP2(zp)
return(
(type(zp)=="table")and(getmetatable(zp)==gdwDZ7K8)and zp)end
local function RU(ovq)
local Btx=(
(type(ovq)=="table")and getmetatable(ovq))return
(Btx and(Btx.sequence==It78KVqm)and ovq)end;local function eeiQ(mtmN)
return(
(type(mtmN)=="table")and(getmetatable(mtmN)==N)and mtmN)end
local function Knl(U6)return
(

(type(U6)=="table")and not
FMQ(U6)and(getmetatable(U6)~=y)and(getmetatable(U6)~=gdwDZ7K8)and not eeiQ(U6)and U6)end
local function JaOvVR5(BTixF)return(type(BTixF)=="string")end
local function q1f0Oc2T(JeGvp)
if epujP2(JeGvp)then return q1f0Oc2T(tostring(JeGvp))elseif
(type(JeGvp)~="string")then return false else
local function cTPe07ea()local FtNgLV3={}
for xb3cZqz in JeGvp:gmatch("[^%.%:]+[%.%:]?")do
local ALLM=xb3cZqz:sub((-1))
if(ALLM==":")then FtNgLV3["multi-sym-method-call"]=true else end;if((ALLM==":")or(ALLM=="."))then FtNgLV3[(#FtNgLV3+1)]=xb3cZqz:sub(1,(
-2))else
FtNgLV3[(#FtNgLV3+1)]=xb3cZqz end end;return((0 <#FtNgLV3)and FtNgLV3)end
return
(

(JeGvp:match("%.")or JeGvp:match(":"))and not
JeGvp:match("%.%.")and(JeGvp:byte()~=
string.byte("."))and(JeGvp:byte((-1))~=string.byte("."))and cTPe07ea())end end;local function ud5HPbcv(zzlLc)return zzlLc.quoted end
local function wk1(v05sOls6)return
(
(type(v05sOls6)=="string")or(type(v05sOls6)=="integer")or(
type(v05sOls6)=="number")or(
epujP2(v05sOls6)and not q1f0Oc2T(v05sOls6)))end
local function VQJ(KxAor2)
if(Knl(KxAor2)or RU(KxAor2))then return
(getmetatable(KxAor2)or{})elseif("table"==type(KxAor2))then return KxAor2 else return{}end end
local function AIijmsE(xnwyE,QWX8_lf,M3LR3tn)
local function Erbj(d4LZ,dLmX,tmAdfrX3,rWwH)
if QWX8_lf(tmAdfrX3,rWwH,dLmX)then
for WZV9gJ,MWkVn1 in d4LZ(rWwH)do Erbj(d4LZ,rWwH,WZV9gJ,MWkVn1)end;return nil else return nil end end;Erbj((M3LR3tn or pairs),nil,nil,xnwyE)
return xnwyE end
local qWK_3JzI={"and","break","do","else","elseif","end","false","for","function","if","in","local","nil","not","or","repeat","return","then","true","until","while","goto"}
for U3tvJtO,tAn_s in ipairs(qWK_3JzI)do qWK_3JzI[tAn_s]=U3tvJtO end;local function nb43hxtA(Rl)return
(Rl:match("^[%a_][%w_]*$")and not qWK_3JzI[Rl])end
local Up={"allowedGlobals","indent","correlate","useMetadata","env","compiler-env","compilerEnv"}
local function kq6F_y(zKTBQ,Bwjp3Zb)for JKwYNF,vZ in ipairs(Up)do Bwjp3Zb[vZ]=zKTBQ[vZ]end;return Bwjp3Zb end;local uB;local function EbTdnc6_()end
uB={chunk=nil,scope=nil,options=nil,reset=EbTdnc6_}
uB["set-reset"]=function(aGXjGx)local TpP=aGXjGx;local Szm5J41=TpP["chunk"]local Kx0f6LwY=TpP["scope"]
local U=TpP["options"]local KQoCWF6y=TpP["reset"]
uB.reset=function()
uB.chunk,uB.scope,uB.options,uB.reset=Szm5J41,Kx0f6LwY,U,KQoCWF6y;return nil end;return uB.reset end;local KKl={}
local function J_(EDZ)local rQSUS=EDZ;local U9fgafbB=rQSUS["name"]local SVDqS=rQSUS["versions"]
local WVWl=rQSUS
if
(
not wt4K(uUc5YN:gsub("-dev",""),(SVDqS or{}))and not KKl[WVWl])then KKl[WVWl]=true;return
rgNe(string.format("plugin %s does not support Fennel version %s",(U9fgafbB or"unknown"),uUc5YN))else return nil end end
local function sLgV(qsG8aH2,J3DYNYlZ,...)local Dv26;local function w1V4n(...)local Bc7kn4=J3DYNYlZ
if(nil~=Bc7kn4)then Bc7kn4=(Bc7kn4).plugins else end;return Bc7kn4 end;local function OaCu_(...)
local be3Cfi=uB.options;if(nil~=be3Cfi)then be3Cfi=(be3Cfi).plugins else end
return be3Cfi end;Dv26=(w1V4n(...)or
OaCu_(...))
if Dv26 then local HJY=nil
for o,FDkG25 in ipairs(Dv26)do if HJY then break end
J_(FDkG25)local kDfLP=FDkG25[qsG8aH2]if(nil~=kDfLP)then local DP2oc6Nu=kDfLP
HJY=DP2oc6Nu(...)else HJY=nil end end;return HJY else return nil end end;local function W(b0N,...)return sLgV(b0N,uB.options,...)end
return
{warn=rgNe,allpairs=qveu,stablepairs=PwmycU9j,copy=O,["get-in"]=RALLLsy,kvmap=J9A3WWhJ,map=eUVcEqV3,["walk-tree"]=AIijmsE,["member?"]=wt4K,maxn=Zz,["every?"]=t,list=hshvQ4,sequence=g,sym=zkEfU2aq,varg=DgN,expr=xPkHq,comment=RzY6je9,["comment?"]=eeiQ,["expr?"]=az,["list?"]=xHs,["multi-sym?"]=q1f0Oc2T,["sequence?"]=RU,["sym?"]=epujP2,["table?"]=Knl,["varg?"]=FMQ,["quoted?"]=ud5HPbcv,["string?"]=JaOvVR5,["idempotent-expr?"]=wk1,["valid-lua-identifier?"]=nb43hxtA,["lua-keywords"]=qWK_3JzI,hook=W,["hook-opts"]=sLgV,["propagate-options"]=kq6F_y,root=uB,["debug-on?"]=nao,["ast-source"]=VQJ,version=uUc5YN,["runtime-version"]=IYCyS,len=wMf06P3R,path=table.concat({"./?.fnl","./?/init.fnl",PK("FENNEL_PATH")},";"),["macro-path"]=table.concat({"./?.fnl","./?/init-macros.fnl","./?/init.fnl",PK("FENNEL_MACRO_PATH")},";")}end;MrHR4XLm=require("fennel.utils")
local Y=require("fennel.parser")local Mm=require("fennel.compiler")
local CD=require("fennel.specials")local vwkjf=require("fennel.repl")
local wcsc=require("fennel.view")
local function ASw(V,QBrhtH)
if(V=="_COMPILER")then
local p6an=CD["make-compiler-env"](nil,Mm.scopes.compiler,{},QBrhtH)if(QBrhtH.allowedGlobals==nil)then
QBrhtH.allowedGlobals=CD["current-global-names"](p6an)else end
return CD["wrap-env"](p6an)else return(V and CD["wrap-env"](V))end end
local function Ku(dh6fW,lEsr)local NalT=MrHR4XLm.copy(dh6fW)if
(NalT.allowedGlobals==nil)then
NalT.allowedGlobals=CD["current-global-names"](NalT.env)else end
if(not NalT.filename and
not NalT.source)then NalT.source=lEsr else end;if(NalT.env=="_COMPILER")then
NalT.scope=Mm["make-scope"](Mm.scopes.compiler)else end;return NalT end
local function K(tIrMMuh1,X,...)local P=Ku(X,tIrMMuh1)local SDpQWorN=ASw(P.env,P)
local AD=Mm["compile-string"](tIrMMuh1,P)local KYeUsAQT;local function tTPXe(...)
if P.filename then return("@"..P.filename)else return tIrMMuh1 end end
KYeUsAQT=CD["load-code"](AD,SDpQWorN,tTPXe(...))P.filename=nil;return KYeUsAQT(...)end
local function Fb(KjWEUr,d,...)local j4PSgY=MrHR4XLm.copy(d)
local NqMzi=assert(io.open(KjWEUr,"rb"))
local jw1H_k=assert(NqMzi:read("*all"),("Could not read "..KjWEUr))NqMzi:close()j4PSgY.filename=KjWEUr
return K(jw1H_k,j4PSgY,...)end
local function XSbn()
local liIoYEJd={"when","with-open","collect","icollect","fcollect","lambda","\206\187","macro","match","match-try","case","case-try","accumulate","faccumulate","doto"}
local h8KDei6f={"collect","icollect","fcollect","each","for","let","with-open","accumulate","faccumulate"}
local JX={"fn","lambda","\206\187","var","local","macro","macros","global"}local BrSRAw={}
for VfLV6h1,E5 in pairs(Mm.scopes.global.specials)do
local rsIIW=(Mm.metadata[E5]or{})do end
(BrSRAw)[VfLV6h1]={["special?"]=true,["body-form?"]=rsIIW["fnl/body-form?"],["binding-form?"]=MrHR4XLm["member?"](VfLV6h1,h8KDei6f),["define?"]=MrHR4XLm["member?"](VfLV6h1,JX)}end
for iAeh,WfS in pairs(Mm.scopes.global.macros)do
BrSRAw[iAeh]={["macro?"]=true,["body-form?"]=MrHR4XLm["member?"](iAeh,liIoYEJd),["binding-form?"]=MrHR4XLm["member?"](iAeh,h8KDei6f),["define?"]=MrHR4XLm["member?"](iAeh,JX)}end
for af8j5i,J1ny in pairs(_G)do local jgdc=type(J1ny)
if(jgdc=="function")then
BrSRAw[af8j5i]={["global?"]=true,["function?"]=true}elseif(jgdc=="table")then
for XMIKS,nh0e in pairs(J1ny)do if(("function"==type(nh0e))and
(af8j5i~="_G"))then
BrSRAw[(af8j5i.."."..XMIKS)]={["function?"]=true,["global?"]=true}else end end;BrSRAw[af8j5i]={["global?"]=true}else end end;return BrSRAw end
local FkyzO={list=MrHR4XLm.list,["list?"]=MrHR4XLm["list?"],sym=MrHR4XLm.sym,["sym?"]=MrHR4XLm["sym?"],["multi-sym?"]=MrHR4XLm["multi-sym?"],sequence=MrHR4XLm.sequence,["sequence?"]=MrHR4XLm["sequence?"],["table?"]=MrHR4XLm["table?"],comment=MrHR4XLm.comment,["comment?"]=MrHR4XLm["comment?"],varg=MrHR4XLm.varg,["varg?"]=MrHR4XLm["varg?"],["sym-char?"]=Y["sym-char?"],parser=Y.parser,compile=Mm.compile,["compile-string"]=Mm["compile-string"],["compile-stream"]=Mm["compile-stream"],eval=K,repl=vwkjf,view=wcsc,dofile=Fb,["load-code"]=CD["load-code"],doc=CD.doc,metadata=Mm.metadata,traceback=Mm.traceback,version=MrHR4XLm.version,["runtime-version"]=MrHR4XLm["runtime-version"],["ast-source"]=MrHR4XLm["ast-source"],path=MrHR4XLm.path,["macro-path"]=MrHR4XLm["macro-path"],["macro-loaded"]=CD["macro-loaded"],["macro-searchers"]=CD["macro-searchers"],["search-module"]=CD["search-module"],["make-searcher"]=CD["make-searcher"],searcher=CD["make-searcher"](),syntax=XSbn,gensym=Mm.gensym,scope=Mm["make-scope"],mangle=Mm["global-mangling"],unmangle=Mm["global-unmangling"],compile1=Mm.compile1,["string-stream"]=Y["string-stream"],granulate=Y.granulate,loadCode=CD["load-code"],make_searcher=CD["make-searcher"],makeSearcher=CD["make-searcher"],searchModule=CD["search-module"],macroPath=MrHR4XLm["macro-path"],macroSearchers=CD["macro-searchers"],macroLoaded=CD["macro-loaded"],compileStream=Mm["compile-stream"],compileString=Mm["compile-string"],stringStream=Y["string-stream"],runtimeVersion=MrHR4XLm["runtime-version"]}
FkyzO.install=function(jgjGmjJ4)
table.insert((package.searchers or package.loaders),CD["make-searcher"](jgjGmjJ4))return FkyzO end;MrHR4XLm["fennel-module"]=FkyzO
do local IGiruNd="fennel.macros"local tjTQb4m;local function U9vs8w()
return FkyzO end;package.preload[IGiruNd]=U9vs8w
tjTQb4m=nil;local KPHc6Aeq
do
local Lx=CD["make-compiler-env"](nil,Mm.scopes.compiler,{})do end(Lx)["utils"]=MrHR4XLm;Lx["fennel"]=FkyzO;KPHc6Aeq=Lx end
local kB6a=K([===[;; These macros are awkward because their definition cannot rely on the any
  ;; built-in macros, only special forms. (no when, no icollect, etc)
  
  (fn copy [t]
    (let [out []]
      (each [_ v (ipairs t)] (table.insert out v))
      (setmetatable out (getmetatable t))))
  
  (fn ->* [val ...]
    "Thread-first macro.
  Take the first value and splice it into the second form as its first argument.
  The value of the second form is spliced into the first arg of the third, etc."
    (var x val)
    (each [_ e (ipairs [...])]
      (let [elt (if (list? e) (copy e) (list e))]
        (table.insert elt 2 x)
        (set x elt)))
    x)
  
  (fn ->>* [val ...]
    "Thread-last macro.
  Same as ->, except splices the value into the last position of each form
  rather than the first."
    (var x val)
    (each [_ e (ipairs [...])]
      (let [elt (if (list? e) (copy e) (list e))]
        (table.insert elt x)
        (set x elt)))
    x)
  
  (fn -?>* [val ?e ...]
    "Nil-safe thread-first macro.
  Same as -> except will short-circuit with nil when it encounters a nil value."
    (if (= nil ?e)
        val
        (let [el (if (list? ?e) (copy ?e) (list ?e))
              tmp (gensym)]
          (table.insert el 2 tmp)
          `(let [,tmp ,val]
             (if (not= nil ,tmp)
                 (-?> ,el ,...)
                 ,tmp)))))
  
  (fn -?>>* [val ?e ...]
    "Nil-safe thread-last macro.
  Same as ->> except will short-circuit with nil when it encounters a nil value."
    (if (= nil ?e)
        val
        (let [el (if (list? ?e) (copy ?e) (list ?e))
              tmp (gensym)]
          (table.insert el tmp)
          `(let [,tmp ,val]
             (if (not= ,tmp nil)
                 (-?>> ,el ,...)
                 ,tmp)))))
  
  (fn ?dot [tbl ...]
    "Nil-safe table look up.
  Same as . (dot), except will short-circuit with nil when it encounters
  a nil value in any of subsequent keys."
    (let [head (gensym :t)
          lookups `(do
                     (var ,head ,tbl)
                     ,head)]
      (each [_ k (ipairs [...])]
        ;; Kinda gnarly to reassign in place like this, but it emits the best lua.
        ;; With this impl, it emits a flat, concise, and readable set of ifs
        (table.insert lookups (# lookups) `(if (not= nil ,head)
                                             (set ,head (. ,head ,k)))))
      lookups))
  
  (fn doto* [val ...]
    "Evaluate val and splice it into the first argument of subsequent forms."
    (assert (not= val nil) "missing subject")
    (let [rebind? (or (not (sym? val))
                      (multi-sym? val))
          name (if rebind? (gensym)            val)
          form (if rebind? `(let [,name ,val]) `(do))]
      (each [_ elt (ipairs [...])]
        (let [elt (if (list? elt) (copy elt) (list elt))]
          (table.insert elt 2 name)
          (table.insert form elt)))
      (table.insert form name)
      form))
  
  (fn when* [condition body1 ...]
    "Evaluate body for side-effects only when condition is truthy."
    (assert body1 "expected body")
    `(if ,condition
         (do
           ,body1
           ,...)))
  
  (fn with-open* [closable-bindings ...]
    "Like `let`, but invokes (v:close) on each binding after evaluating the body.
  The body is evaluated inside `xpcall` so that bound values will be closed upon
  encountering an error before propagating it."
    (let [bodyfn `(fn []
                    ,...)
          closer `(fn close-handlers# [ok# ...]
                    (if ok# ... (error ... 0)))
          traceback `(. (or package.loaded.fennel debug) :traceback)]
      (for [i 1 (length closable-bindings) 2]
        (assert (sym? (. closable-bindings i))
                "with-open only allows symbols in bindings")
        (table.insert closer 4 `(: ,(. closable-bindings i) :close)))
      `(let ,closable-bindings
         ,closer
         (close-handlers# (_G.xpcall ,bodyfn ,traceback)))))
  
  (fn extract-into [iter-tbl]
    (var (into iter-out found?) (values [] (copy iter-tbl)))
    (for [i (length iter-tbl) 2 -1]
      (let [item (. iter-tbl i)]
        (if (or (= `&into item)
                (= :into  item))
            (do
              (assert (not found?) "expected only one &into clause")
              (set found? true)
              (set into (. iter-tbl (+ i 1)))
              (table.remove iter-out i)
              (table.remove iter-out i)))))
    (assert (or (not found?) (sym? into) (table? into) (list? into))
            "expected table, function call, or symbol in &into clause")
    (values into iter-out))
  
  (fn collect* [iter-tbl key-expr value-expr ...]
    "Return a table made by running an iterator and evaluating an expression that
  returns key-value pairs to be inserted sequentially into the table.  This can
  be thought of as a table comprehension. The body should provide two expressions
  (used as key and value) or nil, which causes it to be omitted.
  
  For example,
    (collect [k v (pairs {:apple \"red\" :orange \"orange\"})]
      (values v k))
  returns
    {:red \"apple\" :orange \"orange\"}
  
  Supports an &into clause after the iterator to put results in an existing table.
  Supports early termination with an &until clause."
    (assert (and (sequence? iter-tbl) (<= 2 (length iter-tbl)))
            "expected iterator binding table")
    (assert (not= nil key-expr) "expected key and value expression")
    (assert (= nil ...)
            "expected 1 or 2 body expressions; wrap multiple expressions with do")
    (let [kv-expr (if (= nil value-expr) key-expr `(values ,key-expr ,value-expr))
          (into iter) (extract-into iter-tbl)]
      `(let [tbl# ,into]
         (each ,iter
           (let [(k# v#) ,kv-expr]
             (if (and (not= k# nil) (not= v# nil))
               (tset tbl# k# v#))))
         tbl#)))
  
  (fn seq-collect [how iter-tbl value-expr ...]
    "Common part between icollect and fcollect for producing sequential tables.
  
  Iteration code only differs in using the for or each keyword, the rest
  of the generated code is identical."
    (assert (not= nil value-expr) "expected table value expression")
    (assert (= nil ...)
            "expected exactly one body expression. Wrap multiple expressions in do")
    (let [(into iter) (extract-into iter-tbl)]
      `(let [tbl# ,into]
         ;; believe it or not, using a var here has a pretty good performance
         ;; boost: https://p.hagelb.org/icollect-performance.html
         (var i# (length tbl#))
         (,how ,iter
               (let [val# ,value-expr]
                 (when (not= nil val#)
                   (set i# (+ i# 1))
                   (tset tbl# i# val#))))
         tbl#)))
  
  (fn icollect* [iter-tbl value-expr ...]
    "Return a sequential table made by running an iterator and evaluating an
  expression that returns values to be inserted sequentially into the table.
  This can be thought of as a table comprehension. If the body evaluates to nil
  that element is omitted.
  
  For example,
    (icollect [_ v (ipairs [1 2 3 4 5])]
      (when (not= v 3)
        (* v v)))
  returns
    [1 4 16 25]
  
  Supports an &into clause after the iterator to put results in an existing table.
  Supports early termination with an &until clause."
    (assert (and (sequence? iter-tbl) (<= 2 (length iter-tbl)))
            "expected iterator binding table")
    (seq-collect 'each iter-tbl value-expr ...))
  
  (fn fcollect* [iter-tbl value-expr ...]
    "Return a sequential table made by advancing a range as specified by
  for, and evaluating an expression that returns values to be inserted
  sequentially into the table.  This can be thought of as a range
  comprehension. If the body evaluates to nil that element is omitted.
  
  For example,
    (fcollect [i 1 10 2]
      (when (not= i 3)
        (* i i)))
  returns
    [1 25 49 81]
  
  Supports an &into clause after the range to put results in an existing table.
  Supports early termination with an &until clause."
    (assert (and (sequence? iter-tbl) (< 2 (length iter-tbl)))
            "expected range binding table")
    (seq-collect 'for iter-tbl value-expr ...))
  
  (fn accumulate-impl [for? iter-tbl body ...]
    (assert (and (sequence? iter-tbl) (<= 4 (length iter-tbl)))
            "expected initial value and iterator binding table")
    (assert (not= nil body) "expected body expression")
    (assert (= nil ...)
            "expected exactly one body expression. Wrap multiple expressions with do")
    (let [[accum-var accum-init] iter-tbl
          iter (sym (if for? "for" "each"))] ; accumulate or faccumulate?
      `(do
         (var ,accum-var ,accum-init)
         (,iter ,[(unpack iter-tbl 3)]
                (set ,accum-var ,body))
         ,(if (list? accum-var)
            (list (sym :values) (unpack accum-var))
            accum-var))))
  
  (fn accumulate* [iter-tbl body ...]
    "Accumulation macro.
  
  It takes a binding table and an expression as its arguments.  In the binding
  table, the first form starts out bound to the second value, which is an initial
  accumulator. The rest are an iterator binding table in the format `each` takes.
  
  It runs through the iterator in each step of which the given expression is
  evaluated, and the accumulator is set to the value of the expression. It
  eventually returns the final value of the accumulator.
  
  For example,
    (accumulate [total 0
                 _ n (pairs {:apple 2 :orange 3})]
      (+ total n))
  returns 5"
    (accumulate-impl false iter-tbl body ...))
  
  (fn faccumulate* [iter-tbl body ...]
    "Identical to accumulate, but after the accumulator the binding table is the
  same as `for` instead of `each`. Like collect to fcollect, will iterate over a
  numerical range like `for` rather than an iterator."
    (accumulate-impl true iter-tbl body ...))
  
  (fn double-eval-safe? [x type]
    (or (= :number type) (= :string type) (= :boolean type)
        (and (sym? x) (not (multi-sym? x)))))
  
  (fn partial* [f ...]
    "Return a function with all arguments partially applied to f."
    (assert f "expected a function to partially apply")
    (let [bindings []
          args []]
      (each [_ arg (ipairs [...])]
        (if (double-eval-safe? arg (type arg))
          (table.insert args arg)
          (let [name (gensym)]
            (table.insert bindings name)
            (table.insert bindings arg)
            (table.insert args name))))
      (let [body (list f (unpack args))]
        (table.insert body _VARARG)
        ;; only use the extra let if we need double-eval protection
        (if (= 0 (length bindings))
            `(fn [,_VARARG] ,body)
            `(let ,bindings
               (fn [,_VARARG] ,body))))))
  
  (fn pick-args* [n f]
    "Create a function of arity n that applies its arguments to f.
  
  For example,
    (pick-args 2 func)
  expands to
    (fn [_0_ _1_] (func _0_ _1_))"
    (if (and _G.io _G.io.stderr)
        (_G.io.stderr:write
         "-- WARNING: pick-args is deprecated and will be removed in the future.\n"))
    (assert (and (= (type n) :number) (= n (math.floor n)) (<= 0 n))
            (.. "Expected n to be an integer literal >= 0, got " (tostring n)))
    (let [bindings []]
      (for [i 1 n]
        (tset bindings i (gensym)))
      `(fn ,bindings
         (,f ,(unpack bindings)))))
  
  (fn pick-values* [n ...]
    "Evaluate to exactly n values.
  
  For example,
    (pick-values 2 ...)
  expands to
    (let [(_0_ _1_) ...]
      (values _0_ _1_))"
    (assert (and (= :number (type n)) (<= 0 n) (= n (math.floor n)))
            (.. "Expected n to be an integer >= 0, got " (tostring n)))
    (let [let-syms (list)
          let-values (if (= 1 (select "#" ...)) ... `(values ,...))]
      (for [i 1 n]
        (table.insert let-syms (gensym)))
      (if (= n 0) `(values)
          `(let [,let-syms ,let-values]
             (values ,(unpack let-syms))))))
  
  (fn lambda* [...]
    "Function literal with nil-checked arguments.
  Like `fn`, but will throw an exception if a declared argument is passed in as
  nil, unless that argument's name begins with a question mark."
    (let [args [...]
          has-internal-name? (sym? (. args 1))
          arglist (if has-internal-name? (. args 2) (. args 1))
          docstring-position (if has-internal-name? 3 2)
          has-docstring? (and (< docstring-position (length args))
                              (= :string (type (. args docstring-position))))
          arity-check-position (- 4 (if has-internal-name? 0 1)
                                  (if has-docstring? 0 1))
          empty-body? (< (length args) arity-check-position)]
      (fn check! [a]
        (if (table? a)
            (each [_ a (pairs a)]
              (check! a))
            (let [as (tostring a)]
              (and (not (as:match "^?")) (not= as "&") (not= as "_")
                   (not= as "...") (not= as "&as")))
            (table.insert args arity-check-position
                          `(_G.assert (not= nil ,a)
                                      ,(: "Missing argument %s on %s:%s" :format
                                          (tostring a)
                                          (or a.filename :unknown)
                                          (or a.line "?"))))))
  
      (assert (= :table (type arglist)) "expected arg list")
      (each [_ a (ipairs arglist)]
        (check! a))
      (if empty-body?
          (table.insert args (sym :nil)))
      `(fn ,(unpack args))))
  
  (fn macro* [name ...]
    "Define a single macro."
    (assert (sym? name) "expected symbol for macro name")
    (local args [...])
    `(macros {,(tostring name) (fn ,(unpack args))}))
  
  (fn macrodebug* [form return?]
    "Print the resulting form after performing macroexpansion.
  With a second argument, returns expanded form as a string instead of printing."
    (let [handle (if return? `do `print)]
      `(,handle ,(view (macroexpand form _SCOPE)))))
  
  (fn import-macros* [binding1 module-name1 ...]
    "Bind a table of macros from each macro module according to a binding form.
  Each binding form can be either a symbol or a k/v destructuring table.
  Example:
    (import-macros mymacros                 :my-macros    ; bind to symbol
                   {:macro1 alias : macro2} :proj.macros) ; import by name"
    (assert (and binding1 module-name1 (= 0 (% (select "#" ...) 2)))
            "expected even number of binding/modulename pairs")
    (for [i 1 (select "#" binding1 module-name1 ...) 2]
      ;; delegate the actual loading of the macros to the require-macros
      ;; special which already knows how to set up the compiler env and stuff.
      ;; this is weird because require-macros is deprecated but it works.
      (let [(binding modname) (select i binding1 module-name1 ...)
            scope (get-scope)
            ;; if the module-name is an expression (and not just a string) we
            ;; patch our expression to have the correct source filename so
            ;; require-macros can pass it down when resolving the module-name.
            expr `(import-macros ,modname)
            filename (if (list? modname) (. modname 1 :filename) :unknown)
            _ (tset expr :filename filename)
            macros* (_SPECIALS.require-macros expr scope {} binding)]
        (if (sym? binding)
            ;; bind whole table of macros to table bound to symbol
            (tset scope.macros (. binding 1) macros*)
            ;; 1-level table destructuring for importing individual macros
            (table? binding)
            (each [macro-name [import-key] (pairs binding)]
              (assert (= :function (type (. macros* macro-name)))
                      (.. "macro " macro-name " not found in module "
                          (tostring modname)))
              (tset scope.macros import-key (. macros* macro-name))))))
    nil)
  
  {:-> ->*
   :->> ->>*
   :-?> -?>*
   :-?>> -?>>*
   :?. ?dot
   :doto doto*
   :when when*
   :with-open with-open*
   :collect collect*
   :icollect icollect*
   :fcollect fcollect*
   :accumulate accumulate*
   :faccumulate faccumulate*
   :partial partial*
   :lambda lambda*
   :λ lambda*
   :pick-args pick-args*
   :pick-values pick-values*
   :macro macro*
   :macrodebug macrodebug*
   :import-macros import-macros*}
  ]===],{env=KPHc6Aeq,scope=Mm.scopes.compiler,useMetadata=true,filename="src/fennel/macros.fnl",moduleName=IGiruNd})local Z53B
for PtID,j in pairs(kB6a)do Mm.scopes.global.macros[PtID]=j end;Z53B=nil
local _5pPpX=K([===[;;; Pattern matching
  ;; This is separated out so we can use the "core" macros during the
  ;; implementation of pattern matching.
  
  (fn copy [t] (collect [k v (pairs t)] k v))
  
  (fn with [opts k]
    (doto (copy opts) (tset k true)))
  
  (fn without [opts k]
    (doto (copy opts) (tset k nil)))
  
  (fn case-values [vals pattern unifications case-pattern opts]
    (let [condition `(and)
          bindings []]
      (each [i pat (ipairs pattern)]
        (let [(subcondition subbindings) (case-pattern [(. vals i)] pat
                                                        unifications (without opts :multival?))]
          (table.insert condition subcondition)
          (icollect [_ b (ipairs subbindings) &into bindings] b)))
      (values condition bindings)))
  
  (fn case-table [val pattern unifications case-pattern opts]
    (let [condition `(and (= (_G.type ,val) :table))
          bindings []]
      (each [k pat (pairs pattern)]
        (if (= pat `&)
            (let [rest-pat (. pattern (+ k 1))
                  rest-val `(select ,k ((or table.unpack _G.unpack) ,val))
                  subcondition (case-table `(pick-values 1 ,rest-val)
                                            rest-pat unifications case-pattern
                                            (without opts :multival?))]
              (if (not (sym? rest-pat))
                  (table.insert condition subcondition))
              (assert (= nil (. pattern (+ k 2)))
                      "expected & rest argument before last parameter")
              (table.insert bindings rest-pat)
              (table.insert bindings [rest-val]))
            (= k `&as)
            (do
              (table.insert bindings pat)
              (table.insert bindings val))
            (and (= :number (type k)) (= `&as pat))
            (do
              (assert (= nil (. pattern (+ k 2)))
                      "expected &as argument before last parameter")
              (table.insert bindings (. pattern (+ k 1)))
              (table.insert bindings val))
            ;; don't process the pattern right after &/&as; already got it
            (or (not= :number (type k)) (and (not= `&as (. pattern (- k 1)))
                                             (not= `& (. pattern (- k 1)))))
            (let [subval `(. ,val ,k)
                  (subcondition subbindings) (case-pattern [subval] pat
                                                            unifications
                                                            (without opts :multival?))]
              (table.insert condition subcondition)
              (icollect [_ b (ipairs subbindings) &into bindings] b))))
      (values condition bindings)))
  
  (fn case-guard [vals condition guards unifications case-pattern opts]
    (if (= 0 (length guards))
      (case-pattern vals condition unifications opts)
      (let [(pcondition bindings) (case-pattern vals condition unifications opts)
            condition `(and ,(unpack guards))]
         (values `(and ,pcondition
                       (let ,bindings
                         ,condition)) bindings))))
  
  (fn symbols-in-pattern [pattern]
    "gives the set of symbols inside a pattern"
    (if (list? pattern)
        (let [result {}]
          (each [_ child-pattern (ipairs pattern)]
            (collect [name symbol (pairs (symbols-in-pattern child-pattern)) &into result]
              name symbol))
          result)
        (sym? pattern)
        (if (and (not= pattern `or)
                 (not= pattern `where)
                 (not= pattern `?)
                 (not= pattern `nil))
            {(tostring pattern) pattern}
            {})
        (= (type pattern) :table)
        (let [result {}]
          (each [key-pattern value-pattern (pairs pattern)]
            (collect [name symbol (pairs (symbols-in-pattern key-pattern)) &into result]
              name symbol)
            (collect [name symbol (pairs (symbols-in-pattern value-pattern)) &into result]
              name symbol))
          result)
        {}))
  
  (fn symbols-in-every-pattern [pattern-list infer-unification?]
    "gives a list of symbols that are present in every pattern in the list"
    (let [?symbols (accumulate [?symbols nil
                                _ pattern (ipairs pattern-list)]
                     (let [in-pattern (symbols-in-pattern pattern)]
                       (if ?symbols
                         (do
                           (each [name symbol (pairs ?symbols)]
                             (when (not (. in-pattern name))
                               (tset ?symbols name nil)))
                           ?symbols)
                         in-pattern)))]
      (icollect [_ symbol (pairs (or ?symbols {}))]
        (if (not (and infer-unification?
                      (in-scope? symbol)))
          symbol))))
  
  (fn case-or [vals pattern guards unifications case-pattern opts]
    (let [pattern [(unpack pattern 2)]
          bindings (symbols-in-every-pattern pattern opts.infer-unification?)] ;; TODO opts.infer-unification instead of opts.unification?
      (if (= 0 (length bindings))
        ;; no bindings special case generates simple code
        (let [condition
              (icollect [i subpattern (ipairs pattern) &into `(or)]
                (let [(subcondition subbindings) (case-pattern vals subpattern unifications opts)]
                  subcondition))]
          (values
            (if (= 0 (length guards))
              condition
              `(and ,condition ,(unpack guards)))
            []))
        ;; case with bindings is handled specially, and returns three values instead of two
        (let [matched? (gensym :matched?)
              bindings-mangled (icollect [_ binding (ipairs bindings)]
                                 (gensym (tostring binding)))
              pre-bindings `(if)]
          (each [i subpattern (ipairs pattern)]
            (let [(subcondition subbindings) (case-guard vals subpattern guards {} case-pattern opts)]
              (table.insert pre-bindings subcondition)
              (table.insert pre-bindings `(let ,subbindings
                                            (values true ,(unpack bindings))))))
          (values matched?
                  [`(,(unpack bindings)) `(values ,(unpack bindings-mangled))]
                  [`(,matched? ,(unpack bindings-mangled)) pre-bindings])))))
  
  (fn case-pattern [vals pattern unifications opts top-level?]
    "Take the AST of values and a single pattern and returns a condition
  to determine if it matches as well as a list of bindings to
  introduce for the duration of the body if it does match."
  
    ;; This function returns the following values (multival):
    ;; a "condition", which is an expression that determines whether the
    ;;   pattern should match,
    ;; a "bindings", which bind all of the symbols used in a pattern
    ;; an optional "pre-bindings", which is a list of bindings that happen
    ;;   before the condition and bindings are evaluated. These should only
    ;;   come from a (case-or). In this case there should be no recursion:
    ;;   the call stack should be case-condition > case-pattern > case-or
    ;;
    ;; Here are the expected flags in the opts table:
    ;;   :infer-unification? boolean - if the pattern should guess when to unify  (ie, match -> true, case -> false)
    ;;   :multival? boolean - if the pattern can contain multivals  (in order to disallow patterns like [(1 2)])
    ;;   :in-where? boolean - if the pattern is surrounded by (where)  (where opts into more pattern features)
    ;;   :legacy-guard-allowed? boolean - if the pattern should allow `(a ? b) patterns
  
    ;; we have to assume we're matching against multiple values here until we
    ;; know we're either in a multi-valued clause (in which case we know the #
    ;; of vals) or we're not, in which case we only care about the first one.
    (let [[val] vals]
      (if (and (sym? pattern)
               (or (= pattern `nil)
                   (and opts.infer-unification?
                        (in-scope? pattern)
                        (not= pattern `_))
                   (and opts.infer-unification?
                        (multi-sym? pattern)
                        (in-scope? (. (multi-sym? pattern) 1)))))
          (values `(= ,val ,pattern) [])
          ;; unify a local we've seen already
          (and (sym? pattern) (. unifications (tostring pattern)))
          (values `(= ,(. unifications (tostring pattern)) ,val) [])
          ;; bind a fresh local
          (sym? pattern)
          (let [wildcard? (: (tostring pattern) :find "^_")]
            (if (not wildcard?) (tset unifications (tostring pattern) val))
            (values (if (or wildcard? (string.find (tostring pattern) "^?")) true
                        `(not= ,(sym :nil) ,val)) [pattern val]))
          ;; opt-in unify with (=)
          (and (list? pattern)
               (= (. pattern 1) `=)
               (sym? (. pattern 2)))
          (let [bind (. pattern 2)]
            (assert-compile (= 2 (length pattern)) "(=) should take only one argument" pattern)
            (assert-compile (not opts.infer-unification?) "(=) cannot be used inside of match" pattern)
            (assert-compile opts.in-where? "(=) must be used in (where) patterns" pattern)
            (assert-compile (and (sym? bind) (not= bind `nil) "= has to bind to a symbol" bind))
            (values `(= ,val ,bind) []))
          ;; where-or clause
          (and (list? pattern) (= (. pattern 1) `where) (list? (. pattern 2)) (= (. pattern 2 1) `or))
          (do
            (assert-compile top-level? "can't nest (where) pattern" pattern)
            (case-or vals (. pattern 2) [(unpack pattern 3)] unifications case-pattern (with opts :in-where?)))
          ;; where clause
          (and (list? pattern) (= (. pattern 1) `where))
          (do
            (assert-compile top-level? "can't nest (where) pattern" pattern)
            (case-guard vals (. pattern 2) [(unpack pattern 3)] unifications case-pattern (with opts :in-where?)))
          ;; or clause (not allowed on its own)
          (and (list? pattern) (= (. pattern 1) `or))
          (do
            (assert-compile top-level? "can't nest (or) pattern" pattern)
            ;; This assertion can be removed to make patterns more permissive
            (assert-compile false "(or) must be used in (where) patterns" pattern)
            (case-or vals pattern [] unifications case-pattern opts))
          ;; guard clause
          (and (list? pattern) (= (. pattern 2) `?))
          (do
            (assert-compile opts.legacy-guard-allowed? "legacy guard clause not supported in case" pattern)
            (case-guard vals (. pattern 1) [(unpack pattern 3)] unifications case-pattern opts))
          ;; multi-valued patterns (represented as lists)
          (list? pattern)
          (do
            (assert-compile opts.multival? "can't nest multi-value destructuring" pattern)
            (case-values vals pattern unifications case-pattern opts))
          ;; table patterns
          (= (type pattern) :table)
          (case-table val pattern unifications case-pattern opts)
          ;; literal value
          (values `(= ,val ,pattern) []))))
  
  (fn add-pre-bindings [out pre-bindings]
    "Decide when to switch from the current `if` AST to a new one"
    (if pre-bindings
        ;; `out` no longer needs to grow.
        ;; Instead, a new tail `if` AST is introduced, which is where the rest of
        ;; the clauses will get appended. This way, all future clauses have the
        ;; pre-bindings in scope.
        (let [tail `(if)]
          (table.insert out true)
          (table.insert out `(let ,pre-bindings ,tail))
          tail)
        ;; otherwise, keep growing the current `if` AST.
        out))
  
  (fn case-condition [vals clauses match?]
    "Construct the actual `if` AST for the given match values and clauses."
    ;; root is the original `if` AST.
    ;; out is the `if` AST that is currently being grown.
    (let [root `(if)]
      (faccumulate [out root
                    i 1 (length clauses) 2]
        (let [pattern (. clauses i)
              body (. clauses (+ i 1))
              (condition bindings pre-bindings) (case-pattern vals pattern {}
                                                              {:multival? true
                                                               :infer-unification? match?
                                                               :legacy-guard-allowed? match?}
                                                              true)
              out (add-pre-bindings out pre-bindings)]
          ;; grow the `if` AST by one extra condition
          (table.insert out condition)
          (table.insert out `(let ,bindings
                              ,body))
          out))
      root))
  
  (fn count-case-multival [pattern]
    "Identify the amount of multival values that a pattern requires."
    (if (and (list? pattern) (= (. pattern 2) `?))
        (count-case-multival (. pattern 1))
        (and (list? pattern) (= (. pattern 1) `where))
        (count-case-multival (. pattern 2))
        (and (list? pattern) (= (. pattern 1) `or))
        (accumulate [longest 0
                     _ child-pattern (ipairs pattern)]
          (math.max longest (count-case-multival child-pattern)))
        (list? pattern)
        (length pattern)
        1))
  
  (fn case-val-syms [clauses]
    "What is the length of the largest multi-valued clause? return a list of that
  many gensyms."
    (let [patterns (fcollect [i 1 (length clauses) 2]
                     (. clauses i))
          sym-count (accumulate [longest 0
                                 _ pattern (ipairs patterns)]
                      (math.max longest (count-case-multival pattern)))]
      (fcollect [i 1 sym-count &into (list)]
        (gensym))))
  
  (fn case-impl [match? val ...]
    "The shared implementation of case and match."
    (assert (not= val nil) "missing subject")
    (assert (= 0 (math.fmod (select :# ...) 2))
            "expected even number of pattern/body pairs")
    (assert (not= 0 (select :# ...))
            "expected at least one pattern/body pair")
    (let [clauses [...]
          vals (case-val-syms clauses)]
      ;; protect against multiple evaluation of the value, bind against as
      ;; many values as we ever match against in the clauses.
      (list `let [vals val] (case-condition vals clauses match?))))
  
  (fn case* [val ...]
    "Perform pattern matching on val. See reference for details.
  
  Syntax:
  
  (case data-expression
    pattern body
    (where pattern guards*) body
    (or pattern patterns*) body
    (where (or pattern patterns*) guards*) body
    ;; legacy:
    (pattern ? guards*) body)"
    (case-impl false val ...))
  
  (fn match* [val ...]
    "Perform pattern matching on val, automatically unifying on variables in
  local scope. See reference for details.
  
  Syntax:
  
  (match data-expression
    pattern body
    (where pattern guards*) body
    (or pattern patterns*) body
    (where (or pattern patterns*) guards*) body
    ;; legacy:
    (pattern ? guards*) body)"
    (case-impl true val ...))
  
  (fn case-try-step [how expr else pattern body ...]
    (if (= nil pattern body)
        expr
        ;; unlike regular match, we can't know how many values the value
        ;; might evaluate to, so we have to capture them all in ... via IIFE
        ;; to avoid double-evaluation.
        `((fn [...]
            (,how ...
              ,pattern ,(case-try-step how body else ...)
              ,(unpack else)))
          ,expr)))
  
  (fn case-try-impl [how expr pattern body ...]
    (let [clauses [pattern body ...]
          last (. clauses (length clauses))
          catch (if (= `catch (and (= :table (type last)) (. last 1)))
                   (let [[_ & e] (table.remove clauses)] e) ; remove `catch sym
                   [`_# `...])]
      (assert (= 0 (math.fmod (length clauses) 2))
              "expected every pattern to have a body")
      (assert (= 0 (math.fmod (length catch) 2))
              "expected every catch pattern to have a body")
      (case-try-step how expr catch (unpack clauses))))
  
  (fn case-try* [expr pattern body ...]
    "Perform chained pattern matching for a sequence of steps which might fail.
  
  The values from the initial expression are matched against the first pattern.
  If they match, the first body is evaluated and its values are matched against
  the second pattern, etc.
  
  If there is a (catch pat1 body1 pat2 body2 ...) form at the end, any mismatch
  from the steps will be tried against these patterns in sequence as a fallback
  just like a normal match. If there is no catch, the mismatched values will be
  returned as the value of the entire expression."
    (case-try-impl `case expr pattern body ...))
  
  (fn match-try* [expr pattern body ...]
    "Perform chained pattern matching for a sequence of steps which might fail.
  
  The values from the initial expression are matched against the first pattern.
  If they match, the first body is evaluated and its values are matched against
  the second pattern, etc.
  
  If there is a (catch pat1 body1 pat2 body2 ...) form at the end, any mismatch
  from the steps will be tried against these patterns in sequence as a fallback
  just like a normal match. If there is no catch, the mismatched values will be
  returned as the value of the entire expression."
    (case-try-impl `match expr pattern body ...))
  
  {:case case*
   :case-try case-try*
   :match match*
   :match-try match-try*}
  ]===],{env=KPHc6Aeq,scope=Mm.scopes.compiler,allowedGlobals=false,useMetadata=true,filename="src/fennel/match.fnl",moduleName=IGiruNd})
for aP,oUuAO4X6 in pairs(_5pPpX)do Mm.scopes.global.macros[aP]=oUuAO4X6 end;package.preload[IGiruNd]=nil end;local iJYISVW=FkyzO
local function K(q2lIy)
is_passed,out=pcall(function()return iJYISVW.eval(q2lIy)end,function(n62)return
n62 end)lua=""out=tostring(out)preview=out:gsub("\n.*","")if is_passed then
lua=iJYISVW.compileString(q2lIy)end
return{is_passed=is_passed,preview=preview,out=out,lua=lua}end
return
{{CodeBlock=function(_NgKSEFg)
if _NgKSEFg.classes:includes("eval")then local ydBwQ3=_NgKSEFg.text
print("⚙️ ",ydBwQ3)local Jo7L=K(ydBwQ3)
print("",Jo7L["is_passed"],"→",Jo7L["preview"])if _NgKSEFg.classes:includes("replace")then return
pandoc.CodeBlock(Jo7L["out"],{code=ydBwQ3})end end end}}