clone url: git://git.m455.casa/fa
esperbuild/espersrc/fennel-0.7.0/old/fennel.lua
| 1 | --[[ |
| 2 | Copyright (c) 2016-2020 Calvin Rose and contributors |
| 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of |
| 4 | this software and associated documentation files (the "Software"), to deal in |
| 5 | the Software without restriction, including without limitation the rights to |
| 6 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of |
| 7 | the Software, and to permit persons to whom the Software is furnished to do so, |
| 8 | subject to the following conditions: |
| 9 | The above copyright notice and this permission notice shall be included in all |
| 10 | copies or substantial portions of the Software. |
| 11 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
| 12 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS |
| 13 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR |
| 14 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER |
| 15 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN |
| 16 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |
| 17 | ]] |
| 18 | |
| 19 | -- Make global variables local. |
| 20 | local setmetatable = setmetatable |
| 21 | local getmetatable = getmetatable |
| 22 | local type = type |
| 23 | local assert = assert |
| 24 | local pairs = pairs |
| 25 | local ipairs = ipairs |
| 26 | local tostring = tostring |
| 27 | local unpack = _G.unpack or table.unpack |
| 28 | |
| 29 | -- |
| 30 | -- Main Types and support functions |
| 31 | -- |
| 32 | |
| 33 | local utils = (function() |
| 34 | -- Like pairs, but gives consistent ordering every time. On 5.1, 5.2, and LuaJIT |
| 35 | -- pairs is already stable, but on 5.3 every run gives different ordering. |
| 36 | local function stablepairs(t) |
| 37 | local keys, succ = {}, {} |
| 38 | for k in pairs(t) do table.insert(keys, k) end |
| 39 | table.sort(keys, function(a, b) return tostring(a) < tostring(b) end) |
| 40 | for i,k in ipairs(keys) do succ[k] = keys[i+1] end |
| 41 | local function stablenext(tbl, idx) |
| 42 | if idx == nil then return keys[1], tbl[keys[1]] end |
| 43 | return succ[idx], tbl[succ[idx]] |
| 44 | end |
| 45 | return stablenext, t, nil |
| 46 | end |
| 47 | |
| 48 | -- Map function f over sequential table t, removing values where f returns nil. |
| 49 | -- Optionally takes a target table to insert the mapped values into. |
| 50 | local function map(t, f, out) |
| 51 | out = out or {} |
| 52 | if type(f) ~= "function" then local s = f f = function(x) return x[s] end end |
| 53 | for _,x in ipairs(t) do |
| 54 | local v = f(x) |
| 55 | if v then table.insert(out, v) end |
| 56 | end |
| 57 | return out |
| 58 | end |
| 59 | |
| 60 | -- Map function f over key/value table t, similar to above, but it can return a |
| 61 | -- sequential table if f returns a single value or a k/v table if f returns two. |
| 62 | -- Optionally takes a target table to insert the mapped values into. |
| 63 | local function kvmap(t, f, out) |
| 64 | out = out or {} |
| 65 | if type(f) ~= "function" then local s = f f = function(x) return x[s] end end |
| 66 | for k,x in stablepairs(t) do |
| 67 | local korv, v = f(k, x) |
| 68 | if korv and not v then table.insert(out, korv) end |
| 69 | if korv and v then out[korv] = v end |
| 70 | end |
| 71 | return out |
| 72 | end |
| 73 | |
| 74 | -- Returns a shallow copy of its table argument. Returns an empty table on nil. |
| 75 | local function copy(from) |
| 76 | local to = {} |
| 77 | for k, v in pairs(from or {}) do to[k] = v end |
| 78 | return to |
| 79 | end |
| 80 | |
| 81 | -- Like pairs, but if the table has an __index metamethod, it will recurisvely |
| 82 | -- traverse upwards, skipping duplicates, to iterate all inherited properties |
| 83 | local function allpairs(t) |
| 84 | assert(type(t) == 'table', 'allpairs expects a table') |
| 85 | local seen = {} |
| 86 | local function allpairsNext(_, state) |
| 87 | local nextState, value = next(t, state) |
| 88 | if seen[nextState] then |
| 89 | return allpairsNext(nil, nextState) |
| 90 | elseif nextState then |
| 91 | seen[nextState] = true |
| 92 | return nextState, value |
| 93 | end |
| 94 | local meta = getmetatable(t) |
| 95 | if meta and meta.__index then |
| 96 | t = meta.__index |
| 97 | return allpairsNext(t) |
| 98 | end |
| 99 | end |
| 100 | return allpairsNext |
| 101 | end |
| 102 | |
| 103 | local function deref(self) return self[1] end |
| 104 | |
| 105 | local nilSym -- haven't defined sym yet; create this later |
| 106 | |
| 107 | local function listToString(self, tostring2) |
| 108 | local safe, max = {}, 0 |
| 109 | for k in pairs(self) do if type(k) == "number" and k>max then max=k end end |
| 110 | for i=1,max do -- table.maxn was removed from Lua 5.3 for some reason??? |
| 111 | safe[i] = self[i] == nil and nilSym or self[i] |
| 112 | end |
| 113 | return '(' .. table.concat(map(safe, tostring2 or tostring), ' ', 1, max) .. ')' |
| 114 | end |
| 115 | |
| 116 | local SYMBOL_MT = { 'SYMBOL', __tostring = deref, __fennelview = deref } |
| 117 | local EXPR_MT = { 'EXPR', __tostring = deref } |
| 118 | local VARARG = setmetatable({ '...' }, |
| 119 | { 'VARARG', __tostring = deref, __fennelview = deref }) |
| 120 | local LIST_MT = { 'LIST', __tostring = listToString, __fennelview = listToString } |
| 121 | local SEQUENCE_MARKER = { 'SEQUENCE' } |
| 122 | |
| 123 | -- Safely load an environment variable |
| 124 | local getenv = os and os.getenv or function() return nil end |
| 125 | |
| 126 | local pathTable = {"./?.fnl", "./?/init.fnl"} |
| 127 | table.insert(pathTable, getenv("FENNEL_PATH")) |
| 128 | |
| 129 | local function debugOn(flag) |
| 130 | local level = getenv("FENNEL_DEBUG") or "" |
| 131 | return level == "all" or level:find(flag) |
| 132 | end |
| 133 | |
| 134 | -- Create a new list. Lists are a compile-time construct in Fennel; they are |
| 135 | -- represented as tables with a special marker metatable. They only come from |
| 136 | -- the parser, and they represent code which comes from reading a paren form; |
| 137 | -- they are specifically not cons cells. |
| 138 | local function list(...) |
| 139 | return setmetatable({...}, LIST_MT) |
| 140 | end |
| 141 | |
| 142 | -- Create a new symbol. Symbols are a compile-time construct in Fennel and are |
| 143 | -- not exposed outside the compiler. Symbols have source data describing what |
| 144 | -- file, line, etc that they came from. |
| 145 | local function sym(str, scope, source) |
| 146 | local s = {str, scope = scope} |
| 147 | for k, v in pairs(source or {}) do |
| 148 | if type(k) == 'string' then s[k] = v end |
| 149 | end |
| 150 | return setmetatable(s, SYMBOL_MT) |
| 151 | end |
| 152 | |
| 153 | nilSym = sym("nil") |
| 154 | |
| 155 | -- Create a new sequence. Sequences are tables that come from the parser when |
| 156 | -- it encounters a form with square brackets. They are treated as regular tables |
| 157 | -- except when certain macros need to look for binding forms, etc specifically. |
| 158 | local function sequence(...) |
| 159 | -- can't use SEQUENCE_MT directly as the sequence metatable like we do with |
| 160 | -- the other types without giving up the ability to set source metadata |
| 161 | -- on a sequence, (which we need for error reporting) so embed a marker |
| 162 | -- value in the metatable instead. |
| 163 | return setmetatable({...}, {sequence=SEQUENCE_MARKER}) |
| 164 | end |
| 165 | |
| 166 | -- Create a new expr |
| 167 | -- etype should be one of |
| 168 | -- "literal": literals like numbers, strings, nil, true, false |
| 169 | -- "expression": Complex strings of Lua code, may have side effects, etc |
| 170 | -- but is an expression |
| 171 | -- "statement": Same as expression, but is also a valid statement |
| 172 | -- (function calls). |
| 173 | -- "vargs": varargs symbol |
| 174 | -- "sym": symbol reference |
| 175 | local function expr(strcode, etype) |
| 176 | return setmetatable({ strcode, type = etype }, EXPR_MT) |
| 177 | end |
| 178 | |
| 179 | local function varg() |
| 180 | return VARARG |
| 181 | end |
| 182 | |
| 183 | local function isExpr(x) |
| 184 | return type(x) == 'table' and getmetatable(x) == EXPR_MT and x |
| 185 | end |
| 186 | |
| 187 | local function isVarg(x) |
| 188 | return x == VARARG and x |
| 189 | end |
| 190 | |
| 191 | -- Checks if an object is a List. Returns the object if is a List. |
| 192 | local function isList(x) |
| 193 | return type(x) == 'table' and getmetatable(x) == LIST_MT and x |
| 194 | end |
| 195 | |
| 196 | -- Checks if an object is a symbol. Returns the object if it is a symbol. |
| 197 | local function isSym(x) |
| 198 | return type(x) == 'table' and getmetatable(x) == SYMBOL_MT and x |
| 199 | end |
| 200 | |
| 201 | -- Checks if an object any kind of table, EXCEPT list or symbol |
| 202 | local function isTable(x) |
| 203 | return type(x) == 'table' and |
| 204 | x ~= VARARG and |
| 205 | getmetatable(x) ~= LIST_MT and getmetatable(x) ~= SYMBOL_MT and x |
| 206 | end |
| 207 | |
| 208 | -- Checks if an object is a sequence (created with a [] literal) |
| 209 | local function isSequence(x) |
| 210 | local mt = type(x) == "table" and getmetatable(x) |
| 211 | return mt and mt.sequence == SEQUENCE_MARKER and x |
| 212 | end |
| 213 | |
| 214 | -- A multi symbol is a symbol that is actually composed of |
| 215 | -- two or more symbols using the dot syntax. The main differences |
| 216 | -- from normal symbols is that they cannot be declared local, and |
| 217 | -- they may have side effects on invocation (metatables) |
| 218 | local function isMultiSym(str) |
| 219 | if isSym(str) then |
| 220 | return isMultiSym(tostring(str)) |
| 221 | end |
| 222 | if type(str) ~= 'string' then return end |
| 223 | local parts = {} |
| 224 | for part in str:gmatch('[^%.%:]+[%.%:]?') do |
| 225 | local lastChar = part:sub(-1) |
| 226 | if lastChar == ":" then |
| 227 | parts.multiSymMethodCall = true |
| 228 | end |
| 229 | if lastChar == ":" or lastChar == "." then |
| 230 | parts[#parts + 1] = part:sub(1, -2) |
| 231 | else |
| 232 | parts[#parts + 1] = part |
| 233 | end |
| 234 | end |
| 235 | return #parts > 0 and |
| 236 | (str:match('%.') or str:match(':')) and |
| 237 | (not str:match('%.%.')) and |
| 238 | str:byte() ~= string.byte '.' and |
| 239 | str:byte(-1) ~= string.byte '.' and |
| 240 | parts |
| 241 | end |
| 242 | |
| 243 | local function isQuoted(symbol) return symbol.quoted end |
| 244 | |
| 245 | -- Walks a tree (like the AST), invoking f(node, idx, parent) on each node. |
| 246 | -- When f returns a truthy value, recursively walks the children. |
| 247 | local walkTree = function(root, f, customIterator) |
| 248 | local function walk(iterfn, parent, idx, node) |
| 249 | if f(idx, node, parent) then |
| 250 | for k, v in iterfn(node) do walk(iterfn, node, k, v) end |
| 251 | end |
| 252 | end |
| 253 | |
| 254 | walk(customIterator or pairs, nil, nil, root) |
| 255 | return root |
| 256 | end |
| 257 | |
| 258 | local luaKeywords = { |
| 259 | 'and', 'break', 'do', 'else', 'elseif', 'end', 'false', 'for', |
| 260 | 'function', 'if', 'in', 'local', 'nil', 'not', 'or', 'repeat', 'return', |
| 261 | 'then', 'true', 'until', 'while' |
| 262 | } |
| 263 | |
| 264 | for i, v in ipairs(luaKeywords) do luaKeywords[v] = i end |
| 265 | |
| 266 | local function isValidLuaIdentifier(str) |
| 267 | return (str:match('^[%a_][%w_]*$') and not luaKeywords[str]) |
| 268 | end |
| 269 | |
| 270 | -- Certain options should always get propagated onwards when a function that |
| 271 | -- has options calls down into compile. |
| 272 | local propagatedOptions = {"allowedGlobals", "indent", "correlate", |
| 273 | "useMetadata", "env"} |
| 274 | local function propagateOptions(options, subopts) |
| 275 | for _,name in ipairs(propagatedOptions) do subopts[name] = options[name] end |
| 276 | return subopts |
| 277 | end |
| 278 | |
| 279 | local root = { |
| 280 | -- Top level compilation bindings. |
| 281 | chunk=nil, scope=nil, options=nil, |
| 282 | |
| 283 | -- The root.reset function needs to be called at every exit point of the |
| 284 | -- compiler including when there's a parse error or compiler |
| 285 | -- error. This would be better done using dynamic scope, but we don't |
| 286 | -- have dynamic scope, so we fake it by ensuring we call this at every |
| 287 | -- exit point, including errors. |
| 288 | reset=function() end, |
| 289 | |
| 290 | setReset=function(root) |
| 291 | local chunk, scope, options = root.chunk, root.scope, root.options |
| 292 | local oldResetRoot = root.reset -- this needs to nest! |
| 293 | root.reset = function() |
| 294 | root.chunk, root.scope, root.options = chunk, scope, options |
| 295 | root.reset = oldResetRoot |
| 296 | end |
| 297 | end, |
| 298 | } |
| 299 | |
| 300 | return { |
| 301 | -- basic general table functions: |
| 302 | stablepairs=stablepairs, allpairs=allpairs, map=map, kvmap=kvmap, |
| 303 | copy=copy, walkTree=walkTree, |
| 304 | |
| 305 | -- AST functions: |
| 306 | list=list, sym=sym, sequence=sequence, expr=expr, varg=varg, |
| 307 | isVarg=isVarg, isList=isList, isSym=isSym, isTable=isTable, |
| 308 | isSequence=isSequence, isMultiSym=isMultiSym, isQuoted=isQuoted, |
| 309 | isExpr=isExpr, deref=deref, |
| 310 | |
| 311 | -- other functions: |
| 312 | isValidLuaIdentifier=isValidLuaIdentifier, luaKeywords=luaKeywords, |
| 313 | propagateOptions=propagateOptions, debugOn=debugOn, |
| 314 | root=root, path=table.concat(pathTable, ";"),} |
| 315 | end)() |
| 316 | |
| 317 | -- |
| 318 | -- Parser |
| 319 | -- |
| 320 | |
| 321 | local parser = (function() |
| 322 | -- Convert a stream of chunks to a stream of bytes. |
| 323 | -- Also returns a second function to clear the buffer in the byte stream |
| 324 | local function granulate(getchunk) |
| 325 | local c = '' |
| 326 | local index = 1 |
| 327 | local done = false |
| 328 | return function (parserState) |
| 329 | if done then return nil end |
| 330 | if index <= #c then |
| 331 | local b = c:byte(index) |
| 332 | index = index + 1 |
| 333 | return b |
| 334 | else |
| 335 | c = getchunk(parserState) |
| 336 | if not c or c == '' then |
| 337 | done = true |
| 338 | return nil |
| 339 | end |
| 340 | index = 2 |
| 341 | return c:byte(1) |
| 342 | end |
| 343 | end, function () |
| 344 | c = '' |
| 345 | end |
| 346 | end |
| 347 | |
| 348 | -- Convert a string into a stream of bytes |
| 349 | local function stringStream(str) |
| 350 | str=str:gsub("^#![^\n]*\n", "") -- remove shebang |
| 351 | local index = 1 |
| 352 | return function() |
| 353 | local r = str:byte(index) |
| 354 | index = index + 1 |
| 355 | return r |
| 356 | end |
| 357 | end |
| 358 | |
| 359 | -- Table of delimiter bytes - (, ), [, ], {, } |
| 360 | -- Opener keys have closer as the value, and closers keys |
| 361 | -- have true as their value. |
| 362 | local delims = { |
| 363 | [40] = 41, -- ( |
| 364 | [41] = true, -- ) |
| 365 | [91] = 93, -- [ |
| 366 | [93] = true, -- ] |
| 367 | [123] = 125, -- { |
| 368 | [125] = true -- } |
| 369 | } |
| 370 | |
| 371 | local function iswhitespace(b) |
| 372 | return b == 32 or (b >= 9 and b <= 13) |
| 373 | end |
| 374 | |
| 375 | local function issymbolchar(b) |
| 376 | return b > 32 and |
| 377 | not delims[b] and |
| 378 | b ~= 127 and -- "<BS>" |
| 379 | b ~= 34 and -- "\"" |
| 380 | b ~= 39 and -- "'" |
| 381 | b ~= 126 and -- "~" |
| 382 | b ~= 59 and -- ";" |
| 383 | b ~= 44 and -- "," |
| 384 | b ~= 64 and -- "@" |
| 385 | b ~= 96 -- "`" |
| 386 | end |
| 387 | |
| 388 | local prefixes = { -- prefix chars substituted while reading |
| 389 | [96] = 'quote', -- ` |
| 390 | [44] = 'unquote', -- , |
| 391 | [39] = 'quote', -- ' |
| 392 | [35] = 'hashfn' -- # |
| 393 | } |
| 394 | |
| 395 | -- Parse one value given a function that |
| 396 | -- returns sequential bytes. Will throw an error as soon |
| 397 | -- as possible without getting more bytes on bad input. Returns |
| 398 | -- if a value was read, and then the value read. Will return nil |
| 399 | -- when input stream is finished. |
| 400 | local function parser(getbyte, filename, options) |
| 401 | |
| 402 | -- Stack of unfinished values |
| 403 | local stack = {} |
| 404 | |
| 405 | -- Provide one character buffer and keep |
| 406 | -- track of current line and byte index |
| 407 | local line = 1 |
| 408 | local byteindex = 0 |
| 409 | local lastb |
| 410 | local function ungetb(ub) |
| 411 | if ub == 10 then line = line - 1 end |
| 412 | byteindex = byteindex - 1 |
| 413 | lastb = ub |
| 414 | end |
| 415 | local function getb() |
| 416 | local r |
| 417 | if lastb then |
| 418 | r, lastb = lastb, nil |
| 419 | else |
| 420 | r = getbyte({ stackSize = #stack }) |
| 421 | end |
| 422 | byteindex = byteindex + 1 |
| 423 | if r == 10 then line = line + 1 end |
| 424 | return r |
| 425 | end |
| 426 | |
| 427 | -- If you add new calls to this function, please update fenneldfriend.fnl |
| 428 | -- as well to add suggestions for how to fix the new error. |
| 429 | local function parseError(msg) |
| 430 | local source = utils.root.options and utils.root.options.source |
| 431 | utils.root.reset() |
| 432 | local override = options and options["parse-error"] |
| 433 | if override then override(msg, filename or "unknown", line or "?", |
| 434 | byteindex, source) end |
| 435 | return error(("Parse error in %s:%s: %s"): |
| 436 | format(filename or "unknown", line or "?", msg), 0) |
| 437 | end |
| 438 | |
| 439 | -- Parse stream |
| 440 | return function() |
| 441 | |
| 442 | -- Dispatch when we complete a value |
| 443 | local done, retval |
| 444 | local whitespaceSinceDispatch = true |
| 445 | local function dispatch(v) |
| 446 | if #stack == 0 then |
| 447 | retval = v |
| 448 | done = true |
| 449 | elseif stack[#stack].prefix then |
| 450 | local stacktop = stack[#stack] |
| 451 | stack[#stack] = nil |
| 452 | return dispatch(utils.list(utils.sym(stacktop.prefix), v)) |
| 453 | else |
| 454 | table.insert(stack[#stack], v) |
| 455 | end |
| 456 | whitespaceSinceDispatch = false |
| 457 | end |
| 458 | |
| 459 | -- Throw nice error when we expect more characters |
| 460 | -- but reach end of stream. |
| 461 | local function badend() |
| 462 | local accum = utils.map(stack, "closer") |
| 463 | parseError(('expected closing delimiter%s %s'):format( |
| 464 | #stack == 1 and "" or "s", |
| 465 | string.char(unpack(accum)))) |
| 466 | end |
| 467 | |
| 468 | -- The main parse loop |
| 469 | repeat |
| 470 | local b |
| 471 | |
| 472 | -- Skip whitespace |
| 473 | repeat |
| 474 | b = getb() |
| 475 | if b and iswhitespace(b) then |
| 476 | whitespaceSinceDispatch = true |
| 477 | end |
| 478 | until not b or not iswhitespace(b) |
| 479 | if not b then |
| 480 | if #stack > 0 then badend() end |
| 481 | return nil |
| 482 | end |
| 483 | |
| 484 | if b == 59 then -- ; Comment |
| 485 | repeat |
| 486 | b = getb() |
| 487 | until not b or b == 10 -- newline |
| 488 | elseif type(delims[b]) == 'number' then -- Opening delimiter |
| 489 | if not whitespaceSinceDispatch then |
| 490 | parseError('expected whitespace before opening delimiter ' |
| 491 | .. string.char(b)) |
| 492 | end |
| 493 | table.insert(stack, setmetatable({ |
| 494 | closer = delims[b], |
| 495 | line = line, |
| 496 | filename = filename, |
| 497 | bytestart = byteindex |
| 498 | }, getmetatable(utils.list()))) |
| 499 | elseif delims[b] then -- Closing delimiter |
| 500 | if #stack == 0 then parseError('unexpected closing delimiter ' |
| 501 | .. string.char(b)) end |
| 502 | local last = stack[#stack] |
| 503 | local val |
| 504 | if last.closer ~= b then |
| 505 | parseError('mismatched closing delimiter ' .. string.char(b) .. |
| 506 | ', expected ' .. string.char(last.closer)) |
| 507 | end |
| 508 | last.byteend = byteindex -- Set closing byte index |
| 509 | if b == 41 then -- ; ) |
| 510 | val = last |
| 511 | elseif b == 93 then -- ; ] |
| 512 | val = utils.sequence(unpack(last)) |
| 513 | -- for table literals we can store file/line/offset source |
| 514 | -- data in fields on the table itself, because the AST node |
| 515 | -- *is* the table, and the fields would show up in the |
| 516 | -- compiled output. keep them on the metatable instead. |
| 517 | for k,v in pairs(last) do getmetatable(val)[k]=v end |
| 518 | else -- ; } |
| 519 | if #last % 2 ~= 0 then |
| 520 | byteindex = byteindex - 1 |
| 521 | parseError('expected even number of values in table literal') |
| 522 | end |
| 523 | val = {} |
| 524 | setmetatable(val, last) -- see note above about source data |
| 525 | for i = 1, #last, 2 do |
| 526 | if(tostring(last[i]) == ":" and utils.isSym(last[i + 1]) |
| 527 | and utils.isSym(last[i])) then |
| 528 | last[i] = tostring(last[i + 1]) |
| 529 | end |
| 530 | val[last[i]] = last[i + 1] |
| 531 | end |
| 532 | end |
| 533 | stack[#stack] = nil |
| 534 | dispatch(val) |
| 535 | elseif b == 34 then -- Quoted string |
| 536 | local state = "base" |
| 537 | local chars = {34} |
| 538 | stack[#stack + 1] = {closer = 34} |
| 539 | repeat |
| 540 | b = getb() |
| 541 | chars[#chars + 1] = b |
| 542 | if state == "base" then |
| 543 | if b == 92 then |
| 544 | state = "backslash" |
| 545 | elseif b == 34 then |
| 546 | state = "done" |
| 547 | end |
| 548 | else |
| 549 | -- state == "backslash" |
| 550 | state = "base" |
| 551 | end |
| 552 | until not b or (state == "done") |
| 553 | if not b then badend() end |
| 554 | stack[#stack] = nil |
| 555 | local raw = string.char(unpack(chars)) |
| 556 | local formatted = raw:gsub("[\1-\31]", function (c) |
| 557 | return '\\' .. c:byte() end) |
| 558 | local loadFn = (loadstring or load)(('return %s'):format(formatted)) |
| 559 | dispatch(loadFn()) |
| 560 | elseif prefixes[b] then |
| 561 | -- expand prefix byte into wrapping form eg. '`a' into '(quote a)' |
| 562 | table.insert(stack, { |
| 563 | prefix = prefixes[b] |
| 564 | }) |
| 565 | local nextb = getb() |
| 566 | if iswhitespace(nextb) then |
| 567 | if b == 35 then |
| 568 | stack[#stack] = nil |
| 569 | dispatch(utils.sym('#')) |
| 570 | else |
| 571 | parseError('invalid whitespace after quoting prefix') |
| 572 | end |
| 573 | end |
| 574 | ungetb(nextb) |
| 575 | elseif issymbolchar(b) or b == string.byte("~") then -- Try sym |
| 576 | local chars = {} |
| 577 | local bytestart = byteindex |
| 578 | repeat |
| 579 | chars[#chars + 1] = b |
| 580 | b = getb() |
| 581 | until not b or not issymbolchar(b) |
| 582 | if b then ungetb(b) end |
| 583 | local rawstr = string.char(unpack(chars)) |
| 584 | if rawstr == 'true' then dispatch(true) |
| 585 | elseif rawstr == 'false' then dispatch(false) |
| 586 | elseif rawstr == '...' then dispatch(utils.varg()) |
| 587 | elseif rawstr:match('^:.+$') then -- colon style strings |
| 588 | dispatch(rawstr:sub(2)) |
| 589 | elseif rawstr:match("^~") and rawstr ~= "~=" then |
| 590 | -- for backwards-compatibility, special-case allowance |
| 591 | -- of ~= but all other uses of ~ are disallowed |
| 592 | parseError("illegal character: ~") |
| 593 | else |
| 594 | local forceNumber = rawstr:match('^%d') |
| 595 | local numberWithStrippedUnderscores = rawstr:gsub("_", "") |
| 596 | local x |
| 597 | if forceNumber then |
| 598 | x = tonumber(numberWithStrippedUnderscores) or |
| 599 | parseError('could not read number "' .. rawstr .. '"') |
| 600 | else |
| 601 | x = tonumber(numberWithStrippedUnderscores) |
| 602 | if not x then |
| 603 | if(rawstr:match("%.[0-9]")) then |
| 604 | byteindex = (byteindex - #rawstr + |
| 605 | rawstr:find("%.[0-9]") + 1) |
| 606 | parseError("can't start multisym segment " .. |
| 607 | "with a digit: ".. rawstr) |
| 608 | elseif(rawstr:match("[%.:][%.:]") and |
| 609 | rawstr ~= ".." and rawstr ~= '$...') then |
| 610 | byteindex = (byteindex - #rawstr + |
| 611 | rawstr:find("[%.:][%.:]") + 1) |
| 612 | parseError("malformed multisym: " .. rawstr) |
| 613 | elseif(rawstr:match(":.+[%.:]")) then |
| 614 | byteindex = (byteindex - #rawstr + |
| 615 | rawstr:find(":.+[%.:]")) |
| 616 | parseError("method must be last component " |
| 617 | .. "of multisym: " .. rawstr) |
| 618 | else |
| 619 | x = utils.sym(rawstr, nil, {line = line, |
| 620 | filename = filename, |
| 621 | bytestart = bytestart, |
| 622 | byteend = byteindex,}) |
| 623 | end |
| 624 | end |
| 625 | end |
| 626 | dispatch(x) |
| 627 | end |
| 628 | else |
| 629 | parseError("illegal character: " .. string.char(b)) |
| 630 | end |
| 631 | until done |
| 632 | return true, retval |
| 633 | end, function () |
| 634 | stack = {} |
| 635 | end |
| 636 | end |
| 637 | return { granulate=granulate, stringStream=stringStream, parser=parser } |
| 638 | end)() |
| 639 | |
| 640 | -- |
| 641 | -- Compilation |
| 642 | -- |
| 643 | |
| 644 | local compiler = (function() |
| 645 | local scopes = {} |
| 646 | |
| 647 | -- Create a new Scope, optionally under a parent scope. Scopes are compile time |
| 648 | -- constructs that are responsible for keeping track of local variables, name |
| 649 | -- mangling, and macros. They are accessible to user code via the |
| 650 | -- 'eval-compiler' special form (may change). They use metatables to implement |
| 651 | -- nesting. |
| 652 | local function makeScope(parent) |
| 653 | if not parent then parent = scopes.global end |
| 654 | return { |
| 655 | unmanglings = setmetatable({}, { |
| 656 | __index = parent and parent.unmanglings |
| 657 | }), |
| 658 | manglings = setmetatable({}, { |
| 659 | __index = parent and parent.manglings |
| 660 | }), |
| 661 | specials = setmetatable({}, { |
| 662 | __index = parent and parent.specials |
| 663 | }), |
| 664 | macros = setmetatable({}, { |
| 665 | __index = parent and parent.macros |
| 666 | }), |
| 667 | symmeta = setmetatable({}, { |
| 668 | __index = parent and parent.symmeta |
| 669 | }), |
| 670 | includes = setmetatable({}, { |
| 671 | __index = parent and parent.includes |
| 672 | }), |
| 673 | refedglobals = setmetatable({}, { |
| 674 | __index = parent and parent.refedglobals |
| 675 | }), |
| 676 | autogensyms = {}, |
| 677 | parent = parent, |
| 678 | vararg = parent and parent.vararg, |
| 679 | depth = parent and ((parent.depth or 0) + 1) or 0, |
| 680 | hashfn = parent and parent.hashfn |
| 681 | } |
| 682 | end |
| 683 | |
| 684 | -- Assert a condition and raise a compile error with line numbers. The ast arg |
| 685 | -- should be unmodified so that its first element is the form being called. |
| 686 | -- If you add new calls to this function, please update fenneldfriend.fnl |
| 687 | -- as well to add suggestions for how to fix the new error. |
| 688 | local function assertCompile(condition, msg, ast) |
| 689 | local override = utils.root.options and utils.root.options["assert-compile"] |
| 690 | if override then |
| 691 | local source = utils.root.options and utils.root.options.source |
| 692 | -- don't make custom handlers deal with resetting root; it's error-prone |
| 693 | if not condition then utils.root.reset() end |
| 694 | override(condition, msg, ast, source) |
| 695 | -- should we fall thru to the default check, or should we allow the |
| 696 | -- override to swallow the error? |
| 697 | end |
| 698 | if not condition then |
| 699 | utils.root.reset() |
| 700 | local m = getmetatable(ast) |
| 701 | local filename = m and m.filename or ast.filename or "unknown" |
| 702 | local line = m and m.line or ast.line or "?" |
| 703 | -- if we use regular `assert' we can't provide the `level' argument of 0 |
| 704 | error(string.format("Compile error in '%s' %s:%s: %s", |
| 705 | tostring(utils.isSym(ast[1]) and ast[1][1] or |
| 706 | ast[1] or '()'), |
| 707 | filename, line, msg), 0) |
| 708 | end |
| 709 | return condition |
| 710 | end |
| 711 | |
| 712 | scopes.global = makeScope() |
| 713 | scopes.global.vararg = true |
| 714 | scopes.compiler = makeScope(scopes.global) |
| 715 | scopes.macro = scopes.global -- used by gensym, in-scope?, etc |
| 716 | |
| 717 | -- Allow printing a string to Lua, also keep as 1 line. |
| 718 | local serializeSubst = { |
| 719 | ['\a'] = '\\a', |
| 720 | ['\b'] = '\\b', |
| 721 | ['\f'] = '\\f', |
| 722 | ['\n'] = 'n', |
| 723 | ['\t'] = '\\t', |
| 724 | ['\v'] = '\\v' |
| 725 | } |
| 726 | local function serializeString(str) |
| 727 | local s = ("%q"):format(str) |
| 728 | s = s:gsub('.', serializeSubst):gsub("[\128-\255]", function(c) |
| 729 | return "\\" .. c:byte() |
| 730 | end) |
| 731 | return s |
| 732 | end |
| 733 | |
| 734 | -- Mangler for global symbols. Does not protect against collisions, |
| 735 | -- but makes them unlikely. This is the mangling that is exposed to |
| 736 | -- to the world. |
| 737 | local function globalMangling(str) |
| 738 | if utils.isValidLuaIdentifier(str) then |
| 739 | return str |
| 740 | end |
| 741 | -- Use underscore as escape character |
| 742 | return '__fnl_global__' .. str:gsub('[^%w]', function (c) |
| 743 | return ('_%02x'):format(c:byte()) |
| 744 | end) |
| 745 | end |
| 746 | |
| 747 | -- Reverse a global mangling. Takes a Lua identifier and |
| 748 | -- returns the fennel symbol string that created it. |
| 749 | local function globalUnmangling(identifier) |
| 750 | local rest = identifier:match('^__fnl_global__(.*)$') |
| 751 | if rest then |
| 752 | local r = rest:gsub('_[%da-f][%da-f]', function (code) |
| 753 | return string.char(tonumber(code:sub(2), 16)) |
| 754 | end) |
| 755 | return r -- don't return multiple values |
| 756 | else |
| 757 | return identifier |
| 758 | end |
| 759 | end |
| 760 | |
| 761 | -- If there's a provided list of allowed globals, don't let references thru that |
| 762 | -- aren't on the list. This list is set at the compiler entry points of compile |
| 763 | -- and compileStream. |
| 764 | local allowedGlobals |
| 765 | |
| 766 | local function globalAllowed(name) |
| 767 | if not allowedGlobals then return true end |
| 768 | for _, g in ipairs(allowedGlobals) do |
| 769 | if g == name then return true end |
| 770 | end |
| 771 | end |
| 772 | |
| 773 | -- Creates a symbol from a string by mangling it. |
| 774 | -- ensures that the generated symbol is unique |
| 775 | -- if the input string is unique in the scope. |
| 776 | local function localMangling(str, scope, ast, tempManglings) |
| 777 | local append = 0 |
| 778 | local mangling = str |
| 779 | assertCompile(not utils.isMultiSym(str), 'unexpected multi symbol ' .. str, ast) |
| 780 | |
| 781 | -- Mapping mangling to a valid Lua identifier |
| 782 | if utils.luaKeywords[mangling] or mangling:match('^%d') then |
| 783 | mangling = '_' .. mangling |
| 784 | end |
| 785 | mangling = mangling:gsub('-', '_') |
| 786 | mangling = mangling:gsub('[^%w_]', function (c) |
| 787 | return ('_%02x'):format(c:byte()) |
| 788 | end) |
| 789 | |
| 790 | -- Prevent name collisions with existing symbols |
| 791 | local raw = mangling |
| 792 | while scope.unmanglings[mangling] do |
| 793 | mangling = raw .. append |
| 794 | append = append + 1 |
| 795 | end |
| 796 | |
| 797 | scope.unmanglings[mangling] = str |
| 798 | local manglings = tempManglings or scope.manglings |
| 799 | manglings[str] = mangling |
| 800 | return mangling |
| 801 | end |
| 802 | |
| 803 | -- Calling this function will mean that further |
| 804 | -- compilation in scope will use these new manglings |
| 805 | -- instead of the current manglings. |
| 806 | local function applyManglings(scope, newManglings, ast) |
| 807 | for raw, mangled in pairs(newManglings) do |
| 808 | assertCompile(not scope.refedglobals[mangled], |
| 809 | "use of global " .. raw .. " is aliased by a local", ast) |
| 810 | scope.manglings[raw] = mangled |
| 811 | end |
| 812 | end |
| 813 | |
| 814 | -- Combine parts of a symbol |
| 815 | local function combineParts(parts, scope) |
| 816 | local ret = scope.manglings[parts[1]] or globalMangling(parts[1]) |
| 817 | for i = 2, #parts do |
| 818 | if utils.isValidLuaIdentifier(parts[i]) then |
| 819 | if parts.multiSymMethodCall and i == #parts then |
| 820 | ret = ret .. ':' .. parts[i] |
| 821 | else |
| 822 | ret = ret .. '.' .. parts[i] |
| 823 | end |
| 824 | else |
| 825 | ret = ret .. '[' .. serializeString(parts[i]) .. ']' |
| 826 | end |
| 827 | end |
| 828 | return ret |
| 829 | end |
| 830 | |
| 831 | -- Generates a unique symbol in the scope. |
| 832 | local function gensym(scope, base) |
| 833 | local mangling |
| 834 | local append = 0 |
| 835 | repeat |
| 836 | mangling = (base or '') .. '_' .. append .. '_' |
| 837 | append = append + 1 |
| 838 | until not scope.unmanglings[mangling] |
| 839 | scope.unmanglings[mangling] = true |
| 840 | return mangling |
| 841 | end |
| 842 | |
| 843 | -- Generates a unique symbol in the scope based on the base name. Calling |
| 844 | -- repeatedly with the same base and same scope will return existing symbol |
| 845 | -- rather than generating new one. |
| 846 | local function autogensym(base, scope) |
| 847 | local parts = utils.isMultiSym(base) |
| 848 | if(parts) then |
| 849 | parts[1] = autogensym(parts[1], scope) |
| 850 | return table.concat(parts, parts.multiSymMethodCall and ":" or ".") |
| 851 | end |
| 852 | |
| 853 | if scope.autogensyms[base] then return scope.autogensyms[base] end |
| 854 | local mangling = gensym(scope, base:sub(1, -2)) |
| 855 | scope.autogensyms[base] = mangling |
| 856 | return mangling |
| 857 | end |
| 858 | |
| 859 | -- Check if a binding is valid |
| 860 | local function checkBindingValid(symbol, scope, ast) |
| 861 | -- Check if symbol will be over shadowed by special |
| 862 | local name = symbol[1] |
| 863 | assertCompile(not scope.specials[name] and not scope.macros[name], |
| 864 | ("local %s was overshadowed by a special form or macro") |
| 865 | :format(name), ast) |
| 866 | assertCompile(not utils.isQuoted(symbol), |
| 867 | ("macro tried to bind %s without gensym"):format(name), symbol) |
| 868 | |
| 869 | end |
| 870 | |
| 871 | -- Declare a local symbol |
| 872 | local function declareLocal(symbol, meta, scope, ast, tempManglings) |
| 873 | checkBindingValid(symbol, scope, ast) |
| 874 | local name = symbol[1] |
| 875 | assertCompile(not utils.isMultiSym(name), |
| 876 | "unexpected multi symbol " .. name, ast) |
| 877 | local mangling = localMangling(name, scope, ast, tempManglings) |
| 878 | scope.symmeta[name] = meta |
| 879 | return mangling |
| 880 | end |
| 881 | |
| 882 | -- Convert symbol to Lua code. Will only work for local symbols |
| 883 | -- if they have already been declared via declareLocal |
| 884 | local function symbolToExpression(symbol, scope, isReference) |
| 885 | local name = symbol[1] |
| 886 | local multiSymParts = utils.isMultiSym(name) |
| 887 | if scope.hashfn then |
| 888 | if name == '$' then name = '$1' end |
| 889 | if multiSymParts then |
| 890 | if multiSymParts[1] == "$" then |
| 891 | multiSymParts[1] = "$1" |
| 892 | name = table.concat(multiSymParts, ".") |
| 893 | end |
| 894 | end |
| 895 | end |
| 896 | local parts = multiSymParts or {name} |
| 897 | local etype = (#parts > 1) and "expression" or "sym" |
| 898 | local isLocal = scope.manglings[parts[1]] |
| 899 | if isLocal and scope.symmeta[parts[1]] then scope.symmeta[parts[1]].used = true end |
| 900 | -- if it's a reference and not a symbol which introduces a new binding |
| 901 | -- then we need to check for allowed globals |
| 902 | assertCompile(not isReference or isLocal or globalAllowed(parts[1]), |
| 903 | 'unknown global in strict mode: ' .. parts[1], symbol) |
| 904 | if not isLocal then |
| 905 | utils.root.scope.refedglobals[parts[1]] = true |
| 906 | end |
| 907 | return utils.expr(combineParts(parts, scope), etype) |
| 908 | end |
| 909 | |
| 910 | |
| 911 | -- Emit Lua code |
| 912 | local function emit(chunk, out, ast) |
| 913 | if type(out) == 'table' then |
| 914 | table.insert(chunk, out) |
| 915 | else |
| 916 | table.insert(chunk, {leaf = out, ast = ast}) |
| 917 | end |
| 918 | end |
| 919 | |
| 920 | -- Do some peephole optimization. |
| 921 | local function peephole(chunk) |
| 922 | if chunk.leaf then return chunk end |
| 923 | -- Optimize do ... end in some cases. |
| 924 | if #chunk >= 3 and |
| 925 | chunk[#chunk - 2].leaf == 'do' and |
| 926 | not chunk[#chunk - 1].leaf and |
| 927 | chunk[#chunk].leaf == 'end' then |
| 928 | local kid = peephole(chunk[#chunk - 1]) |
| 929 | local newChunk = {ast = chunk.ast} |
| 930 | for i = 1, #chunk - 3 do table.insert(newChunk, peephole(chunk[i])) end |
| 931 | for i = 1, #kid do table.insert(newChunk, kid[i]) end |
| 932 | return newChunk |
| 933 | end |
| 934 | -- Recurse |
| 935 | return utils.map(chunk, peephole) |
| 936 | end |
| 937 | |
| 938 | -- correlate line numbers in input with line numbers in output |
| 939 | local function flattenChunkCorrelated(mainChunk) |
| 940 | local function flatten(chunk, out, lastLine, file) |
| 941 | if chunk.leaf then |
| 942 | out[lastLine] = (out[lastLine] or "") .. " " .. chunk.leaf |
| 943 | else |
| 944 | for _, subchunk in ipairs(chunk) do |
| 945 | -- Ignore empty chunks |
| 946 | if subchunk.leaf or #subchunk > 0 then |
| 947 | -- don't increase line unless it's from the same file |
| 948 | if subchunk.ast and file == subchunk.ast.file then |
| 949 | lastLine = math.max(lastLine, subchunk.ast.line or 0) |
| 950 | end |
| 951 | lastLine = flatten(subchunk, out, lastLine, file) |
| 952 | end |
| 953 | end |
| 954 | end |
| 955 | return lastLine |
| 956 | end |
| 957 | local out = {} |
| 958 | local last = flatten(mainChunk, out, 1, mainChunk.file) |
| 959 | for i = 1, last do |
| 960 | if out[i] == nil then out[i] = "" end |
| 961 | end |
| 962 | return table.concat(out, "\n") |
| 963 | end |
| 964 | |
| 965 | -- Flatten a tree of indented Lua source code lines. |
| 966 | -- Tab is what is used to indent a block. |
| 967 | local function flattenChunk(sm, chunk, tab, depth) |
| 968 | if type(tab) == 'boolean' then tab = tab and ' ' or '' end |
| 969 | if chunk.leaf then |
| 970 | local code = chunk.leaf |
| 971 | local info = chunk.ast |
| 972 | -- Just do line info for now to save memory |
| 973 | if sm then sm[#sm + 1] = info and info.line or -1 end |
| 974 | return code |
| 975 | else |
| 976 | local parts = utils.map(chunk, function(c) |
| 977 | if c.leaf or #c > 0 then -- Ignore empty chunks |
| 978 | local sub = flattenChunk(sm, c, tab, depth + 1) |
| 979 | if depth > 0 then sub = tab .. sub:gsub('\n', '\n' .. tab) end |
| 980 | return sub |
| 981 | end |
| 982 | end) |
| 983 | return table.concat(parts, '\n') |
| 984 | end |
| 985 | end |
| 986 | |
| 987 | -- Some global state for all fennel sourcemaps. For the time being, |
| 988 | -- this seems the easiest way to store the source maps. |
| 989 | -- Sourcemaps are stored with source being mapped as the key, prepended |
| 990 | -- with '@' if it is a filename (like debug.getinfo returns for source). |
| 991 | -- The value is an array of mappings for each line. |
| 992 | local fennelSourcemap = {} |
| 993 | -- TODO: loading, unloading, and saving sourcemaps? |
| 994 | |
| 995 | local function makeShortSrc(source) |
| 996 | source = source:gsub('\n', ' ') |
| 997 | if #source <= 49 then |
| 998 | return '[fennel "' .. source .. '"]' |
| 999 | else |
| 1000 | return '[fennel "' .. source:sub(1, 46) .. '..."]' |
| 1001 | end |
| 1002 | end |
| 1003 | |
| 1004 | -- Return Lua source and source map table |
| 1005 | local function flatten(chunk, options) |
| 1006 | chunk = peephole(chunk) |
| 1007 | if(options.correlate) then |
| 1008 | return flattenChunkCorrelated(chunk), {} |
| 1009 | else |
| 1010 | local sm = {} |
| 1011 | local ret = flattenChunk(sm, chunk, options.indent, 0) |
| 1012 | if sm then |
| 1013 | local key, short_src |
| 1014 | if options.filename then |
| 1015 | short_src = options.filename |
| 1016 | key = '@' .. short_src |
| 1017 | else |
| 1018 | key = ret |
| 1019 | short_src = makeShortSrc(options.source or ret) |
| 1020 | end |
| 1021 | sm.short_src = short_src |
| 1022 | sm.key = key |
| 1023 | fennelSourcemap[key] = sm |
| 1024 | end |
| 1025 | return ret, sm |
| 1026 | end |
| 1027 | end |
| 1028 | |
| 1029 | -- module-wide state for metadata |
| 1030 | -- create metadata table with weakly-referenced keys |
| 1031 | local function makeMetadata() |
| 1032 | return setmetatable({}, { |
| 1033 | __mode = 'k', |
| 1034 | __index = { |
| 1035 | get = function(self, tgt, key) |
| 1036 | if self[tgt] then return self[tgt][key] end |
| 1037 | end, |
| 1038 | set = function(self, tgt, key, value) |
| 1039 | self[tgt] = self[tgt] or {} |
| 1040 | self[tgt][key] = value |
| 1041 | return tgt |
| 1042 | end, |
| 1043 | setall = function(self, tgt, ...) |
| 1044 | local kvLen, kvs = select('#', ...), {...} |
| 1045 | if kvLen % 2 ~= 0 then |
| 1046 | error('metadata:setall() expected even number of k/v pairs') |
| 1047 | end |
| 1048 | self[tgt] = self[tgt] or {} |
| 1049 | for i = 1, kvLen, 2 do self[tgt][kvs[i]] = kvs[i + 1] end |
| 1050 | return tgt |
| 1051 | end, |
| 1052 | }}) |
| 1053 | end |
| 1054 | |
| 1055 | -- Convert expressions to Lua string |
| 1056 | local function exprs1(exprs) |
| 1057 | return table.concat(utils.map(exprs, 1), ', ') |
| 1058 | end |
| 1059 | |
| 1060 | -- Compile side effects for a chunk |
| 1061 | local function keepSideEffects(exprs, chunk, start, ast) |
| 1062 | start = start or 1 |
| 1063 | for j = start, #exprs do |
| 1064 | local se = exprs[j] |
| 1065 | -- Avoid the rogue 'nil' expression (nil is usually a literal, |
| 1066 | -- but becomes an expression if a special form |
| 1067 | -- returns 'nil'.) |
| 1068 | if se.type == 'expression' and se[1] ~= 'nil' then |
| 1069 | emit(chunk, ('do local _ = %s end'):format(tostring(se)), ast) |
| 1070 | elseif se.type == 'statement' then |
| 1071 | local code = tostring(se) |
| 1072 | emit(chunk, code:byte() == 40 and ("do end " .. code) or code , ast) |
| 1073 | end |
| 1074 | end |
| 1075 | end |
| 1076 | |
| 1077 | -- Does some common handling of returns and register |
| 1078 | -- targets for special forms. Also ensures a list expression |
| 1079 | -- has an acceptable number of expressions if opts contains the |
| 1080 | -- "nval" option. |
| 1081 | local function handleCompileOpts(exprs, parent, opts, ast) |
| 1082 | if opts.nval then |
| 1083 | local n = opts.nval |
| 1084 | if n ~= #exprs then |
| 1085 | local len = #exprs |
| 1086 | if len > n then |
| 1087 | -- Drop extra |
| 1088 | keepSideEffects(exprs, parent, n + 1, ast) |
| 1089 | for i = n + 1, len do |
| 1090 | exprs[i] = nil |
| 1091 | end |
| 1092 | else |
| 1093 | -- Pad with nils |
| 1094 | for i = #exprs + 1, n do |
| 1095 | exprs[i] = utils.expr('nil', 'literal') |
| 1096 | end |
| 1097 | end |
| 1098 | end |
| 1099 | end |
| 1100 | if opts.tail then |
| 1101 | emit(parent, ('return %s'):format(exprs1(exprs)), ast) |
| 1102 | end |
| 1103 | if opts.target then |
| 1104 | local result = exprs1(exprs) |
| 1105 | if result == '' then result = 'nil' end |
| 1106 | emit(parent, ('%s = %s'):format(opts.target, result), ast) |
| 1107 | end |
| 1108 | if opts.tail or opts.target then |
| 1109 | -- Prevent statements and expression from being used twice if they |
| 1110 | -- have side-effects. Since if the target or tail options are set, |
| 1111 | -- the expressions are already emitted, we should not return them. This |
| 1112 | -- is fine, as when these options are set, the caller doesn't need the result |
| 1113 | -- anyways. |
| 1114 | exprs = {} |
| 1115 | end |
| 1116 | return exprs |
| 1117 | end |
| 1118 | |
| 1119 | local function macroexpand(ast, scope, once) |
| 1120 | if not utils.isList(ast) then return ast end -- bail early if not a list form |
| 1121 | local multiSymParts = utils.isMultiSym(ast[1]) |
| 1122 | local macro = utils.isSym(ast[1]) and scope.macros[utils.deref(ast[1])] |
| 1123 | if not macro and multiSymParts then |
| 1124 | local inMacroModule |
| 1125 | macro = scope.macros |
| 1126 | for i = 1, #multiSymParts do |
| 1127 | macro = utils.isTable(macro) and macro[multiSymParts[i]] |
| 1128 | if macro then inMacroModule = true end |
| 1129 | end |
| 1130 | assertCompile(not inMacroModule or type(macro) == 'function', |
| 1131 | 'macro not found in imported macro module', ast) |
| 1132 | end |
| 1133 | if not macro then return ast end |
| 1134 | local oldScope = scopes.macro |
| 1135 | scopes.macro = scope |
| 1136 | local ok, transformed = pcall(macro, unpack(ast, 2)) |
| 1137 | scopes.macro = oldScope |
| 1138 | assertCompile(ok, transformed, ast) |
| 1139 | if once or not transformed then return transformed end -- macroexpand-1 |
| 1140 | return macroexpand(transformed, scope) |
| 1141 | end |
| 1142 | |
| 1143 | -- Compile an AST expression in the scope into parent, a tree |
| 1144 | -- of lines that is eventually compiled into Lua code. Also |
| 1145 | -- returns some information about the evaluation of the compiled expression, |
| 1146 | -- which can be used by the calling function. Macros |
| 1147 | -- are resolved here, as well as special forms in that order. |
| 1148 | -- the 'ast' param is the root AST to compile |
| 1149 | -- the 'scope' param is the scope in which we are compiling |
| 1150 | -- the 'parent' param is the table of lines that we are compiling into. |
| 1151 | -- add lines to parent by appending strings. Add indented blocks by appending |
| 1152 | -- tables of more lines. |
| 1153 | -- the 'opts' param contains info about where the form is being compiled. |
| 1154 | -- Options include: |
| 1155 | -- 'target' - mangled name of symbol(s) being compiled to. |
| 1156 | -- Could be one variable, 'a', or a list, like 'a, b, _0_'. |
| 1157 | -- 'tail' - boolean indicating tail position if set. If set, form will generate a return |
| 1158 | -- instruction. |
| 1159 | -- 'nval' - The number of values to compile to if it is known to be a fixed value. |
| 1160 | |
| 1161 | -- In Lua, an expression can evaluate to 0 or more values via multiple |
| 1162 | -- returns. In many cases, Lua will drop extra values and convert a 0 value |
| 1163 | -- expression to nil. In other cases, Lua will use all of the values in an |
| 1164 | -- expression, such as in the last argument of a function call. Nval is an |
| 1165 | -- option passed to compile1 to say that the resulting expression should have |
| 1166 | -- at least n values. It lets us generate better code, because if we know we |
| 1167 | -- are only going to use 1 or 2 values from an expression, we can create 1 or 2 |
| 1168 | -- locals to store intermediate results rather than turn the expression into a |
| 1169 | -- closure that is called immediately, which we have to do if we don't know. |
| 1170 | |
| 1171 | local function compile1(ast, scope, parent, opts) |
| 1172 | opts = opts or {} |
| 1173 | local exprs = {} |
| 1174 | -- expand any top-level macros before parsing and emitting Lua |
| 1175 | ast = macroexpand(ast, scope) |
| 1176 | -- Compile the form |
| 1177 | if utils.isList(ast) then -- Function call or special form |
| 1178 | assertCompile(#ast > 0, "expected a function, macro, or special to call", ast) |
| 1179 | -- Test for special form |
| 1180 | local len, first = #ast, ast[1] |
| 1181 | local multiSymParts = utils.isMultiSym(first) |
| 1182 | local special = utils.isSym(first) and scope.specials[utils.deref(first)] |
| 1183 | if special then -- Special form |
| 1184 | exprs = special(ast, scope, parent, opts) or utils.expr('nil', 'literal') |
| 1185 | -- Be very accepting of strings or expression |
| 1186 | -- as well as lists or expressions |
| 1187 | if type(exprs) == 'string' then exprs = utils.expr(exprs, 'expression') end |
| 1188 | if utils.isExpr(exprs) then exprs = {exprs} end |
| 1189 | -- Unless the special form explicitly handles the target, tail, and |
| 1190 | -- nval properties, (indicated via the 'returned' flag), handle |
| 1191 | -- these options. |
| 1192 | if not exprs.returned then |
| 1193 | exprs = handleCompileOpts(exprs, parent, opts, ast) |
| 1194 | elseif opts.tail or opts.target then |
| 1195 | exprs = {} |
| 1196 | end |
| 1197 | exprs.returned = true |
| 1198 | return exprs |
| 1199 | elseif multiSymParts and multiSymParts.multiSymMethodCall then |
| 1200 | local tableWithMethod = table.concat({ |
| 1201 | unpack(multiSymParts, 1, #multiSymParts - 1) |
| 1202 | }, '.') |
| 1203 | local methodToCall = multiSymParts[#multiSymParts] |
| 1204 | local newAST = utils.list(utils.sym(':', scope), utils.sym(tableWithMethod, scope), |
| 1205 | methodToCall) |
| 1206 | for i = 2, len do |
| 1207 | newAST[#newAST + 1] = ast[i] |
| 1208 | end |
| 1209 | local compiled = compile1(newAST, scope, parent, opts) |
| 1210 | exprs = compiled |
| 1211 | else -- Function call |
| 1212 | local fargs = {} |
| 1213 | local fcallee = compile1(ast[1], scope, parent, { |
| 1214 | nval = 1 |
| 1215 | })[1] |
| 1216 | assertCompile(fcallee.type ~= 'literal', |
| 1217 | 'cannot call literal value ' .. tostring(ast[1]), ast) |
| 1218 | fcallee = tostring(fcallee) |
| 1219 | for i = 2, len do |
| 1220 | local subexprs = compile1(ast[i], scope, parent, { |
| 1221 | nval = i ~= len and 1 or nil |
| 1222 | }) |
| 1223 | fargs[#fargs + 1] = subexprs[1] or utils.expr('nil', 'literal') |
| 1224 | if i == len then |
| 1225 | -- Add sub expressions to function args |
| 1226 | for j = 2, #subexprs do |
| 1227 | fargs[#fargs + 1] = subexprs[j] |
| 1228 | end |
| 1229 | else |
| 1230 | -- Emit sub expression only for side effects |
| 1231 | keepSideEffects(subexprs, parent, 2, ast[i]) |
| 1232 | end |
| 1233 | end |
| 1234 | local call = ('%s(%s)'):format(tostring(fcallee), exprs1(fargs)) |
| 1235 | exprs = handleCompileOpts({utils.expr(call, 'statement')}, parent, opts, ast) |
| 1236 | end |
| 1237 | elseif utils.isVarg(ast) then |
| 1238 | assertCompile(scope.vararg, "unexpected vararg", ast) |
| 1239 | exprs = handleCompileOpts({utils.expr('...', 'varg')}, parent, opts, ast) |
| 1240 | elseif utils.isSym(ast) then |
| 1241 | local e |
| 1242 | local multiSymParts = utils.isMultiSym(ast) |
| 1243 | assertCompile(not (multiSymParts and multiSymParts.multiSymMethodCall), |
| 1244 | "multisym method calls may only be in call position", ast) |
| 1245 | -- Handle nil as special symbol - it resolves to the nil literal rather than |
| 1246 | -- being unmangled. Alternatively, we could remove it from the lua keywords table. |
| 1247 | if ast[1] == 'nil' then |
| 1248 | e = utils.expr('nil', 'literal') |
| 1249 | else |
| 1250 | e = symbolToExpression(ast, scope, true) |
| 1251 | end |
| 1252 | exprs = handleCompileOpts({e}, parent, opts, ast) |
| 1253 | elseif type(ast) == 'nil' or type(ast) == 'boolean' then |
| 1254 | exprs = handleCompileOpts({utils.expr(tostring(ast), 'literal')}, parent, opts) |
| 1255 | elseif type(ast) == 'number' then |
| 1256 | local n = ('%.17g'):format(ast) |
| 1257 | exprs = handleCompileOpts({utils.expr(n, 'literal')}, parent, opts) |
| 1258 | elseif type(ast) == 'string' then |
| 1259 | local s = serializeString(ast) |
| 1260 | exprs = handleCompileOpts({utils.expr(s, 'literal')}, parent, opts) |
| 1261 | elseif type(ast) == 'table' then |
| 1262 | local buffer = {} |
| 1263 | for i = 1, #ast do -- Write numeric keyed values. |
| 1264 | local nval = i ~= #ast and 1 |
| 1265 | buffer[#buffer + 1] = exprs1(compile1(ast[i], scope, |
| 1266 | parent, {nval = nval})) |
| 1267 | end |
| 1268 | local function writeOtherValues(k) |
| 1269 | if type(k) ~= 'number' or math.floor(k) ~= k or k < 1 or k > #ast then |
| 1270 | if type(k) == 'string' and utils.isValidLuaIdentifier(k) then |
| 1271 | return {k, k} |
| 1272 | else |
| 1273 | local kstr = '[' .. tostring(compile1(k, scope, parent, |
| 1274 | {nval = 1})[1]) .. ']' |
| 1275 | return { kstr, k } |
| 1276 | end |
| 1277 | end |
| 1278 | end |
| 1279 | local keys = utils.kvmap(ast, writeOtherValues) |
| 1280 | table.sort(keys, function (a, b) return a[1] < b[1] end) |
| 1281 | utils.map(keys, function(k) |
| 1282 | local v = tostring(compile1(ast[k[2]], scope, parent, {nval = 1})[1]) |
| 1283 | return ('%s = %s'):format(k[1], v) end, |
| 1284 | buffer) |
| 1285 | local tbl = '{' .. table.concat(buffer, ', ') ..'}' |
| 1286 | exprs = handleCompileOpts({utils.expr(tbl, 'expression')}, parent, opts, ast) |
| 1287 | else |
| 1288 | assertCompile(false, 'could not compile value of type ' .. type(ast), ast) |
| 1289 | end |
| 1290 | exprs.returned = true |
| 1291 | return exprs |
| 1292 | end |
| 1293 | |
| 1294 | -- Implements destructuring for forms like let, bindings, etc. |
| 1295 | -- Takes a number of options to control behavior. |
| 1296 | -- var: Whether or not to mark symbols as mutable |
| 1297 | -- declaration: begin each assignment with 'local' in output |
| 1298 | -- nomulti: disallow multisyms in the destructuring. Used for (local) and (global). |
| 1299 | -- noundef: Don't set undefined bindings. (set) |
| 1300 | -- forceglobal: Don't allow local bindings |
| 1301 | local function destructure(to, from, ast, scope, parent, opts) |
| 1302 | opts = opts or {} |
| 1303 | local isvar = opts.isvar |
| 1304 | local declaration = opts.declaration |
| 1305 | local nomulti = opts.nomulti |
| 1306 | local noundef = opts.noundef |
| 1307 | local forceglobal = opts.forceglobal |
| 1308 | local forceset = opts.forceset |
| 1309 | local setter = declaration and "local %s = %s" or "%s = %s" |
| 1310 | |
| 1311 | local newManglings = {} |
| 1312 | |
| 1313 | -- Get Lua source for symbol, and check for errors |
| 1314 | local function getname(symbol, up1) |
| 1315 | local raw = symbol[1] |
| 1316 | assertCompile(not (nomulti and utils.isMultiSym(raw)), |
| 1317 | 'unexpected multi symbol ' .. raw, up1) |
| 1318 | if declaration then |
| 1319 | return declareLocal(symbol, {var = isvar}, scope, |
| 1320 | symbol, newManglings) |
| 1321 | else |
| 1322 | local parts = utils.isMultiSym(raw) or {raw} |
| 1323 | local meta = scope.symmeta[parts[1]] |
| 1324 | if #parts == 1 and not forceset then |
| 1325 | assertCompile(not(forceglobal and meta), |
| 1326 | ("global %s conflicts with local"):format(tostring(symbol)), symbol) |
| 1327 | assertCompile(not (meta and not meta.var), |
| 1328 | 'expected var ' .. raw, symbol) |
| 1329 | assertCompile(meta or not noundef, |
| 1330 | 'expected local ' .. parts[1], symbol) |
| 1331 | end |
| 1332 | if forceglobal then |
| 1333 | assertCompile(not scope.symmeta[scope.unmanglings[raw]], |
| 1334 | "global " .. raw .. " conflicts with local", symbol) |
| 1335 | scope.manglings[raw] = globalMangling(raw) |
| 1336 | scope.unmanglings[globalMangling(raw)] = raw |
| 1337 | if allowedGlobals then |
| 1338 | table.insert(allowedGlobals, raw) |
| 1339 | end |
| 1340 | end |
| 1341 | |
| 1342 | return symbolToExpression(symbol, scope)[1] |
| 1343 | end |
| 1344 | end |
| 1345 | |
| 1346 | -- Compile the outer most form. We can generate better Lua in this case. |
| 1347 | local function compileTopTarget(lvalues) |
| 1348 | -- Calculate initial rvalue |
| 1349 | local inits = utils.map(lvalues, function(x) |
| 1350 | return scope.manglings[x] and x or 'nil' end) |
| 1351 | local init = table.concat(inits, ', ') |
| 1352 | local lvalue = table.concat(lvalues, ', ') |
| 1353 | |
| 1354 | local plen, plast = #parent, parent[#parent] |
| 1355 | local ret = compile1(from, scope, parent, {target = lvalue}) |
| 1356 | if declaration then |
| 1357 | -- A single leaf emitted at the end of the parent chunk means |
| 1358 | -- a simple assignment a = x was emitted, and we can just |
| 1359 | -- splice "local " onto the front of it. However, we can't |
| 1360 | -- just check based on plen, because some forms (such as |
| 1361 | -- include) insert new chunks at the top of the parent chunk |
| 1362 | -- rather than just at the end; this loop checks for this |
| 1363 | -- occurance and updates plen to be the index of the last |
| 1364 | -- thing in the parent before compiling the new value. |
| 1365 | for pi = plen, #parent do |
| 1366 | if parent[pi] == plast then plen = pi end |
| 1367 | end |
| 1368 | if #parent == plen + 1 and parent[#parent].leaf then |
| 1369 | parent[#parent].leaf = 'local ' .. parent[#parent].leaf |
| 1370 | else |
| 1371 | table.insert(parent, plen + 1, |
| 1372 | { leaf = 'local ' .. lvalue .. ' = ' .. init, |
| 1373 | ast = ast}) |
| 1374 | end |
| 1375 | end |
| 1376 | return ret |
| 1377 | end |
| 1378 | |
| 1379 | -- Recursive auxiliary function |
| 1380 | local function destructure1(left, rightexprs, up1, top) |
| 1381 | if utils.isSym(left) and left[1] ~= "nil" then |
| 1382 | checkBindingValid(left, scope, left) |
| 1383 | local lname = getname(left, up1) |
| 1384 | if top then |
| 1385 | compileTopTarget({lname}) |
| 1386 | else |
| 1387 | emit(parent, setter:format(lname, exprs1(rightexprs)), left) |
| 1388 | end |
| 1389 | elseif utils.isTable(left) then -- table destructuring |
| 1390 | if top then rightexprs = compile1(from, scope, parent) end |
| 1391 | local s = gensym(scope) |
| 1392 | local right = exprs1(rightexprs) |
| 1393 | if right == '' then right = 'nil' end |
| 1394 | emit(parent, ("local %s = %s"):format(s, right), left) |
| 1395 | for k, v in utils.stablepairs(left) do |
| 1396 | if utils.isSym(left[k]) and left[k][1] == "&" then |
| 1397 | assertCompile(type(k) == "number" and not left[k+2], |
| 1398 | "expected rest argument before last parameter", left) |
| 1399 | local subexpr = utils.expr(('{(table.unpack or unpack)(%s, %s)}') |
| 1400 | :format(s, k), 'expression') |
| 1401 | destructure1(left[k+1], {subexpr}, left) |
| 1402 | return |
| 1403 | else |
| 1404 | if utils.isSym(k) and tostring(k) == ":" and utils.isSym(v) then |
| 1405 | k = tostring(v) |
| 1406 | end |
| 1407 | if type(k) ~= "number" then k = serializeString(k) end |
| 1408 | local subexpr = utils.expr(('%s[%s]'):format(s, k), 'expression') |
| 1409 | destructure1(v, {subexpr}, left) |
| 1410 | end |
| 1411 | end |
| 1412 | elseif utils.isList(left) then -- values destructuring |
| 1413 | local leftNames, tables = {}, {} |
| 1414 | for i, name in ipairs(left) do |
| 1415 | local symname |
| 1416 | if utils.isSym(name) then -- binding directly to a name |
| 1417 | symname = getname(name, up1) |
| 1418 | else -- further destructuring of tables inside values |
| 1419 | symname = gensym(scope) |
| 1420 | tables[i] = {name, utils.expr(symname, 'sym')} |
| 1421 | end |
| 1422 | table.insert(leftNames, symname) |
| 1423 | end |
| 1424 | if top then |
| 1425 | compileTopTarget(leftNames) |
| 1426 | else |
| 1427 | local lvalue = table.concat(leftNames, ', ') |
| 1428 | emit(parent, setter:format(lvalue, exprs1(rightexprs)), left) |
| 1429 | end |
| 1430 | for _, pair in utils.stablepairs(tables) do -- recurse if left-side tables found |
| 1431 | destructure1(pair[1], {pair[2]}, left) |
| 1432 | end |
| 1433 | else |
| 1434 | assertCompile(false, ("unable to bind %s %s"): |
| 1435 | format(type(left), tostring(left)), |
| 1436 | type(up1[2]) == "table" and up1[2] or up1) |
| 1437 | end |
| 1438 | if top then return {returned = true} end |
| 1439 | end |
| 1440 | |
| 1441 | local ret = destructure1(to, nil, ast, true) |
| 1442 | applyManglings(scope, newManglings, ast) |
| 1443 | return ret |
| 1444 | end |
| 1445 | |
| 1446 | local function requireInclude(ast, scope, parent, opts) |
| 1447 | opts.fallback = function(e) |
| 1448 | return utils.expr(('require(%s)'):format(tostring(e)), 'statement') |
| 1449 | end |
| 1450 | return scopes.global.specials['include'](ast, scope, parent, opts) |
| 1451 | end |
| 1452 | |
| 1453 | local function compileStream(strm, options) |
| 1454 | local opts = utils.copy(options) |
| 1455 | local oldGlobals = allowedGlobals |
| 1456 | utils.root:setReset() |
| 1457 | allowedGlobals = opts.allowedGlobals |
| 1458 | if opts.indent == nil then opts.indent = ' ' end |
| 1459 | local scope = opts.scope or makeScope(scopes.global) |
| 1460 | if opts.requireAsInclude then scope.specials.require = requireInclude end |
| 1461 | local vals = {} |
| 1462 | for ok, val in parser.parser(strm, opts.filename, opts) do |
| 1463 | if not ok then break end |
| 1464 | vals[#vals + 1] = val |
| 1465 | end |
| 1466 | local chunk = {} |
| 1467 | utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts |
| 1468 | for i = 1, #vals do |
| 1469 | local exprs = compile1(vals[i], scope, chunk, { |
| 1470 | tail = i == #vals, |
| 1471 | nval = i < #vals and 0 or nil |
| 1472 | }) |
| 1473 | keepSideEffects(exprs, chunk, nil, vals[i]) |
| 1474 | end |
| 1475 | allowedGlobals = oldGlobals |
| 1476 | utils.root.reset() |
| 1477 | return flatten(chunk, opts) |
| 1478 | end |
| 1479 | |
| 1480 | local function compileString(str, options) |
| 1481 | options = options or {} |
| 1482 | local oldSource = options.source |
| 1483 | options.source = str -- used by fennelfriend |
| 1484 | local ast = compileStream(parser.stringStream(str), options) |
| 1485 | options.source = oldSource |
| 1486 | return ast |
| 1487 | end |
| 1488 | |
| 1489 | local function compile(ast, options) |
| 1490 | local opts = utils.copy(options) |
| 1491 | local oldGlobals = allowedGlobals |
| 1492 | utils.root:setReset() |
| 1493 | allowedGlobals = opts.allowedGlobals |
| 1494 | if opts.indent == nil then opts.indent = ' ' end |
| 1495 | local chunk = {} |
| 1496 | local scope = opts.scope or makeScope(scopes.global) |
| 1497 | utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts |
| 1498 | if opts.requireAsInclude then scope.specials.require = requireInclude end |
| 1499 | local exprs = compile1(ast, scope, chunk, {tail = true}) |
| 1500 | keepSideEffects(exprs, chunk, nil, ast) |
| 1501 | allowedGlobals = oldGlobals |
| 1502 | utils.root.reset() |
| 1503 | return flatten(chunk, opts) |
| 1504 | end |
| 1505 | |
| 1506 | -- A custom traceback function for Fennel that looks similar to |
| 1507 | -- the Lua's debug.traceback. |
| 1508 | -- Use with xpcall to produce fennel specific stacktraces. |
| 1509 | local function traceback(msg, start) |
| 1510 | local level = start or 2 -- Can be used to skip some frames |
| 1511 | local lines = {} |
| 1512 | if msg then |
| 1513 | if msg:find("^Compile error") or msg:find("^Parse error") then |
| 1514 | -- End users don't want to see compiler stack traces, but when |
| 1515 | -- you're hacking on the compiler, export FENNEL_DEBUG=trace |
| 1516 | if not utils.debugOn("trace") then return msg end |
| 1517 | table.insert(lines, msg) |
| 1518 | else |
| 1519 | local newmsg = msg:gsub('^[^:]*:%d+:%s+', 'runtime error: ') |
| 1520 | table.insert(lines, newmsg) |
| 1521 | end |
| 1522 | end |
| 1523 | table.insert(lines, 'stack traceback:') |
| 1524 | while true do |
| 1525 | local info = debug.getinfo(level, "Sln") |
| 1526 | if not info then break end |
| 1527 | local line |
| 1528 | if info.what == "C" then |
| 1529 | if info.name then |
| 1530 | line = (' [C]: in function \'%s\''):format(info.name) |
| 1531 | else |
| 1532 | line = ' [C]: in ?' |
| 1533 | end |
| 1534 | else |
| 1535 | local remap = fennelSourcemap[info.source] |
| 1536 | if remap and remap[info.currentline] then |
| 1537 | -- And some global info |
| 1538 | info.short_src = remap.short_src |
| 1539 | local mapping = remap[info.currentline] |
| 1540 | -- Overwrite info with values from the mapping (mapping is now |
| 1541 | -- just integer, but may eventually be a table) |
| 1542 | info.currentline = mapping |
| 1543 | end |
| 1544 | if info.what == 'Lua' then |
| 1545 | local n = info.name and ("'" .. info.name .. "'") or '?' |
| 1546 | line = (' %s:%d: in function %s'):format(info.short_src, info.currentline, n) |
| 1547 | elseif info.short_src == '(tail call)' then |
| 1548 | line = ' (tail call)' |
| 1549 | else |
| 1550 | line = (' %s:%d: in main chunk'):format(info.short_src, info.currentline) |
| 1551 | end |
| 1552 | end |
| 1553 | table.insert(lines, line) |
| 1554 | level = level + 1 |
| 1555 | end |
| 1556 | return table.concat(lines, '\n') |
| 1557 | end |
| 1558 | |
| 1559 | -- make a transformer for key / value table pairs, preserving all numeric keys |
| 1560 | local function entryTransform(fk,fv) |
| 1561 | return function(k, v) |
| 1562 | if type(k) == 'number' then |
| 1563 | return k,fv(v) |
| 1564 | else |
| 1565 | return fk(k),fv(v) |
| 1566 | end |
| 1567 | end |
| 1568 | end |
| 1569 | |
| 1570 | -- consume everything return nothing |
| 1571 | local function no() end |
| 1572 | |
| 1573 | local function mixedConcat(t, joiner) |
| 1574 | local ret = "" |
| 1575 | local s = "" |
| 1576 | local seen = {} |
| 1577 | for k,v in ipairs(t) do |
| 1578 | table.insert(seen, k) |
| 1579 | ret = ret .. s .. v |
| 1580 | s = joiner |
| 1581 | end |
| 1582 | for k,v in utils.stablepairs(t) do |
| 1583 | if not(seen[k]) then |
| 1584 | ret = ret .. s .. '[' .. k .. ']' .. '=' .. v |
| 1585 | s = joiner |
| 1586 | end |
| 1587 | end |
| 1588 | return ret |
| 1589 | end |
| 1590 | |
| 1591 | -- expand a quoted form into a data literal, evaluating unquote |
| 1592 | local function doQuote (form, scope, parent, runtime) |
| 1593 | local q = function (x) return doQuote(x, scope, parent, runtime) end |
| 1594 | -- vararg |
| 1595 | if utils.isVarg(form) then |
| 1596 | assertCompile(not runtime, "quoted ... may only be used at compile time", form) |
| 1597 | return "_VARARG" |
| 1598 | -- symbol |
| 1599 | elseif utils.isSym(form) then |
| 1600 | assertCompile(not runtime, "symbols may only be used at compile time", form) |
| 1601 | -- We should be able to use "%q" for this but Lua 5.1 throws an error |
| 1602 | -- when you try to format nil, because it's extremely bad. |
| 1603 | local filename = form.filename and ('%q'):format(form.filename) or "nil" |
| 1604 | if utils.deref(form):find("#$") or utils.deref(form):find("#[:.]") then -- autogensym |
| 1605 | return ("sym('%s', nil, {filename=%s, line=%s})"): |
| 1606 | format(autogensym(utils.deref(form), scope), filename, form.line or "nil") |
| 1607 | else -- prevent non-gensymmed symbols from being bound as an identifier |
| 1608 | return ("sym('%s', nil, {quoted=true, filename=%s, line=%s})"): |
| 1609 | format(utils.deref(form), filename, form.line or "nil") |
| 1610 | end |
| 1611 | -- unquote |
| 1612 | elseif(utils.isList(form) and utils.isSym(form[1]) and |
| 1613 | (utils.deref(form[1]) == 'unquote')) then |
| 1614 | local payload = form[2] |
| 1615 | local res = unpack(compile1(payload, scope, parent)) |
| 1616 | return res[1] |
| 1617 | -- list |
| 1618 | elseif utils.isList(form) then |
| 1619 | assertCompile(not runtime, "lists may only be used at compile time", form) |
| 1620 | local mapped = utils.kvmap(form, entryTransform(no, q)) |
| 1621 | local filename = form.filename and ('%q'):format(form.filename) or "nil" |
| 1622 | -- Constructing a list and then adding file/line data to it triggers a |
| 1623 | -- bug where it changes the value of # for lists that contain nils in |
| 1624 | -- them; constructing the list all in one go with the source data and |
| 1625 | -- contents is how we construct lists in the parser and works around |
| 1626 | -- this problem; allowing # to work in a way that lets us see the nils. |
| 1627 | return ("setmetatable({filename=%s, line=%s, bytestart=%s, %s}" .. |
| 1628 | ", getmetatable(list()))") |
| 1629 | :format(filename, form.line or "nil", form.bytestart or "nil", |
| 1630 | mixedConcat(mapped, ", ")) |
| 1631 | -- table |
| 1632 | elseif type(form) == 'table' then |
| 1633 | local mapped = utils.kvmap(form, entryTransform(q, q)) |
| 1634 | local source = getmetatable(form) |
| 1635 | local filename = source.filename and ('%q'):format(source.filename) or "nil" |
| 1636 | return ("setmetatable({%s}, {filename=%s, line=%s})"): |
| 1637 | format(mixedConcat(mapped, ", "), filename, source and source.line or "nil") |
| 1638 | -- string |
| 1639 | elseif type(form) == 'string' then |
| 1640 | return serializeString(form) |
| 1641 | else |
| 1642 | return tostring(form) |
| 1643 | end |
| 1644 | end |
| 1645 | return { |
| 1646 | -- compiling functions: |
| 1647 | compileString=compileString, compileStream=compileStream, |
| 1648 | compile=compile, compile1=compile1, emit=emit, destructure=destructure, |
| 1649 | requireInclude=requireInclude, |
| 1650 | |
| 1651 | -- AST functions: |
| 1652 | gensym=gensym, autogensym=autogensym, doQuote=doQuote, |
| 1653 | macroexpand=macroexpand, globalUnmangling=globalUnmangling, |
| 1654 | applyManglings=applyManglings, globalMangling=globalMangling, |
| 1655 | |
| 1656 | -- scope functions: |
| 1657 | makeScope=makeScope, keepSideEffects=keepSideEffects, |
| 1658 | declareLocal=declareLocal, symbolToExpression=symbolToExpression, |
| 1659 | |
| 1660 | -- general functions: |
| 1661 | assert=assertCompile, metadata=makeMetadata(), traceback=traceback, |
| 1662 | scopes=scopes, |
| 1663 | } |
| 1664 | end)() |
| 1665 | |
| 1666 | -- |
| 1667 | -- Specials and macros |
| 1668 | -- |
| 1669 | |
| 1670 | local specials = (function() |
| 1671 | local SPECIALS = compiler.scopes.global.specials |
| 1672 | |
| 1673 | -- Convert a fennel environment table to a Lua environment table. |
| 1674 | -- This means automatically unmangling globals when getting a value, |
| 1675 | -- and mangling values when setting a value. This means the original env |
| 1676 | -- will see its values updated as expected, regardless of mangling rules. |
| 1677 | local function wrapEnv(env) |
| 1678 | return setmetatable({}, { |
| 1679 | __index = function(_, key) |
| 1680 | if type(key) == 'string' then |
| 1681 | key = compiler.globalUnmangling(key) |
| 1682 | end |
| 1683 | return env[key] |
| 1684 | end, |
| 1685 | __newindex = function(_, key, value) |
| 1686 | if type(key) == 'string' then |
| 1687 | key = compiler.globalMangling(key) |
| 1688 | end |
| 1689 | env[key] = value |
| 1690 | end, |
| 1691 | -- checking the __pairs metamethod won't work automatically in Lua 5.1 |
| 1692 | -- sadly, but it's important for 5.2+ and can be done manually in 5.1 |
| 1693 | __pairs = function() |
| 1694 | local function putenv(k, v) |
| 1695 | return type(k) == 'string' and compiler.globalUnmangling(k) or k, v |
| 1696 | end |
| 1697 | local pt = utils.kvmap(env, putenv) |
| 1698 | return next, pt, nil |
| 1699 | end, |
| 1700 | }) |
| 1701 | end |
| 1702 | |
| 1703 | local function currentGlobalNames(env) |
| 1704 | return utils.kvmap(env or _G, compiler.globalUnmangling) |
| 1705 | end |
| 1706 | |
| 1707 | -- Load code with an environment in all recent Lua versions |
| 1708 | local function loadCode(code, environment, filename) |
| 1709 | environment = environment or _ENV or _G |
| 1710 | if setfenv and loadstring then |
| 1711 | local f = assert(loadstring(code, filename)) |
| 1712 | setfenv(f, environment) |
| 1713 | return f |
| 1714 | else |
| 1715 | return assert(load(code, filename, "t", environment)) |
| 1716 | end |
| 1717 | end |
| 1718 | |
| 1719 | -- Return a docstring |
| 1720 | local doc = function(tgt, name) |
| 1721 | if(not tgt) then return name .. " not found" end |
| 1722 | local docstring = (compiler.metadata:get(tgt, 'fnl/docstring') or |
| 1723 | '#<undocumented>'):gsub('\n$', ''):gsub('\n', '\n ') |
| 1724 | if type(tgt) == "function" then |
| 1725 | local arglist = table.concat(compiler.metadata:get(tgt, 'fnl/arglist') or |
| 1726 | {'#<unknown-arguments>'}, ' ') |
| 1727 | return string.format("(%s%s%s)\n %s", name, #arglist > 0 and ' ' or '', |
| 1728 | arglist, docstring) |
| 1729 | else |
| 1730 | return string.format("%s\n %s", name, docstring) |
| 1731 | end |
| 1732 | end |
| 1733 | |
| 1734 | local function docSpecial(name, arglist, docstring) |
| 1735 | compiler.metadata[SPECIALS[name]] = |
| 1736 | { ["fnl/docstring"] = docstring, ["fnl/arglist"] = arglist } |
| 1737 | end |
| 1738 | |
| 1739 | -- Compile a list of forms for side effects |
| 1740 | local function compileDo(ast, scope, parent, start) |
| 1741 | start = start or 2 |
| 1742 | local len = #ast |
| 1743 | local subScope = compiler.makeScope(scope) |
| 1744 | for i = start, len do |
| 1745 | compiler.compile1(ast[i], subScope, parent, { |
| 1746 | nval = 0 |
| 1747 | }) |
| 1748 | end |
| 1749 | end |
| 1750 | |
| 1751 | -- Implements a do statement, starting at the 'start' element. By default, start is 2. |
| 1752 | local function doImpl(ast, scope, parent, opts, start, chunk, subScope, preSyms) |
| 1753 | start = start or 2 |
| 1754 | subScope = subScope or compiler.makeScope(scope) |
| 1755 | chunk = chunk or {} |
| 1756 | local len = #ast |
| 1757 | local outerTarget = opts.target |
| 1758 | local outerTail = opts.tail |
| 1759 | local retexprs = {returned = true} |
| 1760 | |
| 1761 | -- See if we need special handling to get the return values |
| 1762 | -- of the do block |
| 1763 | if not outerTarget and opts.nval ~= 0 and not outerTail then |
| 1764 | if opts.nval then |
| 1765 | -- Generate a local target |
| 1766 | local syms = {} |
| 1767 | for i = 1, opts.nval do |
| 1768 | local s = preSyms and preSyms[i] or compiler.gensym(scope) |
| 1769 | syms[i] = s |
| 1770 | retexprs[i] = utils.expr(s, 'sym') |
| 1771 | end |
| 1772 | outerTarget = table.concat(syms, ', ') |
| 1773 | compiler.emit(parent, ('local %s'):format(outerTarget), ast) |
| 1774 | compiler.emit(parent, 'do', ast) |
| 1775 | else |
| 1776 | -- We will use an IIFE for the do |
| 1777 | local fname = compiler.gensym(scope) |
| 1778 | local fargs = scope.vararg and '...' or '' |
| 1779 | compiler.emit(parent, ('local function %s(%s)'):format(fname, fargs), ast) |
| 1780 | retexprs = utils.expr(fname .. '(' .. fargs .. ')', 'statement') |
| 1781 | outerTail = true |
| 1782 | outerTarget = nil |
| 1783 | end |
| 1784 | else |
| 1785 | compiler.emit(parent, 'do', ast) |
| 1786 | end |
| 1787 | -- Compile the body |
| 1788 | if start > len then |
| 1789 | -- In the unlikely case we do a do with no arguments. |
| 1790 | compiler.compile1(nil, subScope, chunk, { |
| 1791 | tail = outerTail, |
| 1792 | target = outerTarget |
| 1793 | }) |
| 1794 | -- There will be no side effects |
| 1795 | else |
| 1796 | for i = start, len do |
| 1797 | local subopts = { |
| 1798 | nval = i ~= len and 0 or opts.nval, |
| 1799 | tail = i == len and outerTail or nil, |
| 1800 | target = i == len and outerTarget or nil |
| 1801 | } |
| 1802 | utils.propagateOptions(opts, subopts) |
| 1803 | local subexprs = compiler.compile1(ast[i], subScope, chunk, subopts) |
| 1804 | if i ~= len then |
| 1805 | compiler.keepSideEffects(subexprs, parent, nil, ast[i]) |
| 1806 | end |
| 1807 | end |
| 1808 | end |
| 1809 | compiler.emit(parent, chunk, ast) |
| 1810 | compiler.emit(parent, 'end', ast) |
| 1811 | return retexprs |
| 1812 | end |
| 1813 | |
| 1814 | SPECIALS["do"] = doImpl |
| 1815 | docSpecial("do", {"..."}, "Evaluate multiple forms; return last value.") |
| 1816 | |
| 1817 | -- Unlike most expressions and specials, 'values' resolves with multiple |
| 1818 | -- values, one for each argument, allowing multiple return values. The last |
| 1819 | -- expression can return multiple arguments as well, allowing for more than |
| 1820 | -- the number of expected arguments. |
| 1821 | SPECIALS["values"] = function(ast, scope, parent) |
| 1822 | local len = #ast |
| 1823 | local exprs = {} |
| 1824 | for i = 2, len do |
| 1825 | local subexprs = compiler.compile1(ast[i], scope, parent, { |
| 1826 | nval = (i ~= len) and 1 |
| 1827 | }) |
| 1828 | exprs[#exprs + 1] = subexprs[1] |
| 1829 | if i == len then |
| 1830 | for j = 2, #subexprs do |
| 1831 | exprs[#exprs + 1] = subexprs[j] |
| 1832 | end |
| 1833 | end |
| 1834 | end |
| 1835 | return exprs |
| 1836 | end |
| 1837 | docSpecial("values", {"..."}, |
| 1838 | "Return multiple values from a function. Must be in tail position.") |
| 1839 | |
| 1840 | -- The fn special declares a function. Syntax is similar to other lisps; |
| 1841 | -- (fn optional-name [arg ...] (body)) |
| 1842 | -- Further decoration such as docstrings, meta info, and multibody functions a possibility. |
| 1843 | SPECIALS["fn"] = function(ast, scope, parent) |
| 1844 | local fScope = compiler.makeScope(scope) |
| 1845 | local fChunk = {} |
| 1846 | local index = 2 |
| 1847 | local fnName = utils.isSym(ast[index]) |
| 1848 | local isLocalFn |
| 1849 | local docstring |
| 1850 | fScope.vararg = false |
| 1851 | local multi = fnName and utils.isMultiSym(fnName[1]) |
| 1852 | compiler.assert(not multi or not multi.multiSymMethodCall, |
| 1853 | "unexpected multi symbol " .. tostring(fnName), ast[index]) |
| 1854 | if fnName and fnName[1] ~= 'nil' then |
| 1855 | isLocalFn = not multi |
| 1856 | if isLocalFn then |
| 1857 | fnName = compiler.declareLocal(fnName, {}, scope, ast) |
| 1858 | else |
| 1859 | fnName = compiler.symbolToExpression(fnName, scope)[1] |
| 1860 | end |
| 1861 | index = index + 1 |
| 1862 | else |
| 1863 | isLocalFn = true |
| 1864 | fnName = compiler.gensym(scope) |
| 1865 | end |
| 1866 | local argList = compiler.assert(utils.isTable(ast[index]), |
| 1867 | "expected parameters", |
| 1868 | type(ast[index]) == "table" and ast[index] or ast) |
| 1869 | local function getArgName(i, name) |
| 1870 | if utils.isVarg(name) then |
| 1871 | compiler.assert(i == #argList, "expected vararg as last parameter", ast[2]) |
| 1872 | fScope.vararg = true |
| 1873 | return "..." |
| 1874 | elseif(utils.isSym(name) and utils.deref(name) ~= "nil" |
| 1875 | and not utils.isMultiSym(utils.deref(name))) then |
| 1876 | return compiler.declareLocal(name, {}, fScope, ast) |
| 1877 | elseif utils.isTable(name) then |
| 1878 | local raw = utils.sym(compiler.gensym(scope)) |
| 1879 | local declared = compiler.declareLocal(raw, {}, fScope, ast) |
| 1880 | compiler.destructure(name, raw, ast, fScope, fChunk, |
| 1881 | { declaration = true, nomulti = true }) |
| 1882 | return declared |
| 1883 | else |
| 1884 | compiler.assert(false, ("expected symbol for function parameter: %s"): |
| 1885 | format(tostring(name)), ast[2]) |
| 1886 | end |
| 1887 | end |
| 1888 | local argNameList = utils.kvmap(argList, getArgName) |
| 1889 | if type(ast[index + 1]) == 'string' and index + 1 < #ast then |
| 1890 | index = index + 1 |
| 1891 | docstring = ast[index] |
| 1892 | end |
| 1893 | for i = index + 1, #ast do |
| 1894 | compiler.compile1(ast[i], fScope, fChunk, { |
| 1895 | tail = i == #ast, |
| 1896 | nval = i ~= #ast and 0 or nil, |
| 1897 | }) |
| 1898 | end |
| 1899 | if isLocalFn then |
| 1900 | compiler.emit(parent, ('local function %s(%s)') |
| 1901 | :format(fnName, table.concat(argNameList, ', ')), ast) |
| 1902 | else |
| 1903 | compiler.emit(parent, ('%s = function(%s)') |
| 1904 | :format(fnName, table.concat(argNameList, ', ')), ast) |
| 1905 | end |
| 1906 | |
| 1907 | compiler.emit(parent, fChunk, ast) |
| 1908 | compiler.emit(parent, 'end', ast) |
| 1909 | |
| 1910 | if utils.root.options.useMetadata then |
| 1911 | local args = utils.map(argList, function(v) |
| 1912 | -- TODO: show destructured args properly instead of replacing |
| 1913 | return utils.isTable(v) and '"#<table>"' or string.format('"%s"', tostring(v)) |
| 1914 | end) |
| 1915 | |
| 1916 | local metaFields = { |
| 1917 | '"fnl/arglist"', '{' .. table.concat(args, ', ') .. '}', |
| 1918 | } |
| 1919 | if docstring then |
| 1920 | table.insert(metaFields, '"fnl/docstring"') |
| 1921 | table.insert(metaFields, '"' .. docstring:gsub('%s+$', '') |
| 1922 | :gsub('\\', '\\\\'):gsub('\n', '\\n') |
| 1923 | :gsub('"', '\\"') .. '"') |
| 1924 | end |
| 1925 | local metaStr = ('require("%s").metadata'): |
| 1926 | format(utils.root.options.moduleName or "fennel") |
| 1927 | compiler.emit(parent, string.format('pcall(function() %s:setall(%s, %s) end)', |
| 1928 | metaStr, fnName, table.concat(metaFields, ', '))) |
| 1929 | end |
| 1930 | |
| 1931 | return utils.expr(fnName, 'sym') |
| 1932 | end |
| 1933 | docSpecial("fn", {"name?", "args", "docstring?", "..."}, |
| 1934 | "Function syntax. May optionally include a name and docstring." |
| 1935 | .."\nIf a name is provided, the function will be bound in the current scope." |
| 1936 | .."\nWhen called with the wrong number of args, excess args will be discarded" |
| 1937 | .."\nand lacking args will be nil, use lambda for arity-checked functions.") |
| 1938 | |
| 1939 | -- (lua "print('hello!')") -> prints hello, evaluates to nil |
| 1940 | -- (lua "print 'hello!'" "10") -> prints hello, evaluates to the number 10 |
| 1941 | -- (lua nil "{1,2,3}") -> Evaluates to a table literal |
| 1942 | SPECIALS['lua'] = function(ast, _, parent) |
| 1943 | compiler.assert(#ast == 2 or #ast == 3, "expected 1 or 2 arguments", ast) |
| 1944 | if ast[2] ~= nil then |
| 1945 | table.insert(parent, {leaf = tostring(ast[2]), ast = ast}) |
| 1946 | end |
| 1947 | if #ast == 3 then |
| 1948 | return tostring(ast[3]) |
| 1949 | end |
| 1950 | end |
| 1951 | |
| 1952 | SPECIALS['doc'] = function(ast, scope, parent) |
| 1953 | assert(utils.root.options.useMetadata, "can't look up doc with metadata disabled.") |
| 1954 | compiler.assert(#ast == 2, "expected one argument", ast) |
| 1955 | |
| 1956 | local target = utils.deref(ast[2]) |
| 1957 | local specialOrMacro = scope.specials[target] or scope.macros[target] |
| 1958 | if specialOrMacro then |
| 1959 | return ("print([[%s]])"):format(doc(specialOrMacro, target)) |
| 1960 | else |
| 1961 | local value = tostring(compiler.compile1(ast[2], scope, parent, {nval = 1})[1]) |
| 1962 | -- need to require here since the metadata is stored in the module |
| 1963 | -- and we need to make sure we look it up in the same module it was |
| 1964 | -- declared from. |
| 1965 | return ("print(require('%s').doc(%s, '%s'))") |
| 1966 | :format(utils.root.options.moduleName or "fennel", value, tostring(ast[2])) |
| 1967 | end |
| 1968 | end |
| 1969 | docSpecial("doc", {"x"}, |
| 1970 | "Print the docstring and arglist for a function, macro, or special form.") |
| 1971 | |
| 1972 | -- Table lookup |
| 1973 | SPECIALS["."] = function(ast, scope, parent) |
| 1974 | local len = #ast |
| 1975 | compiler.assert(len > 1, "expected table argument", ast) |
| 1976 | local lhs = compiler.compile1(ast[2], scope, parent, {nval = 1}) |
| 1977 | if len == 2 then |
| 1978 | return tostring(lhs[1]) |
| 1979 | else |
| 1980 | local indices = {} |
| 1981 | for i = 3, len do |
| 1982 | local index = ast[i] |
| 1983 | if type(index) == 'string' and utils.isValidLuaIdentifier(index) then |
| 1984 | table.insert(indices, '.' .. index) |
| 1985 | else |
| 1986 | index = compiler.compile1(index, scope, parent, {nval = 1})[1] |
| 1987 | table.insert(indices, '[' .. tostring(index) .. ']') |
| 1988 | end |
| 1989 | end |
| 1990 | -- extra parens are needed for table literals |
| 1991 | if utils.isTable(ast[2]) then |
| 1992 | return '(' .. tostring(lhs[1]) .. ')' .. table.concat(indices) |
| 1993 | else |
| 1994 | return tostring(lhs[1]) .. table.concat(indices) |
| 1995 | end |
| 1996 | end |
| 1997 | end |
| 1998 | docSpecial(".", {"tbl", "key1", "..."}, |
| 1999 | "Look up key1 in tbl table. If more args are provided, do a nested lookup.") |
| 2000 | |
| 2001 | SPECIALS["global"] = function(ast, scope, parent) |
| 2002 | compiler.assert(#ast == 3, "expected name and value", ast) |
| 2003 | compiler.destructure(ast[2], ast[3], ast, scope, parent, { |
| 2004 | nomulti = true, |
| 2005 | forceglobal = true |
| 2006 | }) |
| 2007 | end |
| 2008 | docSpecial("global", {"name", "val"}, "Set name as a global with val.") |
| 2009 | |
| 2010 | SPECIALS["set"] = function(ast, scope, parent) |
| 2011 | compiler.assert(#ast == 3, "expected name and value", ast) |
| 2012 | compiler.destructure(ast[2], ast[3], ast, scope, parent, { |
| 2013 | noundef = true |
| 2014 | }) |
| 2015 | end |
| 2016 | docSpecial("set", {"name", "val"}, |
| 2017 | "Set a local variable to a new value. Only works on locals using var.") |
| 2018 | |
| 2019 | SPECIALS["set-forcibly!"] = function(ast, scope, parent) |
| 2020 | compiler.assert(#ast == 3, "expected name and value", ast) |
| 2021 | compiler.destructure(ast[2], ast[3], ast, scope, parent, { |
| 2022 | forceset = true |
| 2023 | }) |
| 2024 | end |
| 2025 | |
| 2026 | SPECIALS["local"] = function(ast, scope, parent) |
| 2027 | compiler.assert(#ast == 3, "expected name and value", ast) |
| 2028 | compiler.destructure(ast[2], ast[3], ast, scope, parent, { |
| 2029 | declaration = true, |
| 2030 | nomulti = true |
| 2031 | }) |
| 2032 | end |
| 2033 | docSpecial("local", {"name", "val"}, |
| 2034 | "Introduce new top-level immutable local.") |
| 2035 | |
| 2036 | SPECIALS["var"] = function(ast, scope, parent) |
| 2037 | compiler.assert(#ast == 3, "expected name and value", ast) |
| 2038 | compiler.destructure(ast[2], ast[3], ast, scope, parent, { |
| 2039 | declaration = true, nomulti = true, isvar = true }) |
| 2040 | end |
| 2041 | docSpecial("var", {"name", "val"}, |
| 2042 | "Introduce new mutable local.") |
| 2043 | |
| 2044 | SPECIALS["let"] = function(ast, scope, parent, opts) |
| 2045 | local bindings = ast[2] |
| 2046 | compiler.assert(utils.isList(bindings) or utils.isTable(bindings), |
| 2047 | "expected binding table", ast) |
| 2048 | compiler.assert(#bindings % 2 == 0, |
| 2049 | "expected even number of name/value bindings", ast[2]) |
| 2050 | compiler.assert(#ast >= 3, "expected body expression", ast[1]) |
| 2051 | -- we have to gensym the binding for the let body's return value before |
| 2052 | -- compiling the binding vector, otherwise there's a possibility to conflict |
| 2053 | local preSyms = {} |
| 2054 | for _ = 1, (opts.nval or 0) do table.insert(preSyms, compiler.gensym(scope)) end |
| 2055 | local subScope = compiler.makeScope(scope) |
| 2056 | local subChunk = {} |
| 2057 | for i = 1, #bindings, 2 do |
| 2058 | compiler.destructure(bindings[i], bindings[i + 1], ast, subScope, subChunk, { |
| 2059 | declaration = true, nomulti = true }) |
| 2060 | end |
| 2061 | return doImpl(ast, scope, parent, opts, 3, subChunk, subScope, preSyms) |
| 2062 | end |
| 2063 | docSpecial("let", {"[name1 val1 ... nameN valN]", "..."}, |
| 2064 | "Introduces a new scope in which a given set of local bindings are used.") |
| 2065 | |
| 2066 | -- For setting items in a table |
| 2067 | SPECIALS["tset"] = function(ast, scope, parent) |
| 2068 | compiler.assert(#ast > 3, ("expected table, key, and value arguments"), ast) |
| 2069 | local root = compiler.compile1(ast[2], scope, parent, {nval = 1})[1] |
| 2070 | local keys = {} |
| 2071 | for i = 3, #ast - 1 do |
| 2072 | local key = compiler.compile1(ast[i], scope, parent, {nval = 1})[1] |
| 2073 | keys[#keys + 1] = tostring(key) |
| 2074 | end |
| 2075 | local value = compiler.compile1(ast[#ast], scope, parent, {nval = 1})[1] |
| 2076 | local rootstr = tostring(root) |
| 2077 | -- Prefix 'do end ' so parens are not ambiguous (grouping or function call?) |
| 2078 | local fmtstr = (rootstr:match("^{")) and "do end (%s)[%s] = %s" or "%s[%s] = %s" |
| 2079 | compiler.emit(parent, fmtstr:format(tostring(root), |
| 2080 | table.concat(keys, ']['), |
| 2081 | tostring(value)), ast) |
| 2082 | end |
| 2083 | docSpecial("tset", {"tbl", "key1", "...", "keyN", "val"}, |
| 2084 | "Set the value of a table field. Can take additional keys to set" |
| 2085 | .. "nested values,\nbut all parents must contain an existing table.") |
| 2086 | |
| 2087 | -- The if special form behaves like the cond form in |
| 2088 | -- many languages |
| 2089 | SPECIALS["if"] = function(ast, scope, parent, opts) |
| 2090 | local doScope = compiler.makeScope(scope) |
| 2091 | local branches = {} |
| 2092 | local elseBranch = nil |
| 2093 | |
| 2094 | -- Calculate some external stuff. Optimizes for tail calls and what not |
| 2095 | local wrapper, innerTail, innerTarget, targetExprs |
| 2096 | if opts.tail or opts.target or opts.nval then |
| 2097 | if opts.nval and opts.nval ~= 0 and not opts.target then |
| 2098 | -- We need to create a target |
| 2099 | targetExprs = {} |
| 2100 | local accum = {} |
| 2101 | for i = 1, opts.nval do |
| 2102 | local s = compiler.gensym(scope) |
| 2103 | accum[i] = s |
| 2104 | targetExprs[i] = utils.expr(s, 'sym') |
| 2105 | end |
| 2106 | wrapper = 'target' |
| 2107 | innerTail = opts.tail |
| 2108 | innerTarget = table.concat(accum, ', ') |
| 2109 | else |
| 2110 | wrapper = 'none' |
| 2111 | innerTail = opts.tail |
| 2112 | innerTarget = opts.target |
| 2113 | end |
| 2114 | else |
| 2115 | wrapper = 'iife' |
| 2116 | innerTail = true |
| 2117 | innerTarget = nil |
| 2118 | end |
| 2119 | |
| 2120 | -- Compile bodies and conditions |
| 2121 | local bodyOpts = { |
| 2122 | tail = innerTail, |
| 2123 | target = innerTarget, |
| 2124 | nval = opts.nval |
| 2125 | } |
| 2126 | local function compileBody(i) |
| 2127 | local chunk = {} |
| 2128 | local cscope = compiler.makeScope(doScope) |
| 2129 | compiler.keepSideEffects(compiler.compile1(ast[i], cscope, chunk, bodyOpts), |
| 2130 | chunk, nil, ast[i]) |
| 2131 | return { |
| 2132 | chunk = chunk, |
| 2133 | scope = cscope |
| 2134 | } |
| 2135 | end |
| 2136 | for i = 2, #ast - 1, 2 do |
| 2137 | local condchunk = {} |
| 2138 | local res = compiler.compile1(ast[i], doScope, condchunk, {nval = 1}) |
| 2139 | local cond = res[1] |
| 2140 | local branch = compileBody(i + 1) |
| 2141 | branch.cond = cond |
| 2142 | branch.condchunk = condchunk |
| 2143 | branch.nested = i ~= 2 and next(condchunk, nil) == nil |
| 2144 | table.insert(branches, branch) |
| 2145 | end |
| 2146 | local hasElse = #ast > 3 and #ast % 2 == 0 |
| 2147 | if hasElse then elseBranch = compileBody(#ast) end |
| 2148 | |
| 2149 | -- Emit code |
| 2150 | local s = compiler.gensym(scope) |
| 2151 | local buffer = {} |
| 2152 | local lastBuffer = buffer |
| 2153 | for i = 1, #branches do |
| 2154 | local branch = branches[i] |
| 2155 | local fstr = not branch.nested and 'if %s then' or 'elseif %s then' |
| 2156 | local cond = tostring(branch.cond) |
| 2157 | local condLine = (cond == "true" and branch.nested and i == #branches) |
| 2158 | and "else" |
| 2159 | or fstr:format(cond) |
| 2160 | if branch.nested then |
| 2161 | compiler.emit(lastBuffer, branch.condchunk, ast) |
| 2162 | else |
| 2163 | for _, v in ipairs(branch.condchunk) do compiler.emit(lastBuffer, v, ast) end |
| 2164 | end |
| 2165 | compiler.emit(lastBuffer, condLine, ast) |
| 2166 | compiler.emit(lastBuffer, branch.chunk, ast) |
| 2167 | if i == #branches then |
| 2168 | if hasElse then |
| 2169 | compiler.emit(lastBuffer, 'else', ast) |
| 2170 | compiler.emit(lastBuffer, elseBranch.chunk, ast) |
| 2171 | -- TODO: Consolidate use of condLine ~= "else" with hasElse |
| 2172 | elseif(innerTarget and condLine ~= 'else') then |
| 2173 | compiler.emit(lastBuffer, 'else', ast) |
| 2174 | compiler.emit(lastBuffer, ("%s = nil"):format(innerTarget), ast) |
| 2175 | end |
| 2176 | compiler.emit(lastBuffer, 'end', ast) |
| 2177 | elseif not branches[i + 1].nested then |
| 2178 | compiler.emit(lastBuffer, 'else', ast) |
| 2179 | local nextBuffer = {} |
| 2180 | compiler.emit(lastBuffer, nextBuffer, ast) |
| 2181 | compiler.emit(lastBuffer, 'end', ast) |
| 2182 | lastBuffer = nextBuffer |
| 2183 | end |
| 2184 | end |
| 2185 | |
| 2186 | if wrapper == 'iife' then |
| 2187 | local iifeargs = scope.vararg and '...' or '' |
| 2188 | compiler.emit(parent, ('local function %s(%s)'):format(tostring(s), iifeargs), ast) |
| 2189 | compiler.emit(parent, buffer, ast) |
| 2190 | compiler.emit(parent, 'end', ast) |
| 2191 | return utils.expr(('%s(%s)'):format(tostring(s), iifeargs), 'statement') |
| 2192 | elseif wrapper == 'none' then |
| 2193 | -- Splice result right into code |
| 2194 | for i = 1, #buffer do |
| 2195 | compiler.emit(parent, buffer[i], ast) |
| 2196 | end |
| 2197 | return {returned = true} |
| 2198 | else -- wrapper == 'target' |
| 2199 | compiler.emit(parent, ('local %s'):format(innerTarget), ast) |
| 2200 | for i = 1, #buffer do |
| 2201 | compiler.emit(parent, buffer[i], ast) |
| 2202 | end |
| 2203 | return targetExprs |
| 2204 | end |
| 2205 | end |
| 2206 | docSpecial("if", {"cond1", "body1", "...", "condN", "bodyN"}, |
| 2207 | "Conditional form.\n" .. |
| 2208 | "Takes any number of condition/body pairs and evaluates the first body where" |
| 2209 | .. "\nthe condition evaluates to truthy. Similar to cond in other lisps.") |
| 2210 | |
| 2211 | -- (each [k v (pairs t)] body...) => [] |
| 2212 | SPECIALS["each"] = function(ast, scope, parent) |
| 2213 | local binding = compiler.assert(utils.isTable(ast[2]), "expected binding table", ast) |
| 2214 | compiler.assert(#ast >= 3, "expected body expression", ast[1]) |
| 2215 | local iter = table.remove(binding, #binding) -- last item is iterator call |
| 2216 | local destructures = {} |
| 2217 | local newManglings = {} |
| 2218 | local subScope = compiler.makeScope(scope) |
| 2219 | local function destructureBinding(v) |
| 2220 | if utils.isSym(v) then |
| 2221 | return compiler.declareLocal(v, {}, subScope, ast, newManglings) |
| 2222 | else |
| 2223 | local raw = utils.sym(compiler.gensym(subScope)) |
| 2224 | destructures[raw] = v |
| 2225 | return compiler.declareLocal(raw, {}, subScope, ast) |
| 2226 | end |
| 2227 | end |
| 2228 | local bindVars = utils.map(binding, destructureBinding) |
| 2229 | local vals = compiler.compile1(iter, subScope, parent) |
| 2230 | local valNames = utils.map(vals, tostring) |
| 2231 | |
| 2232 | compiler.emit(parent, ('for %s in %s do'):format(table.concat(bindVars, ', '), |
| 2233 | table.concat(valNames, ", ")), ast) |
| 2234 | local chunk = {} |
| 2235 | for raw, args in utils.stablepairs(destructures) do |
| 2236 | compiler.destructure(args, raw, ast, subScope, chunk, |
| 2237 | { declaration = true, nomulti = true }) |
| 2238 | end |
| 2239 | compiler.applyManglings(subScope, newManglings, ast) |
| 2240 | compileDo(ast, subScope, chunk, 3) |
| 2241 | compiler.emit(parent, chunk, ast) |
| 2242 | compiler.emit(parent, 'end', ast) |
| 2243 | end |
| 2244 | docSpecial("each", {"[key value (iterator)]", "..."}, |
| 2245 | "Runs the body once for each set of values provided by the given iterator." |
| 2246 | .."\nMost commonly used with ipairs for sequential tables or pairs for" |
| 2247 | .." undefined\norder, but can be used with any iterator.") |
| 2248 | |
| 2249 | -- (while condition body...) => [] |
| 2250 | SPECIALS["while"] = function(ast, scope, parent) |
| 2251 | local len1 = #parent |
| 2252 | local condition = compiler.compile1(ast[2], scope, parent, {nval = 1})[1] |
| 2253 | local len2 = #parent |
| 2254 | local subChunk = {} |
| 2255 | if len1 ~= len2 then |
| 2256 | -- Compound condition |
| 2257 | -- Move new compilation to subchunk |
| 2258 | for i = len1 + 1, len2 do |
| 2259 | subChunk[#subChunk + 1] = parent[i] |
| 2260 | parent[i] = nil |
| 2261 | end |
| 2262 | compiler.emit(parent, 'while true do', ast) |
| 2263 | compiler.emit(subChunk, ('if not %s then break end'):format(condition[1]), ast) |
| 2264 | else |
| 2265 | -- Simple condition |
| 2266 | compiler.emit(parent, 'while ' .. tostring(condition) .. ' do', ast) |
| 2267 | end |
| 2268 | compileDo(ast, compiler.makeScope(scope), subChunk, 3) |
| 2269 | compiler.emit(parent, subChunk, ast) |
| 2270 | compiler.emit(parent, 'end', ast) |
| 2271 | end |
| 2272 | docSpecial("while", {"condition", "..."}, |
| 2273 | "The classic while loop. Evaluates body until a condition is non-truthy.") |
| 2274 | |
| 2275 | SPECIALS["for"] = function(ast, scope, parent) |
| 2276 | local ranges = compiler.assert(utils.isTable(ast[2]), "expected binding table", ast) |
| 2277 | local bindingSym = table.remove(ast[2], 1) |
| 2278 | local subScope = compiler.makeScope(scope) |
| 2279 | compiler.assert(utils.isSym(bindingSym), |
| 2280 | ("unable to bind %s %s"): |
| 2281 | format(type(bindingSym), tostring(bindingSym)), ast[2]) |
| 2282 | compiler.assert(#ast >= 3, "expected body expression", ast[1]) |
| 2283 | local rangeArgs = {} |
| 2284 | for i = 1, math.min(#ranges, 3) do |
| 2285 | rangeArgs[i] = tostring(compiler.compile1(ranges[i], subScope, parent, {nval = 1})[1]) |
| 2286 | end |
| 2287 | compiler.emit(parent, ('for %s = %s do'):format( |
| 2288 | compiler.declareLocal(bindingSym, {}, subScope, ast), |
| 2289 | table.concat(rangeArgs, ', ')), ast) |
| 2290 | local chunk = {} |
| 2291 | compileDo(ast, subScope, chunk, 3) |
| 2292 | compiler.emit(parent, chunk, ast) |
| 2293 | compiler.emit(parent, 'end', ast) |
| 2294 | end |
| 2295 | docSpecial("for", {"[index start stop step?]", "..."}, "Numeric loop construct." .. |
| 2296 | "\nEvaluates body once for each value between start and stop (inclusive).") |
| 2297 | |
| 2298 | -- For statements and expressions, put the value in a local to avoid |
| 2299 | -- double-evaluating it. |
| 2300 | local function once(val, ast, scope, parent) |
| 2301 | if val.type == 'statement' or val.type == 'expression' then |
| 2302 | local s = compiler.gensym(scope) |
| 2303 | compiler.emit(parent, ('local %s = %s'):format(s, tostring(val)), ast) |
| 2304 | return utils.expr(s, 'sym') |
| 2305 | else |
| 2306 | return val |
| 2307 | end |
| 2308 | end |
| 2309 | |
| 2310 | SPECIALS[":"] = function(ast, scope, parent) |
| 2311 | compiler.assert(#ast >= 3, "expected at least 2 arguments", ast) |
| 2312 | -- Compile object |
| 2313 | local objectexpr = compiler.compile1(ast[2], scope, parent, {nval = 1})[1] |
| 2314 | -- Compile method selector |
| 2315 | local methodstring |
| 2316 | local methodident = false |
| 2317 | if type(ast[3]) == 'string' and utils.isValidLuaIdentifier(ast[3]) then |
| 2318 | methodident = true |
| 2319 | methodstring = ast[3] |
| 2320 | else |
| 2321 | methodstring = tostring(compiler.compile1(ast[3], scope, parent, {nval = 1})[1]) |
| 2322 | objectexpr = once(objectexpr, ast[2], scope, parent) |
| 2323 | end |
| 2324 | -- Compile arguments |
| 2325 | local args = {} |
| 2326 | for i = 4, #ast do |
| 2327 | local subexprs = compiler.compile1(ast[i], scope, parent, { |
| 2328 | nval = i ~= #ast and 1 or nil |
| 2329 | }) |
| 2330 | utils.map(subexprs, tostring, args) |
| 2331 | end |
| 2332 | local fstring |
| 2333 | if not methodident then |
| 2334 | -- Make object first argument |
| 2335 | table.insert(args, 1, tostring(objectexpr)) |
| 2336 | fstring = objectexpr.type == 'sym' |
| 2337 | and '%s[%s](%s)' |
| 2338 | or '(%s)[%s](%s)' |
| 2339 | elseif(objectexpr.type == 'literal' or objectexpr.type == 'expression') then |
| 2340 | fstring = '(%s):%s(%s)' |
| 2341 | else |
| 2342 | fstring = '%s:%s(%s)' |
| 2343 | end |
| 2344 | return utils.expr(fstring:format( |
| 2345 | tostring(objectexpr), |
| 2346 | methodstring, |
| 2347 | table.concat(args, ', ')), 'statement') |
| 2348 | end |
| 2349 | docSpecial(":", {"tbl", "method-name", "..."}, |
| 2350 | "Call the named method on tbl with the provided args.".. |
| 2351 | "\nMethod name doesn\"t have to be known at compile-time; if it is, use" |
| 2352 | .."\n(tbl:method-name ...) instead.") |
| 2353 | |
| 2354 | SPECIALS["comment"] = function(ast, _, parent) |
| 2355 | local els = {} |
| 2356 | for i = 2, #ast do |
| 2357 | els[#els + 1] = tostring(ast[i]):gsub('\n', ' ') |
| 2358 | end |
| 2359 | compiler.emit(parent, '-- ' .. table.concat(els, ' '), ast) |
| 2360 | end |
| 2361 | docSpecial("comment", {"..."}, "Comment which will be emitted in Lua output.") |
| 2362 | |
| 2363 | SPECIALS["hashfn"] = function(ast, scope, parent) |
| 2364 | compiler.assert(#ast == 2, "expected one argument", ast) |
| 2365 | local fScope = compiler.makeScope(scope) |
| 2366 | local fChunk = {} |
| 2367 | local name = compiler.gensym(scope) |
| 2368 | local symbol = utils.sym(name) |
| 2369 | compiler.declareLocal(symbol, {}, scope, ast) |
| 2370 | fScope.vararg = false |
| 2371 | fScope.hashfn = true |
| 2372 | local args = {} |
| 2373 | for i = 1, 9 do args[i] = compiler.declareLocal(utils.sym('$' .. i), {}, fScope, ast) end |
| 2374 | -- recursively walk the AST, transforming $... into ... |
| 2375 | utils.walkTree(ast[2], function(idx, node, parentNode) |
| 2376 | if utils.isSym(node) and utils.deref(node) == '$...' then |
| 2377 | parentNode[idx] = utils.varg() |
| 2378 | fScope.vararg = true |
| 2379 | else -- truthy return value determines whether to traverse children |
| 2380 | return utils.isList(node) or utils.isTable(node) |
| 2381 | end |
| 2382 | end) |
| 2383 | -- Compile body |
| 2384 | compiler.compile1(ast[2], fScope, fChunk, {tail = true}) |
| 2385 | local maxUsed = 0 |
| 2386 | for i = 1, 9 do if fScope.symmeta['$' .. i].used then maxUsed = i end end |
| 2387 | if fScope.vararg then |
| 2388 | compiler.assert(maxUsed == 0, '$ and $... in hashfn are mutually exclusive', ast) |
| 2389 | args = {utils.deref(utils.varg())} |
| 2390 | maxUsed = 1 |
| 2391 | end |
| 2392 | local argStr = table.concat(args, ', ', 1, maxUsed) |
| 2393 | compiler.emit(parent, ('local function %s(%s)'):format(name, argStr), ast) |
| 2394 | compiler.emit(parent, fChunk, ast) |
| 2395 | compiler.emit(parent, 'end', ast) |
| 2396 | return utils.expr(name, 'sym') |
| 2397 | end |
| 2398 | docSpecial("hashfn", {"..."}, |
| 2399 | "Function literal shorthand; args are either $... OR $1, $2, etc.") |
| 2400 | |
| 2401 | local function defineArithmeticSpecial(name, zeroArity, unaryPrefix, luaName) |
| 2402 | local paddedOp = ' ' .. (luaName or name) .. ' ' |
| 2403 | SPECIALS[name] = function(ast, scope, parent) |
| 2404 | local len = #ast |
| 2405 | if len == 1 then |
| 2406 | compiler.assert(zeroArity ~= nil, 'Expected more than 0 arguments', ast) |
| 2407 | return utils.expr(zeroArity, 'literal') |
| 2408 | else |
| 2409 | local operands = {} |
| 2410 | for i = 2, len do |
| 2411 | local subexprs = compiler.compile1(ast[i], scope, parent, { |
| 2412 | nval = (i == 1 and 1 or nil) |
| 2413 | }) |
| 2414 | utils.map(subexprs, tostring, operands) |
| 2415 | end |
| 2416 | if #operands == 1 then |
| 2417 | if unaryPrefix then |
| 2418 | return '(' .. unaryPrefix .. paddedOp .. operands[1] .. ')' |
| 2419 | else |
| 2420 | return operands[1] |
| 2421 | end |
| 2422 | else |
| 2423 | return '(' .. table.concat(operands, paddedOp) .. ')' |
| 2424 | end |
| 2425 | end |
| 2426 | end |
| 2427 | docSpecial(name, {"a", "b", "..."}, |
| 2428 | "Arithmetic operator; works the same as Lua but accepts more arguments.") |
| 2429 | end |
| 2430 | |
| 2431 | defineArithmeticSpecial('+', '0') |
| 2432 | defineArithmeticSpecial('..', "''") |
| 2433 | defineArithmeticSpecial('^') |
| 2434 | defineArithmeticSpecial('-', nil, '') |
| 2435 | defineArithmeticSpecial('*', '1') |
| 2436 | defineArithmeticSpecial('%') |
| 2437 | defineArithmeticSpecial('/', nil, '1') |
| 2438 | defineArithmeticSpecial('//', nil, '1') |
| 2439 | |
| 2440 | defineArithmeticSpecial("lshift", nil, "1", "<<") |
| 2441 | defineArithmeticSpecial("rshift", nil, "1", ">>") |
| 2442 | defineArithmeticSpecial("band", "0", "0", "&") |
| 2443 | defineArithmeticSpecial("bor", "0", "0", "|") |
| 2444 | defineArithmeticSpecial("bxor", "0", "0", "~") |
| 2445 | |
| 2446 | docSpecial("lshift", {"x", "n"}, |
| 2447 | "Bitwise logical left shift of x by n bits; only works in Lua 5.3+.") |
| 2448 | docSpecial("rshift", {"x", "n"}, |
| 2449 | "Bitwise logical right shift of x by n bits; only works in Lua 5.3+.") |
| 2450 | docSpecial("band", {"x1", "x2"}, "Bitwise AND of arguments; only works in Lua 5.3+.") |
| 2451 | docSpecial("bor", {"x1", "x2"}, "Bitwise OR of arguments; only works in Lua 5.3+.") |
| 2452 | docSpecial("bxor", {"x1", "x2"}, "Bitwise XOR of arguments; only works in Lua 5.3+.") |
| 2453 | |
| 2454 | defineArithmeticSpecial('or', 'false') |
| 2455 | defineArithmeticSpecial('and', 'true') |
| 2456 | |
| 2457 | docSpecial("and", {"a", "b", "..."}, |
| 2458 | "Boolean operator; works the same as Lua but accepts more arguments.") |
| 2459 | docSpecial("or", {"a", "b", "..."}, |
| 2460 | "Boolean operator; works the same as Lua but accepts more arguments.") |
| 2461 | docSpecial("..", {"a", "b", "..."}, |
| 2462 | "String concatenation operator; works the same as Lua but accepts more arguments.") |
| 2463 | |
| 2464 | local function defineComparatorSpecial(name, realop, chainOp) |
| 2465 | local op = realop or name |
| 2466 | SPECIALS[name] = function(ast, scope, parent) |
| 2467 | local len = #ast |
| 2468 | compiler.assert(len > 2, "expected at least two arguments", ast) |
| 2469 | local lhs = compiler.compile1(ast[2], scope, parent, {nval = 1})[1] |
| 2470 | local lastval = compiler.compile1(ast[3], scope, parent, {nval = 1})[1] |
| 2471 | -- avoid double-eval by introducing locals for possible side-effects |
| 2472 | if len > 3 then lastval = once(lastval, ast[3], scope, parent) end |
| 2473 | local out = ('(%s %s %s)'): |
| 2474 | format(tostring(lhs), op, tostring(lastval)) |
| 2475 | if len > 3 then |
| 2476 | for i = 4, len do -- variadic comparison |
| 2477 | local nextval = once(compiler.compile1(ast[i], scope, parent, {nval = 1})[1], |
| 2478 | ast[i], scope, parent) |
| 2479 | out = (out .. " %s (%s %s %s)"): |
| 2480 | format(chainOp or 'and', tostring(lastval), op, tostring(nextval)) |
| 2481 | lastval = nextval |
| 2482 | end |
| 2483 | out = '(' .. out .. ')' |
| 2484 | end |
| 2485 | return out |
| 2486 | end |
| 2487 | docSpecial(name, {"a", "b", "..."}, |
| 2488 | "Comparison operator; works the same as Lua but accepts more arguments.") |
| 2489 | end |
| 2490 | |
| 2491 | defineComparatorSpecial('>') |
| 2492 | defineComparatorSpecial('<') |
| 2493 | defineComparatorSpecial('>=') |
| 2494 | defineComparatorSpecial('<=') |
| 2495 | defineComparatorSpecial('=', '==') |
| 2496 | defineComparatorSpecial('not=', '~=', 'or') |
| 2497 | SPECIALS["~="] = SPECIALS["not="] -- backwards-compatibility alias |
| 2498 | |
| 2499 | local function defineUnarySpecial(op, realop) |
| 2500 | SPECIALS[op] = function(ast, scope, parent) |
| 2501 | compiler.assert(#ast == 2, 'expected one argument', ast) |
| 2502 | local tail = compiler.compile1(ast[2], scope, parent, {nval = 1}) |
| 2503 | return (realop or op) .. tostring(tail[1]) |
| 2504 | end |
| 2505 | end |
| 2506 | |
| 2507 | defineUnarySpecial("not", "not ") |
| 2508 | docSpecial("not", {"x"}, "Logical operator; works the same as Lua.") |
| 2509 | |
| 2510 | defineUnarySpecial("bnot", "~") |
| 2511 | docSpecial("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+.") |
| 2512 | |
| 2513 | defineUnarySpecial("length", "#") |
| 2514 | docSpecial("length", {"x"}, "Returns the length of a table or string.") |
| 2515 | SPECIALS["#"] = SPECIALS["length"] |
| 2516 | |
| 2517 | SPECIALS['quote'] = function(ast, scope, parent) |
| 2518 | compiler.assert(#ast == 2, "expected one argument") |
| 2519 | local runtime, thisScope = true, scope |
| 2520 | while thisScope do |
| 2521 | thisScope = thisScope.parent |
| 2522 | if thisScope == compiler.scopes.compiler then runtime = false end |
| 2523 | end |
| 2524 | return compiler.doQuote(ast[2], scope, parent, runtime) |
| 2525 | end |
| 2526 | docSpecial('quote', {'x'}, 'Quasiquote the following form. Only works in macro/compiler scope.') |
| 2527 | |
| 2528 | local function makeCompilerEnv(ast, scope, parent) |
| 2529 | return setmetatable({ |
| 2530 | -- State of compiler if needed |
| 2531 | _SCOPE = scope, |
| 2532 | _CHUNK = parent, |
| 2533 | _AST = ast, |
| 2534 | _IS_COMPILER = true, |
| 2535 | _SPECIALS = compiler.scopes.global.specials, |
| 2536 | _VARARG = utils.varg(), |
| 2537 | -- Expose the module in the compiler |
| 2538 | fennel = utils.fennelModule, |
| 2539 | unpack = unpack, |
| 2540 | |
| 2541 | -- Useful for macros and meta programming. All of Fennel can be accessed |
| 2542 | -- via fennel.myfun, for example (fennel.eval "(print 1)"). |
| 2543 | list = utils.list, |
| 2544 | sym = utils.sym, |
| 2545 | sequence = utils.sequence, |
| 2546 | gensym = function() |
| 2547 | return utils.sym(compiler.gensym(compiler.scopes.macro or scope)) |
| 2548 | end, |
| 2549 | ["list?"] = utils.isList, |
| 2550 | ["multi-sym?"] = utils.isMultiSym, |
| 2551 | ["sym?"] = utils.isSym, |
| 2552 | ["table?"] = utils.isTable, |
| 2553 | ["sequence?"] = utils.isSequence, |
| 2554 | ["varg?"] = utils.isVarg, |
| 2555 | ["get-scope"] = function() return compiler.scopes.macro end, |
| 2556 | ["in-scope?"] = function(symbol) |
| 2557 | compiler.assert(compiler.scopes.macro, "must call from macro", ast) |
| 2558 | return compiler.scopes.macro.manglings[tostring(symbol)] |
| 2559 | end, |
| 2560 | ["macroexpand"] = function(form) |
| 2561 | compiler.assert(compiler.scopes.macro, "must call from macro", ast) |
| 2562 | return compiler.macroexpand(form, compiler.scopes.macro) |
| 2563 | end, |
| 2564 | }, { __index = _ENV or _G }) |
| 2565 | end |
| 2566 | |
| 2567 | -- have searchModule use package.config to process package.path (windows compat) |
| 2568 | local cfg = string.gmatch(package.config, "([^\n]+)") |
| 2569 | local dirsep, pathsep, pathmark = cfg() or '/', cfg() or ';', cfg() or '?' |
| 2570 | local pkgConfig = {dirsep = dirsep, pathsep = pathsep, pathmark = pathmark} |
| 2571 | |
| 2572 | -- Escape a string for safe use in a Lua pattern |
| 2573 | local function escapepat(str) |
| 2574 | return string.gsub(str, "[^%w]", "%%%1") |
| 2575 | end |
| 2576 | |
| 2577 | local function searchModule(modulename, pathstring) |
| 2578 | local pathsepesc = escapepat(pkgConfig.pathsep) |
| 2579 | local pathsplit = string.format("([^%s]*)%s", pathsepesc, pathsepesc) |
| 2580 | local nodotModule = modulename:gsub("%.", pkgConfig.dirsep) |
| 2581 | for path in string.gmatch((pathstring or utils.fennelModule.path) .. |
| 2582 | pkgConfig.pathsep, pathsplit) do |
| 2583 | local filename = path:gsub(escapepat(pkgConfig.pathmark), nodotModule) |
| 2584 | local filename2 = path:gsub(escapepat(pkgConfig.pathmark), modulename) |
| 2585 | local file = io.open(filename) or io.open(filename2) |
| 2586 | if(file) then |
| 2587 | file:close() |
| 2588 | return filename |
| 2589 | end |
| 2590 | end |
| 2591 | end |
| 2592 | |
| 2593 | local function macroGlobals(env, globals) |
| 2594 | local allowed = currentGlobalNames(env) |
| 2595 | for _, k in pairs(globals or {}) do table.insert(allowed, k) end |
| 2596 | return allowed |
| 2597 | end |
| 2598 | |
| 2599 | local function addMacros(macros, ast, scope) |
| 2600 | compiler.assert(utils.isTable(macros), 'expected macros to be table', ast) |
| 2601 | for k,v in pairs(macros) do |
| 2602 | compiler.assert(type(v) == 'function', 'expected each macro to be function', ast) |
| 2603 | scope.macros[k] = v |
| 2604 | end |
| 2605 | end |
| 2606 | |
| 2607 | local function loadMacros(modname, ast, scope, parent) |
| 2608 | local filename = compiler.assert(searchModule(modname), |
| 2609 | modname .. " module not found.", ast) |
| 2610 | local env = makeCompilerEnv(ast, scope, parent) |
| 2611 | local globals = macroGlobals(env, currentGlobalNames()) |
| 2612 | return compiler.dofileFennel(filename, |
| 2613 | { env = env, allowedGlobals = globals, |
| 2614 | useMetadata = utils.root.options.useMetadata, |
| 2615 | scope = compiler.scopes.compiler }) |
| 2616 | end |
| 2617 | |
| 2618 | local macroLoaded = {} |
| 2619 | |
| 2620 | SPECIALS['require-macros'] = function(ast, scope, parent) |
| 2621 | compiler.assert(#ast == 2, "Expected one module name argument", ast) |
| 2622 | local modname = ast[2] |
| 2623 | if not macroLoaded[modname] then |
| 2624 | macroLoaded[modname] = loadMacros(modname, ast, scope, parent) |
| 2625 | end |
| 2626 | addMacros(macroLoaded[modname], ast, scope, parent) |
| 2627 | end |
| 2628 | docSpecial('require-macros', {'macro-module-name'}, |
| 2629 | 'Load given module and use its contents as macro definitions in current scope.' |
| 2630 | ..'\nMacro module should return a table of macro functions with string keys.' |
| 2631 | ..'\nConsider using import-macros instead as it is more flexible.') |
| 2632 | |
| 2633 | SPECIALS['include'] = function(ast, scope, parent, opts) |
| 2634 | compiler.assert(#ast == 2, 'expected one argument', ast) |
| 2635 | |
| 2636 | -- Compile mod argument |
| 2637 | local modexpr = compiler.compile1(ast[2], scope, parent, {nval = 1})[1] |
| 2638 | if modexpr.type ~= 'literal' or modexpr[1]:byte() ~= 34 then |
| 2639 | if opts.fallback then |
| 2640 | return opts.fallback(modexpr) |
| 2641 | else |
| 2642 | compiler.assert(false, 'module name must resolve to a string literal', ast) |
| 2643 | end |
| 2644 | end |
| 2645 | local code = 'return ' .. modexpr[1] |
| 2646 | local mod = loadCode(code)() |
| 2647 | |
| 2648 | -- Check cache |
| 2649 | if utils.root.scope.includes[mod] then return utils.root.scope.includes[mod] end |
| 2650 | |
| 2651 | -- Find path to source |
| 2652 | local path = searchModule(mod) |
| 2653 | local isFennel = true |
| 2654 | if not path then |
| 2655 | isFennel = false |
| 2656 | path = searchModule(mod, package.path) |
| 2657 | if not path then |
| 2658 | if opts.fallback then |
| 2659 | return opts.fallback(modexpr) |
| 2660 | else |
| 2661 | compiler.assert(false, 'module not found ' .. mod, ast) |
| 2662 | end |
| 2663 | end |
| 2664 | end |
| 2665 | |
| 2666 | -- Read source |
| 2667 | local f = io.open(path) |
| 2668 | local s = f:read('*all'):gsub('[\r\n]*$', '') |
| 2669 | f:close() |
| 2670 | |
| 2671 | -- splice in source and memoize it in compiler AND package.preload |
| 2672 | -- so we can include it again without duplication, even in runtime |
| 2673 | local ret = utils.expr('require("' .. mod .. '")', 'statement') |
| 2674 | local target = ('package.preload[%q]'):format(mod) |
| 2675 | local preloadStr = target .. ' = ' .. target .. ' or function(...)' |
| 2676 | |
| 2677 | local tempChunk, subChunk = {}, {} |
| 2678 | compiler.emit(tempChunk, preloadStr, ast) |
| 2679 | compiler.emit(tempChunk, subChunk) |
| 2680 | compiler.emit(tempChunk, 'end', ast) |
| 2681 | -- Splice tempChunk to begining of root chunk |
| 2682 | for i, v in ipairs(tempChunk) do table.insert(utils.root.chunk, i, v) end |
| 2683 | |
| 2684 | -- For fnl source, compile subChunk AFTER splicing into start of root chunk. |
| 2685 | if isFennel then |
| 2686 | local subscope = compiler.makeScope(utils.root.scope.parent) |
| 2687 | if utils.root.options.requireAsInclude then |
| 2688 | subscope.specials.require = compiler.requireInclude |
| 2689 | end |
| 2690 | -- parse Fennel src into table of exprs to know which expr is the tail |
| 2691 | local forms, p = {}, parser.parser(parser.stringStream(s), path) |
| 2692 | for _, val in p do table.insert(forms, val) end |
| 2693 | -- Compile the forms into subChunk; compiler.compile1 is necessary for all nested |
| 2694 | -- includes to be emitted in the same root chunk in the top-level module |
| 2695 | for i = 1, #forms do |
| 2696 | -- NOTE: nval=0 here at the end is the only change since 0.4.2 |
| 2697 | local subopts = i == #forms and {nval=1, tail=true} or {nval=0} |
| 2698 | utils.propagateOptions(opts, subopts) |
| 2699 | compiler.compile1(forms[i], subscope, subChunk, subopts) |
| 2700 | end |
| 2701 | else -- for Lua source, simply emit the src into the loader's body |
| 2702 | compiler.emit(subChunk, s, ast) |
| 2703 | end |
| 2704 | |
| 2705 | -- Put in cache and return |
| 2706 | utils.root.scope.includes[mod] = ret |
| 2707 | return ret |
| 2708 | end |
| 2709 | docSpecial('include', {'module-name-literal'}, |
| 2710 | 'Like require, but load the target module during compilation and embed it in the\n' |
| 2711 | .. 'Lua output. The module must be a string literal and resolvable at compile time.') |
| 2712 | |
| 2713 | local function evalCompiler(ast, scope, parent) |
| 2714 | local luaSource = |
| 2715 | compiler.compile(ast, { scope = compiler.makeScope(compiler.scopes.compiler), |
| 2716 | useMetadata = utils.root.options.useMetadata }) |
| 2717 | local loader = loadCode(luaSource, wrapEnv(makeCompilerEnv(ast, scope, parent))) |
| 2718 | return loader() |
| 2719 | end |
| 2720 | |
| 2721 | SPECIALS['macros'] = function(ast, scope, parent) |
| 2722 | compiler.assert(#ast == 2, "Expected one table argument", ast) |
| 2723 | local macros = evalCompiler(ast[2], scope, parent) |
| 2724 | addMacros(macros, ast, scope, parent) |
| 2725 | end |
| 2726 | docSpecial('macros', {'{:macro-name-1 (fn [...] ...) ... :macro-name-N macro-body-N}'}, |
| 2727 | 'Define all functions in the given table as macros local to the current scope.') |
| 2728 | |
| 2729 | SPECIALS['eval-compiler'] = function(ast, scope, parent) |
| 2730 | local oldFirst = ast[1] |
| 2731 | ast[1] = utils.sym('do') |
| 2732 | local val = evalCompiler(ast, scope, parent) |
| 2733 | ast[1] = oldFirst |
| 2734 | return val |
| 2735 | end |
| 2736 | docSpecial('eval-compiler', {'...'}, 'Evaluate the body at compile-time.' |
| 2737 | .. ' Use the macro system instead if possible.') |
| 2738 | |
| 2739 | -- A few things that aren't specials, but are needed to define specials, but |
| 2740 | -- are also needed for the following code. |
| 2741 | return { wrapEnv=wrapEnv, |
| 2742 | currentGlobalNames=currentGlobalNames, |
| 2743 | loadCode=loadCode, |
| 2744 | doc=doc, |
| 2745 | macroLoaded=macroLoaded, |
| 2746 | searchModule=searchModule, |
| 2747 | makeCompilerEnv=makeCompilerEnv, } |
| 2748 | end)() |
| 2749 | |
| 2750 | --- |
| 2751 | --- Evaluation, repl, public API, and macros |
| 2752 | --- |
| 2753 | |
| 2754 | local function eval(str, options, ...) |
| 2755 | local opts = utils.copy(options) |
| 2756 | -- eval and dofile are considered "live" entry points, so we can assume |
| 2757 | -- that the globals available at compile time are a reasonable allowed list |
| 2758 | -- UNLESS there's a metatable on env, in which case we can't assume that |
| 2759 | -- pairs will return all the effective globals; for instance openresty |
| 2760 | -- sets up _G in such a way that all the globals are available thru |
| 2761 | -- the __index meta method, but as far as pairs is concerned it's empty. |
| 2762 | if opts.allowedGlobals == nil and not getmetatable(opts.env) then |
| 2763 | opts.allowedGlobals = specials.currentGlobalNames(opts.env) |
| 2764 | end |
| 2765 | local env = opts.env and specials.wrapEnv(opts.env) |
| 2766 | local luaSource = compiler.compileString(str, opts) |
| 2767 | local loader = specials.loadCode(luaSource, env, opts.filename and |
| 2768 | ('@' .. opts.filename) or str) |
| 2769 | opts.filename = nil |
| 2770 | return loader(...) |
| 2771 | end |
| 2772 | |
| 2773 | -- This is bad; we have a circular dependency between the specials section and |
| 2774 | -- the evaluation section due to require-macros/import-macros needing to be able |
| 2775 | -- to do this. For now stash it in the compiler table, but we should untangle it |
| 2776 | compiler.dofileFennel = function(filename, options, ...) |
| 2777 | local opts = utils.copy(options) |
| 2778 | local f = assert(io.open(filename, "rb")) |
| 2779 | local source = f:read("*all") |
| 2780 | f:close() |
| 2781 | opts.filename = filename |
| 2782 | return eval(source, opts, ...) |
| 2783 | end |
| 2784 | |
| 2785 | -- Everything exported by the module |
| 2786 | local module = { |
| 2787 | parser = parser.parser, |
| 2788 | granulate = parser.granulate, |
| 2789 | stringStream = parser.stringStream, |
| 2790 | |
| 2791 | compile = compiler.compile, |
| 2792 | compileString = compiler.compileString, |
| 2793 | compileStream = compiler.compileStream, |
| 2794 | compile1 = compiler.compile1, |
| 2795 | traceback = compiler.traceback, |
| 2796 | mangle = compiler.globalMangling, |
| 2797 | unmangle = compiler.globalUnmangling, |
| 2798 | metadata = compiler.metadata, |
| 2799 | scope = compiler.makeScope, |
| 2800 | gensym = compiler.gensym, |
| 2801 | |
| 2802 | list = utils.list, |
| 2803 | sym = utils.sym, |
| 2804 | varg = utils.varg, |
| 2805 | path = utils.path, |
| 2806 | |
| 2807 | loadCode = specials.loadCode, |
| 2808 | macroLoaded = specials.macroLoaded, |
| 2809 | searchModule = specials.searchModule, |
| 2810 | doc = specials.doc, |
| 2811 | |
| 2812 | eval = eval, |
| 2813 | dofile = compiler.dofileFennel, |
| 2814 | version = "0.4.3-dev", |
| 2815 | } |
| 2816 | |
| 2817 | utils.fennelModule = module -- yet another circular dependency =( |
| 2818 | |
| 2819 | -- In order to make this more readable, you can switch your editor to treating |
| 2820 | -- this file as if it were Fennel for the purposes of this section |
| 2821 | local replsource = [===[(local (fennel internals) ...) |
| 2822 | |
| 2823 | (fn default-read-chunk [parser-state] |
| 2824 | (io.write (if (< 0 parser-state.stackSize) ".." ">> ")) |
| 2825 | (io.flush) |
| 2826 | (let [input (io.read)] |
| 2827 | (and input (.. input "\n")))) |
| 2828 | |
| 2829 | (fn default-on-values [xs] |
| 2830 | (io.write (table.concat xs "\t")) |
| 2831 | (io.write "\n")) |
| 2832 | |
| 2833 | (fn default-on-error [errtype err lua-source] |
| 2834 | (io.write |
| 2835 | (match errtype |
| 2836 | "Lua Compile" (.. "Bad code generated - likely a bug with the compiler:\n" |
| 2837 | "--- Generated Lua Start ---\n" |
| 2838 | lua-source |
| 2839 | "--- Generated Lua End ---\n") |
| 2840 | "Runtime" (.. (fennel.traceback err 4) "\n") |
| 2841 | _ (: "%s error: %s\n" :format errtype (tostring err))))) |
| 2842 | |
| 2843 | (local save-source |
| 2844 | (table.concat ["local ___i___ = 1" |
| 2845 | "while true do" |
| 2846 | " local name, value = debug.getlocal(1, ___i___)" |
| 2847 | " if(name and name ~= \"___i___\") then" |
| 2848 | " ___replLocals___[name] = value" |
| 2849 | " ___i___ = ___i___ + 1" |
| 2850 | " else break end end"] "\n")) |
| 2851 | |
| 2852 | (fn splice-save-locals [env lua-source] |
| 2853 | (set env.___replLocals___ (or env.___replLocals___ {})) |
| 2854 | (let [spliced-source [] |
| 2855 | bind "local %s = ___replLocals___['%s']"] |
| 2856 | (each [line (lua-source:gmatch "([^\n]+)\n?")] |
| 2857 | (table.insert spliced-source line)) |
| 2858 | (each [name (pairs env.___replLocals___)] |
| 2859 | (table.insert spliced-source 1 (bind:format name name))) |
| 2860 | (when (and (< 1 (# spliced-source)) |
| 2861 | (: (. spliced-source (# spliced-source)) :match "^ *return .*$")) |
| 2862 | (table.insert spliced-source (# spliced-source) save-source)) |
| 2863 | (table.concat spliced-source "\n"))) |
| 2864 | |
| 2865 | (fn completer [env scope text] |
| 2866 | (let [matches [] |
| 2867 | input-fragment (text:gsub ".*[%s)(]+" "")] |
| 2868 | (fn add-partials [input tbl prefix] ; add partial key matches in tbl |
| 2869 | (each [k (internals.allpairs tbl)] |
| 2870 | (let [k (if (or (= tbl env) (= tbl env.___replLocals___)) |
| 2871 | (. scope.unmanglings k) |
| 2872 | k)] |
| 2873 | (when (and (< (# matches) 2000) ; stop explosion on too many items |
| 2874 | (= (type k) "string") |
| 2875 | (= input (k:sub 0 (# input)))) |
| 2876 | (table.insert matches (.. prefix k)))))) |
| 2877 | (fn add-matches [input tbl prefix] ; add matches, descending into tbl fields |
| 2878 | (let [prefix (if prefix (.. prefix ".") "")] |
| 2879 | (if (not (input:find "%.")) ; no more dots, so add matches |
| 2880 | (add-partials input tbl prefix) |
| 2881 | (let [(head tail) (input:match "^([^.]+)%.(.*)") |
| 2882 | raw-head (if (or (= tbl env) (= tbl env.___replLocals___)) |
| 2883 | (. scope.manglings head) |
| 2884 | head)] |
| 2885 | (when (= (type (. tbl raw-head)) "table") |
| 2886 | (add-matches tail (. tbl raw-head) (.. prefix head))))))) |
| 2887 | |
| 2888 | (add-matches input-fragment (or scope.specials [])) |
| 2889 | (add-matches input-fragment (or scope.macros [])) |
| 2890 | (add-matches input-fragment (or env.___replLocals___ [])) |
| 2891 | (add-matches input-fragment env) |
| 2892 | (add-matches input-fragment (or env._ENV env._G [])) |
| 2893 | matches)) |
| 2894 | |
| 2895 | (fn repl [options] |
| 2896 | (let [old-root-options internals.rootOptions |
| 2897 | env (if options.env |
| 2898 | (internals.wrapEnv options.env) |
| 2899 | (setmetatable {} {:__index (or _G._ENV _G)})) |
| 2900 | save-locals? (and (not= options.saveLocals false) |
| 2901 | env.debug env.debug.getlocal) |
| 2902 | opts {} |
| 2903 | _ (each [k v (pairs options)] (tset opts k v)) |
| 2904 | read-chunk (or opts.readChunk default-read-chunk) |
| 2905 | on-values (or opts.onValues default-on-values) |
| 2906 | on-error (or opts.onError default-on-error) |
| 2907 | pp (or opts.pp tostring) |
| 2908 | ;; make parser |
| 2909 | (byte-stream clear-stream) (fennel.granulate read-chunk) |
| 2910 | chars [] |
| 2911 | (read reset) (fennel.parser (fn [parser-state] |
| 2912 | (let [c (byte-stream parser-state)] |
| 2913 | (tset chars (+ (# chars) 1) c) |
| 2914 | c))) |
| 2915 | scope (fennel.scope)] |
| 2916 | |
| 2917 | ;; use metadata unless we've specifically disabled it |
| 2918 | (set opts.useMetadata (not= options.useMetadata false)) |
| 2919 | (when (= opts.allowedGlobals nil) |
| 2920 | (set opts.allowedGlobals (internals.currentGlobalNames opts.env))) |
| 2921 | |
| 2922 | (when opts.registerCompleter |
| 2923 | (opts.registerCompleter (partial completer env scope))) |
| 2924 | |
| 2925 | (fn loop [] |
| 2926 | (each [k (pairs chars)] (tset chars k nil)) |
| 2927 | (let [(ok parse-ok? x) (pcall read) |
| 2928 | src-string (string.char ((or _G.unpack table.unpack) chars))] |
| 2929 | (internals.setRootOptions opts) |
| 2930 | (if (not ok) |
| 2931 | (do (on-error "Parse" parse-ok?) |
| 2932 | (clear-stream) |
| 2933 | (reset) |
| 2934 | (loop)) |
| 2935 | (when parse-ok? ; if this is false, we got eof |
| 2936 | (match (pcall fennel.compile x {:correlate opts.correlate |
| 2937 | :source src-string |
| 2938 | :scope scope |
| 2939 | :useMetadata opts.useMetadata |
| 2940 | :moduleName opts.moduleName |
| 2941 | :assert-compile opts.assert-compile |
| 2942 | :parse-error opts.parse-error}) |
| 2943 | (false msg) (do (clear-stream) |
| 2944 | (on-error "Compile" msg)) |
| 2945 | (true source) (let [source (if save-locals? |
| 2946 | (splice-save-locals env source) |
| 2947 | source) |
| 2948 | (lua-ok? loader) (pcall fennel.loadCode |
| 2949 | source env)] |
| 2950 | (if (not lua-ok?) |
| 2951 | (do (clear-stream) |
| 2952 | (on-error "Lua Compile" loader source)) |
| 2953 | (match (xpcall #[(loader)] |
| 2954 | (partial on-error "Runtime")) |
| 2955 | (true ret) |
| 2956 | (do (set env._ (. ret 1)) |
| 2957 | (set env.__ ret) |
| 2958 | (on-values (internals.map ret pp))))))) |
| 2959 | (internals.setRootOptions old-root-options) |
| 2960 | (loop))))) |
| 2961 | (loop)))]===] |
| 2962 | |
| 2963 | module.repl = function(options) |
| 2964 | -- functionality the repl needs that isn't part of the public API yet |
| 2965 | local internals = { rootOptions = utils.root.options, |
| 2966 | setRootOptions = function(r) utils.root.options = r end, |
| 2967 | currentGlobalNames = specials.currentGlobalNames, |
| 2968 | wrapEnv = specials.wrapEnv, |
| 2969 | allpairs = utils.allpairs, |
| 2970 | map = utils.map } |
| 2971 | return eval(replsource, { correlate = true }, module, internals)(options) |
| 2972 | end |
| 2973 | |
| 2974 | module.makeSearcher = function(options) |
| 2975 | return function(modulename) |
| 2976 | -- this will propagate options from the repl but not from eval, because |
| 2977 | -- eval unsets utils.root.options after compiling but before running the actual |
| 2978 | -- calls to require. |
| 2979 | local opts = utils.copy(utils.root.options) |
| 2980 | for k,v in pairs(options or {}) do opts[k] = v end |
| 2981 | local filename = specials.searchModule(modulename) |
| 2982 | if filename then |
| 2983 | return function(modname) |
| 2984 | return compiler.dofileFennel(filename, opts, modname) |
| 2985 | end |
| 2986 | end |
| 2987 | end |
| 2988 | end |
| 2989 | |
| 2990 | -- This will allow regular `require` to work with Fennel: |
| 2991 | -- table.insert(package.loaders, fennel.searcher) |
| 2992 | module.searcher = module.makeSearcher() |
| 2993 | module.make_searcher = module.makeSearcher -- oops backwards compatibility |
| 2994 | |
| 2995 | -- Load standard macros |
| 2996 | local stdmacros = [===[ |
| 2997 | {"->" (fn [val ...] |
| 2998 | "Thread-first macro. |
| 2999 | Take the first value and splice it into the second form as its first argument. |
| 3000 | The value of the second form is spliced into the first arg of the third, etc." |
| 3001 | (var x val) |
| 3002 | (each [_ e (ipairs [...])] |
| 3003 | (let [elt (if (list? e) e (list e))] |
| 3004 | (table.insert elt 2 x) |
| 3005 | (set x elt))) |
| 3006 | x) |
| 3007 | "->>" (fn [val ...] |
| 3008 | "Thread-last macro. |
| 3009 | Same as ->, except splices the value into the last position of each form |
| 3010 | rather than the first." |
| 3011 | (var x val) |
| 3012 | (each [_ e (pairs [...])] |
| 3013 | (let [elt (if (list? e) e (list e))] |
| 3014 | (table.insert elt x) |
| 3015 | (set x elt))) |
| 3016 | x) |
| 3017 | "-?>" (fn [val ...] |
| 3018 | "Nil-safe thread-first macro. |
| 3019 | Same as -> except will short-circuit with nil when it encounters a nil value." |
| 3020 | (if (= 0 (select "#" ...)) |
| 3021 | val |
| 3022 | (let [els [...] |
| 3023 | e (table.remove els 1) |
| 3024 | el (if (list? e) e (list e)) |
| 3025 | tmp (gensym)] |
| 3026 | (table.insert el 2 tmp) |
| 3027 | `(let [,tmp ,val] |
| 3028 | (if ,tmp |
| 3029 | (-?> ,el ,(unpack els)) |
| 3030 | ,tmp))))) |
| 3031 | "-?>>" (fn [val ...] |
| 3032 | "Nil-safe thread-last macro. |
| 3033 | Same as ->> except will short-circuit with nil when it encounters a nil value." |
| 3034 | (if (= 0 (select "#" ...)) |
| 3035 | val |
| 3036 | (let [els [...] |
| 3037 | e (table.remove els 1) |
| 3038 | el (if (list? e) e (list e)) |
| 3039 | tmp (gensym)] |
| 3040 | (table.insert el tmp) |
| 3041 | `(let [,tmp ,val] |
| 3042 | (if ,tmp |
| 3043 | (-?>> ,el ,(unpack els)) |
| 3044 | ,tmp))))) |
| 3045 | :doto (fn [val ...] |
| 3046 | "Evaluates val and splices it into the first argument of subsequent forms." |
| 3047 | (let [name (gensym) |
| 3048 | form `(let [,name ,val])] |
| 3049 | (each [_ elt (pairs [...])] |
| 3050 | (table.insert elt 2 name) |
| 3051 | (table.insert form elt)) |
| 3052 | (table.insert form name) |
| 3053 | form)) |
| 3054 | :when (fn [condition body1 ...] |
| 3055 | "Evaluate body for side-effects only when condition is truthy." |
| 3056 | (assert body1 "expected body") |
| 3057 | `(if ,condition |
| 3058 | (do ,body1 ,...))) |
| 3059 | :with-open (fn [closable-bindings ...] |
| 3060 | "Like `let`, but invokes (v:close) on every binding after evaluating the body. |
| 3061 | The body is evaluated inside `xpcall` so that bound values will be closed upon |
| 3062 | encountering an error before propagating it." |
| 3063 | (let [bodyfn `(fn [] ,...) |
| 3064 | closer `(fn close-handlers# [ok# ...] (if ok# ... (error ... 0))) |
| 3065 | traceback `(. (or package.loaded.fennel debug) :traceback)] |
| 3066 | (for [i 1 (# closable-bindings) 2] |
| 3067 | (assert (sym? (. closable-bindings i)) |
| 3068 | "with-open only allows symbols in bindings") |
| 3069 | (table.insert closer 4 `(: ,(. closable-bindings i) :close))) |
| 3070 | `(let ,closable-bindings ,closer |
| 3071 | (close-handlers# (xpcall ,bodyfn ,traceback))))) |
| 3072 | :partial (fn [f ...] |
| 3073 | "Returns a function with all arguments partially applied to f." |
| 3074 | (let [body (list f ...)] |
| 3075 | (table.insert body _VARARG) |
| 3076 | `(fn [,_VARARG] ,body))) |
| 3077 | :pick-args (fn [n f] |
| 3078 | "Creates a function of arity n that applies its arguments to f. |
| 3079 | For example,\n\t(pick-args 2 func) |
| 3080 | expands to\n\t(fn [_0_ _1_] (func _0_ _1_))" |
| 3081 | (assert (and (= (type n) :number) (= n (math.floor n)) (>= n 0)) |
| 3082 | "Expected n to be an integer literal >= 0.") |
| 3083 | (let [bindings []] |
| 3084 | (for [i 1 n] (tset bindings i (gensym))) |
| 3085 | `(fn ,bindings (,f ,(unpack bindings))))) |
| 3086 | :pick-values (fn [n ...] |
| 3087 | "Like the `values` special, but emits exactly n values.\nFor example, |
| 3088 | \t(pick-values 2 ...)\nexpands to\n\t(let [(_0_ _1_) ...] (values _0_ _1_))" |
| 3089 | (assert (and (= :number (type n)) (>= n 0) (= n (math.floor n))) |
| 3090 | "Expected n to be an integer >= 0") |
| 3091 | (let [let-syms (list) |
| 3092 | let-values (if (= 1 (select :# ...)) ... `(values ,...))] |
| 3093 | (for [i 1 n] (table.insert let-syms (gensym))) |
| 3094 | (if (= n 0) `(values) |
| 3095 | `(let [,let-syms ,let-values] (values ,(unpack let-syms)))))) |
| 3096 | :lambda (fn [...] |
| 3097 | "Function literal with arity checking. |
| 3098 | Will throw an exception if a declared argument is passed in as nil, unless |
| 3099 | that argument name begins with ?." |
| 3100 | (let [args [...] |
| 3101 | has-internal-name? (sym? (. args 1)) |
| 3102 | arglist (if has-internal-name? (. args 2) (. args 1)) |
| 3103 | docstring-position (if has-internal-name? 3 2) |
| 3104 | has-docstring? (and (> (# args) docstring-position) |
| 3105 | (= :string (type (. args docstring-position)))) |
| 3106 | arity-check-position (- 4 (if has-internal-name? 0 1) (if has-docstring? 0 1))] |
| 3107 | (fn check! [a] |
| 3108 | (if (table? a) |
| 3109 | (each [_ a (pairs a)] |
| 3110 | (check! a)) |
| 3111 | (and (not (: (tostring a) :match "^?")) |
| 3112 | (not= (tostring a) "&") |
| 3113 | (not= (tostring a) "...")) |
| 3114 | (table.insert args arity-check-position |
| 3115 | `(assert (not= nil ,a) |
| 3116 | (: "Missing argument %s on %s:%s" |
| 3117 | :format ,(tostring a) |
| 3118 | ,(or a.filename "unknown") |
| 3119 | ,(or a.line "?")))))) |
| 3120 | (assert (> (length args) 1) "expected body expression") |
| 3121 | (each [_ a (ipairs arglist)] |
| 3122 | (check! a)) |
| 3123 | `(fn ,(unpack args)))) |
| 3124 | :macro (fn macro [name ...] |
| 3125 | "Define a single macro." |
| 3126 | (assert (sym? name) "expected symbol for macro name") |
| 3127 | (local args [...]) |
| 3128 | `(macros { ,(tostring name) (fn ,name ,(unpack args))})) |
| 3129 | :macrodebug (fn macrodebug [form return?] |
| 3130 | "Print the resulting form after performing macroexpansion. |
| 3131 | With a second argument, returns expanded form as a string instead of printing." |
| 3132 | (let [(ok view) (pcall require :fennelview) |
| 3133 | handle (if return? `do `print)] |
| 3134 | `(,handle ,((if ok view tostring) (macroexpand form _SCOPE))))) |
| 3135 | :import-macros (fn import-macros [binding1 module-name1 ...] |
| 3136 | "Binds a table of macros from each macro module according to its binding form. |
| 3137 | Each binding form can be either a symbol or a k/v destructuring table. |
| 3138 | Example:\n (import-macros mymacros :my-macros ; bind to symbol |
| 3139 | {:macro1 alias : macro2} :proj.macros) ; import by name" |
| 3140 | (assert (and binding1 module-name1 (= 0 (% (select :# ...) 2))) |
| 3141 | "expected even number of binding/modulename pairs") |
| 3142 | (for [i 1 (select :# binding1 module-name1 ...) 2] |
| 3143 | (local (binding modname) (select i binding1 module-name1 ...)) |
| 3144 | ;; generate a subscope of current scope, use require-macros to bring in macro |
| 3145 | ;; module. after that, we just copy the macros from subscope to scope. |
| 3146 | (local scope (get-scope)) |
| 3147 | (local subscope (fennel.scope scope)) |
| 3148 | (fennel.compileString (string.format "(require-macros %q)" modname) |
| 3149 | {:scope subscope}) |
| 3150 | (if (sym? binding) |
| 3151 | ;; bind whole table of macros to table bound to symbol |
| 3152 | (do (tset scope.macros (. binding 1) {}) |
| 3153 | (each [k v (pairs subscope.macros)] |
| 3154 | (tset (. scope.macros (. binding 1)) k v))) |
| 3155 | |
| 3156 | ;; 1-level table destructuring for importing individual macros |
| 3157 | (table? binding) |
| 3158 | (each [macro-name [import-key] (pairs binding)] |
| 3159 | (assert (= :function (type (. subscope.macros macro-name))) |
| 3160 | (.. "macro " macro-name " not found in module " modname)) |
| 3161 | (tset scope.macros import-key (. subscope.macros macro-name))))) |
| 3162 | ;; TODO: replace with `nil` once we fix macros being able to return nil |
| 3163 | `(do nil)) |
| 3164 | :match |
| 3165 | (fn match [val ...] |
| 3166 | "Perform pattern matching on val. See reference for details." |
| 3167 | ;; this function takes the AST of values and a single pattern and returns a |
| 3168 | ;; condition to determine if it matches as well as a list of bindings to |
| 3169 | ;; introduce for the duration of the body if it does match. |
| 3170 | (fn match-pattern [vals pattern unifications] |
| 3171 | ;; we have to assume we're matching against multiple values here until we |
| 3172 | ;; know we're either in a multi-valued clause (in which case we know the # |
| 3173 | ;; of vals) or we're not, in which case we only care about the first one. |
| 3174 | (let [[val] vals] |
| 3175 | (if (or (and (sym? pattern) ; unification with outer locals (or nil) |
| 3176 | (not= :_ (tostring pattern)) ; never unify _ |
| 3177 | (or (in-scope? pattern) |
| 3178 | (= :nil (tostring pattern)))) |
| 3179 | (and (multi-sym? pattern) |
| 3180 | (in-scope? (. (multi-sym? pattern) 1)))) |
| 3181 | (values `(= ,val ,pattern) []) |
| 3182 | ;; unify a local we've seen already |
| 3183 | (and (sym? pattern) |
| 3184 | (. unifications (tostring pattern))) |
| 3185 | (values `(= ,(. unifications (tostring pattern)) ,val) []) |
| 3186 | ;; bind a fresh local |
| 3187 | (sym? pattern) |
| 3188 | (let [wildcard? (= (tostring pattern) "_")] |
| 3189 | (if (not wildcard?) (tset unifications (tostring pattern) val)) |
| 3190 | (values (if (or wildcard? (: (tostring pattern) :find "^?")) |
| 3191 | true `(not= ,(sym :nil) ,val)) |
| 3192 | [pattern val])) |
| 3193 | ;; guard clause |
| 3194 | (and (list? pattern) (sym? (. pattern 2)) (= :? (tostring (. pattern 2)))) |
| 3195 | (let [(pcondition bindings) (match-pattern vals (. pattern 1) |
| 3196 | unifications) |
| 3197 | condition `(and ,pcondition)] |
| 3198 | (for [i 3 (# pattern)] ; splice in guard clauses |
| 3199 | (table.insert condition (. pattern i))) |
| 3200 | (values `(let ,bindings ,condition) bindings)) |
| 3201 | |
| 3202 | ;; multi-valued patterns (represented as lists) |
| 3203 | (list? pattern) |
| 3204 | (let [condition `(and) |
| 3205 | bindings []] |
| 3206 | (each [i pat (ipairs pattern)] |
| 3207 | (let [(subcondition subbindings) (match-pattern [(. vals i)] pat |
| 3208 | unifications)] |
| 3209 | (table.insert condition subcondition) |
| 3210 | (each [_ b (ipairs subbindings)] |
| 3211 | (table.insert bindings b)))) |
| 3212 | (values condition bindings)) |
| 3213 | ;; table patterns) |
| 3214 | (= (type pattern) :table) |
| 3215 | (let [condition `(and (= (type ,val) :table)) |
| 3216 | bindings []] |
| 3217 | (each [k pat (pairs pattern)] |
| 3218 | (if (and (sym? pat) (= "&" (tostring pat))) |
| 3219 | (do (assert (not (. pattern (+ k 2))) |
| 3220 | "expected rest argument before last parameter") |
| 3221 | (table.insert bindings (. pattern (+ k 1))) |
| 3222 | (table.insert bindings [`(select ,k ((or _G.unpack table.unpack) |
| 3223 | ,val))])) |
| 3224 | (and (= :number (type k)) |
| 3225 | (= "&" (tostring (. pattern (- k 1))))) |
| 3226 | nil ; don't process the pattern right after &; already got it |
| 3227 | (let [subval `(. ,val ,k) |
| 3228 | (subcondition subbindings) (match-pattern [subval] pat |
| 3229 | unifications)] |
| 3230 | (table.insert condition subcondition) |
| 3231 | (each [_ b (ipairs subbindings)] |
| 3232 | (table.insert bindings b))))) |
| 3233 | (values condition bindings)) |
| 3234 | ;; literal value |
| 3235 | (values `(= ,val ,pattern) [])))) |
| 3236 | (fn match-condition [vals clauses] |
| 3237 | (let [out `(if)] |
| 3238 | (for [i 1 (length clauses) 2] |
| 3239 | (let [pattern (. clauses i) |
| 3240 | body (. clauses (+ i 1)) |
| 3241 | (condition bindings) (match-pattern vals pattern {})] |
| 3242 | (table.insert out condition) |
| 3243 | (table.insert out `(let ,bindings ,body)))) |
| 3244 | out)) |
| 3245 | ;; how many multi-valued clauses are there? return a list of that many gensyms |
| 3246 | (fn val-syms [clauses] |
| 3247 | (let [syms (list (gensym))] |
| 3248 | (for [i 1 (length clauses) 2] |
| 3249 | (if (list? (. clauses i)) |
| 3250 | (each [valnum (ipairs (. clauses i))] |
| 3251 | (if (not (. syms valnum)) |
| 3252 | (tset syms valnum (gensym)))))) |
| 3253 | syms)) |
| 3254 | ;; wrap it in a way that prevents double-evaluation of the matched value |
| 3255 | (let [clauses [...] |
| 3256 | vals (val-syms clauses)] |
| 3257 | (if (not= 0 (% (length clauses) 2)) ; treat odd final clause as default |
| 3258 | (table.insert clauses (length clauses) (sym :_))) |
| 3259 | ;; protect against multiple evaluation of the value, bind against as |
| 3260 | ;; many values as we ever match against in the clauses. |
| 3261 | (list (sym :let) [vals val] |
| 3262 | (match-condition vals clauses)))) |
| 3263 | } |
| 3264 | ]===] |
| 3265 | do |
| 3266 | -- docstrings rely on having a place to "put" metadata; we use the module |
| 3267 | -- system for that. but if you try to require the module while it's being |
| 3268 | -- loaded, you get a stack overflow. so we fake out the module for the |
| 3269 | -- purposes of boostrapping the built-in macros here. |
| 3270 | local moduleName = "__fennel-bootstrap__" |
| 3271 | package.preload[moduleName] = function() return module end |
| 3272 | local env = specials.makeCompilerEnv(nil, compiler.scopes.compiler, {}) |
| 3273 | local macros = eval(stdmacros, { |
| 3274 | env = env, |
| 3275 | scope = compiler.makeScope(compiler.scopes.compiler), |
| 3276 | -- assume the code to load globals doesn't have any |
| 3277 | -- mistaken globals, otherwise this can be |
| 3278 | -- problematic when loading fennel in contexts |
| 3279 | -- where _G is an empty table with an __index |
| 3280 | -- metamethod. (openresty) |
| 3281 | allowedGlobals = false, |
| 3282 | useMetadata = true, |
| 3283 | filename = "src/fennel/macros.fnl", |
| 3284 | moduleName = moduleName }) |
| 3285 | for k,v in pairs(macros) do compiler.scopes.global.macros[k] = v end |
| 3286 | package.preload[moduleName] = nil |
| 3287 | end |
| 3288 | compiler.scopes.global.macros['λ'] = compiler.scopes.global.macros['lambda'] |
| 3289 | |
| 3290 | return module |