2019-12-02 18:30:30 -08:00
|
|
|
--[[
|
|
|
|
Copyright (c) 2016-2019 Calvin Rose and contributors
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
|
|
|
this software and associated documentation files (the "Software"), to deal in
|
|
|
|
the Software without restriction, including without limitation the rights to
|
|
|
|
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
|
|
|
|
the Software, and to permit persons to whom the Software is furnished to do so,
|
|
|
|
subject to the following conditions:
|
|
|
|
The above copyright notice and this permission notice shall be included in all
|
|
|
|
copies or substantial portions of the Software.
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
|
|
|
|
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
|
|
|
|
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
|
|
|
|
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
|
|
|
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
|
|
|
]]
|
|
|
|
|
|
|
|
-- Make global variables local.
|
|
|
|
local setmetatable = setmetatable
|
|
|
|
local getmetatable = getmetatable
|
|
|
|
local type = type
|
|
|
|
local assert = assert
|
|
|
|
local pairs = pairs
|
|
|
|
local ipairs = ipairs
|
|
|
|
local tostring = tostring
|
|
|
|
local unpack = unpack or table.unpack
|
|
|
|
|
|
|
|
--
|
|
|
|
-- Main Types and support functions
|
|
|
|
--
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- Map function f over sequential table t, removing values where f returns nil.
|
|
|
|
-- Optionally takes a target table to insert the mapped values into.
|
|
|
|
local function map(t, f, out)
|
|
|
|
out = out or {}
|
|
|
|
if type(f) ~= "function" then local s = f f = function(x) return x[s] end end
|
|
|
|
for _,x in ipairs(t) do
|
|
|
|
local v = f(x)
|
|
|
|
if v then table.insert(out, v) end
|
|
|
|
end
|
|
|
|
return out
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Map function f over key/value table t, similar to above, but it can return a
|
|
|
|
-- sequential table if f returns a single value or a k/v table if f returns two.
|
|
|
|
-- Optionally takes a target table to insert the mapped values into.
|
|
|
|
local function kvmap(t, f, out)
|
|
|
|
out = out or {}
|
|
|
|
if type(f) ~= "function" then local s = f f = function(x) return x[s] end end
|
|
|
|
for k,x in pairs(t) do
|
|
|
|
local korv, v = f(k, x)
|
|
|
|
if korv and not v then table.insert(out, korv) end
|
|
|
|
if korv and v then out[korv] = v end
|
|
|
|
end
|
|
|
|
return out
|
|
|
|
end
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
local function deref(self) return self[1] end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
local function listToString(self, tostring2)
|
|
|
|
return '(' .. table.concat(map(self, tostring2 or tostring), ' ', 1, #self) .. ')'
|
|
|
|
end
|
|
|
|
|
|
|
|
local SYMBOL_MT = { 'SYMBOL', __tostring = deref, __fennelview = deref }
|
2019-12-02 18:30:30 -08:00
|
|
|
local EXPR_MT = { 'EXPR', __tostring = deref }
|
|
|
|
local VARARG = setmetatable({ '...' }, { 'VARARG', __tostring = deref })
|
2020-03-07 17:41:37 -08:00
|
|
|
local LIST_MT = { 'LIST', __tostring = listToString, __fennelview = listToString }
|
2019-12-02 18:30:30 -08:00
|
|
|
local SEQUENCE_MT = { 'SEQUENCE' }
|
|
|
|
|
|
|
|
-- Load code with an environment in all recent Lua versions
|
|
|
|
local function loadCode(code, environment, filename)
|
|
|
|
environment = environment or _ENV or _G
|
|
|
|
if setfenv and loadstring then
|
|
|
|
local f = assert(loadstring(code, filename))
|
|
|
|
setfenv(f, environment)
|
|
|
|
return f
|
|
|
|
else
|
|
|
|
return assert(load(code, filename, "t", environment))
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- Create a new list. Lists are a compile-time construct in Fennel; they are
|
|
|
|
-- represented as tables with a special marker metatable. They only come from
|
|
|
|
-- the parser, and they represent code which comes from reading a paren form;
|
|
|
|
-- they are specifically not cons cells.
|
2019-12-02 18:30:30 -08:00
|
|
|
local function list(...)
|
|
|
|
return setmetatable({...}, LIST_MT)
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- Create a new symbol. Symbols are a compile-time construct in Fennel and are
|
|
|
|
-- not exposed outside the compiler. Symbols have metadata describing what file,
|
|
|
|
-- line, etc that they came from.
|
2019-12-02 18:30:30 -08:00
|
|
|
local function sym(str, scope, meta)
|
|
|
|
local s = {str, scope = scope}
|
2020-03-07 17:41:37 -08:00
|
|
|
for k, v in pairs(meta or {}) do
|
|
|
|
if type(k) == 'string' then s[k] = v end
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
return setmetatable(s, SYMBOL_MT)
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- Create a new sequence. Sequences are tables that come from the parser when
|
|
|
|
-- it encounters a form with square brackets. They are treated as regular tables
|
|
|
|
-- except when certain macros need to look for binding forms, etc specifically.
|
2019-12-02 18:30:30 -08:00
|
|
|
local function sequence(...)
|
|
|
|
return setmetatable({...}, SEQUENCE_MT)
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Create a new expr
|
|
|
|
-- etype should be one of
|
|
|
|
-- "literal", -- literals like numbers, strings, nil, true, false
|
|
|
|
-- "expression", -- Complex strings of Lua code, may have side effects, etc, but is an expression
|
|
|
|
-- "statement", -- Same as expression, but is also a valid statement (function calls).
|
|
|
|
-- "vargs", -- varargs symbol
|
|
|
|
-- "sym", -- symbol reference
|
|
|
|
local function expr(strcode, etype)
|
|
|
|
return setmetatable({ strcode, type = etype }, EXPR_MT)
|
|
|
|
end
|
|
|
|
|
|
|
|
local function varg()
|
|
|
|
return VARARG
|
|
|
|
end
|
|
|
|
|
|
|
|
local function isVarg(x)
|
|
|
|
return x == VARARG and x
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Checks if an object is a List. Returns the object if is a List.
|
|
|
|
local function isList(x)
|
|
|
|
return type(x) == 'table' and getmetatable(x) == LIST_MT and x
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Checks if an object is a symbol. Returns the object if it is a symbol.
|
|
|
|
local function isSym(x)
|
|
|
|
return type(x) == 'table' and getmetatable(x) == SYMBOL_MT and x
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Checks if an object any kind of table, EXCEPT list or symbol
|
|
|
|
local function isTable(x)
|
|
|
|
return type(x) == 'table' and
|
|
|
|
x ~= VARARG and
|
|
|
|
getmetatable(x) ~= LIST_MT and getmetatable(x) ~= SYMBOL_MT and x
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Checks if an object is a sequence (created with a [] literal)
|
|
|
|
local function isSequence(x)
|
|
|
|
return type(x) == 'table' and getmetatable(x) == SEQUENCE_MT and x
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- Returns a shallow copy of its table argument. Returns an empty table on nil.
|
|
|
|
local function copy(from)
|
|
|
|
local to = {}
|
|
|
|
for k, v in pairs(from or {}) do to[k] = v end
|
|
|
|
return to
|
|
|
|
end
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
--
|
|
|
|
-- Parser
|
|
|
|
--
|
|
|
|
|
|
|
|
-- Convert a stream of chunks to a stream of bytes.
|
|
|
|
-- Also returns a second function to clear the buffer in the byte stream
|
|
|
|
local function granulate(getchunk)
|
|
|
|
local c = ''
|
|
|
|
local index = 1
|
|
|
|
local done = false
|
|
|
|
return function (parserState)
|
|
|
|
if done then return nil end
|
|
|
|
if index <= #c then
|
|
|
|
local b = c:byte(index)
|
|
|
|
index = index + 1
|
|
|
|
return b
|
|
|
|
else
|
|
|
|
c = getchunk(parserState)
|
|
|
|
if not c or c == '' then
|
|
|
|
done = true
|
|
|
|
return nil
|
|
|
|
end
|
|
|
|
index = 2
|
|
|
|
return c:byte(1)
|
|
|
|
end
|
|
|
|
end, function ()
|
|
|
|
c = ''
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Convert a string into a stream of bytes
|
|
|
|
local function stringStream(str)
|
|
|
|
local index = 1
|
|
|
|
return function()
|
|
|
|
local r = str:byte(index)
|
|
|
|
index = index + 1
|
|
|
|
return r
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Table of delimiter bytes - (, ), [, ], {, }
|
|
|
|
-- Opener keys have closer as the value, and closers keys
|
|
|
|
-- have true as their value.
|
|
|
|
local delims = {
|
|
|
|
[40] = 41, -- (
|
|
|
|
[41] = true, -- )
|
|
|
|
[91] = 93, -- [
|
|
|
|
[93] = true, -- ]
|
|
|
|
[123] = 125, -- {
|
|
|
|
[125] = true -- }
|
|
|
|
}
|
|
|
|
|
|
|
|
local function iswhitespace(b)
|
|
|
|
return b == 32 or (b >= 9 and b <= 13)
|
|
|
|
end
|
|
|
|
|
|
|
|
local function issymbolchar(b)
|
|
|
|
return b > 32 and
|
|
|
|
not delims[b] and
|
|
|
|
b ~= 127 and -- "<BS>"
|
|
|
|
b ~= 34 and -- "\""
|
|
|
|
b ~= 39 and -- "'"
|
|
|
|
b ~= 126 and -- "~"
|
|
|
|
b ~= 59 and -- ";"
|
|
|
|
b ~= 44 and -- ","
|
|
|
|
b ~= 64 and -- "@"
|
|
|
|
b ~= 96 -- "`"
|
|
|
|
end
|
|
|
|
|
|
|
|
local prefixes = { -- prefix chars substituted while reading
|
|
|
|
[96] = 'quote', -- `
|
|
|
|
[44] = 'unquote', -- ,
|
|
|
|
[39] = 'quote', -- '
|
|
|
|
[35] = 'hashfn' -- #
|
|
|
|
}
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- The resetRoot function needs to be called at every exit point of the compiler
|
|
|
|
-- including when there's a parse error or compiler error. Introduce it up here
|
|
|
|
-- so error functions have access to it, and set it when we have values below.
|
|
|
|
local resetRoot = nil
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
-- Parse one value given a function that
|
|
|
|
-- returns sequential bytes. Will throw an error as soon
|
|
|
|
-- as possible without getting more bytes on bad input. Returns
|
|
|
|
-- if a value was read, and then the value read. Will return nil
|
|
|
|
-- when input stream is finished.
|
|
|
|
local function parser(getbyte, filename)
|
|
|
|
|
|
|
|
-- Stack of unfinished values
|
|
|
|
local stack = {}
|
|
|
|
|
|
|
|
-- Provide one character buffer and keep
|
|
|
|
-- track of current line and byte index
|
|
|
|
local line = 1
|
|
|
|
local byteindex = 0
|
|
|
|
local lastb
|
|
|
|
local function ungetb(ub)
|
|
|
|
if ub == 10 then line = line - 1 end
|
|
|
|
byteindex = byteindex - 1
|
|
|
|
lastb = ub
|
|
|
|
end
|
|
|
|
local function getb()
|
|
|
|
local r
|
|
|
|
if lastb then
|
|
|
|
r, lastb = lastb, nil
|
|
|
|
else
|
|
|
|
r = getbyte({ stackSize = #stack })
|
|
|
|
end
|
|
|
|
byteindex = byteindex + 1
|
|
|
|
if r == 10 then line = line + 1 end
|
|
|
|
return r
|
|
|
|
end
|
|
|
|
local function parseError(msg)
|
2020-03-07 17:41:37 -08:00
|
|
|
if resetRoot then resetRoot() end
|
2019-12-02 18:30:30 -08:00
|
|
|
return error(msg .. ' in ' .. (filename or 'unknown') .. ':' .. line, 0)
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Parse stream
|
|
|
|
return function()
|
|
|
|
|
|
|
|
-- Dispatch when we complete a value
|
|
|
|
local done, retval
|
|
|
|
local whitespaceSinceDispatch = true
|
|
|
|
local function dispatch(v)
|
|
|
|
if #stack == 0 then
|
|
|
|
retval = v
|
|
|
|
done = true
|
|
|
|
elseif stack[#stack].prefix then
|
|
|
|
local stacktop = stack[#stack]
|
|
|
|
stack[#stack] = nil
|
|
|
|
return dispatch(list(sym(stacktop.prefix), v))
|
|
|
|
else
|
|
|
|
table.insert(stack[#stack], v)
|
|
|
|
end
|
|
|
|
whitespaceSinceDispatch = false
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Throw nice error when we expect more characters
|
|
|
|
-- but reach end of stream.
|
|
|
|
local function badend()
|
2020-03-07 17:41:37 -08:00
|
|
|
local accum = map(stack, "closer")
|
2019-12-02 18:30:30 -08:00
|
|
|
parseError(('expected closing delimiter%s %s'):format(
|
|
|
|
#stack == 1 and "" or "s",
|
|
|
|
string.char(unpack(accum))))
|
|
|
|
end
|
|
|
|
|
|
|
|
-- The main parse loop
|
|
|
|
repeat
|
|
|
|
local b
|
|
|
|
|
|
|
|
-- Skip whitespace
|
|
|
|
repeat
|
|
|
|
b = getb()
|
|
|
|
if b and iswhitespace(b) then
|
|
|
|
whitespaceSinceDispatch = true
|
|
|
|
end
|
|
|
|
until not b or not iswhitespace(b)
|
|
|
|
if not b then
|
|
|
|
if #stack > 0 then badend() end
|
|
|
|
return nil
|
|
|
|
end
|
|
|
|
|
|
|
|
if b == 59 then -- ; Comment
|
|
|
|
repeat
|
|
|
|
b = getb()
|
|
|
|
until not b or b == 10 -- newline
|
|
|
|
elseif type(delims[b]) == 'number' then -- Opening delimiter
|
|
|
|
if not whitespaceSinceDispatch then
|
|
|
|
parseError('expected whitespace before opening delimiter '
|
|
|
|
.. string.char(b))
|
|
|
|
end
|
|
|
|
table.insert(stack, setmetatable({
|
|
|
|
closer = delims[b],
|
|
|
|
line = line,
|
|
|
|
filename = filename,
|
|
|
|
bytestart = byteindex
|
|
|
|
}, LIST_MT))
|
|
|
|
elseif delims[b] then -- Closing delimiter
|
|
|
|
if #stack == 0 then parseError('unexpected closing delimiter '
|
|
|
|
.. string.char(b)) end
|
|
|
|
local last = stack[#stack]
|
|
|
|
local val
|
|
|
|
if last.closer ~= b then
|
|
|
|
parseError('unexpected delimiter ' .. string.char(b) ..
|
|
|
|
', expected ' .. string.char(last.closer))
|
|
|
|
end
|
|
|
|
last.byteend = byteindex -- Set closing byte index
|
|
|
|
if b == 41 then -- ; )
|
|
|
|
val = last
|
|
|
|
elseif b == 93 then -- ; ]
|
|
|
|
val = sequence()
|
|
|
|
for i = 1, #last do
|
|
|
|
val[i] = last[i]
|
|
|
|
end
|
|
|
|
else -- ; }
|
|
|
|
if #last % 2 ~= 0 then
|
|
|
|
parseError('expected even number of values in table literal')
|
|
|
|
end
|
|
|
|
val = {}
|
|
|
|
for i = 1, #last, 2 do
|
2020-03-07 17:41:37 -08:00
|
|
|
if(tostring(last[i]) == ":" and isSym(last[i + 1])
|
|
|
|
and isSym(last[i])) then
|
2019-12-02 18:30:30 -08:00
|
|
|
last[i] = tostring(last[i + 1])
|
|
|
|
end
|
|
|
|
val[last[i]] = last[i + 1]
|
|
|
|
end
|
|
|
|
end
|
|
|
|
stack[#stack] = nil
|
|
|
|
dispatch(val)
|
|
|
|
elseif b == 34 then -- Quoted string
|
|
|
|
local state = "base"
|
|
|
|
local chars = {34}
|
|
|
|
stack[#stack + 1] = {closer = 34}
|
|
|
|
repeat
|
|
|
|
b = getb()
|
|
|
|
chars[#chars + 1] = b
|
|
|
|
if state == "base" then
|
|
|
|
if b == 92 then
|
|
|
|
state = "backslash"
|
|
|
|
elseif b == 34 then
|
|
|
|
state = "done"
|
|
|
|
end
|
|
|
|
else
|
|
|
|
-- state == "backslash"
|
|
|
|
state = "base"
|
|
|
|
end
|
|
|
|
until not b or (state == "done")
|
|
|
|
if not b then badend() end
|
|
|
|
stack[#stack] = nil
|
|
|
|
local raw = string.char(unpack(chars))
|
|
|
|
local formatted = raw:gsub("[\1-\31]", function (c) return '\\' .. c:byte() end)
|
|
|
|
local loadFn = loadCode(('return %s'):format(formatted), nil, filename)
|
|
|
|
dispatch(loadFn())
|
|
|
|
elseif prefixes[b] then
|
|
|
|
-- expand prefix byte into wrapping form eg. '`a' into '(quote a)'
|
|
|
|
table.insert(stack, {
|
|
|
|
prefix = prefixes[b]
|
|
|
|
})
|
|
|
|
local nextb = getb()
|
|
|
|
if iswhitespace(nextb) then
|
|
|
|
if b == 35 then
|
|
|
|
stack[#stack] = nil
|
|
|
|
dispatch(sym('#'))
|
|
|
|
else
|
|
|
|
parseError('invalid whitespace after quoting prefix')
|
|
|
|
end
|
|
|
|
end
|
|
|
|
ungetb(nextb)
|
|
|
|
elseif issymbolchar(b) or b == string.byte("~") then -- Try symbol
|
|
|
|
local chars = {}
|
|
|
|
local bytestart = byteindex
|
|
|
|
repeat
|
|
|
|
chars[#chars + 1] = b
|
|
|
|
b = getb()
|
|
|
|
until not b or not issymbolchar(b)
|
|
|
|
if b then ungetb(b) end
|
|
|
|
local rawstr = string.char(unpack(chars))
|
|
|
|
if rawstr == 'true' then dispatch(true)
|
|
|
|
elseif rawstr == 'false' then dispatch(false)
|
|
|
|
elseif rawstr == '...' then dispatch(VARARG)
|
2020-03-07 17:41:37 -08:00
|
|
|
elseif rawstr:match('^:.+$') then -- colon style strings
|
2019-12-02 18:30:30 -08:00
|
|
|
dispatch(rawstr:sub(2))
|
|
|
|
elseif rawstr:match("^~") and rawstr ~= "~=" then
|
|
|
|
-- for backwards-compatibility, special-case allowance of ~=
|
|
|
|
-- but all other uses of ~ are disallowed
|
|
|
|
parseError("illegal character: ~")
|
|
|
|
else
|
|
|
|
local forceNumber = rawstr:match('^%d')
|
|
|
|
local numberWithStrippedUnderscores = rawstr:gsub("_", "")
|
|
|
|
local x
|
|
|
|
if forceNumber then
|
|
|
|
x = tonumber(numberWithStrippedUnderscores) or
|
|
|
|
parseError('could not read token "' .. rawstr .. '"')
|
|
|
|
else
|
|
|
|
x = tonumber(numberWithStrippedUnderscores) or
|
|
|
|
(rawstr:match("%.[0-9]") and
|
|
|
|
parseError("can't start multisym segment " ..
|
|
|
|
"with digit: ".. rawstr)) or
|
|
|
|
((rawstr:match(":%.") or
|
|
|
|
rawstr:match("%.:") or
|
|
|
|
rawstr:match("::") or
|
|
|
|
(rawstr:match("%.%.") and rawstr ~= "..")) and
|
|
|
|
parseError("malformed multisym: " .. rawstr)) or
|
|
|
|
(rawstr:match(":.+:") and
|
|
|
|
parseError("method call must be last component " ..
|
|
|
|
"of multisym: " .. rawstr)) or
|
|
|
|
sym(rawstr, nil, { line = line,
|
|
|
|
filename = filename,
|
|
|
|
bytestart = bytestart,
|
|
|
|
byteend = byteindex, })
|
|
|
|
end
|
|
|
|
dispatch(x)
|
|
|
|
end
|
|
|
|
else
|
|
|
|
parseError("illegal character: " .. string.char(b))
|
|
|
|
end
|
|
|
|
until done
|
|
|
|
return true, retval
|
|
|
|
end, function ()
|
|
|
|
stack = {}
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
--
|
|
|
|
-- Compilation
|
|
|
|
--
|
|
|
|
|
|
|
|
-- Top level compilation bindings.
|
2020-03-07 17:41:37 -08:00
|
|
|
local rootChunk, rootScope, rootOptions
|
|
|
|
|
|
|
|
local function setResetRoot(oldChunk, oldScope, oldOptions)
|
|
|
|
local oldResetRoot = resetRoot -- this needs to nest!
|
|
|
|
resetRoot = function()
|
|
|
|
rootChunk, rootScope, rootOptions = oldChunk, oldScope, oldOptions
|
|
|
|
resetRoot = oldResetRoot
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
local GLOBAL_SCOPE
|
|
|
|
|
|
|
|
-- Create a new Scope, optionally under a parent scope. Scopes are compile time
|
|
|
|
-- constructs that are responsible for keeping track of local variables, name
|
|
|
|
-- mangling, and macros. They are accessible to user code via the
|
|
|
|
-- 'eval-compiler' special form (may change). They use metatables to implement
|
|
|
|
-- nesting via metatables.
|
2019-12-02 18:30:30 -08:00
|
|
|
local function makeScope(parent)
|
2020-03-07 17:41:37 -08:00
|
|
|
if not parent then parent = GLOBAL_SCOPE end
|
2019-12-02 18:30:30 -08:00
|
|
|
return {
|
|
|
|
unmanglings = setmetatable({}, {
|
|
|
|
__index = parent and parent.unmanglings
|
|
|
|
}),
|
|
|
|
manglings = setmetatable({}, {
|
|
|
|
__index = parent and parent.manglings
|
|
|
|
}),
|
|
|
|
specials = setmetatable({}, {
|
|
|
|
__index = parent and parent.specials
|
|
|
|
}),
|
|
|
|
symmeta = setmetatable({}, {
|
|
|
|
__index = parent and parent.symmeta
|
|
|
|
}),
|
|
|
|
includes = setmetatable({}, {
|
|
|
|
__index = parent and parent.includes
|
|
|
|
}),
|
2020-03-07 17:41:37 -08:00
|
|
|
refedglobals = setmetatable({}, {
|
|
|
|
__index = parent and parent.refedglobals
|
|
|
|
}),
|
2019-12-02 18:30:30 -08:00
|
|
|
autogensyms = {},
|
|
|
|
parent = parent,
|
|
|
|
vararg = parent and parent.vararg,
|
|
|
|
depth = parent and ((parent.depth or 0) + 1) or 0,
|
|
|
|
hashfn = parent and parent.hashfn
|
|
|
|
}
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Assert a condition and raise a compile error with line numbers. The ast arg
|
|
|
|
-- should be unmodified so that its first element is the form being called.
|
|
|
|
local function assertCompile(condition, msg, ast)
|
|
|
|
-- if we use regular `assert' we can't provide the `level' argument of zero
|
|
|
|
if not condition then
|
2020-03-07 17:41:37 -08:00
|
|
|
if resetRoot then resetRoot() end
|
2019-12-02 18:30:30 -08:00
|
|
|
error(string.format("Compile error in '%s' %s:%s: %s",
|
|
|
|
isSym(ast[1]) and ast[1][1] or ast[1] or '()',
|
|
|
|
ast.filename or "unknown", ast.line or '?', msg), 0)
|
|
|
|
end
|
|
|
|
return condition
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
GLOBAL_SCOPE = makeScope()
|
2019-12-02 18:30:30 -08:00
|
|
|
GLOBAL_SCOPE.vararg = true
|
|
|
|
local SPECIALS = GLOBAL_SCOPE.specials
|
|
|
|
local COMPILER_SCOPE = makeScope(GLOBAL_SCOPE)
|
|
|
|
|
|
|
|
local luaKeywords = {
|
|
|
|
'and', 'break', 'do', 'else', 'elseif', 'end', 'false', 'for', 'function',
|
|
|
|
'if', 'in', 'local', 'nil', 'not', 'or', 'repeat', 'return', 'then', 'true',
|
|
|
|
'until', 'while'
|
|
|
|
}
|
2020-03-07 17:41:37 -08:00
|
|
|
|
|
|
|
for i, v in ipairs(luaKeywords) do luaKeywords[v] = i end
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
local function isValidLuaIdentifier(str)
|
|
|
|
return (str:match('^[%a_][%w_]*$') and not luaKeywords[str])
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Allow printing a string to Lua, also keep as 1 line.
|
|
|
|
local serializeSubst = {
|
|
|
|
['\a'] = '\\a',
|
|
|
|
['\b'] = '\\b',
|
|
|
|
['\f'] = '\\f',
|
|
|
|
['\n'] = 'n',
|
|
|
|
['\t'] = '\\t',
|
|
|
|
['\v'] = '\\v'
|
|
|
|
}
|
|
|
|
local function serializeString(str)
|
|
|
|
local s = ("%q"):format(str)
|
|
|
|
s = s:gsub('.', serializeSubst):gsub("[\128-\255]", function(c)
|
|
|
|
return "\\" .. c:byte()
|
|
|
|
end)
|
|
|
|
return s
|
|
|
|
end
|
|
|
|
|
|
|
|
-- A multi symbol is a symbol that is actually composed of
|
|
|
|
-- two or more symbols using the dot syntax. The main differences
|
|
|
|
-- from normal symbols is that they cannot be declared local, and
|
|
|
|
-- they may have side effects on invocation (metatables)
|
|
|
|
local function isMultiSym(str)
|
|
|
|
if isSym(str) then
|
|
|
|
return isMultiSym(tostring(str))
|
|
|
|
end
|
|
|
|
if type(str) ~= 'string' then return end
|
|
|
|
local parts = {}
|
|
|
|
for part in str:gmatch('[^%.%:]+[%.%:]?') do
|
|
|
|
local lastChar = part:sub(-1)
|
|
|
|
if lastChar == ":" then
|
|
|
|
parts.multiSymMethodCall = true
|
|
|
|
end
|
|
|
|
if lastChar == ":" or lastChar == "." then
|
|
|
|
parts[#parts + 1] = part:sub(1, -2)
|
|
|
|
else
|
|
|
|
parts[#parts + 1] = part
|
|
|
|
end
|
|
|
|
end
|
|
|
|
return #parts > 0 and
|
|
|
|
(str:match('%.') or str:match(':')) and
|
|
|
|
(not str:match('%.%.')) and
|
|
|
|
str:byte() ~= string.byte '.' and
|
|
|
|
str:byte(-1) ~= string.byte '.' and
|
|
|
|
parts
|
|
|
|
end
|
|
|
|
|
|
|
|
local function isQuoted(symbol) return symbol.quoted end
|
|
|
|
|
|
|
|
-- Mangler for global symbols. Does not protect against collisions,
|
|
|
|
-- but makes them unlikely. This is the mangling that is exposed to
|
|
|
|
-- to the world.
|
|
|
|
local function globalMangling(str)
|
|
|
|
if isValidLuaIdentifier(str) then
|
|
|
|
return str
|
|
|
|
end
|
|
|
|
-- Use underscore as escape character
|
|
|
|
return '__fnl_global__' .. str:gsub('[^%w]', function (c)
|
|
|
|
return ('_%02x'):format(c:byte())
|
|
|
|
end)
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Reverse a global mangling. Takes a Lua identifier and
|
|
|
|
-- returns the fennel symbol string that created it.
|
|
|
|
local function globalUnmangling(identifier)
|
|
|
|
local rest = identifier:match('^__fnl_global__(.*)$')
|
|
|
|
if rest then
|
2020-03-07 17:41:37 -08:00
|
|
|
local r = rest:gsub('_[%da-f][%da-f]', function (code)
|
2019-12-02 18:30:30 -08:00
|
|
|
return string.char(tonumber(code:sub(2), 16))
|
|
|
|
end)
|
2020-03-07 17:41:37 -08:00
|
|
|
return r -- don't return multiple values
|
2019-12-02 18:30:30 -08:00
|
|
|
else
|
|
|
|
return identifier
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- If there's a provided list of allowed globals, don't let references thru that
|
|
|
|
-- aren't on the list. This list is set at the compiler entry points of compile
|
|
|
|
-- and compileStream.
|
|
|
|
local allowedGlobals
|
|
|
|
|
|
|
|
local function globalAllowed(name)
|
|
|
|
if not allowedGlobals then return true end
|
|
|
|
for _, g in ipairs(allowedGlobals) do
|
|
|
|
if g == name then return true end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
-- Creates a symbol from a string by mangling it.
|
|
|
|
-- ensures that the generated symbol is unique
|
|
|
|
-- if the input string is unique in the scope.
|
2020-03-07 17:41:37 -08:00
|
|
|
local function localMangling(str, scope, ast, tempManglings)
|
2019-12-02 18:30:30 -08:00
|
|
|
local append = 0
|
|
|
|
local mangling = str
|
|
|
|
assertCompile(not isMultiSym(str), 'did not expect multi symbol ' .. str, ast)
|
|
|
|
|
|
|
|
-- Mapping mangling to a valid Lua identifier
|
|
|
|
if luaKeywords[mangling] or mangling:match('^%d') then
|
|
|
|
mangling = '_' .. mangling
|
|
|
|
end
|
|
|
|
mangling = mangling:gsub('-', '_')
|
|
|
|
mangling = mangling:gsub('[^%w_]', function (c)
|
|
|
|
return ('_%02x'):format(c:byte())
|
|
|
|
end)
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- Prevent name collisions with existing symbols
|
2019-12-02 18:30:30 -08:00
|
|
|
local raw = mangling
|
|
|
|
while scope.unmanglings[mangling] do
|
|
|
|
mangling = raw .. append
|
|
|
|
append = append + 1
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
scope.unmanglings[mangling] = str
|
2020-03-07 17:41:37 -08:00
|
|
|
local manglings = tempManglings or scope.manglings
|
|
|
|
manglings[str] = mangling
|
2019-12-02 18:30:30 -08:00
|
|
|
return mangling
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- Calling this function will mean that further
|
|
|
|
-- compilation in scope will use these new manglings
|
|
|
|
-- instead of the current manglings.
|
|
|
|
local function applyManglings(scope, newManglings, ast)
|
|
|
|
for raw, mangled in pairs(newManglings) do
|
|
|
|
assertCompile(not scope.refedglobals[mangled],
|
|
|
|
"use of global " .. raw .. " is aliased by a local", ast)
|
|
|
|
scope.manglings[raw] = mangled
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
-- Combine parts of a symbol
|
|
|
|
local function combineParts(parts, scope)
|
|
|
|
local ret = scope.manglings[parts[1]] or globalMangling(parts[1])
|
|
|
|
for i = 2, #parts do
|
|
|
|
if isValidLuaIdentifier(parts[i]) then
|
|
|
|
if parts.multiSymMethodCall and i == #parts then
|
|
|
|
ret = ret .. ':' .. parts[i]
|
|
|
|
else
|
|
|
|
ret = ret .. '.' .. parts[i]
|
|
|
|
end
|
|
|
|
else
|
|
|
|
ret = ret .. '[' .. serializeString(parts[i]) .. ']'
|
|
|
|
end
|
|
|
|
end
|
|
|
|
return ret
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Generates a unique symbol in the scope.
|
|
|
|
local function gensym(scope, base)
|
|
|
|
local mangling
|
|
|
|
local append = 0
|
|
|
|
repeat
|
|
|
|
mangling = (base or '') .. '_' .. append .. '_'
|
|
|
|
append = append + 1
|
|
|
|
until not scope.unmanglings[mangling]
|
|
|
|
scope.unmanglings[mangling] = true
|
|
|
|
return mangling
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Generates a unique symbol in the scope based on the base name. Calling
|
|
|
|
-- repeatedly with the same base and same scope will return existing symbol
|
|
|
|
-- rather than generating new one.
|
|
|
|
local function autogensym(base, scope)
|
|
|
|
if scope.autogensyms[base] then return scope.autogensyms[base] end
|
|
|
|
local mangling = gensym(scope, base)
|
|
|
|
scope.autogensyms[base] = mangling
|
|
|
|
return mangling
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Check if a binding is valid
|
|
|
|
local function checkBindingValid(symbol, scope, ast)
|
|
|
|
-- Check if symbol will be over shadowed by special
|
|
|
|
local name = symbol[1]
|
|
|
|
assertCompile(not scope.specials[name],
|
|
|
|
("symbol %s may be overshadowed by a special form or macro"):format(name), ast)
|
|
|
|
assertCompile(not isQuoted(symbol), 'macro tried to bind ' .. name ..
|
2020-03-07 17:41:37 -08:00
|
|
|
" without gensym; try ' .. name .. '# instead", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Declare a local symbol
|
2020-03-07 17:41:37 -08:00
|
|
|
local function declareLocal(symbol, meta, scope, ast, tempManglings)
|
2019-12-02 18:30:30 -08:00
|
|
|
checkBindingValid(symbol, scope, ast)
|
|
|
|
local name = symbol[1]
|
|
|
|
assertCompile(not isMultiSym(name), "did not expect mutltisym", ast)
|
2020-03-07 17:41:37 -08:00
|
|
|
local mangling = localMangling(name, scope, ast, tempManglings)
|
2019-12-02 18:30:30 -08:00
|
|
|
scope.symmeta[name] = meta
|
|
|
|
return mangling
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Convert symbol to Lua code. Will only work for local symbols
|
|
|
|
-- if they have already been declared via declareLocal
|
|
|
|
local function symbolToExpression(symbol, scope, isReference)
|
|
|
|
local name = symbol[1]
|
|
|
|
local multiSymParts = isMultiSym(name)
|
|
|
|
if scope.hashfn then
|
|
|
|
if name == '$' then name = '$1' end
|
|
|
|
if multiSymParts then
|
|
|
|
if multiSymParts[1] == "$" then
|
|
|
|
multiSymParts[1] = "$1"
|
|
|
|
name = table.concat(multiSymParts, ".")
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
local parts = multiSymParts or {name}
|
|
|
|
local etype = (#parts > 1) and "expression" or "sym"
|
|
|
|
local isLocal = scope.manglings[parts[1]]
|
|
|
|
if isLocal and scope.symmeta[parts[1]] then scope.symmeta[parts[1]].used = true end
|
|
|
|
-- if it's a reference and not a symbol which introduces a new binding
|
|
|
|
-- then we need to check for allowed globals
|
|
|
|
assertCompile(not isReference or isLocal or globalAllowed(parts[1]),
|
|
|
|
'unknown global in strict mode: ' .. parts[1], symbol)
|
2020-03-07 17:41:37 -08:00
|
|
|
if not isLocal then
|
|
|
|
rootScope.refedglobals[parts[1]] = true
|
|
|
|
end
|
2019-12-02 18:30:30 -08:00
|
|
|
return expr(combineParts(parts, scope), etype)
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
-- Emit Lua code
|
|
|
|
local function emit(chunk, out, ast)
|
|
|
|
if type(out) == 'table' then
|
|
|
|
table.insert(chunk, out)
|
|
|
|
else
|
|
|
|
table.insert(chunk, {leaf = out, ast = ast})
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Do some peephole optimization.
|
|
|
|
local function peephole(chunk)
|
|
|
|
if chunk.leaf then return chunk end
|
|
|
|
-- Optimize do ... end in some cases.
|
|
|
|
if #chunk == 3 and
|
|
|
|
chunk[1].leaf == 'do' and
|
|
|
|
not chunk[2].leaf and
|
|
|
|
chunk[3].leaf == 'end' then
|
|
|
|
return peephole(chunk[2])
|
|
|
|
end
|
|
|
|
-- Recurse
|
2020-03-07 17:41:37 -08:00
|
|
|
return map(chunk, peephole)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
-- correlate line numbers in input with line numbers in output
|
|
|
|
local function flattenChunkCorrelated(mainChunk)
|
|
|
|
local function flatten(chunk, out, lastLine, file)
|
|
|
|
if chunk.leaf then
|
|
|
|
out[lastLine] = (out[lastLine] or "") .. " " .. chunk.leaf
|
|
|
|
else
|
|
|
|
for _, subchunk in ipairs(chunk) do
|
|
|
|
-- Ignore empty chunks
|
|
|
|
if subchunk.leaf or #subchunk > 0 then
|
|
|
|
-- don't increase line unless it's from the same file
|
|
|
|
if subchunk.ast and file == subchunk.ast.file then
|
|
|
|
lastLine = math.max(lastLine, subchunk.ast.line or 0)
|
|
|
|
end
|
|
|
|
lastLine = flatten(subchunk, out, lastLine, file)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
return lastLine
|
|
|
|
end
|
|
|
|
local out = {}
|
|
|
|
local last = flatten(mainChunk, out, 1, mainChunk.file)
|
|
|
|
for i = 1, last do
|
|
|
|
if out[i] == nil then out[i] = "" end
|
|
|
|
end
|
|
|
|
return table.concat(out, "\n")
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Flatten a tree of indented Lua source code lines.
|
|
|
|
-- Tab is what is used to indent a block.
|
|
|
|
local function flattenChunk(sm, chunk, tab, depth)
|
|
|
|
if type(tab) == 'boolean' then tab = tab and ' ' or '' end
|
|
|
|
if chunk.leaf then
|
|
|
|
local code = chunk.leaf
|
|
|
|
local info = chunk.ast
|
|
|
|
-- Just do line info for now to save memory
|
|
|
|
if sm then sm[#sm + 1] = info and info.line or -1 end
|
|
|
|
return code
|
|
|
|
else
|
2020-03-07 17:41:37 -08:00
|
|
|
local parts = map(chunk, function(c)
|
|
|
|
if c.leaf or #c > 0 then -- Ignore empty chunks
|
|
|
|
local sub = flattenChunk(sm, c, tab, depth + 1)
|
2019-12-02 18:30:30 -08:00
|
|
|
if depth > 0 then sub = tab .. sub:gsub('\n', '\n' .. tab) end
|
2020-03-07 17:41:37 -08:00
|
|
|
return sub
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
end)
|
2019-12-02 18:30:30 -08:00
|
|
|
return table.concat(parts, '\n')
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Some global state for all fennel sourcemaps. For the time being,
|
|
|
|
-- this seems the easiest way to store the source maps.
|
|
|
|
-- Sourcemaps are stored with source being mapped as the key, prepended
|
|
|
|
-- with '@' if it is a filename (like debug.getinfo returns for source).
|
|
|
|
-- The value is an array of mappings for each line.
|
|
|
|
local fennelSourcemap = {}
|
|
|
|
-- TODO: loading, unloading, and saving sourcemaps?
|
|
|
|
|
|
|
|
local function makeShortSrc(source)
|
|
|
|
source = source:gsub('\n', ' ')
|
|
|
|
if #source <= 49 then
|
|
|
|
return '[fennel "' .. source .. '"]'
|
|
|
|
else
|
|
|
|
return '[fennel "' .. source:sub(1, 46) .. '..."]'
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Return Lua source and source map table
|
|
|
|
local function flatten(chunk, options)
|
|
|
|
chunk = peephole(chunk)
|
|
|
|
if(options.correlate) then
|
|
|
|
return flattenChunkCorrelated(chunk), {}
|
|
|
|
else
|
|
|
|
local sm = {}
|
|
|
|
local ret = flattenChunk(sm, chunk, options.indent, 0)
|
|
|
|
if sm then
|
|
|
|
local key, short_src
|
|
|
|
if options.filename then
|
|
|
|
short_src = options.filename
|
|
|
|
key = '@' .. short_src
|
|
|
|
else
|
|
|
|
key = ret
|
|
|
|
short_src = makeShortSrc(options.source or ret)
|
|
|
|
end
|
|
|
|
sm.short_src = short_src
|
|
|
|
sm.key = key
|
|
|
|
fennelSourcemap[key] = sm
|
|
|
|
end
|
|
|
|
return ret, sm
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- module-wide state for metadata
|
|
|
|
-- create metadata table with weakly-referenced keys
|
|
|
|
local function makeMetadata()
|
|
|
|
return setmetatable({}, {
|
|
|
|
__mode = 'k',
|
|
|
|
__index = {
|
|
|
|
get = function(self, tgt, key)
|
|
|
|
if self[tgt] then return self[tgt][key] end
|
|
|
|
end,
|
|
|
|
set = function(self, tgt, key, value)
|
|
|
|
self[tgt] = self[tgt] or {}
|
|
|
|
self[tgt][key] = value
|
|
|
|
return tgt
|
|
|
|
end,
|
|
|
|
setall = function(self, tgt, ...)
|
|
|
|
local kvLen, kvs = select('#', ...), {...}
|
|
|
|
if kvLen % 2 ~= 0 then
|
|
|
|
error('metadata:setall() expected even number of k/v pairs')
|
|
|
|
end
|
|
|
|
self[tgt] = self[tgt] or {}
|
|
|
|
for i = 1, kvLen, 2 do self[tgt][kvs[i]] = kvs[i + 1] end
|
|
|
|
return tgt
|
|
|
|
end,
|
|
|
|
}})
|
|
|
|
end
|
|
|
|
|
|
|
|
local metadata = makeMetadata()
|
|
|
|
local doc = function(tgt, name)
|
|
|
|
if(not tgt) then return name .. " not found" end
|
|
|
|
local docstring = (metadata:get(tgt, 'fnl/docstring') or
|
|
|
|
'#<undocumented>'):gsub('\n$', ''):gsub('\n', '\n ')
|
|
|
|
if type(tgt) == "function" then
|
|
|
|
local arglist = table.concat(metadata:get(tgt, 'fnl/arglist') or
|
|
|
|
{'#<unknown-arguments>'}, ' ')
|
|
|
|
return string.format("(%s%s%s)\n %s", name, #arglist > 0 and ' ' or '',
|
|
|
|
arglist, docstring)
|
|
|
|
else
|
|
|
|
return string.format("%s\n %s", name, docstring)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
local function docSpecial(name, arglist, docstring)
|
|
|
|
metadata[SPECIALS[name]] =
|
2020-03-07 17:41:37 -08:00
|
|
|
{ ["fnl/docstring"] = docstring, ["fnl/arglist"] = arglist }
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
-- Convert expressions to Lua string
|
|
|
|
local function exprs1(exprs)
|
2020-03-07 17:41:37 -08:00
|
|
|
return table.concat(map(exprs, 1), ', ')
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
-- Compile side effects for a chunk
|
|
|
|
local function keepSideEffects(exprs, chunk, start, ast)
|
|
|
|
start = start or 1
|
|
|
|
for j = start, #exprs do
|
|
|
|
local se = exprs[j]
|
|
|
|
-- Avoid the rogue 'nil' expression (nil is usually a literal,
|
|
|
|
-- but becomes an expression if a special form
|
|
|
|
-- returns 'nil'.)
|
|
|
|
if se.type == 'expression' and se[1] ~= 'nil' then
|
|
|
|
emit(chunk, ('do local _ = %s end'):format(tostring(se)), ast)
|
|
|
|
elseif se.type == 'statement' then
|
|
|
|
local code = tostring(se)
|
|
|
|
emit(chunk, code:byte() == 40 and ("do end " .. code) or code , ast)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Does some common handling of returns and register
|
|
|
|
-- targets for special forms. Also ensures a list expression
|
|
|
|
-- has an acceptable number of expressions if opts contains the
|
|
|
|
-- "nval" option.
|
|
|
|
local function handleCompileOpts(exprs, parent, opts, ast)
|
|
|
|
if opts.nval then
|
|
|
|
local n = opts.nval
|
|
|
|
if n ~= #exprs then
|
|
|
|
local len = #exprs
|
|
|
|
if len > n then
|
|
|
|
-- Drop extra
|
|
|
|
keepSideEffects(exprs, parent, n + 1, ast)
|
|
|
|
for i = n + 1, len do
|
|
|
|
exprs[i] = nil
|
|
|
|
end
|
|
|
|
else
|
|
|
|
-- Pad with nils
|
|
|
|
for i = #exprs + 1, n do
|
|
|
|
exprs[i] = expr('nil', 'literal')
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
if opts.tail then
|
|
|
|
emit(parent, ('return %s'):format(exprs1(exprs)), ast)
|
|
|
|
end
|
|
|
|
if opts.target then
|
|
|
|
emit(parent, ('%s = %s'):format(opts.target, exprs1(exprs)), ast)
|
|
|
|
end
|
|
|
|
if opts.tail or opts.target then
|
|
|
|
-- Prevent statements and expression from being used twice if they
|
|
|
|
-- have side-effects. Since if the target or tail options are set,
|
|
|
|
-- the expressions are already emitted, we should not return them. This
|
|
|
|
-- is fine, as when these options are set, the caller doesn't need the result
|
|
|
|
-- anyways.
|
|
|
|
exprs = {}
|
|
|
|
end
|
|
|
|
return exprs
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Compile an AST expression in the scope into parent, a tree
|
|
|
|
-- of lines that is eventually compiled into Lua code. Also
|
|
|
|
-- returns some information about the evaluation of the compiled expression,
|
|
|
|
-- which can be used by the calling function. Macros
|
|
|
|
-- are resolved here, as well as special forms in that order.
|
|
|
|
-- the 'ast' param is the root AST to compile
|
|
|
|
-- the 'scope' param is the scope in which we are compiling
|
|
|
|
-- the 'parent' param is the table of lines that we are compiling into.
|
|
|
|
-- add lines to parent by appending strings. Add indented blocks by appending
|
|
|
|
-- tables of more lines.
|
|
|
|
-- the 'opts' param contains info about where the form is being compiled.
|
|
|
|
-- Options include:
|
|
|
|
-- 'target' - mangled name of symbol(s) being compiled to.
|
|
|
|
-- Could be one variable, 'a', or a list, like 'a, b, _0_'.
|
|
|
|
-- 'tail' - boolean indicating tail position if set. If set, form will generate a return
|
|
|
|
-- instruction.
|
|
|
|
-- 'nval' - The number of values to compile to if it is known to be a fixed value.
|
2020-03-07 17:41:37 -08:00
|
|
|
|
|
|
|
-- In Lua, an expression can evaluate to 0 or more values via multiple
|
|
|
|
-- returns. In many cases, Lua will drop extra values and convert a 0 value
|
|
|
|
-- expression to nil. In other cases, Lua will use all of the values in an
|
|
|
|
-- expression, such as in the last argument of a function call. Nval is an
|
|
|
|
-- option passed to compile1 to say that the resulting expression should have
|
|
|
|
-- at least n values. It lets us generate better code, because if we know we
|
|
|
|
-- are only going to use 1 or 2 values from an expression, we can create 1 or 2
|
|
|
|
-- locals to store intermediate results rather than turn the expression into a
|
|
|
|
-- closure that is called immediately, which we have to do if we don't know.
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
local function compile1(ast, scope, parent, opts)
|
|
|
|
opts = opts or {}
|
|
|
|
local exprs = {}
|
|
|
|
|
|
|
|
-- Compile the form
|
|
|
|
if isList(ast) then
|
|
|
|
-- Function call or special form
|
|
|
|
local len = #ast
|
|
|
|
assertCompile(len > 0, "expected a function to call", ast)
|
|
|
|
-- Test for special form
|
|
|
|
local first = ast[1]
|
|
|
|
if isSym(first) then -- Resolve symbol
|
|
|
|
first = first[1]
|
|
|
|
end
|
|
|
|
local multiSymParts = isMultiSym(first)
|
|
|
|
local special = scope.specials[first]
|
|
|
|
if special and isSym(ast[1]) then
|
|
|
|
-- Special form
|
|
|
|
exprs = special(ast, scope, parent, opts) or expr('nil', 'literal')
|
|
|
|
-- Be very accepting of strings or expression
|
|
|
|
-- as well as lists or expressions
|
|
|
|
if type(exprs) == 'string' then exprs = expr(exprs, 'expression') end
|
|
|
|
if getmetatable(exprs) == EXPR_MT then exprs = {exprs} end
|
|
|
|
-- Unless the special form explicitly handles the target, tail, and
|
|
|
|
-- nval properties, (indicated via the 'returned' flag), handle
|
|
|
|
-- these options.
|
|
|
|
if not exprs.returned then
|
|
|
|
exprs = handleCompileOpts(exprs, parent, opts, ast)
|
|
|
|
elseif opts.tail or opts.target then
|
|
|
|
exprs = {}
|
|
|
|
end
|
|
|
|
exprs.returned = true
|
|
|
|
return exprs
|
|
|
|
elseif multiSymParts and multiSymParts.multiSymMethodCall then
|
|
|
|
local tableWithMethod = table.concat({
|
|
|
|
unpack(multiSymParts, 1, #multiSymParts - 1)
|
|
|
|
}, '.')
|
|
|
|
local methodToCall = multiSymParts[#multiSymParts]
|
|
|
|
local newAST = list(sym(':', scope), sym(tableWithMethod, scope), methodToCall)
|
|
|
|
for i = 2, len do
|
|
|
|
newAST[#newAST + 1] = ast[i]
|
|
|
|
end
|
|
|
|
local compiled = compile1(newAST, scope, parent, opts)
|
|
|
|
exprs = compiled
|
|
|
|
else
|
|
|
|
-- Function call
|
|
|
|
local fargs = {}
|
|
|
|
local fcallee = compile1(ast[1], scope, parent, {
|
|
|
|
nval = 1
|
|
|
|
})[1]
|
|
|
|
assertCompile(fcallee.type ~= 'literal',
|
|
|
|
'cannot call literal value', ast)
|
|
|
|
fcallee = tostring(fcallee)
|
|
|
|
for i = 2, len do
|
|
|
|
local subexprs = compile1(ast[i], scope, parent, {
|
|
|
|
nval = i ~= len and 1 or nil
|
|
|
|
})
|
|
|
|
fargs[#fargs + 1] = subexprs[1] or expr('nil', 'literal')
|
|
|
|
if i == len then
|
|
|
|
-- Add sub expressions to function args
|
|
|
|
for j = 2, #subexprs do
|
|
|
|
fargs[#fargs + 1] = subexprs[j]
|
|
|
|
end
|
|
|
|
else
|
|
|
|
-- Emit sub expression only for side effects
|
|
|
|
keepSideEffects(subexprs, parent, 2, ast[i])
|
|
|
|
end
|
|
|
|
end
|
|
|
|
local call = ('%s(%s)'):format(tostring(fcallee), exprs1(fargs))
|
|
|
|
exprs = handleCompileOpts({expr(call, 'statement')}, parent, opts, ast)
|
|
|
|
end
|
|
|
|
elseif isVarg(ast) then
|
|
|
|
assertCompile(scope.vararg, "unexpected vararg", ast)
|
|
|
|
exprs = handleCompileOpts({expr('...', 'varg')}, parent, opts, ast)
|
|
|
|
elseif isSym(ast) then
|
|
|
|
local e
|
|
|
|
local multiSymParts = isMultiSym(ast)
|
|
|
|
assertCompile(not (multiSymParts and multiSymParts.multiSymMethodCall),
|
|
|
|
"multisym method calls may only be in call position", ast)
|
|
|
|
-- Handle nil as special symbol - it resolves to the nil literal rather than
|
|
|
|
-- being unmangled. Alternatively, we could remove it from the lua keywords table.
|
|
|
|
if ast[1] == 'nil' then
|
|
|
|
e = expr('nil', 'literal')
|
|
|
|
else
|
|
|
|
e = symbolToExpression(ast, scope, true)
|
|
|
|
end
|
|
|
|
exprs = handleCompileOpts({e}, parent, opts, ast)
|
|
|
|
elseif type(ast) == 'nil' or type(ast) == 'boolean' then
|
|
|
|
exprs = handleCompileOpts({expr(tostring(ast), 'literal')}, parent, opts)
|
|
|
|
elseif type(ast) == 'number' then
|
|
|
|
local n = ('%.17g'):format(ast)
|
|
|
|
exprs = handleCompileOpts({expr(n, 'literal')}, parent, opts)
|
|
|
|
elseif type(ast) == 'string' then
|
|
|
|
local s = serializeString(ast)
|
|
|
|
exprs = handleCompileOpts({expr(s, 'literal')}, parent, opts)
|
|
|
|
elseif type(ast) == 'table' then
|
|
|
|
local buffer = {}
|
|
|
|
for i = 1, #ast do -- Write numeric keyed values.
|
|
|
|
local nval = i ~= #ast and 1
|
|
|
|
buffer[#buffer + 1] = exprs1(compile1(ast[i], scope, parent, {nval = nval}))
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
local function writeOtherValues(k)
|
2019-12-02 18:30:30 -08:00
|
|
|
if type(k) ~= 'number' or math.floor(k) ~= k or k < 1 or k > #ast then
|
|
|
|
if type(k) == 'string' and isValidLuaIdentifier(k) then
|
2020-03-07 17:41:37 -08:00
|
|
|
return {k, k}
|
2019-12-02 18:30:30 -08:00
|
|
|
else
|
2020-03-07 17:41:37 -08:00
|
|
|
local kstr = '[' .. tostring(compile1(k, scope, parent,
|
|
|
|
{nval = 1})[1]) .. ']'
|
|
|
|
return { kstr, k }
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
local keys = kvmap(ast, writeOtherValues)
|
2019-12-02 18:30:30 -08:00
|
|
|
table.sort(keys, function (a, b) return a[1] < b[1] end)
|
2020-03-07 17:41:37 -08:00
|
|
|
map(keys, function(k)
|
|
|
|
local v = tostring(compile1(ast[k[2]], scope, parent, {nval = 1})[1])
|
|
|
|
return ('%s = %s'):format(k[1], v) end,
|
|
|
|
buffer)
|
2019-12-02 18:30:30 -08:00
|
|
|
local tbl = '{' .. table.concat(buffer, ', ') ..'}'
|
|
|
|
exprs = handleCompileOpts({expr(tbl, 'expression')}, parent, opts, ast)
|
|
|
|
else
|
|
|
|
assertCompile(false, 'could not compile value of type ' .. type(ast), ast)
|
|
|
|
end
|
|
|
|
exprs.returned = true
|
|
|
|
return exprs
|
|
|
|
end
|
|
|
|
|
|
|
|
-- SPECIALS --
|
|
|
|
|
|
|
|
-- For statements and expressions, put the value in a local to avoid
|
|
|
|
-- double-evaluating it.
|
|
|
|
local function once(val, ast, scope, parent)
|
|
|
|
if val.type == 'statement' or val.type == 'expression' then
|
|
|
|
local s = gensym(scope)
|
|
|
|
emit(parent, ('local %s = %s'):format(s, tostring(val)), ast)
|
|
|
|
return expr(s, 'sym')
|
|
|
|
else
|
|
|
|
return val
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Implements destructuring for forms like let, bindings, etc.
|
|
|
|
-- Takes a number of options to control behavior.
|
|
|
|
-- var: Whether or not to mark symbols as mutable
|
|
|
|
-- declaration: begin each assignment with 'local' in output
|
|
|
|
-- nomulti: disallow multisyms in the destructuring. Used for (local) and (global).
|
|
|
|
-- noundef: Don't set undefined bindings. (set)
|
|
|
|
-- forceglobal: Don't allow local bindings
|
|
|
|
local function destructure(to, from, ast, scope, parent, opts)
|
|
|
|
opts = opts or {}
|
|
|
|
local isvar = opts.isvar
|
|
|
|
local declaration = opts.declaration
|
|
|
|
local nomulti = opts.nomulti
|
|
|
|
local noundef = opts.noundef
|
|
|
|
local forceglobal = opts.forceglobal
|
|
|
|
local forceset = opts.forceset
|
|
|
|
local setter = declaration and "local %s = %s" or "%s = %s"
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
local newManglings = {}
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
-- Get Lua source for symbol, and check for errors
|
|
|
|
local function getname(symbol, up1)
|
|
|
|
local raw = symbol[1]
|
|
|
|
assertCompile(not (nomulti and isMultiSym(raw)),
|
|
|
|
'did not expect multisym', up1)
|
|
|
|
if declaration then
|
2020-03-07 17:41:37 -08:00
|
|
|
return declareLocal(symbol, {var = isvar}, scope, symbol, newManglings)
|
2019-12-02 18:30:30 -08:00
|
|
|
else
|
|
|
|
local parts = isMultiSym(raw) or {raw}
|
|
|
|
local meta = scope.symmeta[parts[1]]
|
|
|
|
if #parts == 1 and not forceset then
|
|
|
|
assertCompile(not(forceglobal and meta),
|
|
|
|
'expected global, found var', up1)
|
|
|
|
assertCompile(meta or not noundef,
|
|
|
|
'expected local var ' .. parts[1], up1)
|
|
|
|
assertCompile(not (meta and not meta.var),
|
|
|
|
'expected local var', up1)
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
if forceglobal then
|
|
|
|
assertCompile(not scope.symmeta[scope.unmanglings[raw]],
|
|
|
|
"global " .. raw .. " conflicts with local", ast)
|
|
|
|
scope.manglings[raw] = globalMangling(raw)
|
|
|
|
scope.unmanglings[globalMangling(raw)] = raw
|
|
|
|
if allowedGlobals then
|
|
|
|
table.insert(allowedGlobals, raw)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
return symbolToExpression(symbol, scope)[1]
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Compile the outer most form. We can generate better Lua in this case.
|
|
|
|
local function compileTopTarget(lvalues)
|
|
|
|
-- Calculate initial rvalue
|
2020-03-07 17:41:37 -08:00
|
|
|
local inits = map(lvalues, function(x)
|
|
|
|
return scope.manglings[x] and x or 'nil' end)
|
2019-12-02 18:30:30 -08:00
|
|
|
local init = table.concat(inits, ', ')
|
|
|
|
local lvalue = table.concat(lvalues, ', ')
|
|
|
|
|
|
|
|
local plen = #parent
|
|
|
|
local ret = compile1(from, scope, parent, {target = lvalue})
|
|
|
|
if declaration then
|
|
|
|
if #parent == plen + 1 and parent[#parent].leaf then
|
|
|
|
-- A single leaf emitted means an simple assignment a = x was emitted
|
|
|
|
parent[#parent].leaf = 'local ' .. parent[#parent].leaf
|
|
|
|
else
|
|
|
|
table.insert(parent, plen + 1, { leaf = 'local ' .. lvalue ..
|
|
|
|
' = ' .. init, ast = ast})
|
|
|
|
end
|
|
|
|
end
|
|
|
|
return ret
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Recursive auxiliary function
|
|
|
|
local function destructure1(left, rightexprs, up1, top)
|
|
|
|
if isSym(left) and left[1] ~= "nil" then
|
|
|
|
checkBindingValid(left, scope, left)
|
|
|
|
local lname = getname(left, up1)
|
|
|
|
if top then
|
|
|
|
compileTopTarget({lname})
|
|
|
|
else
|
|
|
|
emit(parent, setter:format(lname, exprs1(rightexprs)), left)
|
|
|
|
end
|
|
|
|
elseif isTable(left) then -- table destructuring
|
|
|
|
if top then rightexprs = compile1(from, scope, parent) end
|
|
|
|
local s = gensym(scope)
|
|
|
|
emit(parent, ("local %s = %s"):format(s, exprs1(rightexprs)), left)
|
|
|
|
for k, v in pairs(left) do
|
|
|
|
if isSym(left[k]) and left[k][1] == "&" then
|
|
|
|
assertCompile(type(k) == "number" and not left[k+2],
|
|
|
|
"expected rest argument in final position", left)
|
|
|
|
local subexpr = expr(('{(table.unpack or unpack)(%s, %s)}'):format(s, k),
|
|
|
|
'expression')
|
|
|
|
destructure1(left[k+1], {subexpr}, left)
|
|
|
|
return
|
|
|
|
else
|
|
|
|
if isSym(k) and tostring(k) == ":" and isSym(v) then k = tostring(v) end
|
|
|
|
if type(k) ~= "number" then k = serializeString(k) end
|
|
|
|
local subexpr = expr(('%s[%s]'):format(s, k), 'expression')
|
|
|
|
destructure1(v, {subexpr}, left)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
elseif isList(left) then -- values destructuring
|
|
|
|
local leftNames, tables = {}, {}
|
|
|
|
for i, name in ipairs(left) do
|
|
|
|
local symname
|
|
|
|
if isSym(name) then -- binding directly to a name
|
|
|
|
symname = getname(name, up1)
|
|
|
|
else -- further destructuring of tables inside values
|
|
|
|
symname = gensym(scope)
|
|
|
|
tables[i] = {name, expr(symname, 'sym')}
|
|
|
|
end
|
|
|
|
table.insert(leftNames, symname)
|
|
|
|
end
|
|
|
|
if top then
|
|
|
|
compileTopTarget(leftNames)
|
|
|
|
else
|
|
|
|
local lvalue = table.concat(leftNames, ', ')
|
|
|
|
emit(parent, setter:format(lvalue, exprs1(rightexprs)), left)
|
|
|
|
end
|
|
|
|
for _, pair in pairs(tables) do -- recurse if left-side tables found
|
|
|
|
destructure1(pair[1], {pair[2]}, left)
|
|
|
|
end
|
|
|
|
else
|
|
|
|
assertCompile(false, 'unable to bind ' .. tostring(left), up1)
|
|
|
|
end
|
|
|
|
if top then return {returned = true} end
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
local ret = destructure1(to, nil, ast, true)
|
|
|
|
applyManglings(scope, newManglings, ast)
|
|
|
|
return ret
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
-- Unlike most expressions and specials, 'values' resolves with multiple
|
|
|
|
-- values, one for each argument, allowing multiple return values. The last
|
|
|
|
-- expression can return multiple arguments as well, allowing for more than the number
|
|
|
|
-- of expected arguments.
|
|
|
|
local function values(ast, scope, parent)
|
|
|
|
local len = #ast
|
|
|
|
local exprs = {}
|
|
|
|
for i = 2, len do
|
|
|
|
local subexprs = compile1(ast[i], scope, parent, {
|
|
|
|
nval = (i ~= len) and 1
|
|
|
|
})
|
|
|
|
exprs[#exprs + 1] = subexprs[1]
|
|
|
|
if i == len then
|
|
|
|
for j = 2, #subexprs do
|
|
|
|
exprs[#exprs + 1] = subexprs[j]
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
return exprs
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Compile a list of forms for side effects
|
|
|
|
local function compileDo(ast, scope, parent, start)
|
|
|
|
start = start or 2
|
|
|
|
local len = #ast
|
|
|
|
local subScope = makeScope(scope)
|
|
|
|
for i = start, len do
|
|
|
|
compile1(ast[i], subScope, parent, {
|
|
|
|
nval = 0
|
|
|
|
})
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- Raises compile error if unused locals are found and we're checking for them.
|
|
|
|
local function checkUnused(scope, ast)
|
|
|
|
if not rootOptions.checkUnusedLocals then return end
|
|
|
|
for symName in pairs(scope.symmeta) do
|
|
|
|
assertCompile(scope.symmeta[symName].used or symName:find("^_"),
|
|
|
|
("unused local %s"):format(symName), ast)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
-- Implements a do statement, starting at the 'start' element. By default, start is 2.
|
|
|
|
local function doImpl(ast, scope, parent, opts, start, chunk, subScope)
|
|
|
|
start = start or 2
|
|
|
|
subScope = subScope or makeScope(scope)
|
|
|
|
chunk = chunk or {}
|
|
|
|
local len = #ast
|
|
|
|
local outerTarget = opts.target
|
|
|
|
local outerTail = opts.tail
|
|
|
|
local retexprs = {returned = true}
|
|
|
|
|
|
|
|
-- See if we need special handling to get the return values
|
|
|
|
-- of the do block
|
|
|
|
if not outerTarget and opts.nval ~= 0 and not outerTail then
|
|
|
|
if opts.nval then
|
|
|
|
-- Generate a local target
|
|
|
|
local syms = {}
|
|
|
|
for i = 1, opts.nval do
|
|
|
|
local s = gensym(scope)
|
|
|
|
syms[i] = s
|
|
|
|
retexprs[i] = expr(s, 'sym')
|
|
|
|
end
|
|
|
|
outerTarget = table.concat(syms, ', ')
|
|
|
|
emit(parent, ('local %s'):format(outerTarget), ast)
|
|
|
|
emit(parent, 'do', ast)
|
|
|
|
else
|
|
|
|
-- We will use an IIFE for the do
|
|
|
|
local fname = gensym(scope)
|
|
|
|
local fargs = scope.vararg and '...' or ''
|
|
|
|
emit(parent, ('local function %s(%s)'):format(fname, fargs), ast)
|
|
|
|
retexprs = expr(fname .. '(' .. fargs .. ')', 'statement')
|
|
|
|
outerTail = true
|
|
|
|
outerTarget = nil
|
|
|
|
end
|
|
|
|
else
|
|
|
|
emit(parent, 'do', ast)
|
|
|
|
end
|
|
|
|
-- Compile the body
|
|
|
|
if start > len then
|
|
|
|
-- In the unlikely case we do a do with no arguments.
|
|
|
|
compile1(nil, subScope, chunk, {
|
|
|
|
tail = outerTail,
|
|
|
|
target = outerTarget
|
|
|
|
})
|
|
|
|
-- There will be no side effects
|
|
|
|
else
|
|
|
|
for i = start, len do
|
|
|
|
local subopts = {
|
|
|
|
nval = i ~= len and 0 or opts.nval,
|
|
|
|
tail = i == len and outerTail or nil,
|
|
|
|
target = i == len and outerTarget or nil
|
|
|
|
}
|
|
|
|
local subexprs = compile1(ast[i], subScope, chunk, subopts)
|
|
|
|
if i ~= len then
|
|
|
|
keepSideEffects(subexprs, parent, nil, ast[i])
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
emit(parent, chunk, ast)
|
|
|
|
emit(parent, 'end', ast)
|
2020-03-07 17:41:37 -08:00
|
|
|
checkUnused(subScope, ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
return retexprs
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["do"] = doImpl
|
|
|
|
docSpecial("do", {"..."}, "Evaluate multiple forms; return last value.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["values"] = values
|
|
|
|
docSpecial("values", {"..."},
|
|
|
|
"Return multiple values from a function. Must be in tail position.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
-- The fn special declares a function. Syntax is similar to other lisps;
|
|
|
|
-- (fn optional-name [arg ...] (body))
|
|
|
|
-- Further decoration such as docstrings, meta info, and multibody functions a possibility.
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["fn"] = function(ast, scope, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
local fScope = makeScope(scope)
|
|
|
|
local fChunk = {}
|
|
|
|
local index = 2
|
|
|
|
local fnName = isSym(ast[index])
|
|
|
|
local isLocalFn
|
|
|
|
local docstring
|
|
|
|
fScope.vararg = false
|
|
|
|
if fnName and fnName[1] ~= 'nil' then
|
|
|
|
isLocalFn = not isMultiSym(fnName[1])
|
|
|
|
if isLocalFn then
|
|
|
|
fnName = declareLocal(fnName, {}, scope, ast)
|
|
|
|
else
|
|
|
|
fnName = symbolToExpression(fnName, scope)[1]
|
|
|
|
end
|
|
|
|
index = index + 1
|
|
|
|
else
|
|
|
|
isLocalFn = true
|
|
|
|
fnName = gensym(scope)
|
|
|
|
end
|
|
|
|
local argList = assertCompile(isTable(ast[index]),
|
2020-03-07 17:41:37 -08:00
|
|
|
"expected vector arg list [a b ...]", ast)
|
|
|
|
local function getArgName(i, name)
|
|
|
|
if isVarg(name) then
|
|
|
|
assertCompile(i == #argList, "expected vararg as last parameter", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
fScope.vararg = true
|
2020-03-07 17:41:37 -08:00
|
|
|
return "..."
|
|
|
|
elseif(isSym(name) and deref(name) ~= "nil"
|
|
|
|
and not isMultiSym(deref(name))) then
|
|
|
|
return declareLocal(name, {}, fScope, ast)
|
|
|
|
elseif isTable(name) then
|
2019-12-02 18:30:30 -08:00
|
|
|
local raw = sym(gensym(scope))
|
2020-03-07 17:41:37 -08:00
|
|
|
local declared = declareLocal(raw, {}, fScope, ast)
|
|
|
|
destructure(name, raw, ast, fScope, fChunk,
|
2019-12-02 18:30:30 -08:00
|
|
|
{ declaration = true, nomulti = true })
|
2020-03-07 17:41:37 -08:00
|
|
|
return declared
|
2019-12-02 18:30:30 -08:00
|
|
|
else
|
2020-03-07 17:41:37 -08:00
|
|
|
assertCompile(false, "expected symbol for function parameter", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
local argNameList = kvmap(argList, getArgName)
|
2019-12-02 18:30:30 -08:00
|
|
|
if type(ast[index + 1]) == 'string' and index + 1 < #ast then
|
|
|
|
index = index + 1
|
|
|
|
docstring = ast[index]
|
|
|
|
end
|
|
|
|
for i = index + 1, #ast do
|
|
|
|
compile1(ast[i], fScope, fChunk, {
|
|
|
|
tail = i == #ast,
|
|
|
|
nval = i ~= #ast and 0 or nil,
|
|
|
|
})
|
|
|
|
end
|
|
|
|
if isLocalFn then
|
|
|
|
emit(parent, ('local function %s(%s)')
|
|
|
|
:format(fnName, table.concat(argNameList, ', ')), ast)
|
|
|
|
else
|
|
|
|
emit(parent, ('%s = function(%s)')
|
|
|
|
:format(fnName, table.concat(argNameList, ', ')), ast)
|
|
|
|
end
|
|
|
|
|
|
|
|
emit(parent, fChunk, ast)
|
|
|
|
emit(parent, 'end', ast)
|
|
|
|
|
|
|
|
if rootOptions.useMetadata then
|
2020-03-07 17:41:37 -08:00
|
|
|
local args = map(argList, function(v)
|
2019-12-02 18:30:30 -08:00
|
|
|
-- TODO: show destructured args properly instead of replacing
|
2020-03-07 17:41:37 -08:00
|
|
|
return isTable(v) and '"#<table>"' or string.format('"%s"', tostring(v))
|
|
|
|
end)
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
local metaFields = {
|
|
|
|
'"fnl/arglist"', '{' .. table.concat(args, ', ') .. '}',
|
|
|
|
}
|
|
|
|
if docstring then
|
|
|
|
table.insert(metaFields, '"fnl/docstring"')
|
|
|
|
table.insert(metaFields, '"' .. docstring:gsub('%s+$', '')
|
|
|
|
:gsub('\\', '\\\\'):gsub('\n', '\\n')
|
|
|
|
:gsub('"', '\\"') .. '"')
|
|
|
|
end
|
|
|
|
local metaStr = ('require("%s").metadata'):format(rootOptions.moduleName or "fennel")
|
|
|
|
emit(parent, string.format('%s:setall(%s, %s)', metaStr,
|
|
|
|
fnName, table.concat(metaFields, ', ')))
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
checkUnused(fScope, ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
return expr(fnName, 'sym')
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("fn", {"name?", "args", "docstring?", "..."},
|
|
|
|
"Function syntax. May optionally include a name and docstring."
|
|
|
|
.."\nIf a name is provided, the function will be bound in the current scope."
|
|
|
|
.."\nWhen called with the wrong number of args, excess args will be discarded"
|
|
|
|
.."\nand lacking args will be nil, use lambda for arity-checked functions.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
-- (lua "print('hello!')") -> prints hello, evaluates to nil
|
|
|
|
-- (lua "print 'hello!'" "10") -> prints hello, evaluates to the number 10
|
|
|
|
-- (lua nil "{1,2,3}") -> Evaluates to a table literal
|
|
|
|
SPECIALS['lua'] = function(ast, _, parent)
|
|
|
|
assertCompile(#ast == 2 or #ast == 3,
|
|
|
|
"expected 2 or 3 arguments in 'lua' special form", ast)
|
|
|
|
if ast[2] ~= nil then
|
|
|
|
table.insert(parent, {leaf = tostring(ast[2]), ast = ast})
|
|
|
|
end
|
|
|
|
if #ast == 3 then
|
|
|
|
return tostring(ast[3])
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
SPECIALS['doc'] = function(ast, scope, parent)
|
|
|
|
assert(rootOptions.useMetadata, "can't look up doc with metadata disabled.")
|
|
|
|
assertCompile(#ast == 2, "expected one argument", ast)
|
|
|
|
|
|
|
|
local target = deref(ast[2])
|
|
|
|
local special = scope.specials[target]
|
|
|
|
if special then
|
|
|
|
return ("print([[%s]])"):format(doc(special, target))
|
|
|
|
else
|
|
|
|
local value = tostring(compile1(ast[2], scope, parent, {nval = 1})[1])
|
|
|
|
-- need to require here since the metadata is stored in the module
|
|
|
|
-- and we need to make sure we look it up in the same module it was
|
|
|
|
-- declared from.
|
|
|
|
return ("print(require('%s').doc(%s, '%s'))")
|
|
|
|
:format(rootOptions.moduleName or "fennel", value, tostring(ast[2]))
|
|
|
|
end
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("doc", {"x"},
|
|
|
|
"Print the docstring and arglist for a function, macro, or special form.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
-- Table lookup
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["."] = function(ast, scope, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
local len = #ast
|
|
|
|
assertCompile(len > 1, "expected table argument", ast)
|
|
|
|
local lhs = compile1(ast[2], scope, parent, {nval = 1})
|
|
|
|
if len == 2 then
|
|
|
|
return tostring(lhs[1])
|
|
|
|
else
|
|
|
|
local indices = {}
|
|
|
|
for i = 3, len do
|
|
|
|
local index = ast[i]
|
|
|
|
if type(index) == 'string' and isValidLuaIdentifier(index) then
|
|
|
|
table.insert(indices, '.' .. index)
|
|
|
|
else
|
|
|
|
index = compile1(index, scope, parent, {nval = 1})[1]
|
|
|
|
table.insert(indices, '[' .. tostring(index) .. ']')
|
|
|
|
end
|
|
|
|
end
|
|
|
|
-- extra parens are needed for table literals
|
|
|
|
if isTable(ast[2]) then
|
|
|
|
return '(' .. tostring(lhs[1]) .. ')' .. table.concat(indices)
|
|
|
|
else
|
|
|
|
return tostring(lhs[1]) .. table.concat(indices)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial(".", {"tbl", "key1", "..."},
|
|
|
|
"Look up key1 in tbl table. If more args are provided, do a nested lookup.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["global"] = function(ast, scope, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
assertCompile(#ast == 3, "expected name and value", ast)
|
|
|
|
destructure(ast[2], ast[3], ast, scope, parent, {
|
|
|
|
nomulti = true,
|
|
|
|
forceglobal = true
|
|
|
|
})
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("global", {"name", "val"}, "Set name as a global with val.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["set"] = function(ast, scope, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
assertCompile(#ast == 3, "expected name and value", ast)
|
|
|
|
destructure(ast[2], ast[3], ast, scope, parent, {
|
|
|
|
noundef = true
|
|
|
|
})
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("set", {"name", "val"},
|
|
|
|
"Set a local variable to a new value. Only works on locals using var.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["set-forcibly!"] = function(ast, scope, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
assertCompile(#ast == 3, "expected name and value", ast)
|
|
|
|
destructure(ast[2], ast[3], ast, scope, parent, {
|
|
|
|
forceset = true
|
|
|
|
})
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["local"] = function(ast, scope, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
assertCompile(#ast == 3, "expected name and value", ast)
|
|
|
|
destructure(ast[2], ast[3], ast, scope, parent, {
|
|
|
|
declaration = true,
|
|
|
|
nomulti = true
|
|
|
|
})
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("local", {"name", "val"},
|
|
|
|
"Introduce new top-level immutable local.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["var"] = function(ast, scope, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
assertCompile(#ast == 3, "expected name and value", ast)
|
|
|
|
destructure(ast[2], ast[3], ast, scope, parent, {
|
|
|
|
declaration = true,
|
|
|
|
nomulti = true,
|
|
|
|
isvar = true
|
|
|
|
})
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("var", {"name", "val"},
|
|
|
|
"Introduce new mutable local.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["let"] = function(ast, scope, parent, opts)
|
2019-12-02 18:30:30 -08:00
|
|
|
local bindings = ast[2]
|
|
|
|
assertCompile(isList(bindings) or isTable(bindings),
|
2020-03-07 17:41:37 -08:00
|
|
|
"expected table for destructuring", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
assertCompile(#bindings % 2 == 0,
|
2020-03-07 17:41:37 -08:00
|
|
|
"expected even number of name/value bindings", ast)
|
|
|
|
assertCompile(#ast >= 3, "missing body expression", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
local subScope = makeScope(scope)
|
|
|
|
local subChunk = {}
|
|
|
|
for i = 1, #bindings, 2 do
|
|
|
|
destructure(bindings[i], bindings[i + 1], ast, subScope, subChunk, {
|
|
|
|
declaration = true,
|
|
|
|
nomulti = true
|
|
|
|
})
|
|
|
|
end
|
|
|
|
return doImpl(ast, scope, parent, opts, 3, subChunk, subScope)
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("let", {"[name1 val1 ... nameN valN]", "..."},
|
|
|
|
"Introduces a new scope in which a given set of local bindings are used.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
-- For setting items in a table
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["tset"] = function(ast, scope, parent)
|
|
|
|
assertCompile(#ast > 3, ("tset form needs table, key, and value"), ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
local root = compile1(ast[2], scope, parent, {nval = 1})[1]
|
|
|
|
local keys = {}
|
|
|
|
for i = 3, #ast - 1 do
|
|
|
|
local key = compile1(ast[i], scope, parent, {nval = 1})[1]
|
|
|
|
keys[#keys + 1] = tostring(key)
|
|
|
|
end
|
|
|
|
local value = compile1(ast[#ast], scope, parent, {nval = 1})[1]
|
|
|
|
local rootstr = tostring(root)
|
|
|
|
-- Prefix 'do end ' so parens are not ambiguous (grouping or function call?)
|
2020-03-07 17:41:37 -08:00
|
|
|
local fmtstr = (rootstr:match("^{")) and "do end (%s)[%s] = %s" or "%s[%s] = %s"
|
2019-12-02 18:30:30 -08:00
|
|
|
emit(parent, fmtstr:format(tostring(root),
|
|
|
|
table.concat(keys, ']['),
|
|
|
|
tostring(value)), ast)
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("tset", {"tbl", "key1", "...", "keyN", "val"},
|
|
|
|
"Set the value of a table field. Can take additional keys to set"
|
|
|
|
.. "nested values,\nbut all parents must contain an existing table.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
-- The if special form behaves like the cond form in
|
|
|
|
-- many languages
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["if"] = function(ast, scope, parent, opts)
|
2019-12-02 18:30:30 -08:00
|
|
|
local doScope = makeScope(scope)
|
|
|
|
local branches = {}
|
|
|
|
local elseBranch = nil
|
|
|
|
|
|
|
|
-- Calculate some external stuff. Optimizes for tail calls and what not
|
|
|
|
local wrapper, innerTail, innerTarget, targetExprs
|
|
|
|
if opts.tail or opts.target or opts.nval then
|
|
|
|
if opts.nval and opts.nval ~= 0 and not opts.target then
|
|
|
|
-- We need to create a target
|
|
|
|
targetExprs = {}
|
|
|
|
local accum = {}
|
|
|
|
for i = 1, opts.nval do
|
|
|
|
local s = gensym(scope)
|
|
|
|
accum[i] = s
|
|
|
|
targetExprs[i] = expr(s, 'sym')
|
|
|
|
end
|
|
|
|
wrapper = 'target'
|
|
|
|
innerTail = opts.tail
|
|
|
|
innerTarget = table.concat(accum, ', ')
|
|
|
|
else
|
|
|
|
wrapper = 'none'
|
|
|
|
innerTail = opts.tail
|
|
|
|
innerTarget = opts.target
|
|
|
|
end
|
|
|
|
else
|
|
|
|
wrapper = 'iife'
|
|
|
|
innerTail = true
|
|
|
|
innerTarget = nil
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Compile bodies and conditions
|
|
|
|
local bodyOpts = {
|
|
|
|
tail = innerTail,
|
|
|
|
target = innerTarget,
|
|
|
|
nval = opts.nval
|
|
|
|
}
|
|
|
|
local function compileBody(i)
|
|
|
|
local chunk = {}
|
|
|
|
local cscope = makeScope(doScope)
|
|
|
|
keepSideEffects(compile1(ast[i], cscope, chunk, bodyOpts),
|
|
|
|
chunk, nil, ast[i])
|
|
|
|
return {
|
|
|
|
chunk = chunk,
|
|
|
|
scope = cscope
|
|
|
|
}
|
|
|
|
end
|
|
|
|
for i = 2, #ast - 1, 2 do
|
|
|
|
local condchunk = {}
|
|
|
|
local res = compile1(ast[i], doScope, condchunk, {nval = 1})
|
|
|
|
local cond = res[1]
|
|
|
|
local branch = compileBody(i + 1)
|
|
|
|
branch.cond = cond
|
|
|
|
branch.condchunk = condchunk
|
|
|
|
branch.nested = i ~= 2 and next(condchunk, nil) == nil
|
|
|
|
table.insert(branches, branch)
|
|
|
|
end
|
|
|
|
local hasElse = #ast > 3 and #ast % 2 == 0
|
|
|
|
if hasElse then elseBranch = compileBody(#ast) end
|
|
|
|
|
|
|
|
-- Emit code
|
|
|
|
local s = gensym(scope)
|
|
|
|
local buffer = {}
|
|
|
|
local lastBuffer = buffer
|
|
|
|
for i = 1, #branches do
|
|
|
|
local branch = branches[i]
|
|
|
|
local fstr = not branch.nested and 'if %s then' or 'elseif %s then'
|
|
|
|
local cond = tostring(branch.cond)
|
|
|
|
local condLine = (cond == "true" and branch.nested and i == #branches)
|
|
|
|
and "else"
|
|
|
|
or fstr:format(cond)
|
|
|
|
if branch.nested then
|
|
|
|
emit(lastBuffer, branch.condchunk, ast)
|
|
|
|
else
|
|
|
|
for _, v in ipairs(branch.condchunk) do emit(lastBuffer, v, ast) end
|
|
|
|
end
|
|
|
|
emit(lastBuffer, condLine, ast)
|
|
|
|
emit(lastBuffer, branch.chunk, ast)
|
|
|
|
if i == #branches then
|
|
|
|
if hasElse then
|
|
|
|
emit(lastBuffer, 'else', ast)
|
|
|
|
emit(lastBuffer, elseBranch.chunk, ast)
|
2020-03-07 17:41:37 -08:00
|
|
|
-- TODO: Consolidate use of condLine ~= "else" with hasElse
|
|
|
|
elseif(innerTarget and condLine ~= 'else') then
|
|
|
|
emit(lastBuffer, 'else', ast)
|
|
|
|
emit(lastBuffer, ("%s = nil"):format(innerTarget), ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
emit(lastBuffer, 'end', ast)
|
|
|
|
elseif not branches[i + 1].nested then
|
|
|
|
emit(lastBuffer, 'else', ast)
|
|
|
|
local nextBuffer = {}
|
|
|
|
emit(lastBuffer, nextBuffer, ast)
|
|
|
|
emit(lastBuffer, 'end', ast)
|
|
|
|
lastBuffer = nextBuffer
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
if wrapper == 'iife' then
|
|
|
|
local iifeargs = scope.vararg and '...' or ''
|
|
|
|
emit(parent, ('local function %s(%s)'):format(tostring(s), iifeargs), ast)
|
|
|
|
emit(parent, buffer, ast)
|
|
|
|
emit(parent, 'end', ast)
|
|
|
|
return expr(('%s(%s)'):format(tostring(s), iifeargs), 'statement')
|
|
|
|
elseif wrapper == 'none' then
|
|
|
|
-- Splice result right into code
|
|
|
|
for i = 1, #buffer do
|
|
|
|
emit(parent, buffer[i], ast)
|
|
|
|
end
|
|
|
|
return {returned = true}
|
|
|
|
else -- wrapper == 'target'
|
|
|
|
emit(parent, ('local %s'):format(innerTarget), ast)
|
|
|
|
for i = 1, #buffer do
|
|
|
|
emit(parent, buffer[i], ast)
|
|
|
|
end
|
|
|
|
return targetExprs
|
|
|
|
end
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("if", {"cond1", "body1", "...", "condN", "bodyN"},
|
|
|
|
"Conditional form.\n" ..
|
|
|
|
"Takes any number of condition/body pairs and evaluates the first body where"
|
|
|
|
.. "\nthe condition evaluates to truthy. Similar to cond in other lisps.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
-- (each [k v (pairs t)] body...) => []
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["each"] = function(ast, scope, parent)
|
|
|
|
local binding = assertCompile(isTable(ast[2]), "expected binding table", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
local iter = table.remove(binding, #binding) -- last item is iterator call
|
|
|
|
local destructures = {}
|
2020-03-07 17:41:37 -08:00
|
|
|
local newManglings = {}
|
|
|
|
local function destructureBinding(v)
|
|
|
|
assertCompile(isSym(v) or isTable(v), "expected iterator symbol or table", ast)
|
|
|
|
if isSym(v) then
|
|
|
|
return declareLocal(v, {}, scope, ast, newManglings)
|
2019-12-02 18:30:30 -08:00
|
|
|
else
|
|
|
|
local raw = sym(gensym(scope))
|
|
|
|
destructures[raw] = v
|
2020-03-07 17:41:37 -08:00
|
|
|
return declareLocal(raw, {}, scope, ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
local bindVars = map(binding, destructureBinding)
|
|
|
|
local vals = compile1(iter, scope, parent)
|
|
|
|
local valNames = map(vals, tostring)
|
|
|
|
|
|
|
|
emit(parent, ('for %s in %s do'):format(table.concat(bindVars, ', '),
|
|
|
|
table.concat(valNames, ", ")), ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
local chunk = {}
|
|
|
|
for raw, args in pairs(destructures) do
|
|
|
|
destructure(args, raw, ast, scope, chunk,
|
|
|
|
{ declaration = true, nomulti = true })
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
applyManglings(scope, newManglings, ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
compileDo(ast, scope, chunk, 3)
|
|
|
|
emit(parent, chunk, ast)
|
|
|
|
emit(parent, 'end', ast)
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("each", {"[key value (iterator)]", "..."},
|
|
|
|
"Runs the body once for each set of values provided by the given iterator."
|
|
|
|
.."\nMost commonly used with ipairs for sequential tables or pairs for"
|
|
|
|
.." undefined\norder, but can be used with any iterator.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
-- (while condition body...) => []
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["while"] = function(ast, scope, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
local len1 = #parent
|
|
|
|
local condition = compile1(ast[2], scope, parent, {nval = 1})[1]
|
|
|
|
local len2 = #parent
|
|
|
|
local subChunk = {}
|
|
|
|
if len1 ~= len2 then
|
|
|
|
-- Compound condition
|
|
|
|
-- Move new compilation to subchunk
|
|
|
|
for i = len1 + 1, len2 do
|
|
|
|
subChunk[#subChunk + 1] = parent[i]
|
|
|
|
parent[i] = nil
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
emit(parent, 'while true do', ast)
|
|
|
|
emit(subChunk, ('if not %s then break end'):format(condition[1]), ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
else
|
|
|
|
-- Simple condition
|
|
|
|
emit(parent, 'while ' .. tostring(condition) .. ' do', ast)
|
|
|
|
end
|
|
|
|
compileDo(ast, makeScope(scope), subChunk, 3)
|
|
|
|
emit(parent, subChunk, ast)
|
|
|
|
emit(parent, 'end', ast)
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("while", {"condition", "..."},
|
|
|
|
"The classic while loop. Evaluates body until a condition is non-truthy.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["for"] = function(ast, scope, parent)
|
|
|
|
local ranges = assertCompile(isTable(ast[2]), "expected binding table", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
local bindingSym = assertCompile(isSym(table.remove(ast[2], 1)),
|
2020-03-07 17:41:37 -08:00
|
|
|
"expected iterator symbol", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
local rangeArgs = {}
|
|
|
|
for i = 1, math.min(#ranges, 3) do
|
|
|
|
rangeArgs[i] = tostring(compile1(ranges[i], scope, parent, {nval = 1})[1])
|
|
|
|
end
|
|
|
|
emit(parent, ('for %s = %s do'):format(
|
|
|
|
declareLocal(bindingSym, {}, scope, ast),
|
|
|
|
table.concat(rangeArgs, ', ')), ast)
|
|
|
|
local chunk = {}
|
|
|
|
compileDo(ast, scope, chunk, 3)
|
|
|
|
emit(parent, chunk, ast)
|
|
|
|
emit(parent, 'end', ast)
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("for", {"[index start stop step?]", "..."}, "Numeric loop construct." ..
|
|
|
|
"\nEvaluates body once for each value between start and stop (inclusive).")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS[":"] = function(ast, scope, parent)
|
|
|
|
assertCompile(#ast >= 3, "expected at least 3 arguments", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
-- Compile object
|
|
|
|
local objectexpr = compile1(ast[2], scope, parent, {nval = 1})[1]
|
|
|
|
-- Compile method selector
|
|
|
|
local methodstring
|
|
|
|
local methodident = false
|
|
|
|
if type(ast[3]) == 'string' and isValidLuaIdentifier(ast[3]) then
|
|
|
|
methodident = true
|
|
|
|
methodstring = ast[3]
|
|
|
|
else
|
|
|
|
methodstring = tostring(compile1(ast[3], scope, parent, {nval = 1})[1])
|
|
|
|
objectexpr = once(objectexpr, ast[2], scope, parent)
|
|
|
|
end
|
|
|
|
-- Compile arguments
|
|
|
|
local args = {}
|
|
|
|
for i = 4, #ast do
|
|
|
|
local subexprs = compile1(ast[i], scope, parent, {
|
|
|
|
nval = i ~= #ast and 1 or nil
|
|
|
|
})
|
2020-03-07 17:41:37 -08:00
|
|
|
map(subexprs, tostring, args)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
local fstring
|
|
|
|
if not methodident then
|
|
|
|
-- Make object first argument
|
|
|
|
table.insert(args, 1, tostring(objectexpr))
|
|
|
|
fstring = objectexpr.type == 'sym'
|
|
|
|
and '%s[%s](%s)'
|
|
|
|
or '(%s)[%s](%s)'
|
|
|
|
elseif(objectexpr.type == 'literal' or objectexpr.type == 'expression') then
|
|
|
|
fstring = '(%s):%s(%s)'
|
|
|
|
else
|
|
|
|
fstring = '%s:%s(%s)'
|
|
|
|
end
|
|
|
|
return expr(fstring:format(
|
|
|
|
tostring(objectexpr),
|
|
|
|
methodstring,
|
|
|
|
table.concat(args, ', ')), 'statement')
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial(":", {"tbl", "method-name", "..."},
|
|
|
|
"Call the named method on tbl with the provided args."..
|
|
|
|
"\nMethod name doesn\"t have to be known at compile-time; if it is, use"
|
|
|
|
.."\n(tbl:method-name ...) instead.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["comment"] = function(ast, _, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
local els = {}
|
|
|
|
for i = 2, #ast do
|
|
|
|
els[#els + 1] = tostring(ast[i]):gsub('\n', ' ')
|
|
|
|
end
|
|
|
|
emit(parent, ' -- ' .. table.concat(els, ' '), ast)
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("comment", {"..."}, "Comment which will be emitted in Lua output.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
SPECIALS["hashfn"] = function(ast, scope, parent)
|
2019-12-02 18:30:30 -08:00
|
|
|
assertCompile(#ast == 2, "expected one argument", ast)
|
|
|
|
local fScope = makeScope(scope)
|
|
|
|
local fChunk = {}
|
|
|
|
local name = gensym(scope)
|
|
|
|
local symbol = sym(name)
|
|
|
|
declareLocal(symbol, {}, scope, ast)
|
|
|
|
fScope.vararg = false
|
|
|
|
fScope.hashfn = true
|
|
|
|
local args = {}
|
|
|
|
for i = 1, 9 do args[i] = declareLocal(sym('$' .. i), {}, fScope, ast) end
|
|
|
|
-- Compile body
|
|
|
|
compile1(ast[2], fScope, fChunk, {tail = true})
|
|
|
|
local maxUsed = 0
|
|
|
|
for i = 1, 9 do if fScope.symmeta['$' .. i].used then maxUsed = i end end
|
|
|
|
local argStr = table.concat(args, ', ', 1, maxUsed)
|
|
|
|
emit(parent, ('local function %s(%s)'):format(name, argStr), ast)
|
|
|
|
emit(parent, fChunk, ast)
|
|
|
|
emit(parent, 'end', ast)
|
|
|
|
return expr(name, 'sym')
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("hashfn", {"..."}, "Function literal shorthand; args are $1, $2, etc.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
local function defineArithmeticSpecial(name, zeroArity, unaryPrefix)
|
|
|
|
local paddedOp = ' ' .. name .. ' '
|
|
|
|
SPECIALS[name] = function(ast, scope, parent)
|
|
|
|
local len = #ast
|
|
|
|
if len == 1 then
|
|
|
|
assertCompile(zeroArity ~= nil, 'Expected more than 0 arguments', ast)
|
|
|
|
return expr(zeroArity, 'literal')
|
|
|
|
else
|
|
|
|
local operands = {}
|
|
|
|
for i = 2, len do
|
|
|
|
local subexprs = compile1(ast[i], scope, parent, {
|
|
|
|
nval = (i == 1 and 1 or nil)
|
|
|
|
})
|
2020-03-07 17:41:37 -08:00
|
|
|
map(subexprs, tostring, operands)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
if #operands == 1 then
|
|
|
|
if unaryPrefix then
|
|
|
|
return '(' .. unaryPrefix .. paddedOp .. operands[1] .. ')'
|
|
|
|
else
|
|
|
|
return operands[1]
|
|
|
|
end
|
|
|
|
else
|
|
|
|
return '(' .. table.concat(operands, paddedOp) .. ')'
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial(name, {"a", "b", "..."},
|
|
|
|
"Arithmetic operator; works the same as Lua but accepts more arguments.")
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
defineArithmeticSpecial('+', '0')
|
|
|
|
defineArithmeticSpecial('..', "''")
|
|
|
|
defineArithmeticSpecial('^')
|
|
|
|
defineArithmeticSpecial('-', nil, '')
|
|
|
|
defineArithmeticSpecial('*', '1')
|
|
|
|
defineArithmeticSpecial('%')
|
|
|
|
defineArithmeticSpecial('/', nil, '1')
|
|
|
|
defineArithmeticSpecial('//', nil, '1')
|
|
|
|
defineArithmeticSpecial('or', 'false')
|
|
|
|
defineArithmeticSpecial('and', 'true')
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial("and", {"a", "b", "..."},
|
|
|
|
"Boolean operator; works the same as Lua but accepts more arguments.")
|
|
|
|
docSpecial("or", {"a", "b", "..."},
|
|
|
|
"Boolean operator; works the same as Lua but accepts more arguments.")
|
|
|
|
docSpecial("..", {"a", "b", "..."},
|
|
|
|
"String concatenation operator; works the same as Lua but accepts more arguments.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
local function defineComparatorSpecial(name, realop, chainOp)
|
|
|
|
local op = realop or name
|
|
|
|
SPECIALS[name] = function(ast, scope, parent)
|
|
|
|
local len = #ast
|
2020-03-07 17:41:37 -08:00
|
|
|
assertCompile(len > 2, "expected at least two arguments", ast)
|
2019-12-02 18:30:30 -08:00
|
|
|
local lhs = compile1(ast[2], scope, parent, {nval = 1})[1]
|
|
|
|
local lastval = compile1(ast[3], scope, parent, {nval = 1})[1]
|
|
|
|
-- avoid double-eval by introducing locals for possible side-effects
|
|
|
|
if len > 3 then lastval = once(lastval, ast[3], scope, parent) end
|
|
|
|
local out = ('(%s %s %s)'):
|
|
|
|
format(tostring(lhs), op, tostring(lastval))
|
|
|
|
if len > 3 then
|
|
|
|
for i = 4, len do -- variadic comparison
|
|
|
|
local nextval = once(compile1(ast[i], scope, parent, {nval = 1})[1],
|
|
|
|
ast[i], scope, parent)
|
|
|
|
out = (out .. " %s (%s %s %s)"):
|
|
|
|
format(chainOp or 'and', tostring(lastval), op, tostring(nextval))
|
|
|
|
lastval = nextval
|
|
|
|
end
|
|
|
|
out = '(' .. out .. ')'
|
|
|
|
end
|
|
|
|
return out
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial(name, {"a", "b", "..."},
|
|
|
|
"Comparison operator; works the same as Lua but accepts more arguments.")
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
defineComparatorSpecial('>')
|
|
|
|
defineComparatorSpecial('<')
|
|
|
|
defineComparatorSpecial('>=')
|
|
|
|
defineComparatorSpecial('<=')
|
|
|
|
defineComparatorSpecial('=', '==')
|
|
|
|
defineComparatorSpecial('not=', '~=', 'or')
|
|
|
|
SPECIALS["~="] = SPECIALS["not="] -- backwards-compatibility alias
|
|
|
|
|
|
|
|
local function defineUnarySpecial(op, realop)
|
|
|
|
SPECIALS[op] = function(ast, scope, parent)
|
|
|
|
assertCompile(#ast == 2, 'expected one argument', ast)
|
|
|
|
local tail = compile1(ast[2], scope, parent, {nval = 1})
|
|
|
|
return (realop or op) .. tostring(tail[1])
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
defineUnarySpecial("not", "not ")
|
|
|
|
docSpecial("not", {"x"}, "Logical operator; works the same as Lua.")
|
2019-12-02 18:30:30 -08:00
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
defineUnarySpecial("length", "#")
|
|
|
|
docSpecial("length", {"x"}, "Returns the length of a table or string.")
|
|
|
|
SPECIALS["#"] = SPECIALS["length"]
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
-- Save current macro scope
|
|
|
|
local macroCurrentScope = GLOBAL_SCOPE
|
|
|
|
|
|
|
|
-- Covert a macro function to a special form
|
|
|
|
local function macroToSpecial(mac)
|
|
|
|
local special = function(ast, scope, parent, opts)
|
|
|
|
local oldScope = macroCurrentScope
|
|
|
|
macroCurrentScope = scope
|
|
|
|
local ok, transformed = pcall(mac, unpack(ast, 2))
|
|
|
|
macroCurrentScope = oldScope
|
|
|
|
assertCompile(ok, transformed, ast)
|
|
|
|
local result = compile1(transformed, scope, parent, opts)
|
|
|
|
return result
|
|
|
|
end
|
|
|
|
if metadata[mac] then
|
|
|
|
-- copy metadata from original function to special form function
|
|
|
|
metadata[mac], metadata[special] = nil, metadata[mac]
|
|
|
|
end
|
|
|
|
return special
|
|
|
|
end
|
|
|
|
|
|
|
|
local requireSpecial
|
|
|
|
local function compile(ast, options)
|
2020-03-07 17:41:37 -08:00
|
|
|
local opts = copy(options)
|
2019-12-02 18:30:30 -08:00
|
|
|
local oldGlobals = allowedGlobals
|
2020-03-07 17:41:37 -08:00
|
|
|
setResetRoot(rootChunk, rootScope, rootOptions)
|
|
|
|
allowedGlobals = opts.allowedGlobals
|
|
|
|
if opts.indent == nil then opts.indent = ' ' end
|
2019-12-02 18:30:30 -08:00
|
|
|
local chunk = {}
|
2020-03-07 17:41:37 -08:00
|
|
|
local scope = opts.scope or makeScope(GLOBAL_SCOPE)
|
|
|
|
rootChunk, rootScope, rootOptions = chunk, scope, opts
|
|
|
|
if opts.requireAsInclude then scope.specials.require = requireSpecial end
|
2019-12-02 18:30:30 -08:00
|
|
|
local exprs = compile1(ast, scope, chunk, {tail = true})
|
|
|
|
keepSideEffects(exprs, chunk, nil, ast)
|
|
|
|
allowedGlobals = oldGlobals
|
2020-03-07 17:41:37 -08:00
|
|
|
resetRoot()
|
|
|
|
return flatten(chunk, opts)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
-- make a transformer for key / value table pairs, preserving all numeric keys
|
|
|
|
local function entryTransform(fk,fv)
|
|
|
|
return function(k, v)
|
|
|
|
if type(k) == 'number' then
|
|
|
|
return k,fv(v)
|
|
|
|
else
|
|
|
|
return fk(k),fv(v)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- consume everything return nothing
|
|
|
|
local function no() end
|
|
|
|
|
|
|
|
local function mixedConcat(t, joiner)
|
|
|
|
local ret = ""
|
|
|
|
local s = ""
|
|
|
|
local seen = {}
|
|
|
|
for k,v in ipairs(t) do
|
|
|
|
table.insert(seen, k)
|
|
|
|
ret = ret .. s .. v
|
|
|
|
s = joiner
|
|
|
|
end
|
|
|
|
for k,v in pairs(t) do
|
|
|
|
if not(seen[k]) then
|
|
|
|
ret = ret .. s .. '[' .. k .. ']' .. '=' .. v
|
|
|
|
s = joiner
|
|
|
|
end
|
|
|
|
end
|
|
|
|
return ret
|
|
|
|
end
|
|
|
|
|
|
|
|
-- expand a quoted form into a data literal, evaluating unquote
|
|
|
|
local function doQuote (form, scope, parent, runtime)
|
|
|
|
local q = function (x) return doQuote(x, scope, parent, runtime) end
|
|
|
|
-- vararg
|
|
|
|
if isVarg(form) then
|
|
|
|
assertCompile(not runtime, "quoted ... may only be used at compile time", form)
|
|
|
|
return "_VARARG"
|
|
|
|
-- symbol
|
|
|
|
elseif isSym(form) then
|
|
|
|
assertCompile(not runtime, "symbols may only be used at compile time", form)
|
|
|
|
if deref(form):find("#$") then -- autogensym
|
|
|
|
return ("sym('%s')"):format(autogensym(deref(form), scope))
|
|
|
|
else -- prevent non-gensymmed symbols from being bound as an identifier
|
|
|
|
return ("sym('%s', nil, {quoted=true})"):format(deref(form))
|
|
|
|
end
|
|
|
|
-- unquote
|
|
|
|
elseif isList(form) and isSym(form[1]) and (deref(form[1]) == 'unquote') then
|
|
|
|
local payload = form[2]
|
|
|
|
local res = unpack(compile1(payload, scope, parent))
|
|
|
|
return res[1]
|
|
|
|
-- list
|
|
|
|
elseif isList(form) then
|
|
|
|
assertCompile(not runtime, "lists may only be used at compile time", form)
|
2020-03-07 17:41:37 -08:00
|
|
|
local mapped = kvmap(form, entryTransform(no, q))
|
2019-12-02 18:30:30 -08:00
|
|
|
return 'list(' .. mixedConcat(mapped, ", ") .. ')'
|
|
|
|
-- table
|
|
|
|
elseif type(form) == 'table' then
|
2020-03-07 17:41:37 -08:00
|
|
|
local mapped = kvmap(form, entryTransform(q, q))
|
2019-12-02 18:30:30 -08:00
|
|
|
return '{' .. mixedConcat(mapped, ", ") .. '}'
|
|
|
|
-- string
|
|
|
|
elseif type(form) == 'string' then
|
|
|
|
return serializeString(form)
|
|
|
|
else
|
|
|
|
return tostring(form)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
SPECIALS['quote'] = function(ast, scope, parent)
|
|
|
|
assertCompile(#ast == 2, "quote only takes a single form")
|
|
|
|
local runtime, thisScope = true, scope
|
|
|
|
while thisScope do
|
|
|
|
thisScope = thisScope.parent
|
|
|
|
if thisScope == COMPILER_SCOPE then runtime = false end
|
|
|
|
end
|
|
|
|
return doQuote(ast[2], scope, parent, runtime)
|
|
|
|
end
|
|
|
|
docSpecial('quote', {'x'}, 'Quasiquote the following form. Only works in macro/compiler scope.')
|
|
|
|
|
|
|
|
local function compileStream(strm, options)
|
2020-03-07 17:41:37 -08:00
|
|
|
local opts = copy(options)
|
2019-12-02 18:30:30 -08:00
|
|
|
local oldGlobals = allowedGlobals
|
2020-03-07 17:41:37 -08:00
|
|
|
setResetRoot(rootChunk, rootScope, rootOptions)
|
|
|
|
allowedGlobals = opts.allowedGlobals
|
|
|
|
if opts.indent == nil then opts.indent = ' ' end
|
|
|
|
local scope = opts.scope or makeScope(GLOBAL_SCOPE)
|
|
|
|
if opts.requireAsInclude then scope.specials.require = requireSpecial end
|
2019-12-02 18:30:30 -08:00
|
|
|
local vals = {}
|
2020-03-07 17:41:37 -08:00
|
|
|
for ok, val in parser(strm, opts.filename) do
|
2019-12-02 18:30:30 -08:00
|
|
|
if not ok then break end
|
|
|
|
vals[#vals + 1] = val
|
|
|
|
end
|
|
|
|
local chunk = {}
|
2020-03-07 17:41:37 -08:00
|
|
|
rootChunk, rootScope, rootOptions = chunk, scope, opts
|
2019-12-02 18:30:30 -08:00
|
|
|
for i = 1, #vals do
|
|
|
|
local exprs = compile1(vals[i], scope, chunk, {
|
|
|
|
tail = i == #vals,
|
|
|
|
})
|
|
|
|
keepSideEffects(exprs, chunk, nil, vals[i])
|
|
|
|
end
|
|
|
|
allowedGlobals = oldGlobals
|
2020-03-07 17:41:37 -08:00
|
|
|
resetRoot()
|
|
|
|
return flatten(chunk, opts)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
local function compileString(str, options)
|
|
|
|
local strm = stringStream(str)
|
|
|
|
return compileStream(strm, options)
|
|
|
|
end
|
|
|
|
|
|
|
|
---
|
|
|
|
--- Evaluation
|
|
|
|
---
|
|
|
|
|
|
|
|
-- Convert a fennel environment table to a Lua environment table.
|
|
|
|
-- This means automatically unmangling globals when getting a value,
|
|
|
|
-- and mangling values when setting a value. This means the original
|
|
|
|
-- env will see its values updated as expected, regardless of mangling rules.
|
|
|
|
local function wrapEnv(env)
|
|
|
|
return setmetatable({}, {
|
|
|
|
__index = function(_, key)
|
|
|
|
if type(key) == 'string' then
|
|
|
|
key = globalUnmangling(key)
|
|
|
|
end
|
|
|
|
return env[key]
|
|
|
|
end,
|
|
|
|
__newindex = function(_, key, value)
|
|
|
|
if type(key) == 'string' then
|
|
|
|
key = globalMangling(key)
|
|
|
|
end
|
|
|
|
env[key] = value
|
|
|
|
end,
|
|
|
|
-- checking the __pairs metamethod won't work automatically in Lua 5.1
|
|
|
|
-- sadly, but it's important for 5.2+ and can be done manually in 5.1
|
|
|
|
__pairs = function()
|
2020-03-07 17:41:37 -08:00
|
|
|
local function putenv(k, v)
|
|
|
|
return type(k) == 'string' and globalUnmangling(k) or k, v
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
local pt = kvmap(env, putenv)
|
2019-12-02 18:30:30 -08:00
|
|
|
return next, pt, nil
|
|
|
|
end,
|
|
|
|
})
|
|
|
|
end
|
|
|
|
|
|
|
|
-- A custom traceback function for Fennel that looks similar to
|
|
|
|
-- the Lua's debug.traceback.
|
|
|
|
-- Use with xpcall to produce fennel specific stacktraces.
|
|
|
|
local function traceback(msg, start)
|
|
|
|
local level = start or 2 -- Can be used to skip some frames
|
|
|
|
local lines = {}
|
|
|
|
if msg then
|
2020-03-07 17:41:37 -08:00
|
|
|
if msg:find("^Compile error") then
|
|
|
|
table.insert(lines, msg)
|
|
|
|
else
|
|
|
|
local newmsg = msg:gsub('^[^:]*:%d+:%s+', 'runtime error: ')
|
|
|
|
table.insert(lines, newmsg)
|
|
|
|
end
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
table.insert(lines, 'stack traceback:')
|
|
|
|
while true do
|
|
|
|
local info = debug.getinfo(level, "Sln")
|
|
|
|
if not info then break end
|
|
|
|
local line
|
|
|
|
if info.what == "C" then
|
|
|
|
if info.name then
|
|
|
|
line = (' [C]: in function \'%s\''):format(info.name)
|
|
|
|
else
|
|
|
|
line = ' [C]: in ?'
|
|
|
|
end
|
|
|
|
else
|
|
|
|
local remap = fennelSourcemap[info.source]
|
|
|
|
if remap and remap[info.currentline] then
|
|
|
|
-- And some global info
|
|
|
|
info.short_src = remap.short_src
|
|
|
|
local mapping = remap[info.currentline]
|
|
|
|
-- Overwrite info with values from the mapping (mapping is now
|
|
|
|
-- just integer, but may eventually be a table)
|
|
|
|
info.currentline = mapping
|
|
|
|
end
|
|
|
|
if info.what == 'Lua' then
|
|
|
|
local n = info.name and ("'" .. info.name .. "'") or '?'
|
|
|
|
line = (' %s:%d: in function %s'):format(info.short_src, info.currentline, n)
|
|
|
|
elseif info.short_src == '(tail call)' then
|
|
|
|
line = ' (tail call)'
|
|
|
|
else
|
|
|
|
line = (' %s:%d: in main chunk'):format(info.short_src, info.currentline)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
table.insert(lines, line)
|
|
|
|
level = level + 1
|
|
|
|
end
|
|
|
|
return table.concat(lines, '\n')
|
|
|
|
end
|
|
|
|
|
|
|
|
local function currentGlobalNames(env)
|
2020-03-07 17:41:37 -08:00
|
|
|
return kvmap(env or _G, globalUnmangling)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
local function eval(str, options, ...)
|
2020-03-07 17:41:37 -08:00
|
|
|
local opts = copy(options)
|
2019-12-02 18:30:30 -08:00
|
|
|
-- eval and dofile are considered "live" entry points, so we can assume
|
|
|
|
-- that the globals available at compile time are a reasonable allowed list
|
|
|
|
-- UNLESS there's a metatable on env, in which case we can't assume that
|
|
|
|
-- pairs will return all the effective globals; for instance openresty
|
|
|
|
-- sets up _G in such a way that all the globals are available thru
|
|
|
|
-- the __index meta method, but as far as pairs is concerned it's empty.
|
2020-03-07 17:41:37 -08:00
|
|
|
if opts.allowedGlobals == nil and not getmetatable(opts.env) then
|
|
|
|
opts.allowedGlobals = currentGlobalNames(opts.env)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
local env = opts.env and wrapEnv(opts.env)
|
|
|
|
local luaSource = compileString(str, opts)
|
2019-12-02 18:30:30 -08:00
|
|
|
local loader = loadCode(luaSource, env,
|
2020-03-07 17:41:37 -08:00
|
|
|
opts.filename and ('@' .. opts.filename) or str)
|
|
|
|
opts.filename = nil
|
2019-12-02 18:30:30 -08:00
|
|
|
return loader(...)
|
|
|
|
end
|
|
|
|
|
|
|
|
local function dofileFennel(filename, options, ...)
|
2020-03-07 17:41:37 -08:00
|
|
|
local opts = copy(options)
|
|
|
|
if opts.allowedGlobals == nil then
|
|
|
|
opts.allowedGlobals = currentGlobalNames(opts.env)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
local f = assert(io.open(filename, "rb"))
|
|
|
|
local source = f:read("*all"):gsub("^#![^\n]*\n", "")
|
|
|
|
f:close()
|
2020-03-07 17:41:37 -08:00
|
|
|
opts.filename = filename
|
|
|
|
return eval(source, opts, ...)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
local macroLoaded = {}
|
|
|
|
|
|
|
|
local pathTable = {"./?.fnl", "./?/init.fnl"}
|
2020-03-07 17:41:37 -08:00
|
|
|
local osPath = os and os.getenv and os.getenv("FENNEL_PATH")
|
2019-12-02 18:30:30 -08:00
|
|
|
if osPath then
|
|
|
|
table.insert(pathTable, osPath)
|
|
|
|
end
|
|
|
|
|
|
|
|
local module = {
|
|
|
|
parser = parser,
|
|
|
|
granulate = granulate,
|
|
|
|
stringStream = stringStream,
|
|
|
|
compile = compile,
|
|
|
|
compileString = compileString,
|
|
|
|
compileStream = compileStream,
|
|
|
|
compile1 = compile1,
|
2020-03-07 17:41:37 -08:00
|
|
|
loadCode = loadCode,
|
2019-12-02 18:30:30 -08:00
|
|
|
mangle = globalMangling,
|
|
|
|
unmangle = globalUnmangling,
|
|
|
|
list = list,
|
|
|
|
sym = sym,
|
|
|
|
varg = varg,
|
|
|
|
scope = makeScope,
|
|
|
|
gensym = gensym,
|
|
|
|
eval = eval,
|
|
|
|
dofile = dofileFennel,
|
|
|
|
macroLoaded = macroLoaded,
|
|
|
|
path = table.concat(pathTable, ";"),
|
|
|
|
traceback = traceback,
|
2020-03-07 17:41:37 -08:00
|
|
|
version = "0.4.0-dev",
|
2019-12-02 18:30:30 -08:00
|
|
|
}
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- In order to make this more readable, you can switch your editor to treating
|
|
|
|
-- this file as if it were Fennel for the purposes of this section
|
|
|
|
local replsource = [===[(local (fennel internals) ...)
|
|
|
|
|
|
|
|
(fn default-read-chunk [parser-state]
|
|
|
|
(io.write (if (< 0 parser-state.stackSize) ".." ">> "))
|
|
|
|
(io.flush)
|
|
|
|
(let [input (io.read)]
|
|
|
|
(and input (.. input "\n"))))
|
|
|
|
|
|
|
|
(fn default-on-values [xs]
|
|
|
|
(io.write (table.concat xs "\t"))
|
|
|
|
(io.write "\n"))
|
|
|
|
|
|
|
|
(fn default-on-error [errtype err lua-source]
|
|
|
|
(io.write
|
|
|
|
(match errtype
|
|
|
|
"Lua Compile" (.. "Bad code generated - likely a bug with the compiler:\n"
|
|
|
|
"--- Generated Lua Start ---\n"
|
|
|
|
lua-source
|
|
|
|
"--- Generated Lua End ---\n")
|
|
|
|
"Runtime" (.. (fennel.traceback err 4) "\n")
|
|
|
|
_ (: "%s error: %s\n" :format errtype (tostring err)))))
|
|
|
|
|
|
|
|
(local save-source
|
|
|
|
(table.concat ["local ___i___ = 1"
|
|
|
|
"while true do"
|
|
|
|
" local name, value = debug.getlocal(1, ___i___)"
|
|
|
|
" if(name and name ~= \"___i___\") then"
|
|
|
|
" ___replLocals___[name] = value"
|
|
|
|
" ___i___ = ___i___ + 1"
|
|
|
|
" else break end end"] "\n"))
|
|
|
|
|
|
|
|
(fn splice-save-locals [env lua-source]
|
|
|
|
(set env.___replLocals___ (or env.___replLocals___ {}))
|
|
|
|
(let [spliced-source []
|
|
|
|
bind "local %s = ___replLocals___['%s']"]
|
|
|
|
(each [line (lua-source:gmatch "([^\n]+)\n?")]
|
|
|
|
(table.insert spliced-source line))
|
|
|
|
(each [name (pairs env.___replLocals___)]
|
|
|
|
(table.insert spliced-source 1 (bind:format name name)))
|
|
|
|
(when (and (: (. spliced-source (# spliced-source)) :match "^ *return .*$")
|
|
|
|
(< 1 (# spliced-source)))
|
|
|
|
(table.insert spliced-source (# spliced-source) save-source))
|
|
|
|
(table.concat spliced-source "\n")))
|
|
|
|
|
|
|
|
(fn completer [env scope text]
|
|
|
|
(let [matches []
|
|
|
|
input-fragment (text:gsub ".*[%s)(]+" "")]
|
|
|
|
(fn add-partials [input tbl prefix] ; add partial key matches in tbl
|
|
|
|
(each [k (pairs tbl)]
|
|
|
|
(let [k (if (or (= tbl env) (= tbl env.___replLocals___))
|
|
|
|
(. scope.unmanglings k)
|
|
|
|
k)]
|
|
|
|
(when (and (< (# matches) 40)
|
|
|
|
(= (type k) "string")
|
|
|
|
(= input (k:sub 0 (# input))))
|
|
|
|
(table.insert matches (.. prefix k))))))
|
|
|
|
(fn add-matches [input tbl prefix] ; add matches, descending into tbl fields
|
|
|
|
(let [prefix (if prefix (.. prefix ".") "")]
|
|
|
|
(if (not (input:find "%.")) ; no more dots, so add matches
|
|
|
|
(add-partials input tbl prefix)
|
|
|
|
(let [(head tail) (input:match "^([^.]+)%.(.*)")
|
|
|
|
raw-head (if (or (= tbl env) (= tbl env.___replLocals___))
|
|
|
|
(. scope.manglings head)
|
|
|
|
head)]
|
|
|
|
(when (= (type (. tbl raw-head)) "table")
|
|
|
|
(add-matches tail (. tbl raw-head) (.. prefix head)))))))
|
|
|
|
|
|
|
|
(add-matches input-fragment (or scope.specials []))
|
|
|
|
(add-matches input-fragment (or internals.SPECIALS []))
|
|
|
|
(add-matches input-fragment (or env.___replLocals___ []))
|
|
|
|
(add-matches input-fragment env)
|
|
|
|
(add-matches input-fragment (or env._ENV env._G []))
|
|
|
|
matches))
|
|
|
|
|
|
|
|
(fn repl [options]
|
|
|
|
(let [old-root-options internals.rootOptions
|
|
|
|
env (if options.env
|
|
|
|
(internals.wrapEnv options.env)
|
|
|
|
(setmetatable {} {:__index (or _G._ENV _G)}))
|
|
|
|
save-locals? (and (not= options.saveLocals false)
|
|
|
|
env.debug env.debug.getlocal)
|
|
|
|
opts {}
|
|
|
|
_ (each [k v (pairs options)] (tset opts k v))
|
|
|
|
read-chunk (or opts.readChunk default-read-chunk)
|
|
|
|
on-values (or opts.onValues default-on-values)
|
|
|
|
on-error (or opts.onError default-on-error)
|
|
|
|
pp (or opts.pp tostring)
|
|
|
|
;; make parser
|
|
|
|
(byte-stream clear-stream) (fennel.granulate read-chunk)
|
|
|
|
chars []
|
|
|
|
(read reset) (fennel.parser (fn [parser-state]
|
|
|
|
(let [c (byte-stream parser-state)]
|
|
|
|
(tset chars (+ (# chars) 1) c)
|
|
|
|
c)))
|
|
|
|
scope (fennel.scope)]
|
|
|
|
|
|
|
|
;; use metadata unless we've specifically disabled it
|
|
|
|
(set opts.useMetadata (not= options.useMetadata false))
|
|
|
|
(when (= opts.allowedGlobals nil)
|
|
|
|
(set opts.allowedGlobals (internals.currentGlobalNames opts.env)))
|
|
|
|
|
|
|
|
(when opts.registerCompleter
|
|
|
|
(opts.registerCompleter (partial completer env scope)))
|
|
|
|
|
|
|
|
(fn loop []
|
|
|
|
(each [k (pairs chars)] (tset chars k nil))
|
|
|
|
(let [(ok parse-ok? x) (pcall read)
|
|
|
|
src-string (string.char ((or _G.unpack table.unpack) chars))]
|
|
|
|
(internals.setRootOptions opts)
|
|
|
|
(if (not ok)
|
|
|
|
(do (on-error "Parse" parse-ok?)
|
|
|
|
(clear-stream)
|
|
|
|
(reset)
|
|
|
|
(loop))
|
|
|
|
(when parse-ok? ; if this is false, we got eof
|
|
|
|
(match (pcall fennel.compile x {:correlate opts.correlate
|
|
|
|
:source src-string
|
|
|
|
:scope scope
|
|
|
|
:useMetadata opts.useMetadata
|
|
|
|
:moduleName opts.moduleName})
|
|
|
|
(false msg) (do (clear-stream)
|
|
|
|
(on-error "Compile" msg))
|
|
|
|
(true source) (let [source (if save-locals?
|
|
|
|
(splice-save-locals env source)
|
|
|
|
source)
|
|
|
|
(lua-ok? loader) (pcall fennel.loadCode
|
|
|
|
source env)]
|
|
|
|
(if (not lua-ok?)
|
|
|
|
(do (clear-stream)
|
|
|
|
(on-error "Lua Compile" loader source))
|
|
|
|
(match (xpcall #[(loader)]
|
|
|
|
(partial on-error "Runtime"))
|
|
|
|
(true ret)
|
|
|
|
(do (set env._ (. ret 1))
|
|
|
|
(set env.__ ret)
|
|
|
|
(on-values (internals.map ret pp)))))))
|
|
|
|
(internals.setRootOptions old-root-options)
|
|
|
|
(loop)))))
|
|
|
|
(loop)))]===]
|
|
|
|
|
|
|
|
module.repl = function(options)
|
|
|
|
-- functionality the repl needs that isn't part of the public API yet
|
|
|
|
local internals = { rootOptions = rootOptions,
|
|
|
|
setRootOptions = function(r) rootOptions = r end,
|
|
|
|
currentGlobalNames = currentGlobalNames,
|
|
|
|
wrapEnv = wrapEnv,
|
|
|
|
SPECIALS = SPECIALS,
|
|
|
|
map = map }
|
|
|
|
return eval(replsource, { correlate = true }, module, internals)(options)
|
|
|
|
end
|
|
|
|
|
2019-12-02 18:30:30 -08:00
|
|
|
local function searchModule(modulename, pathstring)
|
|
|
|
modulename = modulename:gsub("%.", "/")
|
|
|
|
for path in string.gmatch((pathstring or module.path)..";", "([^;]*);") do
|
|
|
|
local filename = path:gsub("%?", modulename)
|
|
|
|
local file = io.open(filename, "rb")
|
|
|
|
if(file) then
|
|
|
|
file:close()
|
|
|
|
return filename
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
module.makeSearcher = function(options)
|
|
|
|
return function(modulename)
|
|
|
|
-- this will propagate options from the repl but not from eval, because
|
|
|
|
-- eval unsets rootOptions after compiling but before running the actual
|
|
|
|
-- calls to require.
|
2020-03-07 17:41:37 -08:00
|
|
|
local opts = copy(rootOptions)
|
2019-12-02 18:30:30 -08:00
|
|
|
for k,v in pairs(options or {}) do opts[k] = v end
|
|
|
|
local filename = searchModule(modulename)
|
|
|
|
if filename then
|
|
|
|
return function(modname)
|
|
|
|
return dofileFennel(filename, opts, modname)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Add metadata and docstrings to fennel module
|
|
|
|
module.metadata = metadata
|
|
|
|
module.doc = doc
|
|
|
|
|
|
|
|
-- This will allow regular `require` to work with Fennel:
|
|
|
|
-- table.insert(package.loaders, fennel.searcher)
|
|
|
|
module.searcher = module.makeSearcher()
|
|
|
|
module.make_searcher = module.makeSearcher -- oops backwards compatibility
|
|
|
|
|
|
|
|
local function makeCompilerEnv(ast, scope, parent)
|
|
|
|
return setmetatable({
|
|
|
|
-- State of compiler if needed
|
|
|
|
_SCOPE = scope,
|
|
|
|
_CHUNK = parent,
|
|
|
|
_AST = ast,
|
|
|
|
_IS_COMPILER = true,
|
|
|
|
_SPECIALS = SPECIALS,
|
|
|
|
_VARARG = VARARG,
|
|
|
|
-- Expose the module in the compiler
|
|
|
|
fennel = module,
|
|
|
|
-- Useful for macros and meta programming. All of Fennel can be accessed
|
|
|
|
-- via fennel.myfun, for example (fennel.eval "(print 1)").
|
|
|
|
list = list,
|
|
|
|
sym = sym,
|
|
|
|
unpack = unpack,
|
|
|
|
gensym = function() return sym(gensym(macroCurrentScope)) end,
|
|
|
|
["list?"] = isList,
|
|
|
|
["multi-sym?"] = isMultiSym,
|
|
|
|
["sym?"] = isSym,
|
|
|
|
["table?"] = isTable,
|
|
|
|
["sequence?"] = isSequence,
|
|
|
|
["varg?"] = isVarg,
|
|
|
|
["get-scope"] = function() return macroCurrentScope end,
|
|
|
|
["in-scope?"] = function(symbol)
|
|
|
|
return macroCurrentScope.manglings[tostring(symbol)]
|
|
|
|
end
|
|
|
|
}, { __index = _ENV or _G })
|
|
|
|
end
|
|
|
|
|
|
|
|
local function macroGlobals(env, globals)
|
2020-03-07 17:41:37 -08:00
|
|
|
local allowed = currentGlobalNames(env)
|
|
|
|
for _, k in pairs(globals or {}) do table.insert(allowed, k) end
|
2019-12-02 18:30:30 -08:00
|
|
|
return allowed
|
|
|
|
end
|
|
|
|
|
|
|
|
local function addMacros(macros, ast, scope)
|
|
|
|
assertCompile(isTable(macros), 'expected macros to be table', ast)
|
2020-03-07 17:41:37 -08:00
|
|
|
kvmap(macros, function(k, v) return k, macroToSpecial(v) end, scope.specials)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
local function loadMacros(modname, ast, scope, parent)
|
|
|
|
local filename = assertCompile(searchModule(modname),
|
|
|
|
modname .. " not found.", ast)
|
|
|
|
local env = makeCompilerEnv(ast, scope, parent)
|
|
|
|
local globals = macroGlobals(env, currentGlobalNames())
|
|
|
|
return dofileFennel(filename, { env = env, allowedGlobals = globals,
|
|
|
|
useMetadata = rootOptions.useMetadata,
|
|
|
|
scope = COMPILER_SCOPE })
|
|
|
|
end
|
|
|
|
|
|
|
|
SPECIALS['require-macros'] = function(ast, scope, parent)
|
|
|
|
assertCompile(#ast == 2, "Expected one module name argument", ast)
|
|
|
|
local modname = ast[2]
|
|
|
|
if not macroLoaded[modname] then
|
|
|
|
macroLoaded[modname] = loadMacros(modname, ast, scope, parent)
|
|
|
|
end
|
|
|
|
addMacros(macroLoaded[modname], ast, scope, parent)
|
|
|
|
end
|
|
|
|
docSpecial('require-macros', {'macro-module-name'},
|
|
|
|
'Load given module and use its contents as macro definitions in current scope.'
|
|
|
|
..'\nMacro module should return a table of macro functions with string keys.')
|
|
|
|
|
|
|
|
SPECIALS['include'] = function(ast, scope, parent, opts)
|
|
|
|
assertCompile(#ast == 2, 'expected one argument', ast)
|
|
|
|
|
|
|
|
-- Compile mod argument
|
|
|
|
local modexpr = compile1(ast[2], scope, parent, {nval = 1})[1]
|
|
|
|
if modexpr.type ~= 'literal' or modexpr[1]:byte() ~= 34 then
|
|
|
|
if opts.fallback then
|
|
|
|
return opts.fallback(modexpr)
|
|
|
|
else
|
|
|
|
assertCompile(false, 'module name must resolve to a string literal', ast)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
local code = 'return ' .. modexpr[1]
|
|
|
|
local mod = loadCode(code)()
|
|
|
|
|
|
|
|
-- Check cache
|
2020-03-07 17:41:37 -08:00
|
|
|
if scope.includes[mod] then return scope.includes[mod] end
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
-- Find path to source
|
|
|
|
local path = searchModule(mod)
|
|
|
|
local isFennel = true
|
|
|
|
if not path then
|
|
|
|
isFennel = false
|
|
|
|
path = searchModule(mod, package.path)
|
|
|
|
if not path then
|
|
|
|
if opts.fallback then
|
|
|
|
return opts.fallback(modexpr)
|
|
|
|
else
|
|
|
|
assertCompile(false, 'could not find module ' .. mod, ast)
|
|
|
|
end
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
-- Read source
|
|
|
|
local f = io.open(path)
|
|
|
|
local s = f:read('*all')
|
|
|
|
f:close()
|
|
|
|
|
2020-03-07 17:41:37 -08:00
|
|
|
-- splice in source and memoize it in compiler AND package.preload
|
|
|
|
-- so we can include it again without duplication, even in runtime
|
|
|
|
local target = 'package.preload["' .. mod .. '"]'
|
|
|
|
local ret = expr('require("' .. mod .. '")', 'statement')
|
|
|
|
|
|
|
|
local subChunk, tempChunk = {}, {}
|
|
|
|
emit(tempChunk, subChunk, ast)
|
|
|
|
-- if lua, simply emit the setting of package.preload
|
|
|
|
if not isFennel then
|
|
|
|
emit(tempChunk, target .. ' = ' .. target .. ' or function()\n' .. s .. 'end', ast)
|
|
|
|
end
|
|
|
|
-- Splice tempChunk to begining of rootChunk
|
|
|
|
for i, v in ipairs(tempChunk) do
|
|
|
|
table.insert(rootChunk, i, v)
|
|
|
|
end
|
|
|
|
|
|
|
|
-- For fnl source, compile subChunk AFTER splicing into start of rootChunk.
|
2019-12-02 18:30:30 -08:00
|
|
|
if isFennel then
|
2020-03-07 17:41:37 -08:00
|
|
|
local subopts = { nval = 1, target = target }
|
2019-12-02 18:30:30 -08:00
|
|
|
local subscope = makeScope(rootScope.parent)
|
|
|
|
if rootOptions.requireAsInclude then
|
|
|
|
subscope.specials.require = requireSpecial
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
local targetForm = list(sym('.'), sym('package.preload'), mod)
|
|
|
|
-- splice "or" statement in so it uses existing package.preload[modname]
|
|
|
|
-- if it's been set by something else, allowing for overrides
|
|
|
|
local forms = list(sym('or'), targetForm, list(sym('fn'), sequence()))
|
|
|
|
local p = parser(stringStream(s), path)
|
|
|
|
for _, val in p do table.insert(forms[3], val) end
|
|
|
|
compile1(forms, subscope, subChunk, subopts)
|
2019-12-02 18:30:30 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
-- Put in cache and return
|
|
|
|
rootScope.includes[mod] = ret
|
|
|
|
return ret
|
|
|
|
end
|
2020-03-07 17:41:37 -08:00
|
|
|
docSpecial('include', {'module-name-literal'},
|
|
|
|
'Like require, but load the target module during compilation and embed it in the\n'
|
|
|
|
.. 'Lua output. The module must be a string literal and resolvable at compile time.')
|
2019-12-02 18:30:30 -08:00
|
|
|
|
|
|
|
local function requireFallback(e)
|
|
|
|
local code = ('require(%s)'):format(tostring(e))
|
|
|
|
return expr(code, 'statement')
|
|
|
|
end
|
|
|
|
|
|
|
|
requireSpecial = function (ast, scope, parent, opts)
|
|
|
|
opts.fallback = requireFallback
|
|
|
|
return SPECIALS['include'](ast, scope, parent, opts)
|
|
|
|
end
|
|
|
|
|
|
|
|
local function evalCompiler(ast, scope, parent)
|
|
|
|
local luaSource = compile(ast, { scope = makeScope(COMPILER_SCOPE),
|
|
|
|
useMetadata = rootOptions.useMetadata })
|
|
|
|
local loader = loadCode(luaSource, wrapEnv(makeCompilerEnv(ast, scope, parent)))
|
|
|
|
return loader()
|
|
|
|
end
|
|
|
|
|
|
|
|
SPECIALS['macros'] = function(ast, scope, parent)
|
|
|
|
assertCompile(#ast == 2, "Expected one table argument", ast)
|
|
|
|
local macros = evalCompiler(ast[2], scope, parent)
|
|
|
|
addMacros(macros, ast, scope, parent)
|
|
|
|
end
|
|
|
|
docSpecial('macros', {'{:macro-name-1 (fn [...] ...) ... :macro-name-N macro-body-N}'},
|
|
|
|
'Define all functions in the given table as macros local to the current scope.')
|
|
|
|
|
|
|
|
SPECIALS['eval-compiler'] = function(ast, scope, parent)
|
|
|
|
local oldFirst = ast[1]
|
|
|
|
ast[1] = sym('do')
|
|
|
|
local val = evalCompiler(ast, scope, parent)
|
|
|
|
ast[1] = oldFirst
|
|
|
|
return val
|
|
|
|
end
|
|
|
|
docSpecial('eval-compiler', {'...'}, 'Evaluate the body at compile-time.'
|
|
|
|
.. ' Use the macro system instead if possible.')
|
|
|
|
|
|
|
|
-- Load standard macros
|
|
|
|
local stdmacros = [===[
|
|
|
|
{"->" (fn [val ...]
|
|
|
|
"Thread-first macro.
|
|
|
|
Take the first value and splice it into the second form as its first argument.
|
|
|
|
The value of the second form is spliced into the first arg of the third, etc."
|
|
|
|
(var x val)
|
|
|
|
(each [_ e (ipairs [...])]
|
|
|
|
(let [elt (if (list? e) e (list e))]
|
|
|
|
(table.insert elt 2 x)
|
|
|
|
(set x elt)))
|
|
|
|
x)
|
|
|
|
"->>" (fn [val ...]
|
|
|
|
"Thread-last macro.
|
|
|
|
Same as ->, except splices the value into the last position of each form
|
|
|
|
rather than the first."
|
|
|
|
(var x val)
|
|
|
|
(each [_ e (pairs [...])]
|
|
|
|
(let [elt (if (list? e) e (list e))]
|
|
|
|
(table.insert elt x)
|
|
|
|
(set x elt)))
|
|
|
|
x)
|
|
|
|
"-?>" (fn [val ...]
|
|
|
|
"Nil-safe thread-first macro.
|
|
|
|
Same as -> except will short-circuit with nil when it encounters a nil value."
|
|
|
|
(if (= 0 (select "#" ...))
|
|
|
|
val
|
|
|
|
(let [els [...]
|
|
|
|
e (table.remove els 1)
|
|
|
|
el (if (list? e) e (list e))
|
|
|
|
tmp (gensym)]
|
|
|
|
(table.insert el 2 tmp)
|
|
|
|
`(let [,tmp ,val]
|
|
|
|
(if ,tmp
|
|
|
|
(-?> ,el ,(unpack els))
|
|
|
|
,tmp)))))
|
|
|
|
"-?>>" (fn [val ...]
|
|
|
|
"Nil-safe thread-last macro.
|
|
|
|
Same as ->> except will short-circuit with nil when it encounters a nil value."
|
|
|
|
(if (= 0 (select "#" ...))
|
|
|
|
val
|
|
|
|
(let [els [...]
|
|
|
|
e (table.remove els 1)
|
|
|
|
el (if (list? e) e (list e))
|
|
|
|
tmp (gensym)]
|
|
|
|
(table.insert el tmp)
|
|
|
|
`(let [,tmp ,val]
|
|
|
|
(if ,tmp
|
|
|
|
(-?>> ,el ,(unpack els))
|
|
|
|
,tmp)))))
|
|
|
|
:doto (fn [val ...]
|
|
|
|
"Evaluates val and splices it into the first argument of subsequent forms."
|
|
|
|
(let [name (gensym)
|
|
|
|
form `(let [,name ,val])]
|
|
|
|
(each [_ elt (pairs [...])]
|
|
|
|
(table.insert elt 2 name)
|
|
|
|
(table.insert form elt))
|
|
|
|
(table.insert form name)
|
|
|
|
form))
|
|
|
|
:when (fn [condition body1 ...]
|
|
|
|
"Evaluate body for side-effects only when condition is truthy."
|
|
|
|
(assert body1 "expected body")
|
|
|
|
`(if ,condition
|
|
|
|
(do ,body1 ,...)))
|
|
|
|
:partial (fn [f ...]
|
|
|
|
"Returns a function with all arguments partially applied to f."
|
|
|
|
(let [body (list f ...)]
|
|
|
|
(table.insert body _VARARG)
|
|
|
|
`(fn [,_VARARG] ,body)))
|
|
|
|
:lambda (fn [...]
|
|
|
|
"Function literal with arity checking.
|
|
|
|
Will throw an exception if a declared argument is passed in as nil, unless
|
|
|
|
that argument name begins with ?."
|
|
|
|
(let [args [...]
|
|
|
|
has-internal-name? (sym? (. args 1))
|
|
|
|
arglist (if has-internal-name? (. args 2) (. args 1))
|
|
|
|
docstring-position (if has-internal-name? 3 2)
|
|
|
|
has-docstring? (and (> (# args) docstring-position)
|
|
|
|
(= :string (type (. args docstring-position))))
|
|
|
|
arity-check-position (- 4 (if has-internal-name? 0 1) (if has-docstring? 0 1))]
|
|
|
|
(fn check! [a]
|
|
|
|
(if (table? a)
|
|
|
|
(each [_ a (pairs a)]
|
|
|
|
(check! a))
|
|
|
|
(and (not (: (tostring a) :match "^?"))
|
|
|
|
(not= (tostring a) "&")
|
|
|
|
(not= (tostring a) "..."))
|
|
|
|
(table.insert args arity-check-position
|
|
|
|
`(assert (not= nil ,a)
|
|
|
|
(: "Missing argument %s on %s:%s"
|
|
|
|
:format ,(tostring a)
|
|
|
|
,(or a.filename "unknown")
|
|
|
|
,(or a.line "?"))))))
|
|
|
|
(assert (> (length args) 1) "missing body expression")
|
|
|
|
(each [_ a (ipairs arglist)]
|
|
|
|
(check! a))
|
|
|
|
`(fn ,(unpack args))))
|
|
|
|
:macro (fn macro [name ...]
|
|
|
|
"Define a single macro."
|
|
|
|
(assert (sym? name) "expected symbol for macro name")
|
|
|
|
(local args [...])
|
|
|
|
`(macros { ,(tostring name) (fn ,name ,(unpack args))}))
|
|
|
|
:match
|
|
|
|
(fn match [val ...]
|
|
|
|
"Perform pattern matching on val. See reference for details."
|
|
|
|
;; this function takes the AST of values and a single pattern and returns a
|
|
|
|
;; condition to determine if it matches as well as a list of bindings to
|
|
|
|
;; introduce for the duration of the body if it does match.
|
|
|
|
(fn match-pattern [vals pattern unifications]
|
|
|
|
;; we have to assume we're matching against multiple values here until we
|
|
|
|
;; know we're either in a multi-valued clause (in which case we know the #
|
|
|
|
;; of vals) or we're not, in which case we only care about the first one.
|
|
|
|
(let [[val] vals]
|
|
|
|
(if (or (and (sym? pattern) ; unification with outer locals (or nil)
|
|
|
|
(not= :_ (tostring pattern)) ; never unify _
|
|
|
|
(or (in-scope? pattern)
|
|
|
|
(= :nil (tostring pattern))))
|
|
|
|
(and (multi-sym? pattern)
|
|
|
|
(in-scope? (. (multi-sym? pattern) 1))))
|
|
|
|
(values `(= ,val ,pattern) [])
|
|
|
|
;; unify a local we've seen already
|
|
|
|
(and (sym? pattern)
|
|
|
|
(. unifications (tostring pattern)))
|
|
|
|
(values `(= ,(. unifications (tostring pattern)) ,val) [])
|
|
|
|
;; bind a fresh local
|
|
|
|
(sym? pattern)
|
|
|
|
(let [wildcard? (= (tostring pattern) "_")]
|
|
|
|
(if (not wildcard?) (tset unifications (tostring pattern) val))
|
|
|
|
(values (if (or wildcard? (: (tostring pattern) :find "^?"))
|
|
|
|
true `(not= ,(sym :nil) ,val))
|
|
|
|
[pattern val]))
|
|
|
|
;; guard clause
|
|
|
|
(and (list? pattern) (sym? (. pattern 2)) (= :? (tostring (. pattern 2))))
|
|
|
|
(let [(pcondition bindings) (match-pattern vals (. pattern 1)
|
|
|
|
unifications)
|
|
|
|
condition `(and ,pcondition)]
|
|
|
|
(for [i 3 (# pattern)] ; splice in guard clauses
|
|
|
|
(table.insert condition (. pattern i)))
|
|
|
|
(values `(let ,bindings ,condition) bindings))
|
|
|
|
|
|
|
|
;; multi-valued patterns (represented as lists)
|
|
|
|
(list? pattern)
|
|
|
|
(let [condition `(and)
|
|
|
|
bindings []]
|
|
|
|
(each [i pat (ipairs pattern)]
|
|
|
|
(let [(subcondition subbindings) (match-pattern [(. vals i)] pat
|
|
|
|
unifications)]
|
|
|
|
(table.insert condition subcondition)
|
|
|
|
(each [_ b (ipairs subbindings)]
|
|
|
|
(table.insert bindings b))))
|
|
|
|
(values condition bindings))
|
|
|
|
;; table patterns)
|
|
|
|
(= (type pattern) :table)
|
|
|
|
(let [condition `(and (= (type ,val) :table))
|
|
|
|
bindings []]
|
|
|
|
(each [k pat (pairs pattern)]
|
|
|
|
(if (and (sym? pat) (= "&" (tostring pat)))
|
|
|
|
(do (assert (not (. pattern (+ k 2)))
|
|
|
|
"expected rest argument in final position")
|
|
|
|
(table.insert bindings (. pattern (+ k 1)))
|
2020-03-07 17:41:37 -08:00
|
|
|
(table.insert bindings [`(select ,k ((or _G.unpack table.unpack)
|
2019-12-02 18:30:30 -08:00
|
|
|
,val))]))
|
|
|
|
(and (= :number (type k))
|
|
|
|
(= "&" (tostring (. pattern (- k 1)))))
|
|
|
|
nil ; don't process the pattern right after &; already got it
|
|
|
|
(let [subval `(. ,val ,k)
|
|
|
|
(subcondition subbindings) (match-pattern [subval] pat
|
|
|
|
unifications)]
|
|
|
|
(table.insert condition subcondition)
|
|
|
|
(each [_ b (ipairs subbindings)]
|
|
|
|
(table.insert bindings b)))))
|
|
|
|
(values condition bindings))
|
|
|
|
;; literal value
|
|
|
|
(values `(= ,val ,pattern) []))))
|
|
|
|
(fn match-condition [vals clauses]
|
|
|
|
(let [out `(if)]
|
|
|
|
(for [i 1 (length clauses) 2]
|
|
|
|
(let [pattern (. clauses i)
|
|
|
|
body (. clauses (+ i 1))
|
|
|
|
(condition bindings) (match-pattern vals pattern {})]
|
|
|
|
(table.insert out condition)
|
|
|
|
(table.insert out `(let ,bindings ,body))))
|
|
|
|
out))
|
|
|
|
;; how many multi-valued clauses are there? return a list of that many gensyms
|
|
|
|
(fn val-syms [clauses]
|
|
|
|
(let [syms (list (gensym))]
|
|
|
|
(for [i 1 (length clauses) 2]
|
|
|
|
(if (list? (. clauses i))
|
|
|
|
(each [valnum (ipairs (. clauses i))]
|
|
|
|
(if (not (. syms valnum))
|
|
|
|
(tset syms valnum (gensym))))))
|
|
|
|
syms))
|
|
|
|
;; wrap it in a way that prevents double-evaluation of the matched value
|
|
|
|
(let [clauses [...]
|
|
|
|
vals (val-syms clauses)]
|
|
|
|
(if (not= 0 (% (length clauses) 2)) ; treat odd final clause as default
|
|
|
|
(table.insert clauses (length clauses) (sym :_)))
|
|
|
|
;; protect against multiple evaluation of the value, bind against as
|
|
|
|
;; many values as we ever match against in the clauses.
|
|
|
|
(list (sym :let) [vals val]
|
|
|
|
(match-condition vals clauses))))
|
|
|
|
}
|
|
|
|
]===]
|
|
|
|
do
|
|
|
|
-- docstrings rely on having a place to "put" metadata; we use the module
|
|
|
|
-- system for that. but if you try to require the module while it's being
|
|
|
|
-- loaded, you get a stack overflow. so we fake out the module for the
|
|
|
|
-- purposes of boostrapping the built-in macros here.
|
|
|
|
local moduleName = "__fennel-bootstrap__"
|
|
|
|
package.preload[moduleName] = function() return module end
|
|
|
|
local env = makeCompilerEnv(nil, COMPILER_SCOPE, {})
|
2020-03-07 17:41:37 -08:00
|
|
|
local macros = eval(stdmacros, {
|
|
|
|
env = env,
|
|
|
|
scope = makeScope(COMPILER_SCOPE),
|
|
|
|
-- assume the code to load globals doesn't have any
|
|
|
|
-- mistaken globals, otherwise this can be
|
|
|
|
-- problematic when loading fennel in contexts
|
|
|
|
-- where _G is an empty table with an __index
|
|
|
|
-- metamethod. (openresty)
|
|
|
|
allowedGlobals = false,
|
|
|
|
useMetadata = true,
|
|
|
|
filename = "built-ins",
|
|
|
|
moduleName = moduleName })
|
|
|
|
kvmap(macros,
|
|
|
|
function(name, fn) return name, macroToSpecial(fn, name) end,
|
|
|
|
SPECIALS)
|
2019-12-02 18:30:30 -08:00
|
|
|
package.preload[moduleName] = nil
|
|
|
|
end
|
|
|
|
SPECIALS['λ'] = SPECIALS['lambda']
|
|
|
|
|
|
|
|
return module
|