From c843deea3de5d5d8782fe4dadbdbd40422ab88f8 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Thu, 19 Nov 2020 15:42:08 -0500 Subject: [PATCH] git subrepo clone https://gitlab.com/technomancy/jeejah.git vendor/jeejah subrepo: subdir: "vendor/jeejah" merged: "3ed9eb1" upstream: origin: "https://gitlab.com/technomancy/jeejah.git" branch: "master" commit: "3ed9eb1" git-subrepo: version: "0.4.2" origin: "https://github.com/ingydotnet/git-subrepo" commit: "65fde50" --- vendor/jeejah/.gitrepo | 12 + vendor/jeejah/Changelog.md | 31 + vendor/jeejah/LICENSE | 19 + vendor/jeejah/Makefile | 1 + vendor/jeejah/Readme.md | 94 + vendor/jeejah/bencode.lua | 78 + vendor/jeejah/bin/jeejah | 35 + vendor/jeejah/fennel.lua | 2229 +++++++++++++++++ vendor/jeejah/fennelview.fnl | 156 ++ vendor/jeejah/jeejah.lua | 357 +++ vendor/jeejah/jeejah/fenneleval.lua | 77 + vendor/jeejah/monroe-lua-complete.el | 89 + .../jeejah/rockspecs/jeejah-0.1.0-1.rockspec | 28 + .../jeejah/rockspecs/jeejah-0.2.1-1.rockspec | 28 + .../jeejah/rockspecs/jeejah-0.2.1-4.rockspec | 28 + .../jeejah/rockspecs/jeejah-0.3.0-1.rockspec | 28 + .../jeejah/rockspecs/jeejah-0.3.1-1.rockspec | 28 + .../jeejah/rockspecs/jeejah-0.3.1-2.rockspec | 29 + .../jeejah/rockspecs/jeejah-0.3.1-4.rockspec | 30 + vendor/jeejah/serpent.lua | 125 + 20 files changed, 3502 insertions(+) create mode 100644 vendor/jeejah/.gitrepo create mode 100644 vendor/jeejah/Changelog.md create mode 100644 vendor/jeejah/LICENSE create mode 100644 vendor/jeejah/Makefile create mode 100644 vendor/jeejah/Readme.md create mode 100644 vendor/jeejah/bencode.lua create mode 100755 vendor/jeejah/bin/jeejah create mode 100644 vendor/jeejah/fennel.lua create mode 100644 vendor/jeejah/fennelview.fnl create mode 100644 vendor/jeejah/jeejah.lua create mode 100644 vendor/jeejah/jeejah/fenneleval.lua create mode 100644 vendor/jeejah/monroe-lua-complete.el create mode 100644 vendor/jeejah/rockspecs/jeejah-0.1.0-1.rockspec create mode 100644 vendor/jeejah/rockspecs/jeejah-0.2.1-1.rockspec create mode 100644 vendor/jeejah/rockspecs/jeejah-0.2.1-4.rockspec create mode 100644 vendor/jeejah/rockspecs/jeejah-0.3.0-1.rockspec create mode 100644 vendor/jeejah/rockspecs/jeejah-0.3.1-1.rockspec create mode 100644 vendor/jeejah/rockspecs/jeejah-0.3.1-2.rockspec create mode 100644 vendor/jeejah/rockspecs/jeejah-0.3.1-4.rockspec create mode 100644 vendor/jeejah/serpent.lua diff --git a/vendor/jeejah/.gitrepo b/vendor/jeejah/.gitrepo new file mode 100644 index 0000000..3ff1896 --- /dev/null +++ b/vendor/jeejah/.gitrepo @@ -0,0 +1,12 @@ +; DO NOT EDIT (unless you know what you are doing) +; +; This subdirectory is a git "subrepo", and this file is maintained by the +; git-subrepo command. See https://github.com/git-commands/git-subrepo#readme +; +[subrepo] + remote = https://gitlab.com/technomancy/jeejah.git + branch = master + commit = 3ed9eb1f368c825e33e73dec0bcc9c553c33cf82 + parent = 3d52b70bbcc475d8ef69accd990c367f1a72bbba + method = merge + cmdver = 0.4.2 diff --git a/vendor/jeejah/Changelog.md b/vendor/jeejah/Changelog.md new file mode 100644 index 0000000..2146057 --- /dev/null +++ b/vendor/jeejah/Changelog.md @@ -0,0 +1,31 @@ +# Jeejah changelog: history of user-visible changes + +## 0.3.1 / 2020-04-24 + +* Fix compatibility for Lua 5.1 and 5.2. +* Improve error reporting. +* Move Fennel support to special handler instead of middleware. + +## 0.3.0 / 2019-08-01 + +* Fix a bug with socket timeout. +* Add foreground mode. +* Avoid burning CPU when there's nothing to do. + +## 0.2.1 / 2019-05-21 + +* Add support for launching a Fennel server using middleware. +* Add support for middleware. +* Support Luas newer than 5.1. + +## 0.2.0 / 2016-06-20 + +* Support requesting a read from stdin. +* Support stopping the server. +* Change module API to return a table, not a function. +* Support multiple sessions. + +## 0.1.0 / 2016-06-09 + +* Initial release! + diff --git a/vendor/jeejah/LICENSE b/vendor/jeejah/LICENSE new file mode 100644 index 0000000..22c94ef --- /dev/null +++ b/vendor/jeejah/LICENSE @@ -0,0 +1,19 @@ +Copyright © 2016-2019 Phil Hagelberg 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. diff --git a/vendor/jeejah/Makefile b/vendor/jeejah/Makefile new file mode 100644 index 0000000..32c7fbb --- /dev/null +++ b/vendor/jeejah/Makefile @@ -0,0 +1 @@ +check: ; luacheck --std max jeejah.lua bencode.lua diff --git a/vendor/jeejah/Readme.md b/vendor/jeejah/Readme.md new file mode 100644 index 0000000..90e3035 --- /dev/null +++ b/vendor/jeejah/Readme.md @@ -0,0 +1,94 @@ +# JeeJah + +An nREPL server for [Fennel](https://fennel-lang.org) and [Lua](https://lua.org). + +## A what now? + +The [nREPL protocol](https://nrepl.org/nrepl/index.html#_why_nrepl) +allows developers to embed a server in their programs to which +external programs can connect for development, debugging, etc. + +The original implementation of the protocol was written in Clojure, +and many clients assume they will connect to a Clojure server; however +the protocol is quite agnostic about what language is being +evaluated. It supports evaluating snippets of code or whole files with +`print` and `io.write` redirected back to the connected client. + +This library was originally written to add Emacs support to +[Bussard](https://gitlab.com/technomancy/bussard), a spaceflight +programming game. + +Currently mainly tested with +[monroe](https://github.com/sanel/monroe/) and +[shevek](https://git.sr.ht/~technomancy/shevek/) as +clients. [grenchman](https://leiningen.org/grench.html) version 0.3.0+ +works. Other clients exist for Vim, Eclipse, and Atom, as well as +several independent command-line clients; however these may require +some adaptation to work with Jeejah. If you try your favorite client +and find that it makes Clojure-specific assumptions, please report a +bug with it so that it can gracefully degrade when those assumptions +don't hold. + +## Installation + +The pure-Lua dependencies are included (`bencode`, `serpent`, and +`fennel`) but you will need to install `luasocket` yourself. If your +operating system does not provide it, you can install it using LuaRocks: + + $ luarocks install --local luasocket + +Note that [LÖVE](https://love2d.org) ships with its own copy of +luasocket, so there is no need to install it there. + +You can symlink `bin/jeejah` to your `$PATH` or something. + +## Usage + +You can launch a standalone nREPL server: + + $ bin/jeejah + +Pass in a `--fennel` flag to start a server for evaluating Fennel code +instead of Lua. Accepts a `--port` argument and a `--debug` flag. + +You can use it as a library too, of course: + +```lua +local jeejah = require("jeejah") +local coro = jeejah.start(port, {debug=true, sandbox={x=12}}) +``` + +The function returns a coroutine which you'll need to repeatedly +resume in order to handle requests. Each accepted connection is stored +in a coroutine internal to that function; these are each repeatedly +resumed by the main coroutine. If all you're doing is starting an +nrepl server, you can pass `foreground=true` in the options table to +leave the server running in the foreground and skip the step of +resuming the coroutine. + +Note that the sandbox feature is not well-tested or audited and should +not be trusted to provide robust security. It currently only works +with Lua 5.1 and LuaJIT. + +You can also pass in a `handlers` table where the keys are custom +[nREPL ops](https://nrepl.org/nrepl/ops.html) +you want to handle yourself. + +## Completion + +The included `monroe-lua-complete.el` file adds support for completion +to the Monroe client by querying the connected nREPL server for +possibilities. Simply invoke `completion-at-point` (bound to `C-M-i` +by default) when connected. + +## Caveats + +PUC Lua 5.1 does not allow yielding coroutines from inside protected +calls, which means you cannot use `io.read`, though LuaJIT and +Lua 5.2+ allow it. + +## License + +Copyright © 2016-2020 Phil Hagelberg and contributors + +Distributed under the MIT license; see file LICENSE diff --git a/vendor/jeejah/bencode.lua b/vendor/jeejah/bencode.lua new file mode 100644 index 0000000..dddc432 --- /dev/null +++ b/vendor/jeejah/bencode.lua @@ -0,0 +1,78 @@ +local encode, decode + +local function decode_list(str, t, total_len) + -- print("list", str, lume.serialize(t)) + if(str:sub(1,1) == "e") then return t, total_len + 1 end + local value, v_len = decode(str) + table.insert(t, value) + total_len = total_len + v_len + return decode_list(str:sub(v_len + 1), t, total_len) +end + +local function decode_table(str, t, total_len) + -- print("table", str, lume.serialize(t)) + if(str:sub(1,1) == "e") then return t, total_len + 1 end + local key, k_len = decode(str) + local value, v_len = decode(str:sub(k_len+1)) + local end_pos = 1 + k_len + v_len + t[key] = value + total_len = total_len + k_len + v_len + return decode_table(str:sub(end_pos), t, total_len) +end + +function decode(str) + -- print("decoding", str) + if(str:sub(1,1) == "l") then + return decode_list(str:sub(2), {}, 1) + elseif(str:sub(1,1) == "d") then + return decode_table(str:sub(2), {}, 1) + elseif(str:sub(1,1) == "i") then + return(tonumber(str:sub(2, str:find("e") - 1))), str:find("e") + elseif(str:match("[0-9]+")) then + local num_str = str:match("[0-9]+") + local beginning_of_string = #num_str + 2 + local str_len = tonumber(num_str) + local total_len = beginning_of_string + str_len - 1 + return str:sub(beginning_of_string, total_len), total_len + else + error("Could not parse "..str) + end +end + +local function encode_str(s) return #s .. ":" .. s end +local function encode_int(n) return "i" .. tostring(n) .. "e" end + +local function encode_table(t) + local s = "d" + for k,v in pairs(t) do s = s .. encode(k) .. encode(v) end + return s .. "e" +end + +local function encode_list(l) + local s = "l" + for _,x in ipairs(l) do s = s .. encode(x) end + return s .. "e" +end + +local function count(tbl) + local i = 0 + for _ in pairs(tbl) do i = i + 1 end + return i +end + +function encode(x) + local unpack = unpack or table.unpack + if(type(x) == "table" and select("#", unpack(x)) == count(x)) then + return encode_list(x) + elseif(type(x) == "table") then + return encode_table(x) + elseif(type(x) == "number" and math.floor(x) == x) then + return encode_int(x) + elseif(type(x) == "string") then + return encode_str(x) + else + error("Could not encode " .. type(x) .. ": " .. tostring(x)) + end +end + +return {decode=decode, encode=encode} diff --git a/vendor/jeejah/bin/jeejah b/vendor/jeejah/bin/jeejah new file mode 100755 index 0000000..9b49226 --- /dev/null +++ b/vendor/jeejah/bin/jeejah @@ -0,0 +1,35 @@ +#!/usr/bin/env lua + +require "luarocks.loader" + +local opts, port = {foreground = true} + +for n,v in ipairs(arg) do + if(v == "--port") then + port = arg[n+1] + elseif(v == "--fennel") then + opts.fennel = true + elseif(v == "--debug") then + opts.debug = true + elseif(v == "--empty-sandbox") then + opts.sandbox = {} + elseif(v == "--version" or v == "--help") then + print("jeejah 0.2.0\n") + print("Options:") + print(" --fennel Start a Fennel server instead of Lua") + print(" --port Port on which to listen") + print(" --debug Print verbose debugging information") + os.exit(0) + end +end + +local root_dir = debug.getinfo(1).source:sub(2, -(1+#"bin/jeejah")) +local search_parent = string.format("%s?.lua;%s", root_dir, package.path) +if(package.searchpath) then + local jeejah = dofile(package.searchpath("jeejah", search_parent)) + jeejah.start(port, opts) +else -- 5.1 + if root_dir == "" then root_dir = "." end + local jeejah = dofile(root_dir .. "/jeejah.lua") + jeejah.start(port, opts) +end diff --git a/vendor/jeejah/fennel.lua b/vendor/jeejah/fennel.lua new file mode 100644 index 0000000..cb52462 --- /dev/null +++ b/vendor/jeejah/fennel.lua @@ -0,0 +1,2229 @@ +--[[ +Copyright (c) 2016-2018 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 +-- + +local function deref(self) return self[1] end + +local SYMBOL_MT = { 'SYMBOL', __tostring = deref } +local EXPR_MT = { 'EXPR', __tostring = deref } +local VARARG = setmetatable({ '...' }, { 'VARARG', __tostring = deref }) +local LIST_MT = { 'LIST', + __tostring = function (self) + local strs = {} + for _, s in ipairs(self) do + table.insert(strs, tostring(s)) + end + return '(' .. table.concat(strs, ', ', 1, #self) .. ')' + end +} + +-- 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 + +-- Create a new list +local function list(...) + return setmetatable({...}, LIST_MT) +end + +-- Create a new symbol +local function sym(str, scope, meta) + local s = {str, scope = scope} + if meta then + for k, v in pairs(meta) do + if type(k) == 'string' then s[k] = v end + end + end + return setmetatable(s, SYMBOL_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 + +-- +-- 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) or b == 44 +end + +local function issymbolchar(b) + return b > 32 and + not delims[b] and + b ~= 127 and -- "" + b ~= 34 and -- "\"" + b ~= 39 and -- "'" + b ~= 59 and -- ";" + b ~= 44 and -- "," + b ~= 96 -- "`" +end + +local prefixes = { -- prefix chars substituted while reading + [96] = 'quote', -- ` + [64] = 'unquote' -- @ +} + +-- 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) + return error(msg .. ' in ' .. (filename or 'unknown') .. ':' .. line, 0) + end + + -- Parse stream + return function() + + -- Dispatch when we complete a value + local done, retval + 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 + end + + -- The main parse loop + repeat + local b + + -- Skip whitespace + repeat + b = getb() + until not b or not iswhitespace(b) + if not b then + if #stack > 0 then parseError 'unexpected end of source' 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 + 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' 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 = {} + 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 + val[last[i]] = last[i + 1] + end + end + stack[#stack] = nil + dispatch(val) + elseif b == 34 or b == 39 then -- Quoted string + local start = b + local state = "base" + local chars = {start} + repeat + b = getb() + chars[#chars + 1] = b + if state == "base" then + if b == 92 then + state = "backslash" + elseif b == start then + state = "done" + end + else + -- state == "backslash" + state = "base" + end + until not b or (state == "done") + if not b then parseError('unexpected end of source') end + 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] + }) + else -- 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) + elseif rawstr:match('^:.+$') then -- keyword style strings + dispatch(rawstr:sub(2)) + 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 + sym(rawstr, nil, { line = line, + filename = filename, + bytestart = bytestart, + byteend = byteindex, }) + end + dispatch(x) + end + end + until done + return true, retval + end, function () + stack = {} + end +end + +-- +-- Compilation +-- + +-- 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 '*compiler' special form (may change). They +-- use metatables to implement nesting via inheritance. +local function makeScope(parent) + 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 + }), + parent = parent, + vararg = parent and parent.vararg, + depth = parent and ((parent.depth or 0) + 1) or 0 + } +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 + 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 + +local GLOBAL_SCOPE = makeScope() +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' +} +for i, v in ipairs(luaKeywords) do + luaKeywords[v] = i +end + +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 type(str) ~= 'string' then return end + local parts = {} + for part in str:gmatch('[^%.]+') do + parts[#parts + 1] = part + end + return #parts > 0 and + str:match('%.') and + (not str:match('%.%.')) and + str:byte() ~= string.byte '.' and + str:byte(-1) ~= string.byte '.' and + parts +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 + return rest:gsub('_[%da-f][%da-f]', function (code) + return string.char(tonumber(code:sub(2), 16)) + end) + else + return identifier + end +end + +-- 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. +local function localMangling(str, scope, ast) + if scope.manglings[str] then + return scope.manglings[str] + end + 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) + + local raw = mangling + while scope.unmanglings[mangling] do + mangling = raw .. append + append = append + 1 + end + scope.unmanglings[mangling] = str + scope.manglings[str] = mangling + return mangling +end + +-- 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 + ret = ret .. '.' .. parts[i] + else + ret = ret .. '[' .. serializeString(parts[i]) .. ']' + end + end + return ret +end + +-- Generates a unique symbol in the scope. +local function gensym(scope) + local mangling + local append = 0 + repeat + mangling = '_' .. append .. '_' + append = append + 1 + until not scope.unmanglings[mangling] + scope.unmanglings[mangling] = true + return mangling +end + +-- Declare a local symbol +local function declareLocal(symbol, meta, scope, ast) + local name = symbol[1] + assertCompile(not isMultiSym(name), "did not expect mutltisym", ast) + local mangling = localMangling(name, scope, ast) + scope.symmeta[name] = meta + return mangling +end + +-- 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 + +-- 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 parts = isMultiSym(name) or {name} + local etype = (#parts > 1) and "expression" or "sym" + local isLocal = scope.manglings[parts[1]] + -- 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) + 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 + for i, v in ipairs(chunk) do + chunk[i] = peephole(v) + end + return chunk +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 + local parts = {} + for i = 1, #chunk do + -- Ignore empty chunks + if chunk[i].leaf or #(chunk[i]) > 0 then + local sub = flattenChunk(sm, chunk[i], tab, depth + 1) + if depth > 0 then sub = tab .. sub:gsub('\n', '\n' .. tab) end + table.insert(parts, sub) + end + end + 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) + local sm = options.sourcemap and {} + chunk = peephole(chunk) + if(options.correlate) then + return flattenChunkCorrelated(chunk), {} + else + 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 + +-- Convert expressions to Lua string +local function exprs1(exprs) + local t = {} + for _, e in ipairs(exprs) do + t[#t + 1] = e[1] + end + return table.concat(t, ', ') +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 + emit(chunk, tostring(se), 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, 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. +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 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 + 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 + -- 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 + local keys = {} + for k, _ in pairs(ast) do -- Write other keys. + if type(k) ~= 'number' or math.floor(k) ~= k or k < 1 or k > #ast then + local kstr + if type(k) == 'string' and isValidLuaIdentifier(k) then + kstr = k + else + kstr = '[' .. tostring(compile1(k, scope, parent, {nval = 1})[1]) .. ']' + end + table.insert(keys, { kstr, k }) + end + end + table.sort(keys, function (a, b) return a[1] < b[1] end) + for _, k in ipairs(keys) do + local v = ast[k[2]] + buffer[#buffer + 1] = ('%s = %s'):format( + k[1], tostring(compile1(v, scope, parent, {nval = 1})[1])) + end + 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" + + -- 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 + return declareLocal(symbol, {var = isvar}, scope, symbol) + 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 + return symbolToExpression(symbol, scope)[1] + end + end + + -- Recursive auxiliary function + local function destructure1(left, rightexprs, up1) + if isSym(left) and left[1] ~= "nil" then + emit(parent, setter:format(getname(left, up1), exprs1(rightexprs)), left) + elseif isTable(left) then -- table destructuring + 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 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 + emit(parent, setter: + format(table.concat(leftNames, ", "), exprs1(rightexprs)), left) + for _, pair in pairs(tables) do -- recurse if left-side tables found + destructure1(pair[1], {pair[2]}, left) + end + else + assertCompile(false, 'unable to destructure ' .. tostring(left), up1) + end + end + + local rexps = compile1(from, scope, parent) + local ret = destructure1(to, rexps, ast) + return ret +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, {}) + exprs[#exprs + 1] = subexprs[1] or expr('nil', 'literal') + if i == len then + for j = 2, #subexprs do + exprs[#exprs + 1] = subexprs[j] + end + else + -- Emit sub expression only for side effects + keepSideEffects(subexprs, parent, 2, ast) + 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 + +-- 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) + return retexprs +end + +SPECIALS['do'] = doImpl +SPECIALS['values'] = values + +-- 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. +SPECIALS['fn'] = function(ast, scope, parent) + local fScope = makeScope(scope) + local fChunk = {} + local index = 2 + local fnName = isSym(ast[index]) + local isLocalFn + 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]), + 'expected vector arg list [a b ...]', ast) + local argNameList = {} + for i = 1, #argList do + if isVarg(argList[i]) then + assertCompile(i == #argList, "expected vararg in last parameter position", ast) + argNameList[i] = '...' + fScope.vararg = true + elseif(isSym(argList[i]) and argList[i][1] ~= "nil" + and not isMultiSym(argList[i][1])) then + argNameList[i] = declareLocal(argList[i], {}, fScope, ast) + elseif isTable(argList[i]) then + local raw = sym(gensym(scope)) + argNameList[i] = declareLocal(raw, {}, fScope, ast) + destructure(argList[i], raw, ast, fScope, fChunk, + { declaration = true, nomulti = true }) + else + assertCompile(false, 'expected symbol for function parameter', ast) + end + 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) + return expr(fnName, 'sym') +end + +SPECIALS['luaexpr'] = function(ast) + return tostring(ast[2]) +end + +SPECIALS['luastatement'] = function(ast) + return expr(tostring(ast[2]), 'statement') +end + +-- Wrapper for table access +SPECIALS['.'] = function(ast, scope, parent) + 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 + +SPECIALS['global'] = function(ast, scope, parent) + assertCompile(#ast == 3, "expected name and value", ast) + if allowedGlobals then table.insert(allowedGlobals, ast[2][1]) end + destructure(ast[2], ast[3], ast, scope, parent, { + nomulti = true, + forceglobal = true + }) +end + +SPECIALS['set'] = function(ast, scope, parent) + assertCompile(#ast == 3, "expected name and value", ast) + destructure(ast[2], ast[3], ast, scope, parent, { + noundef = true + }) +end + +SPECIALS['set-forcibly!'] = function(ast, scope, parent) + assertCompile(#ast == 3, "expected name and value", ast) + destructure(ast[2], ast[3], ast, scope, parent, { + forceset = true + }) +end + +SPECIALS['local'] = function(ast, scope, parent) + assertCompile(#ast == 3, "expected name and value", ast) + destructure(ast[2], ast[3], ast, scope, parent, { + declaration = true, + nomulti = true + }) +end + +SPECIALS['var'] = function(ast, scope, parent) + assertCompile(#ast == 3, "expected name and value", ast) + destructure(ast[2], ast[3], ast, scope, parent, { + declaration = true, + nomulti = true, + isvar = true + }) +end + +SPECIALS['let'] = function(ast, scope, parent, opts) + local bindings = ast[2] + assertCompile(isList(bindings) or isTable(bindings), + 'expected table for destructuring', ast) + assertCompile(#bindings % 2 == 0, + 'expected even number of name/value bindings', ast) + assertCompile(#ast >= 3, 'missing body expression', ast) + 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 + +-- For setting items in a table +SPECIALS['tset'] = function(ast, scope, parent) + assertCompile(#ast > 3, + ('tset form needs table, key, and value'), ast) + 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] + emit(parent, ('%s[%s] = %s'):format(tostring(root), + table.concat(keys, ']['), + tostring(value)), ast) +end + +-- The if special form behaves like the cond form in +-- many languages +SPECIALS['if'] = function(ast, scope, parent, opts) + local doScope = makeScope(scope) + local branches = {} + local elseBranch = nil + + -- Calculate some external stuff. Optimizes for tail calls and what not + local outerTail = true + local outerTarget = nil + local wrapper = 'iife' + if opts.tail then + wrapper = 'none' + end + + -- Compile bodies and conditions + local bodyOpts = { + tail = outerTail, + target = outerTarget + } + local function compileBody(i) + local chunk = {} + local cscope = makeScope(doScope) + compile1(ast[i], cscope, chunk, bodyOpts) + return { + chunk = chunk, + scope = cscope + } + end + for i = 2, #ast - 1, 2 do + local condchunk = {} + local cond = compile1(ast[i], doScope, condchunk, {nval = 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 condLine = fstr:format(tostring(branch.cond[1])) + 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) + 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} + end +end + +-- (each [k v (pairs t)] body...) => [] +SPECIALS['each'] = function(ast, scope, parent) + local binding = assertCompile(isTable(ast[2]), 'expected binding table', ast) + local iter = table.remove(binding, #binding) -- last item is iterator call + local bindVars = {} + local destructures = {} + for _, v in ipairs(binding) do + assertCompile(isSym(v) or isTable(v), + 'expected iterator symbol or table', ast) + if(isSym(v)) then + table.insert(bindVars, declareLocal(v, {}, scope, ast)) + else + local raw = sym(gensym(scope)) + destructures[raw] = v + table.insert(bindVars, declareLocal(raw, {}, scope, ast)) + end + end + emit(parent, ('for %s in %s do'):format( + table.concat(bindVars, ', '), + tostring(compile1(iter, scope, parent, {nval = 1})[1])), ast) + local chunk = {} + for raw, args in pairs(destructures) do + destructure(args, raw, ast, scope, chunk, + { declaration = true, nomulti = true }) + end + compileDo(ast, scope, chunk, 3) + emit(parent, chunk, ast) + emit(parent, 'end', ast) +end + +-- (while condition body...) => [] +SPECIALS['while'] = function(ast, scope, parent) + local len1 = #parent + local condition = compile1(ast[2], scope, parent, {nval = 1})[1] + local len2 = #parent + local subChunk = {} + if len1 ~= len2 then + -- Compound condition + emit(parent, 'while true do', ast) + -- Move new compilation to subchunk + for i = len1 + 1, len2 do + subChunk[#subChunk + 1] = parent[i] + parent[i] = nil + end + emit(parent, ('if %s then break end'):format(condition[1]), ast) + 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 + +SPECIALS['for'] = function(ast, scope, parent) + local ranges = assertCompile(isTable(ast[2]), 'expected binding table', ast) + local bindingSym = assertCompile(isSym(table.remove(ast[2], 1)), + 'expected iterator symbol', ast) + 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 + +SPECIALS[':'] = function(ast, scope, parent) + assertCompile(#ast >= 3, 'expected at least 3 arguments', ast) + -- 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 + }) + for j = 1, #subexprs do + args[#args + 1] = tostring(subexprs[j]) + end + end + local fstring + if methodident then + fstring = objectexpr.type == 'literal' + and '(%s):%s(%s)' + or '%s:%s(%s)' + else + -- Make object first argument + table.insert(args, 1, tostring(objectexpr)) + fstring = objectexpr.type == 'sym' + and '%s[%s](%s)' + or '(%s)[%s](%s)' + end + return expr(fstring:format( + tostring(objectexpr), + methodstring, + table.concat(args, ', ')), 'statement') +end + +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) + }) + for j = 1, #subexprs do + operands[#operands + 1] = tostring(subexprs[j]) + end + 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 +end + +defineArithmeticSpecial('+', '0') +defineArithmeticSpecial('..', "''") +defineArithmeticSpecial('^') +defineArithmeticSpecial('-', nil, '') +defineArithmeticSpecial('*', '1') +defineArithmeticSpecial('%') +defineArithmeticSpecial('/', nil, '1') +defineArithmeticSpecial('//', nil, '1') +defineArithmeticSpecial('or', 'false') +defineArithmeticSpecial('and', 'true') + +local function defineComparatorSpecial(name, realop) + local op = realop or name + SPECIALS[name] = function(ast, scope, parent) + local len = #ast + assertCompile(len > 2, 'expected at least two arguments', ast) + 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 .. " and (%s %s %s)"): + format(tostring(lastval), op, tostring(nextval)) + lastval = nextval + end + out = '(' .. out .. ')' + end + return out + end +end + +defineComparatorSpecial('>') +defineComparatorSpecial('<') +defineComparatorSpecial('>=') +defineComparatorSpecial('<=') +defineComparatorSpecial('=', '==') +defineComparatorSpecial('~=') + +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 + +defineUnarySpecial('not', 'not ') +defineUnarySpecial('#') + +-- Covert a macro function to a special form +local function macroToSpecial(mac) + return function(ast, scope, parent, opts) + local ok, transformed = pcall(mac, unpack(ast, 2)) + assertCompile(ok, transformed, ast) + return compile1(transformed, scope, parent, opts) + end +end + +local function compile(ast, options) + options = options or {} + local oldGlobals = allowedGlobals + allowedGlobals = options.allowedGlobals + if options.indent == nil then options.indent = ' ' end + local chunk = {} + local scope = options.scope or makeScope(GLOBAL_SCOPE) + local exprs = compile1(ast, scope, chunk, {tail = true}) + keepSideEffects(exprs, chunk, nil, ast) + allowedGlobals = oldGlobals + return flatten(chunk, options) +end + +-- map a function across all pairs in a table +local function quoteTmap(f, t) + local res = {} + for k,v in pairs(t) do + local nk, nv = f(k, v) + if nk then + res[nk] = nv + end + end + return res +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 + -- symbol + if isSym(form) then + assertCompile(not runtime, "symbols may only be used at compile time", form) + return ("sym('%s')"):format(deref(form)) + -- 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) + local mapped = quoteTmap(entryTransform(no, q), form) + return 'list(' .. mixedConcat(mapped, ", ") .. ')' + -- table + elseif type(form) == 'table' then + local mapped = quoteTmap(entryTransform(q, q), form) + 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 + +local function compileStream(strm, options) + options = options or {} + local oldGlobals = allowedGlobals + allowedGlobals = options.allowedGlobals + if options.indent == nil then options.indent = ' ' end + local scope = options.scope or makeScope(GLOBAL_SCOPE) + local vals = {} + for ok, val in parser(strm, options.filename) do + if not ok then break end + vals[#vals + 1] = val + end + local chunk = {} + for i = 1, #vals do + local exprs = compile1(vals[i], scope, chunk, { + tail = i == #vals + }) + keepSideEffects(exprs, chunk, nil, vals[i]) + end + allowedGlobals = oldGlobals + return flatten(chunk, options) +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() + local pt = {} + for key, value in pairs(env) do + if type(key) == 'string' then + pt[globalUnmangling(key)] = value + else + pt[key] = value + end + end + 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 + table.insert(lines, msg) + 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) + local names = {} + for k in pairs(env or _G) do + k = globalUnmangling(k) + table.insert(names, k) + end + return names +end + +local function eval(str, options, ...) + options = options or {} + -- 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. + if options.allowedGlobals == nil and not getmetatable(options.env) then + options.allowedGlobals = currentGlobalNames(options.env) + end + local env = options.env and wrapEnv(options.env) + local luaSource = compileString(str, options) + local loader = loadCode(luaSource, env, + options.filename and ('@' .. options.filename) or str) + return loader(...) +end + +local function dofileFennel(filename, options, ...) + options = options or {sourcemap = true} + if options.allowedGlobals == nil then + options.allowedGlobals = currentGlobalNames(options.env) + end + local f = assert(io.open(filename, "rb")) + local source = f:read("*all"):gsub("^#![^\n]*\n", "") + f:close() + options.filename = options.filename or filename + return eval(source, options, ...) +end + +-- Implements a configurable repl +local function repl(options) + + local opts = options or {} + -- This would get set for us when calling eval, but we want to seed it + -- with a value that is persistent so it doesn't get reset on each eval. + if opts.allowedGlobals == nil then + options.allowedGlobals = currentGlobalNames(opts.env) + end + + local env = opts.env and wrapEnv(opts.env) or setmetatable({}, { + __index = _ENV or _G + }) + + local function defaultReadChunk(parserState) + io.write(parserState.stackSize > 0 and '.. ' or '>> ') + io.flush() + local input = io.read() + return input and input .. '\n' + end + + local function defaultOnValues(xs) + io.write(table.concat(xs, '\t')) + io.write('\n') + end + + local function defaultOnError(errtype, err, luaSource) + if (errtype == 'Lua Compile') then + io.write('Bad code generated - likely a bug with the compiler:\n') + io.write('--- Generated Lua Start ---\n') + io.write(luaSource .. '\n') + io.write('--- Generated Lua End ---\n') + end + if (errtype == 'Runtime') then + io.write(traceback(err, 4)) + io.write('\n') + else + io.write(('%s error: %s\n'):format(errtype, tostring(err))) + end + end + + -- Read options + local readChunk = opts.readChunk or defaultReadChunk + local onValues = opts.onValues or defaultOnValues + local onError = opts.onError or defaultOnError + local pp = opts.pp or tostring + + -- Make parser + local bytestream, clearstream = granulate(readChunk) + local chars = {} + local read, reset = parser(function (parserState) + local c = bytestream(parserState) + chars[#chars + 1] = c + return c + end) + + local envdbg = (opts.env or _G)["debug"] + -- if the environment doesn't support debug.getlocal you can't save locals + local saveLocals = opts.saveLocals ~= false and envdbg and envdbg.getlocal + local saveSource = 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") + + local spliceSaveLocals = function(luaSource) + -- we do some source munging in order to save off locals from each chunk + -- and reintroduce them to the beginning of the next chunk, allowing + -- locals to work in the repl the way you'd expect them to. + env.___replLocals___ = env.___replLocals___ or {} + local splicedSource = {} + for line in luaSource:gmatch("([^\n]+)\n?") do + table.insert(splicedSource, line) + end + -- reintroduce locals from the previous time around + local bind = "local %s = ___replLocals___['%s']" + for name in pairs(env.___replLocals___) do + table.insert(splicedSource, 1, bind:format(name, name)) + end + -- save off new locals at the end - if safe to do so (i.e. last line is a return) + if (string.match(splicedSource[#splicedSource], "^ *return .*$")) then + if (#splicedSource > 1) then + table.insert(splicedSource, #splicedSource, saveSource) + end + end + return table.concat(splicedSource, "\n") + end + + local scope = makeScope(GLOBAL_SCOPE) + + -- REPL loop + while true do + chars = {} + local ok, parseok, x = pcall(read) + local srcstring = string.char(unpack(chars)) + if not ok then + onError('Parse', parseok) + clearstream() + reset() + else + if not parseok then break end -- eof + local compileOk, luaSource = pcall(compile, x, { + sourcemap = opts.sourcemap, + source = srcstring, + scope = scope, + }) + if not compileOk then + clearstream() + onError('Compile', luaSource) -- luaSource is error message in this case + else + if saveLocals then + luaSource = spliceSaveLocals(luaSource) + end + local luacompileok, loader = pcall(loadCode, luaSource, env) + if not luacompileok then + clearstream() + onError('Lua Compile', loader, luaSource) + else + local loadok, ret = xpcall(function () return {loader()} end, + function (runtimeErr) + onError('Runtime', runtimeErr) + end) + if loadok then + env._ = ret[1] + env.__ = ret + for i = 1, #ret do ret[i] = pp(ret[i]) end + onValues(ret) + end + end + end + end + end +end + +local macroLoaded = {} + +local module = { + parser = parser, + granulate = granulate, + stringStream = stringStream, + compile = compile, + compileString = compileString, + compileStream = compileStream, + compile1 = compile1, + mangle = globalMangling, + unmangle = globalUnmangling, + list = list, + sym = sym, + varg = varg, + scope = makeScope, + gensym = gensym, + eval = eval, + repl = repl, + dofile = dofileFennel, + macroLoaded = macroLoaded, + path = "./?.fnl;./?/init.fnl", + traceback = traceback, + version = "0.1.1-dev", +} + +local function searchModule(modulename) + modulename = modulename:gsub("%.", "/") + for path in string.gmatch(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) + local opts = {} + 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 + +-- 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(scope)) end, + ["list?"] = isList, + ["multi-sym?"] = isMultiSym, + ["sym?"] = isSym, + ["table?"] = isTable, + ["varg?"] = isVarg, + ["in-scope?"] = function(symbol) + return scope.manglings[symbol] + end + }, { __index = _ENV or _G }) +end + +local function macroGlobals(env, globals) + local allowed = {} + for k in pairs(env) do + local g = globalUnmangling(k) + table.insert(allowed, g) + end + if globals then + for _, k in pairs(globals) do + table.insert(allowed, k) + end + end + return allowed +end + +local function addMacros(macros, ast, scope) + assertCompile(isTable(macros), 'expected macros to be table', ast) + for k, v in pairs(macros) do + scope.specials[k] = macroToSpecial(v) + end +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, + 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 + +local function evalCompiler(ast, scope, parent) + local luaSource = compile(ast, { scope = makeScope(COMPILER_SCOPE) }) + 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 + +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 + +-- Load standard macros +local stdmacros = [===[ +{"->" (fn [val ...] + (var x val) + (each [_ elt (ipairs [...])] + (table.insert elt 2 x) + (set x elt)) + x) + "->>" (fn [val ...] + (var x val) + (each [_ elt (pairs [...])] + (table.insert elt x) + (set x elt)) + x) + "-?>" (fn [val ...] + (if (= 0 (# [...])) + val + (let [els [...] + el (table.remove els 1) + tmp (gensym)] + (table.insert el 2 tmp) + `(let [@tmp @val] + (if @tmp + (-?> @el @(unpack els)) + @tmp))))) + "-?>>" (fn [val ...] + (if (= 0 (# [...])) + val + (let [els [...] + el (table.remove els 1) + tmp (gensym)] + (table.insert el tmp) + `(let [@tmp @val] + (if @tmp + (-?>> @el @(unpack els)) + @tmp))))) + :doto (fn [val ...] + (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 ...] + (assert body1 "expected body") + `(if @condition + (do @body1 @...))) + :partial (fn [f ...] + (let [body (list f ...)] + (table.insert body _VARARG) + `(fn [@_VARARG] @body))) + :lambda (fn [...] + (let [args [...] + has-internal-name? (sym? (. args 1)) + arglist (if has-internal-name? (. args 2) (. args 1)) + arity-check-position (if has-internal-name? 3 2)] + (assert (> (# args) 1) "missing body expression") + (each [i a (ipairs arglist)] + (if (and (not (: (tostring a) :match "^?")) + (~= (tostring a) "...")) + (table.insert args arity-check-position + `(assert (~= nil @a) + (: "Missing argument %s on %s:%s" + :format @(tostring a) + @(or a.filename "unknown") + @(or a.line "?")))))) + `(fn @(unpack args)))) + :match +(fn match [val ...] + ;; 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 (and (sym? pattern) ; unification with outer locals (or nil) + (or (in-scope? pattern) + (= :nil (tostring pattern)))) + (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) + (do (if (~= (tostring pattern) "_") + (tset unifications (tostring pattern) val)) + (values (if (: (tostring pattern) :find "^?") + true `(~= @(sym :nil) @val)) + [pattern val])) + + ;; 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)] + (assert (not (varg? pat)) "TODO: match against varg not implemented") + (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 (# 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 (# 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 (~= 0 (% (# clauses) 2)) ; treat odd final clause as default + (table.insert clauses (# 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 + local env = makeCompilerEnv(nil, COMPILER_SCOPE, {}) + for name, fn in pairs(eval(stdmacros, { + env = env, + scope = makeScope(COMPILER_SCOPE), + allowedGlobals = macroGlobals(env, currentGlobalNames()), + })) do + SPECIALS[name] = macroToSpecial(fn) + end +end +SPECIALS['λ'] = SPECIALS['lambda'] + +return module diff --git a/vendor/jeejah/fennelview.fnl b/vendor/jeejah/fennelview.fnl new file mode 100644 index 0000000..1cb4598 --- /dev/null +++ b/vendor/jeejah/fennelview.fnl @@ -0,0 +1,156 @@ +;; A pretty-printer that outputs tables in Fennel syntax. +;; Loosely based on inspect.lua: http://github.com/kikito/inspect.lua + +(local view-quote (fn [str] (.. '"' (: str :gsub '"' '\\"') '"'))) + +(local short-control-char-escapes + {"\a" "\\a" "\b" "\\b" "\f" "\\f" "\n" "\\n" + "\r" "\\r" "\t" "\\t" "\v" "\\v"}) + +(local long-control-char-esapes + (let [long {}] + (for [i 0 31] + (let [ch (string.char i)] + (when (not (. short-control-char-escapes ch)) + (tset short-control-char-escapes ch (.. "\\" i)) + (tset long ch (: "\\%03d" :format i))))) + long)) + +(fn escape [str] + (let [str (: str :gsub "\\" "\\\\") + str (: str :gsub "(%c)%f[0-9]" long-control-char-esapes)] + (: str :gsub "%c" short-control-char-escapes))) + +(fn sequence-key? [k len] + (and (= (type k) "number") + (<= 1 k) + (<= k len) + (= (math.floor k) k))) + +(local type-order {:number 1 :boolean 2 :string 3 :table 4 + :function 5 :userdata 6 :thread 7}) + +(fn sort-keys [a b] + (let [ta (type a) tb (type b)] + (if (and (= ta tb) (~= ta "boolean") + (or (= ta "string") (= ta "number"))) + (< a b) + (let [dta (. type-order a) + dtb (. type-order b)] + (if (and dta dtb) + (< dta dtb) + dta true + dtb false + :else (< ta tb)))))) + +(fn get-sequence-length [t] + (var len 1) + (each [i (ipairs t)] (set len i)) + len) + +(fn get-nonsequential-keys [t] + (let [keys {} + sequence-length (get-sequence-length t)] + (each [k (pairs t)] + (when (not (sequence-key? k sequence-length)) + (table.insert keys k))) + (table.sort keys sort-keys) + (values keys sequence-length))) + +(fn count-table-appearances [t appearances] + (if (= (type t) "table") + (when (not (. appearances t)) + (tset appearances t 1) + (each [k v (pairs t)] + (count-table-appearances k appearances) + (count-table-appearances v appearances))) + (when (and t (= t t)) ; no nans please + (tset appearances t (+ (or (. appearances t) 0) 1)))) + appearances) + + + +(var put-value nil) ; mutual recursion going on; defined below + +(fn puts [self ...] + (each [_ v (ipairs [...])] + (table.insert self.buffer v))) + +(fn tabify [self] (puts self "\n" (: self.indent :rep self.level))) + +(fn already-visited? [self v] (~= (. self.ids v) nil)) + +(fn get-id [self v] + (var id (. self.ids v)) + (when (not id) + (let [tv (type v)] + (set id (+ (or (. self.max-ids tv) 0) 1)) + (tset self.max-ids tv id) + (tset self.ids v id))) + (tostring id)) + +(fn put-sequential-table [self t length] + (puts self "[") + (set self.level (+ self.level 1)) + (for [i 1 length] + (puts self " ") + (put-value self (. t i))) + (set self.level (- self.level 1)) + (puts self " ]")) + +(fn put-key [self k] + (if (and (= (type k) "string") + (: k :find "^[-%w?\\^_`!#$%&*+./@~:|<=>]+$")) + (puts self ":" k) + (put-value self k))) + +(fn put-kv-table [self t] + (puts self "{") + (set self.level (+ self.level 1)) + (each [k v (pairs t)] + (tabify self) + (put-key self k) + (puts self " ") + (put-value self v)) + (set self.level (- self.level 1)) + (tabify self) + (puts self "}")) + +(fn put-table [self t] + (if (already-visited? self t) + (puts self "#") + (>= self.level self.depth) + (puts self "{...}") + :else + (let [(non-seq-keys length) (get-nonsequential-keys t) + id (get-id self t)] + (if (> (. self.appearances t) 1) + (puts self "#<" id ">") + (and (= (# non-seq-keys) 0) (= (# t) 0)) + (puts self "{}") + (= (# non-seq-keys) 0) + (put-sequential-table self t length) + :else + (put-kv-table self t))))) + +(set put-value (fn [self v] + (let [tv (type v)] + (if (= tv "string") + (puts self (view-quote (escape v))) + (or (= tv "number") (= tv "boolean") (= tv "nil")) + (puts self (tostring v)) + (= tv "table") + (put-table self v) + :else + (puts self "#<" (tostring v) ">"))))) + + + +(fn fennelview [root options] + (let [options (or options {}) + inspector {:appearances (count-table-appearances root {}) + :depth (or options.depth 128) + :level 0 :buffer {} :ids {} :max-ids {} + :indent (or options.indent " ")}] + (put-value inspector root) + (table.concat inspector.buffer))) diff --git a/vendor/jeejah/jeejah.lua b/vendor/jeejah/jeejah.lua new file mode 100644 index 0000000..3dffd9f --- /dev/null +++ b/vendor/jeejah/jeejah.lua @@ -0,0 +1,357 @@ +local socket = require "socket" +local serpent = require "serpent" +local bencode = require "bencode" + +local load = loadstring or load + +local timeout = 0.001 + +local d = os.getenv("DEBUG") and print or function(_) end +local serpent_pp = function(p) return function(x) + local serpent_opts = {maxlevel=8,maxnum=64,nocode=true} + p(serpent.block(x, serpent_opts)) end +end +local sessions = {} + +local response_for = function(old_msg, msg) + -- certain implementations break when the ns field is empty; see + -- https://gitlab.com/technomancy/jeejah/issues/5 + msg.session, msg.id, msg.ns = old_msg.session, old_msg.id, ">" + return msg +end + +local send = function(conn, msg) + d("Sending", bencode.encode(msg)) + conn:send(bencode.encode(msg)) +end + +local write_for = function(conn, msg) + return function(...) + send(conn, response_for(msg, {out=table.concat({...}, "\t")})) + end +end + +local print_for = function(write) + return function(...) + local args = {...} + for i,x in ipairs(args) do args[i] = tostring(x) end + table.insert(args, "\n") + write(table.concat(args, " ")) + end +end + +local read_for = function(conn, msg) + return function() + send(conn, response_for(msg, {status={"need-input"}})) + while(not sessions[msg.session].input) do + coroutine.yield() + d("yielded") + end + local input = sessions[msg.session].input + sessions[msg.session].input = nil + return input + end +end + +local sandbox_for = function(write, provided_sandbox) + local sandbox = { io = { write = write }, + print = print_for(write), } + for k,v in pairs(provided_sandbox) do + sandbox[k] = v + end + return sandbox +end + +-- for stuff that's shared between eval and load_file +local execute_chunk = function(session, chunk, pp) + local old_write, old_print, old_read = io.write, print, io.read + if(session.sandbox) then + setfenv(chunk, session.sandbox) + pp = pp or serpent_pp(session.sandbox.print) + else + _G.print = print_for(session.write) + _G.io.write, _G.io.read = session.write, session.read + pp = pp or serpent_pp(_G.print) + end + + local trace, err + local result = {xpcall(chunk, function(e) + trace = debug.traceback() + err = e end)} + + _G.print, _G.io.write, _G.io.read = old_print, old_write, old_read + + if(result[1]) then + local res, i = pp(result[2]), 3 + while i <= #result do + res = res .. ', ' .. pp(result[i]) + i = i + 1 + end + return res + else + return nil, (err or "Unknown error") .. "\n" .. trace + end +end + +local eval = function(session, code, pp) + local chunk, err = load("return " .. code, "*socket*") + if(err and not chunk) then -- statement, not expression + chunk, err = load(code, "*socket*") + if(not chunk) then + return nil, "Compilation error: " .. (err or "unknown") + end + end + return execute_chunk(session, chunk, pp) +end + +local load_file = function(session, file, loader) + local chunk, err = (loader or loadfile)(file) + if(not chunk) then + return nil, "Compilation error in " .. file ": ".. (err or "unknown") + end + return execute_chunk(session, chunk) +end + +local register_session = function(conn, msg, provided_sandbox) + local id = tostring(math.random(999999999)) + local write = write_for(conn, msg) + local sandbox = provided_sandbox and sandbox_for(write, provided_sandbox) + sessions[id] = { conn = conn, write = write, print = print_for(write), + sandbox = sandbox, coros = {}, id = id} + return response_for(msg, {["new-session"]=id, status={"done"}}) +end + +local unregister_session = function(msg) + sessions[msg.session] = nil + return response_for(msg, {status={"done"}}) +end + +local describe = function(msg, handlers) + local ops = { "clone", "close", "describe", "eval", "load-file", + "ls-sessions", "complete", "stdin", "interrupt" } + for op in handlers do table.insert(ops, op) end + return response_for(msg, {ops=ops, status={"done"}}) +end + +local session_for = function(conn, msg, sandbox) + local s = sessions[msg.session] or register_session(conn, msg, sandbox) + s.write = write_for(conn, msg) + s.read = read_for(conn, msg) + return s +end + +local complete = function(msg, sandbox) + local clone = function(t) + local n = {} for k,v in pairs(t) do n[k] = v end return n + end + local top_ctx = clone(sandbox or _G) + for k,v in pairs(msg.libs or {}) do + top_ctx[k] = require(v:sub(2,-2)) + end + + local function cpl_for(input_parts, ctx) + if type(ctx) ~= "table" then return {} end + if #input_parts == 0 and ctx ~= top_ctx then + return ctx + elseif #input_parts == 1 then + local matches = {} + for k in pairs(ctx) do + if k:find('^' .. input_parts[1]) then + table.insert(matches, k) + end + end + return matches + else + local token1 = table.remove(input_parts, 1) + return cpl_for(input_parts, ctx[token1]) + end + end + local input_parts = {} + for i in string.gmatch(msg.input, "([^.%s]+)") do + table.insert(input_parts, i) + end + return response_for(msg, {completions = cpl_for(input_parts, top_ctx)}) +end + +-- see https://github.com/clojure/tools.nrepl/blob/master/doc/ops.md +local handle = function(conn, handlers, sandbox, msg) + if(handlers and handlers[msg.op]) then + d("Custom op:", msg.op) + handlers[msg.op](conn, msg, session_for(conn, msg, sandbox), + send, response_for) + elseif(msg.op == "clone") then + d("New session.") + send(conn, register_session(conn, msg, sandbox)) + elseif(msg.op == "describe") then + d("Describe.") + send(conn, describe(msg, handlers)) + elseif(msg.op == "eval") then + d("Evaluating", msg.code) + local value, err = eval(session_for(conn, msg, sandbox), msg.code, msg.pp) + d("Got", value, err) + -- monroe bug means you have to send done status separately + send(conn, response_for(msg, {value=value, ex=err})) + send(conn, response_for(msg, {status={"done"}})) + elseif(msg.op == "load-file") then + d("Loading file", msg.file) + local value, err = load_file(session_for(conn, msg, sandbox), + msg.file, msg.loader) + d("Got", value, err) + send(conn, response_for(msg, {value=value, ex=err, status={"done"}})) + elseif(msg.op == "ls-sessions") then + d("List sessions") + local session_ids = {} + for id in pairs(sessions) do table.insert(session_ids, id) end + send(conn, response_for(msg, {sessions=session_ids, status={"done"}})) + elseif(msg.op == "complete") then + d("Complete", msg.input) + local session_sandbox = session_for(conn, msg, sandbox).sandbox + send(conn, complete(msg, session_sandbox)) + elseif(msg.op == "stdin") then + d("Stdin", serpent.block(msg)) + sessions[msg.session].input = msg.stdin + send(conn, response_for(msg, {status={"done"}})) + return + elseif(msg.op ~= "interrupt") then -- silently ignore interrupt + send(conn, response_for(msg, {status={"unknown-op"}})) + print(" | Unknown op", serpent.block(msg)) + end +end + +local handler_coros = {} + +local function receive(conn, partial) + local s, err = conn:receive(1) -- wow this is primitive + -- iterate backwards so we can safely remove + for i=#handler_coros, 1, -1 do + local ok, err2 = coroutine.resume(handler_coros[i]) + if(coroutine.status(handler_coros[i]) ~= "suspended") then + if(not ok) then print(" | Handler error", err2) end + table.remove(handler_coros, i) + end + end + + if(s) then + return receive(conn, (partial or "") .. s) + elseif(err == "timeout" and partial == nil) then + coroutine.yield() + return receive(conn) + elseif(err == "timeout") then + return partial + else + return nil, err + end +end + +local function client_loop(conn, sandbox, handlers, middleware, partial) + local input, r_err = receive(conn, partial) + if(input) then + local decoded, d_err = bencode.decode(input) + if decoded and d_err < #input then + partial = input:sub(d_err + 1) + else + partial = nil + end + coroutine.yield() + if(decoded and decoded.op == "close") then + d("End session.") + return send(conn, unregister_session(decoded)) + elseif(decoded and decoded.op ~= "close") then + -- If we don't spin up a coroutine here, we can't io.read, because + -- that requires waiting for a response from the client. But most + -- messages don't need to stick around. + local coro = coroutine.create(handle) + if(middleware) then + middleware(function(msg) + local ok, err = coroutine.resume(coro, conn, handlers, + sandbox, msg) + if(not ok) then print(" | Handler error", err) end + end, decoded) + else + local ok, err = coroutine.resume(coro, conn, handlers, + sandbox, decoded) + if(not ok) then print(" | Handler error", err) end + end + if(coroutine.status(coro) == "suspended") then + table.insert(handler_coros, coro) + end + else + print(" | Decoding error:", d_err) + end + return client_loop(conn, sandbox, handlers, middleware, partial) + else + return r_err + end +end + +local connections = {} + +local function loop(server, sandbox, handlers, middleware, foreground) + socket.sleep(timeout) + local conn, err = server:accept() + local stop = (not foreground) and (coroutine.yield() == "stop") + if(conn) then + conn:settimeout(timeout) + d("Connected.") + local coro = coroutine.create(function() + local _, h_err = pcall(client_loop, conn, sandbox, handlers, middleware) + if(h_err ~= "closed") then print("Connection closed: " .. h_err) end + end) + table.insert(connections, coro) + return loop(server, sandbox, handlers, middleware, foreground) + else + if(err ~= "timeout") then print(" | Socket error: " .. err) end + for _,c in ipairs(connections) do coroutine.resume(c) end + if(stop or err == "closed") then + server:close() + print("Server stopped.") + else + return loop(server, sandbox, handlers, middleware, foreground) + end + end +end + +return { + -- Start an nrepl socket server on the given port. For opts you can pass a + -- table with foreground=true to run in the foreground, debug=true for + -- verbose logging, and sandbox={...} to evaluate all code in a sandbox. You + -- can also give an opts.handlers table keying ops to handler functions which + -- take the socket, the decoded message, and the optional sandbox table. + start = function(port, opts) + port = port or 7888 + opts = opts or {} + opts.handlers = opts.handlers or {} + -- host should always be localhost on a PC, but not always on a micro + local server = assert(socket.bind(opts.host or "localhost", port)) + if(opts.debug) then d = print end + if(opts.timeout) then timeout = tonumber(opts.timeout) end + if(opts.fennel) then + local fenneleval = require("jeejah.fenneleval") + opts.handlers.eval = fenneleval + opts.handlers.stdin = fenneleval + end + assert(not opts.sandbox or setfenv, "Can't use sandbox on 5.2+") + + server:settimeout(timeout) + print("Server started on port " .. port .. "...") + if opts.foreground then + return loop(server, opts.sandbox, opts.handlers, + opts.middleware, opts.foreground) + else + return coroutine.create(function() + loop(server, opts.sandbox, opts.handlers, opts.middleware) + end) + end + end, + + -- Pass in the coroutine from jeejah.start to this function to stop it. + stop = function(coro) + coroutine.resume(coro, "stop") + end, + + broadcast = function(msg) + for _,session in pairs(sessions) do + send(session.conn, msg) + end + end, +} diff --git a/vendor/jeejah/jeejah/fenneleval.lua b/vendor/jeejah/jeejah/fenneleval.lua new file mode 100644 index 0000000..ffac3ce --- /dev/null +++ b/vendor/jeejah/jeejah/fenneleval.lua @@ -0,0 +1,77 @@ +local fennel = require("fennel") +local fennelview_ok, fennelview = pcall(require, "fennelview") +if not fennelview_ok then fennelview = fennel.dofile("fennelview.fnl") end + +local d = os.getenv("DEBUG") and print or function(_) end + +local repls = {} + +local print_for = function(write) + return function(...) + local args = {...} + for i,x in ipairs(args) do args[i] = tostring(x) end + table.insert(args, "\n") + write(table.concat(args, " ")) + end +end + +local make_repl = function(session, repls) + local on_values = function(xs) + session.values(xs) + session.done({status={"done"}}) + end + local read = function() + -- If we skip empty input, it confuses the client. + local input = coroutine.yield() + if(input:find("^%s*$")) then return "nil\n" else return input end + end + local err = function(errtype, msg) + session.write(table.concat({errtype, msg}, ": ")) session.done() + end + + local env = session.sandbox + if not env then + env = {} + for k, v in pairs(_G) do env[k] = v end + env.io = {} + end + env.print = print_for(session.write) + env.io.write = session.write + env.io.read = function() + session.needinput() + local input, done = coroutine.yield() + done() + return input + end + + local f = function() + return fennel.repl({readChunk = read, + onValues = on_values, + onError = err, + env = env, + pp = fennelview}) + end + repls[session.id] = coroutine.wrap(f) + repls[session.id]() + return repls[session.id] +end + +return function(conn, msg, session, send, response_for) + d("Evaluating", msg.code) + local repl = repls[session.id] or make_repl(session, repls) + if msg.op == "eval" then + session.values = function(xs) + send(conn, response_for(msg, {value=table.concat(xs, "\n") .. "\n"})) + end + session.done = function() + send(conn, response_for(msg, {status={"done"}})) + end + session.needinput = function() + send(conn, response_for(msg, {status={"need-input"}})) + end + repl(msg.code .. "\n") + elseif msg.op == "stdin" then + repl(msg.stdin, + function() send(conn, response_for(msg, {status={"done"}})) end) + end +end diff --git a/vendor/jeejah/monroe-lua-complete.el b/vendor/jeejah/monroe-lua-complete.el new file mode 100644 index 0000000..26836ba --- /dev/null +++ b/vendor/jeejah/monroe-lua-complete.el @@ -0,0 +1,89 @@ +;;; monroe-lua-complete.el --- Completion for Lua over Monroe connection + +;; Copyright © 2016 Phil Hagelberg +;; +;; Author: Phil Hagelberg +;; URL: https://gitlab.com/technomancy/jeejah +;; Version: 0.1.0 +;; Keywords: languages, nrepl, lua + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Provides live completion results for Lua by querying a Lua process +;; over an nREPL connection. Uses `completion-at-point' but can be +;; adapted for other completion methods. + +;;; Installation: + +;; Copy it to your load-path and (require 'monroe-lua-complete) + +;;; Usage: + +;; * Launch an nREPL server using jeejah. +;; * Connect to it with M-x monroe. +;; * Complete the expression at point with M-x completion-at-point +;; also bound to M-tab or C-M-i. + +;;; Code: + +(require 'lua-mode) ; requires a newer lua-mode that has lua-start-of-expr +(require 'monroe) + +(defvar monroe-completion-candidates nil) + +(defun monroe-completion-handler (response) + "Set `monroe-completion-candidates' based on response from Lua server. + +Since monroe doesn't have any synchronous communication available, we +have to `sit-for' and hope a response has been returned and handled." + (monroe-dbind-response response (id completions status output) + (let ((process (get-buffer-process monroe-repl-buffer))) + (comint-output-filter process output) + (when completions + (setq monroe-completion-candidates completions)) + (when status + (when (member "done" status) + (remhash id monroe-requests)))))) + +(defun monroe-lua-complete-function () + "Completion function for `completion-at-point-functions'. + +Queries over current lua connection for possible completions." + (let ((expr (buffer-substring-no-properties (lua-start-of-expr) (point)))) + (monroe-send-request `("op" "complete" + "input" ,expr + ;; TODO: at this time, monroe cannot bencode + ;; nested values, only string->string dicts + ;; "libs" ,(lua-local-libs) + "session" ,(monroe-current-session)) + 'monroe-completion-handler)) + (sit-for 0.1) + (list (save-excursion (when (symbol-at-point) (backward-sexp)) (point)) + (point) + monroe-completion-candidates)) + +;;;###autoload +(defun monroe-lua-hook () + (make-local-variable 'completion-at-point-functions) + (add-to-list 'completion-at-point-functions 'monroe-lua-complete-function)) + +;;;###autoload +(eval-after-load 'lua-mode + '(add-to-list 'lua-mode-hook 'monroe-lua-hook)) + +;;; monroe-lua-complete.el ends here diff --git a/vendor/jeejah/rockspecs/jeejah-0.1.0-1.rockspec b/vendor/jeejah/rockspecs/jeejah-0.1.0-1.rockspec new file mode 100644 index 0000000..5669dee --- /dev/null +++ b/vendor/jeejah/rockspecs/jeejah-0.1.0-1.rockspec @@ -0,0 +1,28 @@ +-- -*- lua -*- + +package = "jeejah" +version = "0.1.0-1" +source = { + url = "https://gitlab.com/technomancy/jeejah.git", + tag = "0.1.0", +} +description = { + summary = "An nREPL server", + detailed = [[ + Implements a server that speaks the nREPL protocol and allows + clients to connect and evaluate code over a network connection. + ]], + homepage = "https://gitlab.com/technomancy/jeejah.git", + license = "MIT/X11", +} +dependencies = { + "lua ~> 5.1", + "luasocket = 3.0rc1-2", + "serpent = 0.28-1", + "bencode = 2.2.0-1", +} +build = { + type = "builtin", + modules = { jeejah = "jeejah.lua", }, + install = { bin = { "bin/jeejah" } }, +} diff --git a/vendor/jeejah/rockspecs/jeejah-0.2.1-1.rockspec b/vendor/jeejah/rockspecs/jeejah-0.2.1-1.rockspec new file mode 100644 index 0000000..03fd6c2 --- /dev/null +++ b/vendor/jeejah/rockspecs/jeejah-0.2.1-1.rockspec @@ -0,0 +1,28 @@ +-- -*- lua -*- + +package = "jeejah" +version = "0.2.1-1" +source = { + url = "git+https://gitlab.com/technomancy/jeejah.git", + tag = "0.2.1", +} +description = { + summary = "An nREPL server", + detailed = [[ + Implements a server that speaks the nREPL protocol and allows + clients to connect and evaluate code over a network connection. + ]], + homepage = "https://gitlab.com/technomancy/jeejah", + license = "MIT/X11", +} +dependencies = { + "lua >= 5.1", + "luasocket = 3.0rc1-2", + "serpent = 0.28-1", + "bencode = 2.2.0-1", +} +build = { + type = "builtin", + modules = { jeejah = "jeejah.lua", }, + install = { bin = { "bin/jeejah" } }, +} diff --git a/vendor/jeejah/rockspecs/jeejah-0.2.1-4.rockspec b/vendor/jeejah/rockspecs/jeejah-0.2.1-4.rockspec new file mode 100644 index 0000000..305c2d3 --- /dev/null +++ b/vendor/jeejah/rockspecs/jeejah-0.2.1-4.rockspec @@ -0,0 +1,28 @@ +-- -*- lua -*- + +package = "jeejah" +version = "0.2.1-4" +source = { + url = "git+https://gitlab.com/technomancy/jeejah.git", + tag = "0.2.4", +} +description = { + summary = "An nREPL server", + detailed = [[ + Implements a server that speaks the nREPL protocol and allows + clients to connect and evaluate code over a network connection. + ]], + homepage = "https://gitlab.com/technomancy/jeejah", + license = "MIT/X11", +} +dependencies = { + "lua >= 5.1", + "luasocket = 3.0rc1-2", + "serpent = 0.28-1", + "bencode = 2.2.0-1", +} +build = { + type = "builtin", + modules = { jeejah = "jeejah.lua", }, + install = { bin = { "bin/jeejah" } }, +} diff --git a/vendor/jeejah/rockspecs/jeejah-0.3.0-1.rockspec b/vendor/jeejah/rockspecs/jeejah-0.3.0-1.rockspec new file mode 100644 index 0000000..a383996 --- /dev/null +++ b/vendor/jeejah/rockspecs/jeejah-0.3.0-1.rockspec @@ -0,0 +1,28 @@ +-- -*- lua -*- + +package = "jeejah" +version = "0.3.0-1" +source = { + url = "git+https://gitlab.com/technomancy/jeejah.git", + tag = "0.3.0", +} +description = { + summary = "An nREPL server", + detailed = [[ + Implements a server that speaks the nREPL protocol and allows + clients to connect and evaluate code over a network connection. + ]], + homepage = "https://gitlab.com/technomancy/jeejah", + license = "MIT/X11", +} +dependencies = { + "lua >= 5.1", + "luasocket = 3.0rc1-2", + "serpent = 0.28-1", + "bencode = 2.2.0-1", +} +build = { + type = "builtin", + modules = { jeejah = "jeejah.lua", }, + install = { bin = { "bin/jeejah" } }, +} diff --git a/vendor/jeejah/rockspecs/jeejah-0.3.1-1.rockspec b/vendor/jeejah/rockspecs/jeejah-0.3.1-1.rockspec new file mode 100644 index 0000000..9ca7801 --- /dev/null +++ b/vendor/jeejah/rockspecs/jeejah-0.3.1-1.rockspec @@ -0,0 +1,28 @@ +-- -*- lua -*- + +package = "jeejah" +version = "0.3.1-1" +source = { + url = "git+https://gitlab.com/technomancy/jeejah.git", + tag = "0.3.1", +} +description = { + summary = "An nREPL server", + detailed = [[ + Implements a server that speaks the nREPL protocol and allows + clients to connect and evaluate code over a network connection. + ]], + homepage = "https://gitlab.com/technomancy/jeejah", + license = "MIT/X11", +} +dependencies = { + "lua >= 5.1", + "luasocket = 3.0rc1-2", + "serpent = 0.28-1", + "bencode = 2.2.0-1", +} +build = { + type = "builtin", + modules = { jeejah = "jeejah.lua", }, + install = { bin = { "bin/jeejah" } }, +} diff --git a/vendor/jeejah/rockspecs/jeejah-0.3.1-2.rockspec b/vendor/jeejah/rockspecs/jeejah-0.3.1-2.rockspec new file mode 100644 index 0000000..3db60a9 --- /dev/null +++ b/vendor/jeejah/rockspecs/jeejah-0.3.1-2.rockspec @@ -0,0 +1,29 @@ +-- -*- lua -*- + +package = "jeejah" +version = "0.3.1-2" +source = { + url = "git+https://gitlab.com/technomancy/jeejah.git", + tag = "0.3.1", +} +description = { + summary = "An nREPL server", + detailed = [[ + Implements a server that speaks the nREPL protocol and allows + clients to connect and evaluate code over a network connection. + ]], + homepage = "https://gitlab.com/technomancy/jeejah", + license = "MIT/X11", +} +dependencies = { + "lua >= 5.1", + "luasocket = 3.0rc1-2", + "serpent = 0.28-1", + "bencode = 2.2.0-1", +} +build = { + type = "builtin", + modules = { jeejah = "jeejah.lua", + ["jeejah.fenneleval"] = "jeejah/fenneleval.lua" }, + install = { bin = { "bin/jeejah" } }, +} diff --git a/vendor/jeejah/rockspecs/jeejah-0.3.1-4.rockspec b/vendor/jeejah/rockspecs/jeejah-0.3.1-4.rockspec new file mode 100644 index 0000000..34504f0 --- /dev/null +++ b/vendor/jeejah/rockspecs/jeejah-0.3.1-4.rockspec @@ -0,0 +1,30 @@ +-- -*- lua -*- + +package = "jeejah" +version = "0.3.1-4" +source = { + url = "git+https://gitlab.com/technomancy/jeejah.git", + tag = "0.3.1", +} +description = { + summary = "An nREPL server", + detailed = [[ + Implements a server that speaks the nREPL protocol and allows + clients to connect and evaluate code over a network connection. + ]], + homepage = "https://gitlab.com/technomancy/jeejah", + license = "MIT/X11", +} +dependencies = { + "lua >= 5.1", + "luasocket = 3.0rc1-2", + "serpent = 0.28-1", +} +build = { + type = "builtin", + modules = { jeejah = "jeejah.lua", + ["jeejah.fenneleval"] = "jeejah/fenneleval.lua", + bencode = "bencode.lua", + }, + install = { bin = { "bin/jeejah" } }, +} diff --git a/vendor/jeejah/serpent.lua b/vendor/jeejah/serpent.lua new file mode 100644 index 0000000..c0a0d8f --- /dev/null +++ b/vendor/jeejah/serpent.lua @@ -0,0 +1,125 @@ +local n, v = "serpent", 0.28 -- (C) 2012-15 Paul Kulchenko; MIT License +local c, d = "Paul Kulchenko", "Lua serializer and pretty printer" +local snum = {[tostring(1/0)]='1/0 --[[math.huge]]',[tostring(-1/0)]='-1/0 --[[-math.huge]]',[tostring(0/0)]='0/0'} +local badtype = {thread = true, userdata = true, cdata = true} +local keyword, globals, G = {}, {}, (_G or _ENV) +for _,k in ipairs({'and', 'break', 'do', 'else', 'elseif', 'end', 'false', + 'for', 'function', 'goto', 'if', 'in', 'local', 'nil', 'not', 'or', 'repeat', + 'return', 'then', 'true', 'until', 'while'}) do keyword[k] = true end +for k,v in pairs(G) do globals[v] = k end -- build func to name mapping +for _,g in ipairs({'coroutine', 'debug', 'io', 'math', 'string', 'table', 'os'}) do + for k,v in pairs(G[g] or {}) do globals[v] = g..'.'..k end end + +local function s(t, opts) + local name, indent, fatal, maxnum = opts.name, opts.indent, opts.fatal, opts.maxnum + local sparse, custom, huge = opts.sparse, opts.custom, not opts.nohuge + local space, maxl = (opts.compact and '' or ' '), (opts.maxlevel or math.huge) + local iname, comm = '_'..(name or ''), opts.comment and (tonumber(opts.comment) or math.huge) + local seen, sref, syms, symn = {}, {'local '..iname..'={}'}, {}, 0 + local function gensym(val) return '_'..(tostring(tostring(val)):gsub("[^%w]",""):gsub("(%d%w+)", + -- tostring(val) is needed because __tostring may return a non-string value + function(s) if not syms[s] then symn = symn+1; syms[s] = symn end return tostring(syms[s]) end)) end + local function safestr(s) return type(s) == "number" and tostring(huge and snum[tostring(s)] or s) + or type(s) ~= "string" and tostring(s) -- escape NEWLINE/010 and EOF/026 + or ("%q"):format(s):gsub("\010","n"):gsub("\026","\\026") end + local function comment(s,l) return comm and (l or 0) < comm and ' --[['..tostring(s)..']]' or '' end + local function globerr(s,l) return globals[s] and globals[s]..comment(s,l) or not fatal + and safestr(select(2, pcall(tostring, s))) or error("Can't serialize "..tostring(s)) end + local function safename(path, name) -- generates foo.bar, foo[3], or foo['b a r'] + local n = name == nil and '' or name + local plain = type(n) == "string" and n:match("^[%l%u_][%w_]*$") and not keyword[n] + local safe = plain and n or '['..safestr(n)..']' + return (path or '')..(plain and path and '.' or '')..safe, safe end + local alphanumsort = type(opts.sortkeys) == 'function' and opts.sortkeys or function(k, o, n) -- k=keys, o=originaltable, n=padding + local maxn, to = tonumber(n) or 12, {number = 'a', string = 'b'} + local function padnum(d) return ("%0"..tostring(maxn).."d"):format(tonumber(d)) end + table.sort(k, function(a,b) + -- sort numeric keys first: k[key] is not nil for numerical keys + return (k[a] ~= nil and 0 or to[type(a)] or 'z')..(tostring(a):gsub("%d+",padnum)) + < (k[b] ~= nil and 0 or to[type(b)] or 'z')..(tostring(b):gsub("%d+",padnum)) end) end + local function val2str(t, name, indent, insref, path, plainindex, level) + local ttype, level, mt = type(t), (level or 0), getmetatable(t) + local spath, sname = safename(path, name) + local tag = plainindex and + ((type(name) == "number") and '' or name..space..'='..space) or + (name ~= nil and sname..space..'='..space or '') + if seen[t] then -- already seen this element + sref[#sref+1] = spath..space..'='..space..seen[t] + return tag..'nil'..comment('ref', level) end + if type(mt) == 'table' and (mt.__serialize or mt.__tostring) then -- knows how to serialize itself + seen[t] = insref or spath + if mt.__serialize then t = mt.__serialize(t) else t = tostring(t) end + ttype = type(t) end -- new value falls through to be serialized + if ttype == "table" then + if level >= maxl then return tag..'{}'..comment('max', level) end + seen[t] = insref or spath + -- PNH: this breaks with our metatable monkeypatch to support iterators + -- if next(t) == nil then return tag..'{}'..comment(t, level) end -- table empty + local maxn, o, out = math.min(#t, maxnum or #t), {}, {} + for key = 1, maxn do o[key] = key end + if not maxnum or #o < maxnum then + local n = #o -- n = n + 1; o[n] is much faster than o[#o+1] on large tables + for key in pairs(t) do if o[key] ~= key then n = n + 1; o[n] = key end end end + if maxnum and #o > maxnum then o[maxnum+1] = nil end + if opts.sortkeys and #o > maxn then alphanumsort(o, t, opts.sortkeys) end + local sparse = sparse and #o > maxn -- disable sparsness if only numeric keys (shorter output) + for n, key in ipairs(o) do + local value, ktype, plainindex = t[key], type(key), n <= maxn and not sparse + if opts.valignore and opts.valignore[value] -- skip ignored values; do nothing + or opts.keyallow and not opts.keyallow[key] + or opts.valtypeignore and opts.valtypeignore[type(value)] -- skipping ignored value types + or sparse and value == nil then -- skipping nils; do nothing + elseif ktype == 'table' or ktype == 'function' or badtype[ktype] then + if not seen[key] and not globals[key] then + sref[#sref+1] = 'placeholder' + local sname = safename(iname, gensym(key)) -- iname is table for local variables + sref[#sref] = val2str(key,sname,indent,sname,iname,true) end + sref[#sref+1] = 'placeholder' + local path = seen[t]..'['..tostring(seen[key] or globals[key] or gensym(key))..']' + sref[#sref] = path..space..'='..space..tostring(seen[value] or val2str(value,nil,indent,path)) + else + out[#out+1] = val2str(value,key,indent,insref,seen[t],plainindex,level+1) + end + end + local prefix = string.rep(indent or '', level) + local head = indent and '{\n'..prefix..indent or '{' + local body = table.concat(out, ','..(indent and '\n'..prefix..indent or space)) + local tail = indent and "\n"..prefix..'}' or '}' + return (custom and custom(tag,head,body,tail) or tag..head..body..tail)..comment(t, level) + elseif badtype[ttype] then + seen[t] = insref or spath + return tag..globerr(t, level) + elseif ttype == 'function' then + seen[t] = insref or spath + local ok, res = pcall(string.dump, t) + local func = ok and ((opts.nocode and "function() --[[..skipped..]] end" or + "((loadstring or load)("..safestr(res)..",'@serialized'))")..comment(t, level)) + return tag..(func or globerr(t, level)) + else return tag..safestr(t) end -- handle all other types + end + local sepr = indent and "\n" or ";"..space + local body = val2str(t, name, indent) -- this call also populates sref + local tail = #sref>1 and table.concat(sref, sepr)..sepr or '' + local warn = opts.comment and #sref>1 and space.."--[[incomplete output with shared/self-references skipped]]" or '' + return not name and body..warn or "do local "..body..sepr..tail.."return "..name..sepr.."end" +end + +local function deserialize(data, opts) + local env = (opts and opts.safe == false) and G + or setmetatable({}, { + __index = function(t,k) return t end, + __call = function(t,...) error("cannot call functions") end + }) + local f, res = (loadstring or load)('return '..data, nil, nil, env) + if not f then f, res = (loadstring or load)(data, nil, nil, env) end + if not f then return f, res end + if setfenv then setfenv(f, env) end + return pcall(f) +end + +local function merge(a, b) if b then for k,v in pairs(b) do a[k] = v end end; return a; end +return { _NAME = n, _COPYRIGHT = c, _DESCRIPTION = d, _VERSION = v, serialize = s, + load = deserialize, + dump = function(a, opts) return s(a, merge({name = '_', compact = true, sparse = true}, opts)) end, + line = function(a, opts) return s(a, merge({sortkeys = true, comment = true}, opts)) end, + block = function(a, opts) return s(a, merge({indent = ' ', sortkeys = true, comment = true}, opts)) end }