path: root/compiler.lua

--[[
    This file is part of cratera.lua - pure-Lua Cratera-to-Lua transpiler
    Copyright (C) 2019  Soni L.

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero 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 Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
--]]

--[[
    This software is based on Lua 5.1 and Lua 5.3

    Lua 5.1 license:

/******************************************************************************
* Copyright (C) 1994-2012 Lua.org, PUC-Rio.  All rights reserved.
*
* 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.
******************************************************************************/

    Lua 5.3 license:

/******************************************************************************
* Copyright (C) 1994-2018 Lua.org, PUC-Rio.
*
* 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.
******************************************************************************/
--]]

-- this is basically just a straight translation of the lparser.c
-- main difference is we don't care about lua_State *L

local parser = require "parser"
local selfify = parser.selfify
local STATE = parser.STATE
local TK = require "luatokens".TK
local error, assert = error, assert
-- try to avoid making too many locals because Lua has a limit to how many locals you can have
local coroutine = {create = coroutine.create,
                   resume = coroutine.resume,
                   yield  = coroutine.yield}
local math = {huge  = math.huge,
              floor = math.floor}
local string = {format = string.format}

local luaX = {} -- lexer
local luaK = {} -- code generator

luaK.ret = function() end -- FIXME

luaX.next = (function()
    local extra_tokens = {[TK.NAME] = true, [TK.INT] = true, [TK.FLT] = true, [TK.STRING] = true}
    return function(ls)
        ls.lastline = ls.linenumber
        if ls.lookahead_token then
            ls.t_token = ls.lookahead_token
            ls.lookahead_token = nil
            ls.t_seminfo = ls.lookahead_seminfo
        end
        local token = coroutine.yield()
        ls.t_token = token
        if extra_tokens[token] then
            ls.t_seminfo = coroutine.yield()
        end
    end
end)()

