minimize diffs between keythemes

[lisp-parkour.git] / parser.lua

require'lpeg'
local l = lpeg
local P, S, R, V, C, Cb, Cc, Cg, Cmt, Cp, Ct = l.P, l.S, l.R, l.V, l.C, l.Cb, l.Cc, l.Cg, l.Cmt, l.Cp, l.Ct

local M = {}

local hspace = S" \t"
local blank = S"\n\v\f" + hspace
local newline = S('\r\n\f')^1

local function gt(pos, val)
        return val and pos > val
end

local function le(pos, val)
        return val and pos <= val
end

-- binary search a list for the nearest node before pos
local function before(t, pos, key, skip)
        local left, right = 1, #t
        while left <= right do
                local m = math.floor(left + (right - left) / 2)
                local m_val = key(t[m])
                if gt(pos, m_val) and (m == #t or le(pos, key(t[m + 1]))) then
                        if skip then
                                while (t[m] and skip(t[m])) do
                                        m = m - 1
                                end
                        end
                        return t[m], m
                end
                if le(pos, m_val) then right = m - 1 else left = m + 1 end
        end
end

-- binary search a list for the nearest node after pos
local function after(t, pos, key, skip)
        if t.is_root and (#t == 0 or pos >= t[#t].start) then
                -- XXX: if we are at the last parsed top-level node, try to access the next one
                -- to get it parsed as well. Otherwise the search will stop prematurely.
                local _ = t[#t + 1]
        end
        local left, right = 1, #t
        while left <= right do
                local m = math.floor(left + (right - left) / 2)
                local m_val = key(t[m])
                if le(pos, m_val) and (m == 1 or gt(pos, key(t[m - 1]))) then
                        if skip then
                                while (t[m] and skip(t[m])) do
                                        m = m + 1
                                end
                        end
                        return t[m], m
                end
                if le(pos, m_val) then right = m - 1 else left = m + 1 end
        end
end

-- binary search a list for the node that contains pos
local function around(t, range)
        if not (range.start and range.finish) then return end
        local left, right = 1, #t
        while left <= right do
                local m = math.floor(left + (right - left) / 2)
                local e = t[m]
                local nxt = t[m + 1]
                if e.start and range.start >= e.start and e.finish and range.finish <= e.finish + 1 and
                        (not nxt or nxt.start > range.start) -- if adjoined - asdf|(qwer) - this will prefer (qwer)
                        then return e, m end
                if e.start and range.start < e.start then right = m - 1 else left = m + 1 end
        end
end

local function incr(index, offset) return index + offset - 1 end
local function m1(pos) return pos - 1 end
local function past(_, position, pos) return position <= pos end
local function startof(element) return element.start end
local function finishof(element) return element.finish end
local function _start(patt) return Cg(patt, "start") end
local function _finish(patt) return Cg(patt, "finish") end
local bof_or_bol = (hspace^0 * P"\n"^1)^1 + Cmt("", function(_, pos) return pos == 1 end)
local function _indent(I)
        return Cg(bof_or_bol * I * P"\f", "section")^0 *
                Cg(bof_or_bol * C(hspace^0) / function(indent) return #indent end, "indent")^-1
end
local function _string(patt) return Cg(patt / function() return true end, "is_string") end
local function _char(patt) return Cg(patt / function() return true end, "is_char") end
local function _comment(patt) return Cg(patt / function() return true end, "is_comment") end
local function delimited_range(d)
        return Cg(d, "d") * (P(1) - "\\" - d + P"\\" * 1)^0 * d
end
local function nested_pair(d1, d2)
        return P{Cg(d1, "d") * (P(1) - d1 - d2 + V(1))^0 * d2}
end


local function find_after(t, selection, pred, stop)
        local _, n = t.after(selection.start, startof)
        while t[n] and not pred(t[n]) do
                if stop and stop(t[n]) then return end
                n = n + 1
        end
        return t[n], n
end

local function find_before(t, selection, pred, stop)
        local _, n = t.before(selection.finish, finishof)
        while t[n] and not pred(t[n]) do
                if stop and stop(t[n]) then return end
                n = n - 1
        end
        return t[n], n
end

local function intersects(t)
        return function(range)
                local start = t.start + (t.p and #t.p or 0)
                return start >= range.start and t.finish >= range.finish and start < range.finish
                or start < range.start and t.finish < range.finish and range.start <= t.finish
        end
end

local atom_methods = {
        contains = function(t) return function(range) return t.start <= range.start and t.finish >= range.finish - 1 end end,
        touches = function(t) return function(range) return t.start == range.start or t.finish == range.finish - 1 end end,
        intersects = intersects,
}

local list_methods = {
        is_list = function(_) return true end,
        is_empty = function(t) return #t == 0 end,
        contains = function(t)
                return function(range)
                        return t.start + (t.p and #t.p or 0) < range.start and t.finish > range.finish - 1
                end
        end,
        touches = function(t)
                return function(range)
                        return t.start + (t.p and #t.p or 0) >= range.start and t.start <= range.start or
                                t.finish == range.finish - 1
                end
        end,
        overlaps = function(t) return function(range)
                return t.start == range.start and t.finish > range.finish - 1
                or t.start < range.start and t.finish == range.finish - 1 end
        end,
        intersects = intersects,
        around = function(t)
                return function(range)
                        return around(t, range)
                end
        end,
        before = function(t)
                return function(pos, key, skip)
                        return before(t, pos, key, skip)
                end
        end,
        after = function(t)
                return function(pos, key, skip)
                        return after(t, pos, key, skip)
                end
        end,
        find_after = function(t)
                return function(range, pred, stop)
                        return find_after(t, range, pred, stop)
                end
        end,
        find_before = function(t)
                return function(range, pred, stop)
                        return find_before(t, range, pred, stop)
                end
        end,
}

local escaped_methods = {}
local pseudo_methods = {}

local function sexp_around(t, range)
        if t.is_root or (t.is_list and t.contains(range)) then
                local child, nth = t.around(range)
                if child and child.is_list and not child.touches(range) then
                        return sexp_around(child, range)
                else
                        return child, t, nth
                end
        end
end

local function find_before_innermost(t, range, pred)
        if t.is_root or (t.d and t.start < range.start) then
                if t.d and not t.is_list then
                        local newpos = t.start_before(range.start)
                        if newpos then
                                local word = t.word_at({start = newpos, finish = newpos})
                                if word and pred(word) then
                                        return word
                                end
                        end
                        return
                end
                local _, nearest_n = t.before(range.start, startof)
                if nearest_n then
                        for n = nearest_n, 1, -1 do
                                local child = t[n]
                                if child.d and not child.is_empty then
                                        local ret = find_before_innermost(child, range, pred)
                                        if ret then
                                                return ret
                                        end
                                elseif pred(child, n, #t) then
                                        return child, n, #t
                                end
                        end
                end
                if not t.is_root and pred(t) then
                        return t
                end
        end
end

local function find_after_innermost(t, range, pred)
        if t.is_root or (t.d and t.finish >= range.finish) then
                if t.d and not t.is_list then
                        local newpos = t.finish_after(math.max(t.start + #t.d, range.finish))
                        if newpos then
                                local word = t.word_at({start = newpos, finish = newpos})
                                if word and pred(word) then
                                        return word
                                end
                        end
                        return
                end
                local _, nearest_n = t.after(range.finish, finishof)
                if nearest_n then
                        for n = nearest_n, #t do
                                local child = t[n]
                                if child.d and not child.is_empty then
                                        local ret = find_after_innermost(child, range, pred)
                                        if ret then
                                                return ret
                                        end
                                elseif pred(child, n, #t) then
                                        return child, n, #t
                                end
                        end
                end
                if not t.is_root and pred(t) then
                        return t
                end
        end
end

-- save the current logical position in terms of sexps, not offsets
local function sexp_path(t, range, floors)
        if t.is_root or (t.is_list and t.contains(range)) then
                local child, nth = t.around(range)
                table.insert(floors, nth)
                if child and child.is_list and not child.touches(range) then
                        sexp_path(child, range, floors)
                end
        end
        return floors
end

-- find a sexp by pattern-matching a saved "sexp path"
-- inspired by Interlisp "location specifications", but this here is very rudimentary in comparison
-- currently only used for restoring the cursor position after an aggressive reindent
local function goto_path(root, path)
        local dest = root
        local parent
        for n, i in ipairs(path) do
                dest = dest[i]
                parent = not parent and root or parent[path[n - 1]]
        end
        return dest, parent
end

local function catchup(tree, range)
        if range.finish and range.finish >= tree.first_invalid then
                tree.parse_to(range.finish + 1)
        end
end

local root_methods = {
        around = function(t)
                return function(range)
                        catchup(t, range)
                        return around(t, range)
                end
        end,
        before = function(t)
                return function(pos, key, skip)
                        catchup(t, {finish = pos})
                        return before(t, pos, key, skip)
                end
        end,
        after = function(t)
                return function(pos, key, skip)
                        catchup(t, {finish = pos})
                        return after(t, pos, key, skip)
                end
        end,
        find_after = function(t)
                return function(range, pred, stop)
                        catchup(t, range)
                        return find_after(t, range, pred, stop)
                end
        end,
        find_before = function(t)
                return function(range, pred, stop)
                        return find_before(t, range, pred, stop)
                end
        end,
        rewind = function(t)
                return function(index)
                        assert(index <= t.first_invalid, ("%d > %d - You can only rewind backwards!"):format(index, t.first_invalid))
                        t.first_invalid = index
                end
        end,
        is_parsed = function(t)
                return function(index)
                        return index < t.first_invalid
                end
        end,
        sexp_at = function(t)
                return function(range)
                        catchup(t, range)
                        return sexp_around(t, range)
                end
        end,
        paragraph_at = function(t)
                return function(range)
                        catchup(t, range)
                        local sexp, n = t.around(range)
                        return sexp, t, n
                end
        end,
        find_before_innermost = function(t)
                return function(range, pred)
                        catchup(t, range)
                        return find_before_innermost(t, range, pred)
                end
        end,
        find_after_innermost = function(t)
                return function(range, pred)
                        catchup(t, range)
                        return find_after_innermost(t, range, pred)
                end
        end,
        sexp_path = function(t)
                return function(range)
                        catchup(t, range)
                        return sexp_path(t, range, {})
                end
        end,
        goto_path = function(t)
                return function(path)
                        local range = {start = t[path[1]].finish, finish = t[path[1]].finish}
                        catchup(t, range)
                        return goto_path(t, path)
                end
        end,
}

local function dispatch(vtable)
        return function(self, key)
                if vtable[key] then
                        return vtable[key](self)
                end
        end
end

local atom_node = {
        __index = dispatch(atom_methods)
}

local list_node = {
        __index = dispatch(list_methods)
}

local escaped_node = {
        __index = dispatch(escaped_methods)
}

local pseudo_node = {
        __index = dispatch(pseudo_methods)
}

local function at_pos(_, position, start, finish, range)
        if range.start + 1 >= start and range.start < finish and range.finish < finish then
                return position, start - 1, finish - 1
        end
end

local function purge(base, lists)
        if not base then return lists end
        for _, list in pairs(lists) do
                for i = #list, 1, -1 do
                        if list[i].start >= base then
                                table.remove(list)
                        else
                                break
                        end
                end
        end
        return lists
end

local function append(old, new)
        for name, list in pairs(new) do
                for _, element in ipairs(list) do
                        table.insert(old[name], element)
                end
        end
        local last = #old.tree ~= 0 and old.tree[#old.tree]
        old.tree.first_invalid = last and (last.finish or last.start) + 1 or 0
        return old
end

local function make_driver(read, parse, lists)
        return function(advance)
                local base
                if lists.tree.first_invalid then
                        local last_parsed = #lists.tree ~= 0 and lists.tree[#lists.tree].finish + 1 or 0
                        if lists.tree.first_invalid < last_parsed then
                                local nearest = before(lists.tree, lists.tree.first_invalid, startof)
                                base = nearest and nearest.start or lists.tree.first_invalid
                        else
                                base = lists.tree.first_invalid
                        end
                end
                local new
                local chunk_size = 42 * 1024
                local tries = 1
                local content = ""
                local from = base
                local len = advance > 0 and advance - base + chunk_size or chunk_size
                repeat
                        local chunk, further = read(from, len)
                        if not chunk then break end
                        content = content .. chunk
                        new = parse(content, advance, base)
                        from = from + len
                        tries = tries + 1
                        len = chunk_size * 2^(tries - 1)
                until not new.tree.unbalanced and (advance > 0 or advance < 0 and #new.tree >= math.abs(advance))
                        or not further
                return append(purge(base, lists), new or {})
        end
end

local function make_parser(lispwords, prefix, opposite, xatom, word, match, d1, d2, D1, D2, read)
        list_methods.last_distinguished = function(t)
                return t[1] and lispwords[t[1].text]
        end
        local function text(t)
                local len = t.finish + 1 - t.start
                return read(t.start, len)
        end
        atom_methods.text = text
        list_methods.text = text
        pseudo_methods.text = text
        function escaped_methods.start_before(t)
                return function(pos)
                        pos = pos - (t.start + #t.d)
                        local stops = P{Ct(((1 - word)^0 * Cp() * Cmt(Cc(pos), past) * word)^0)}:match(t.itext)
                        local newpos = stops and stops[#stops]
                        return newpos and (t.start + #t.d + newpos - 1)
                end
        end
        function escaped_methods.start_after(t)
                return function(pos)
                        pos = pos - (t.start + #t.d)
                        local stop = P{(1 - word) * Cp() * word + 1 * V(1)}:match(t.itext, pos + 1)
                        return stop and (t.start + #t.d + stop - 1)
                end
        end
        function escaped_methods.finish_before(t)
                return function(pos)
                        pos = pos - (t.start + #t.d)
                        local stops = P{Ct(((1 - word)^0 * word * Cp() * Cmt(Cc(pos + 1), past))^0)}:match(t.itext)
                        local newpos = stops and stops[#stops]
                        return newpos and (t.start + #t.d + newpos - 1)
                end
        end
        function escaped_methods.finish_after(t)
                return function(pos)
                        pos = pos - (t.start + #t.d)
                        local stop = P{word * Cp() + 1 * V(1)}:match(t.itext, pos + 1)
                        return stop and (t.start + #t.d + stop - 1)
                end
        end
        function escaped_methods.word_at(t)
                return function(range)
                        local r = {}
                        r.start = range.start - (t.start + #t.d)
                        r.finish = range.finish - (t.start + #t.d)
                        local start, finish = P{Cmt(Cp() * word * Cp() * Cc(r), at_pos) +
                                Cmt(1 * Cc(r.finish + 1), past) * V(1)}:match(t.itext)
                        if not start then return end
                        local node = {start = t.start + #t.d + start, finish = t.start + #t.d + finish - 1}
                        return setmetatable(node, pseudo_node)
                end
        end
        function escaped_methods.is_empty(t)
                return not t.finish_after(t.start + #t.d)
        end
        for k, v in pairs(atom_methods) do
                escaped_methods[k] = v
        end
        function escaped_methods.itext(t)
                local len = t.finish + 1 - #match(t.d) - t.start - #t.d
                return read(t.start + #t.d, len) or ""
        end
        local function atom_methodize(t)
                return setmetatable(t, (t.is_string or t.is_comment) and escaped_node or atom_node)
        end
        return function(content, advance, offset)
                local tree, esc = nil, {}
                local I = Cp() * Cc(offset) / incr
                local I1 = I / m1
                local opening = _start(I) * Cg(prefix^1, "p")^-1 * d1
                local closing = _finish(I) * d2
                local lone_prefix = _indent(I) * _start(I) * Cg(prefix^1, "p") * -#P(d1) * _finish(I1)
                local unbalanced
                local function debalance(t) unbalanced = true return t end
                local function collect_escaped(sexp)
                        if sexp.is_comment and match(sexp.d):find("^\n") then
                                -- XYZZY: Poof! You are in the parser room. There is a scroll here:
                                -- The pattern for line comments deliberately doesn't consume the newline
                                -- *during parsing*, so the parser gets to tag the next sexp with .indent.
                                -- The range is extended here afterwards, though, so when you are at the end
                                -- of a line comment, the editor knows that you are inside it and won't try
                                -- to apply behaviour that is meant for code.
                                sexp.finish = sexp.finish + 1
                        end
                        if sexp.is_string or sexp.is_comment then
                                table.insert(esc, sexp)
                        end
                        return sexp
                end
                local char = ('#\\' * (P'alarm' + 'backspace' + 'delete' + 'escape'
                                + 'newline' + 'null' + 'return' + 'space' + 'tab')
                                + '#\\x' * R('09', 'AF', 'af')^1
                                + '#\\' * P(1)) * _char(P(true))
                local dq_string = delimited_range('"') * _string(P(true))
                local multi_esc = delimited_range("|") * _string(P(true))
                local line_comment = Cg(';' * #-P';' + P';'^1 * hspace^-1, "d") * (1 - newline)^0 * _comment(P(true))
                local block_comment = nested_pair("#|", "|#") * _comment(P(true))
                local comment = opposite["#|"] and (line_comment + block_comment) or line_comment
                local atom = Ct(_indent(I) * _start(I) * (
                        comment
                        + dq_string
                        + char
                        + multi_esc      -- before xatom, since the latter matches too
                        + xatom(Cg(prefix^1, "p")^-1)
                        ) * _finish(I1)) / atom_methodize / collect_escaped + Ct(lone_prefix)
                local list = P{Ct(_indent(I) * opening * (atom + hspace^1 + V(1))^0 * blank^0 * closing) *
                        Cc(list_node) / setmetatable}
                -- XXX: semicolon (for line comments) should be listed below, too, but since I don't consume the newline
                -- (the XYZZY trick), I can't tell if a line comment was not completely read due to insufficient chunk length.
                -- So, don't set chunk_size below the size of the longest line comment probable.
                local lone_paren = Ct(_indent(I) * _start(I) * (D1 + D2) * _finish(I1)) / debalance
                local sexp = hspace^0 * (list + atom) + lone_paren
                if advance < 0 then
                        tree = Ct(sexp^advance):match(content)
                elseif advance > 0 then
                        tree = Ct((Cmt(Cc(advance - offset), past) * sexp)^0):match(content)
                end
                tree.unbalanced = unbalanced
                return {tree = tree, escaped = esc}
        end
end

function M.new(syntax, read)
        local L = require('parkour.dialect.'..syntax)
        local lispwords, prefix, opposite, xatom, word = L.lispwords, L.prefix, L.opposite, L.atom, L.word
        local function match(delimiter)
                return opposite[delimiter] or delimiter:find("^;") and opposite[";"]
        end
        local function unbalanced_delimiters(t, range)
                if t.d or t.is_root then
                        for i = 1, #t do
                                if (t[i].d) and (t[i].contains(range) or t[i].intersects(range)) then
                                        unbalanced_delimiters(t[i], range)
                                end
                        end
                        if not t.is_root then
                                local start = t.start + (t.p and #t.p or 0) + #t.d
                                local finish = t.finish + 1 - #match(t.d)
                                if start <= range.start and finish < range.finish then
                                        coroutine.yield({start = finish, finish = t.finish + 1, closing = true})
                                elseif start > range.start and t.finish >= range.finish then
                                        coroutine.yield({start = t.start, finish = start, opening = true})
                                end
                        end
                end
        end

        root_methods.unbalanced_delimiters = function(t)
                local slice_at = coroutine.wrap(unbalanced_delimiters)
                return function(range)
                        local skips = {}
                        catchup(t, range)
                        repeat
                                local slice_pos = slice_at(t, range)
                                if slice_pos then table.insert(skips, slice_pos) end
                        until not slice_pos
                        return skips
                end
        end

        local lists = {
                tree = {
                        first_invalid = 0,
                        is_root = true,
                },     -- (sorted) tree of sexps
                escaped = {},  -- sorted list of strings and comments (redundant, for faster search)
        }
        local opening, closing = {}, {}
        for o, c in pairs(opposite) do
                if S"([{":match(o) then
                        table.insert(opening, o)
                        table.insert(closing, c)
                end
        end
        local D1 = S(table.concat(opening))
        local d1 = Cg(D1, "d")
        local d2 = Cmt(Cb("d") * C(1), function(_, _, o, c) return opposite[o] == c end)
        local D2 = S(table.concat(closing))
        local parse = make_parser(lispwords, prefix, opposite, xatom, word, match, d1, d2, D1, D2, read)
        local drive = make_driver(read, parse, lists)
        setmetatable(lists.tree, {
                __index = function(t, key)
                        if type(key) == "number" then
                                if #t < key then t.parse_to(#t - key) end
                                return rawget(t, key)
                        elseif root_methods[key] then
                                return root_methods[key](t)
                        elseif key == "parse_to" then
                                return drive
                        elseif key == "opposite" then
                                return match
                        end
                end
        })
        setmetatable(lists.escaped, {
                __index = {
                        around = function(range)
                                catchup(lists.tree, range)
                                return around(lists.escaped, range)
                        end
                }
        })
        return lists, d1, D2
end

return M