local function save_token(ls)
    local tk = ls.t_token
    local seminfo = ls.t_seminfo
    local c = ls[parser.COLLECT] or ls
    if tk == TK.FLOAT then
        local token = seminfo
        local extra, num, den = 1, token, 1
        assert(token == token and token >= 0, "NYI") -- the tokenizer should never output NaNs or negative values
        if token == math.huge then
            num, den = 1, 0
        else
            while num ~= math.floor(num) do
                num = num * 2 -- always safe (I think)
                local oldden = den
                den = den * 2
                if den == math.huge then -- subnormals or something?
                    extra = oldden
                    den = 2
                end
            end
        end
        c[#c+1] = string.format('((%d/%d)/%d)', num, den, extra)
    elseif tk == TK.INT then
        c[#c+1] = string.format('%d', seminfo)
    elseif tk == TK.STRING then
        c[#c+1] = string.format('%q', seminfo)
    elseif tk == TK.NAME then
        c[#c+1] = seminfo
    else
        c[#c+1] = tostring(tk)
    end
end

function luaX.syntaxerror(ls, msg)
    error("NYI")
end

-- maximum number of local variables per function (must be smaller
-- than 250, due to the bytecode format)
local MAXVARS = 200

-- hasmultret TODO
-- eqstr TODO

-- prototypes for recursive non-terminal functions
local statement, expr

-- semantic error
local function semerror(ls, msg)
    ls.t_token = nil -- remove "near <token>" from final message
    luaX.syntaxerror(ls, msg)
end

local function error_expected(ls, token)
    luaX.syntaxerror(ls, string.format("%s expected", tostring(token)))
end

-- errorlimit TODO
-- checklimit TODO

local function testnext(ls, c)
    if ls.t_token == c then
        save_token(ls)
        luaX.next(ls)
        return true
    end
    return false
end

local function check(ls, c)
    if ls.t_token ~= c then
        error_expected(ls, c)
    end
end

local function checknext(ls, c)
    check(ls, c)
    save_token(ls)
    luaX.next(ls)
end

local function check_condition(ls, c, msg) if not c then luaX.syntaxerror(ls, msg) end end

local function check_match(ls, what, who, where)
    if not testnext(ls, what) then
        if where == ls.linenumber then
            error_expected(ls, what)
        else
            luaX.syntaxerror(ls, string.format("%s expected (to close %s at line %d)", tostring(what), tostring(who), where))
        end
    end
end

local function str_checkname(ls)
    check(ls, TK.NAME)
    local ts = ls.t_seminfo
    save_token(ls)
    luaX.next(ls)
    return ts
end

local function init_exp(expdesc, expkind, i)
    expdesc.t = NO_JUMP
    expdesc.f = expdesc.t
    expdesc.k = expkind
    expdesc.val = i
end

local function codestring(ls, e, s)
    init_exp(e, VK, luaK.stringK(ls.fs, s))
end

-- checkname TODO
-- registerlocalvar TODO
-- new_localvar TODO
-- new_localvarliteral_ TODO
-- new_localvarliteral TODO
-- getlocvar TODO
-- adjustlocalvars TODO
-- removevars TODO
-- searchupvalue TODO
-- newupvalue TODO
-- searchvar TODO
-- markupval TODO
-- singlevaraux TODO
-- singlevar TODO
-- adjust_assign TODO

local function enterlevel(ls)
    -- don't bother
    --local L = ls.L
    --L.nCcalls = L.nCcalls + 1
    --checklimit(ls.fs, L.nCcalls, LUAI_MAXCCALLS, "C levels")
end

local function leavelevel(ls)
    --ls.L.nCcalls = ls.L.nCcalls - 1
end

-- closegoto TODO
-- findlabel TODO
-- newlabelentry TODO
-- findgotos TODO
-- movegotosout TODO

local function enterblock(fs, bl, isloop)
    bl.isloop = isloop
    bl.nactvar = fs.nactvar
    bl.firstlabel = #fs.ls.dyd.label
    bl.firstgoto = #fs.ls.dyd.gt
    bl.upval = 0
    bl.previous = fs.bl
    fs.bl = bl
    --lua_assert(fs.freereg == fs.nactvar)
end

-- breaklabel TODO
-- undefgoto TODO

local function leaveblock(fs)
    local bl = fs.bl
    local ls = fs.ls
    if bl.previous and bl.upval then
        -- create a 'jump to here' to close upvalues
        local j = luaK.jump(fs)
        luaK.patchclose(fs, j, bl.nactvar)
        luaK.patchtohere(fs, j)
    end
    if bl.isloop then
        breaklabel(ls) -- close pending breaks
    end
    fs.bl = bl.previous
    removevars(fs, bl.nactvar)
    --lua_assert(bl.nactvar == fs.nactvar)
    fs.freereg = fs.nactvar -- free registers
    for i=bl.firstlabel,#ls.dyd.label do ls.dyd.label[i]=nil end -- remove local labels
    if bl.previous then
        movegotosout(fs, bl)
    elseif bl.firstgoto < #ls.dyd.gt then
        undefgoto(ls, ls.dyd.gt[bl.firstgoto])
    end
end

-- addprototype TODO

-- codes instruction to create new closure in parent function.
-- The OP_CLOSURe instruction must use the last available register,
-- so that, if it invokes the GC, the GC knows which registers
-- are in use at that time.
local function codeclosure(ls, v)
    local fs = ls.fs.prev
    init_exp(v, VRELOCABLE, luaK.codeABx(fs, OP_CLOSURE, 0, #fs.f.p - 1))
    luaK.exp2nextreg(fs, v) -- fix it at the last register
end

local function open_func(ls, fs, bl)
    fs.prev = ls.fs
    fs.ls = ls
    ls.fs = fs
    fs.pc = 0
    fs.lasttarget = 0
    fs.jpc = NO_JUMP
    fs.freereg = 0
    fs.nactvar = 0
    fs.firstlocal = #ls.dyd.actvar
    fs.bl = nil
    local f = fs.f
    f.source = ls.source
    f.maxstacksize = 2 -- registers 0/1 are always valid
    enterblock(fs, bl, false)
end

local function close_func(ls)
    local fs = ls.fs
    local f = fs.f
    luaK.ret(fs, 0, 0) -- final return
    leaveblock(fs)
    -- don't need to worry about reallocating vectors
    --lua_assert(fs.bl == nil)
    ls.fs = fs.prev
end

local block_follow = (function()
    local tokens = {[TK.ELSE] = true, [TK.ELSEIF] = true, [TK.END] = true, [parser.EOZ] = true}
    return function(ls, withuntil)
        local tk = ls.t_token
        return tokens[tk] or (withuntil and tk == TK.UNTIL)
    end
end)()

local function statlist(ls)
    -- statlist -> { stat [';'] }
    while not block_follow(ls, true) do
        if ls.t_token == TK_RETURN then
            statement(ls)
            return -- 'return' must be last statement
        end
        statement(ls)
    end
end

-- fieldsel TODO

local function yindex(ls, v)
    -- index -> '[' expr ']'
    save_token(ls)
    luaX.next(ls) -- skip the '['
    expr(ls, v)
    luaK.exp2val(ls.fs, v)
    checknext(ls, ']')
end

-- recfield TODO
-- closelistfield TODO
-- lastlistfield TODO
-- listfield TODO
-- field TODO
-- constructor TODO
-- parlist TODO

local function body(ls, e, ismethod, line)
    -- body -> '(' parlist ')' block END
    -- TODO
    error("NYI")
end

local function explist(ls, v)
    -- explist -> expr { ',' expr }
    local n = 1 -- at least one expression
    expr(ls, v)
    while testnext(ls, ',') do
        luaK.exp2nextreg(ls.fs, v)
        expr(ls, v)
        n = n + 1
    end
    return n
end

local function funcargs(ls, f, line)
    local fs = ls.fs
    local args = {}
    local base, nparams
    local tk = ls.t_token
    if tk == '(' then -- funcargs -> '(' [ explist ] ')'
        save_token(ls)
        luaX.next(ls)
        if ls.t_token == ')' then -- arg list is empty?
            args.k = VVOID
        else
            explist(ls, args)
            luaK.setmultret(fs, args)
        end
        check_match(ls, ')', '(', line)
    elseif tk == '{' then -- funcargs -> constructor
        constructor(ls, args)
    elseif tk == TK.STRING then -- funcargs -> STRING
        codestring(ls, args, ls.t_seminfo)
        save_token(ls)
        luaX.next(ls) -- must use 'seminfo' before 'next'
    else
        luaX.syntaxerror(ls, "function arguments expected")
    end
    --lua_assert(f.k == VNONRELOC)
    base = f.val -- base register for call
    if hasmultret(args.k) then
        nparams = LUA_MULTRET -- open call
    else
        if args.k ~= VVOID then
            luaK.exp2nextreg(fs, args) -- close last argument
        end
        nparams = fs.freereg - (base+1)
    end
    init_exp(f, VCALL, luaK.codeABC(fs, OP_CALL, base, nparams+1, 2))
    luaK.fixline(fs, line)
    fs.freereg = base+1 -- call remove function and arguments and leaves
                        -- (unless changed) one result
end

local suffixedexp -- hm.

;(function() -- avoid issues with 200 locals or w/e
    local function primaryexp(ls, v)
        local tk = ls.t_token
        if tk == '(' then
            local line = ls.linenumber
            save_token(ls)
            luaX.next(ls)
            expr(ls, v)
            check_match(ls, ')', '(', line)
            luaK.dischargevars(ls.fs, v)
        elseif tk == TK.NAME then
            singlevar(ls, v)
        else
            luaX.syntaxerror(ls, "unexpected symbol")
        end
    end

    function suffixedexp(ls, v)
        -- suffixedexp ->
        --   primaryexp { '.' NAME | '[' exp ']' | ':' NAME funcargs | funcargs }
        local fs = ls.fs
        local line = ls.linenumber
        primaryexp(ls, v)
        repeat
            local tk = ls.t_token
            if tk == '.' then -- fieldsel
                fieldsel(ls, v)
            elseif tk == '[' then -- '[' exp1 ']'
                local key = {}
                luaK.exp2anyregup(fs, v)
                yindex(ls, key)
                luaK.indexed(fs, v, key)
            elseif tk == ':' then -- ':' NAME funcargs
                local key = {}
                save_token(ls)
                luaX.next(ls)
                checkname(ls, key)
                luaK.self(fs, v, key)
                funcargs(ls, v, line)
            elseif tk == '(' or tk == TK.STRING or tk == '{' then -- funcargs
                luaK.exp2nextreg(fs, v)
                funcargs(ls, v, line)
            else
                return
            end
        until nil
    end

    local function simpleexp(ls, v)
        -- simpleexp -> FLT | INT | STRING | NIL | TRUE | FALSE | ... |
        --              constructor | FUNCTION body | suffixedexp
        local tk = ls.t_token
        if tk == TK.FLT then
            init_exp(v, VKFLT, 0)
            v.val = ls.t_seminfo
        elseif tk == TK.INT then
            init_exp(v, VKINT, 0)
            v.val = ls.t_seminfo
        elseif tk == TK.STRING then
            codestring(ls, v, ls.t_seminfo)
        elseif tk == TK.NIL then
            init_exp(v, VNIL, 0)
        elseif tk == TK.TRUE then
            init_exp(v, VTRUE, 0)
        elseif tk == TK.FALSE then
            init_exp(v, VFALSE, 0)
        elseif tk == TK.DOTS then -- vararg
            local fs = ls.fs
            check_condition(ls, fs.f.is_vararg,
                            "cannot use '...' outside a vararg function")
            init_exp(v, VVARARG, luaK.codeABC(fs, OP.VARARG, 0, 1, 0))
        elseif tk == '{' then
            constructor(ls, v)
        elseif tk == TK.FUNCTION then
            save_token(ls)
            luaX.next(ls)
            body(ls, v, 0, ls.linenumber)
        else
            suffixedexp(ls, v)
        end
        save_token(ls)
        luaX.next(ls)
    end

    local function getunopr(op)
        if op == TK.NOT or
           op == '-' or
           op == '~' or
           op == '#' then
            return op
        end
    end

    -- order intentionally swapped
    local priority = {
        ['+'] =       {left=10, right=10},
        ['-'] =       {left=10, right=10},
        ['*'] =       {left=11, right=11},
        ['%'] =       {left=11, right=11},
        ['^'] =       {left=14, right=13},
        ['/'] =       {left=11, right=11},
        [TK.IDIV] =   {left=11, right=11},
        ['&'] =       {left=6,  right=6},
        ['|'] =       {left=4,  right=4},
        ['~'] =       {left=5,  right=5},
        [TK.SHL] =    {left=7,  right=7},
        [TK.SHR] =    {left=7,  right=7},
        [TK.CONCAT] = {left=9,  right=8},
        [TK.EQ] =     {left=3,  right=3},
        ['<'] =       {left=3,  right=3},
        [TK.LE] =     {left=3,  right=3},
        [TK.NE] =     {left=3,  right=3},
        ['>'] =       {left=3,  right=3},
        [TK.GE] =     {left=3,  right=3},
        [TK.AND] =    {left=2,  right=2},
        [TK.OR] =     {left=1,  right=1},
    }

    -- order intentionally swapped
    local function getbinopr(op)
        if priority[op] then
            return op
        end
    end

    local UNARY_PRIORITY = 12

    -- subexpr -> (simpleexp | unop subexpr) { binop subexpr }
    -- where 'binop' is any binary operator with a priority higher than 'limit'
    local function subexpr(ls, v, limit)
        enterlevel(ls)
        local uop = getunopr(ls.t_token)
        if uop then
            local line = ls.linenumber
            save_token(ls)
            luaX.next(ls)
            subexpr(ls, v, UNARY_PRIORITY)
            luaK.prefix(ls.fs, uop, v, line)
        else
            simpleexp(ls, v)
        end
        -- expand while operators have priorities higher than 'limit'
        local op = getbinopr(ls.t_token)
        while op and priority[op].left > limit do
            local line = ls.linenumber
            save_token(ls)
            luaX.next(ls)
            luaK.infix(ls.fs, op, v)
            -- read sub-expression with higher priority
            local nextop = subexpr(ls, v2, priority[op].right)
            luaK_posfix(ls.fs, op, v, v2, line)
            op = nextop
        end
        leavelevel(ls)
        return op -- return first untreated operator
    end

    function expr(ls, v)
        subexpr(ls, v, 0)
    end
end)()

;(function() -- avoid issues with 200 locals or w/e
    -- block TODO
    -- check_conflict TODO
    -- assignment TODO
    -- cond TODO

    local function gotostat(ls, pc)
        local line = ls.linenumber
        local label
        if testnext(ls, TK.GOTO) then
            label = str_checkname(ls)
        else
            save_token(ls)
            luaX.next(ls) -- skip break
            label = "break" -- ?
        end
        local g = newlabelentry(ls, ls.dyd.gt, label, line, pc)
        findlabel(ls, g) -- close it if label already defined
    end

    -- checkrepeated TODO

    local function skipnoopstat(ls)
        while ls.t_token == ';' or ls.t_token == TK.DBCOLON do
            statement(ls)
        end
    end

    -- labelstat TODO
    -- whilestat TODO
    -- repeatstat TODO
    -- exp1 TODO
    -- forbody TODO
    -- fornum TODO
    -- forlist TODO
    -- forstat TODO
    -- test_then_block TODO
    -- ifstat TODO
    -- localfunc TODO
    -- localstat TODO
    -- funcname TODO
    -- funcstat TODO
    -- exprstat TODO

    local function retstat(ls)
        local fs = ls.fs
        local e = {}
        local first, nret
        if block_follow(ls, true) or ls.t_token == ';' then
            first, nret = 0, 0
        else
            nret = explist(ls, e)
            if hasmultret(e.k) then
                luaK.setmultret(fs, e)
                if e.k == VCALL and nret == 1 then -- tail call?
                    --SET_OPCODE(getinstruction(fs,e), OP_TAILCALL)
                    --lua_assert(GETARG_A(getinstruction(fs,e)) == fs.nactvar)
                end
                first = fs.nactvar
                nret = LUA_MULTRET
            else
                if nret == 1 then
                    first = luaK.exp2anyreg(fs, e)
                else
                    luaK.exp2nextreg(fs, e)
                    first = fs.nactvar
                    --lua_assert(nret == fs.freereg - first)
                end
            end
        end
        luaK.ret(fs, first, nret)
        testnext(ls, ';') -- skip optional semicolon
    end

    function statement(ls)
        local line = ls.linenumber
        enterlevel(ls)
        local tk = ls.t_token
        if tk == ';' then -- stat -> ';' (empty statement)
            save_token(ls)
            luaX.next(ls) -- skip ';'
        elseif tk == TK.IF then -- stat -> ifstat
            ifstat(ls, line)
        elseif tk == TK.WHILE then -- stat -> whilestat
            whilestat(ls, line)
        elseif tk == TK.DO then --> stat -> DO block END
            save_token(ls)
            luaX.next(ls) -- skip DO
            block(ls)
            check_match(ls, TK_END, TK_DO, line)
        elseif tk == TK.FOR then -- stat -> forstat
            forstat(ls, line)
        elseif tk == TK.REPEAT then -- stat -> repeatstat
            repeatstat(ls, line)
        elseif tk == TK.FUNCTION then -- stat -> funcstat
            funcstat(ls, line)
        elseif tk == TK.LOCAL then -- stat -> localstat
            save_token(ls)
            luaX.next(ls) -- skip LOCAL
            if testnext(ls, TK.FUNCTION) then -- local function?
                localfunc(ls)
            else
                localstat(ls)
            end
        elseif tk == TK.DBCOLON then -- stat -> label
            save_token(ls)
            luaX.next(ls) -- skip double colon
            labelstat(ls, str_checkname(ls), line)
        elseif tk == TK.RETURN then -- stat -> retstat
            save_token(ls)
            luaX.next(ls) -- skip RETURN
            retstat(ls)
        elseif tk == TK.BREAK     -- stat -> breakstat
            or tk == TK.GOTO then -- stat -> 'goto' NAME
            gotostat(ls, luaK.jump(ls.fs))
        else
            exprstat(ls)
        end
        --lua_assert(ls.fs.f.maxstacksize >= ls.fs.freereg and
        --           ls.fs.freereg >= ls.fs.nactvar)
        ls.fs.freereg = ls.fs.nactvar -- free registers
        leavelevel(ls)
    end
end)()

local function mainfunc(ls, fs)
    local bl = {}
    open_func(ls, fs, bl)
    fs.f.is_vararg = true
    -- we don't worry about these:
    --local v = {}
    --init_exp(v, VLOCAL, 0)
    --newupvalue(fs, ls.envn, &v)
    luaX.next(ls)
    statlist(ls)
    check(ls, parser.EOZ)
    close_func(ls)
end

local function worst_cratera_parser(ls) -- luaY.parser
    local lexstate, funcstate, cl
    lexstate = ls
    funcstate = {}
    cl = {}
    lexstate.h = {}
    cl.p = {}
    funcstate.f = cl.p
    funcstate.f.source = lexstate.source
    --lua_assert(iswhite(funcstate.f))
    --lexstate.buff = {} -- ???
    lexstate.dyd = {actvar = {}, gt = {}, label = {}} -- ???
    if not lexstate.linenumber then lexstate.linenumber = 1 end -- not managed by us
    lexstate.lastline = 1
    mainfunc(lexstate, funcstate)
    --lua_assert(!funcstate.prev and funcstate.nups == 1 and !lexstate.fs)
    --lua_assert(#dyd.actvar == 0 and #dyd.gt == 0 and #dyd.label == 0)
    return cl -- close enough
end

local defs = selfify({})
defs[parser.EOZ] = parser.FALLBACK
defs[parser.FALLBACK] = function(state, token)
    local coro = state.coro
    if not coro then
        coro = coroutine.create(worst_cratera_parser)
        state.coro = coro
        state.t = {} -- token
        assert(coroutine.resume(coro, state))
    end
    local _, override = assert(coroutine.resume(coro, token))
    if override then return override end
    return "self"
end

return {
    defs = defs,
}