https://www.lexaloffle.com/bbs/?tid=36381

pico_repl-16.p8

(function () -- ensure we run in a clean scope

-- Prepare globals

local my_ENV, globfuncs = {}, {}
for k,v in pairs(_ENV) do
    my_ENV[k] = v
    if (type(v) == "function") globfuncs[k] = true
end

local g_ENV = _ENV
local _ENV = my_ENV -- with this, we segregate ourselves from the running code (all global accesses below use _ENV automagically)

-- get an assert whenever globals are accidentally added
-- KEEP COMMENTED OUT due to ord/chr weak globals
--[[setmetatable(_ENV, {
    __index=function(o,k) assert(false,'global get: '..k) end,
    __newindex=function(o,k,v) assert(false,'global set: '..k) end
})]]

-- Utils

local function isoneof(ch, str)
    for i=1,#str do
        if (sub(str,i,i) == ch) return true
    end
    return false
end

local function isin(obj, tab)
    for i=1,#tab do
        if (tab[i] == obj) return true
    end
    return false
end

local function rest(a, ...)
    return ...
end

local function _pack_n(...)
    local empty = type(btn(...)) == "number"
    return empty and 0 or 1 + _pack_n(rest(...))
end

local function pack(...)
    local t = {...}
    t.n = _pack_n(...)
    return t
end

local function unpack(t, i)
    i = i or 1
    if (i > t.n) return
    return t[i], unpack(t, i+1)
end

local function is_pack_empty(t)
    return t.n == 0
end

local function pack_self_test()
    return (coresume(cocreate(function() assert(_pack_n({},{},'','z',-1,0.5,1.5,0,9999,false,true,nil) == 12) end)))
end

if not pack_self_test() then
    printh("falling back to naive packing...")

    pack = function(...) -- naive (no trailing nil support)
        local t = {...}
        local n = 1 -- prefer nil over empty
        for k, v in pairs(t) do n = max(n, k) end -- more reliable than #
        t.n = n
        return t
    end

    is_pack_empty = function(t)
        return t.n <= 1 and t[1] == nil
    end
end

local g_error = nil

local function fail(err)
    g_error = err
    assert(false, "FAIL")
end

local function copy(t)
    local ct = {}
    for k, v in pairs(t) do ct[k] = v end
    return ct
end

local function popkeys()
    while (stat(30)) do stat(31) end
end

-- Input : Tokenize

local escapes = {a="\a",b="\b",f="\f",n="\n",r="\r",t="\t",v="\v",["\\"]="\\",['"']='"',["'"]="''"}

local function isalnum(ch)
    return ch >= '0' and ch <= '9' or ch >= 'A' and ch <= 'Z' or ch >= 'a' and ch <= 'z' or ch == '_' or ch >= '\x80'
end

local function dequote(str, i, quote)
    local rawstr = ''
    while i <= #str and sub(str,i,i) != quote do
        local ch = sub(str,i,i)
        if ch == '\\' then
            i += 1
            local esch = sub(str,i,i)
            ch = escapes[esch] -- normal escapes
            if esch == 'x' then -- hex escape
                i += 2
                esch = tonum('0x'..sub(str,i-1,i))
                if (not esch) fail("bad hex escape") esch=0
                if chr then ch = chr(esch) else fail("hex escape requires 1.12d+") ch='' end
            elseif esch >= '0' and esch <= '9' then -- dec escape
                local start = i
                while esch >= '0' and esch <= '9' and i < start + 3 do i += 1; esch = sub(str,i,i) end
                i -= 1
                esch = tonum(sub(str,start,i))
                if (not esch or esch >= 256) fail("bad decimal escape") esch=0
                if chr then ch = chr(esch) else fail("decimal escape requires 1.12d+") ch='' end
            elseif esch == '\n' then -- newline
                ch = '\n'
            elseif esch == 'z' then -- ignore wspace
                repeat i += 1; esch = sub(str,i,i) until not isoneof(esch, ' \r\t\f\v\n')
                if (esch == '') fail(false)
                ch = ''
                i -= 1
            elseif esch == '' then fail(false) end
            if (not ch) fail("bad escape: " .. esch) ch=''
        end
        rawstr = rawstr .. ch
        i += 1
    end
    if (i > #str) fail("unterminated string", true)
    return rawstr, i+1
end

local function delongbracket(str, i)
    if sub(str,i,i) == '[' then i += 1
        local eq_start = i
        while sub(str,i,i) == '=' do i += 1 end
        local end_delim = ']' .. sub(str,eq_start,i-1) .. ']'
        local j = #end_delim

        if sub(str,i,i) == '[' then i += 1
            if (sub(str,i,i) == '\n') i += 1
            local start = i
            while i <= #str and sub(str,i,i+j-1) != end_delim do i += 1 end
            if (i >= #str) fail(false)
            return sub(str,start,i-1), i+j
        end
    end
    fail("invalid long brackets")
    return str, i
end

local function tokenize(str, lenient)
    local i = 1
    local line = 1
    local tokens = {}
    local tlines = {}
    local tstarts = {}
    local tends = {}
    local _fail, err = fail
    if (lenient) fail = function(v,ok) err = v and not ok end
    while i <= #str do
        local start = i
        local ch = sub(str,i,i)
        local ws, token
        if isoneof(ch, ' \r\t\f\v') then i += 1; ws = true
        elseif ch == '\n' then i += 1; line += 1; ws = true
        elseif ch == '-' and sub(str,i+1,i+1) == '-' then -- comment
            i += 2
            if sub(str,i,i) == '[' then
                token, i = delongbracket(str, i)
            else
                while i <= #str and sub(str,i,i) != '\n' do i += 1 end
            end
            if (lenient) add(tokens, true) else ws = true
        elseif (ch >= '0' and ch <= '9') or  -- number
               (ch == '.' and isoneof(sub(str,i+1,i+1), "0123456789")) then
            while isoneof(sub(str,i,i), "0123456789aAbBcCdDeEfF") or sub(str,i,i) == '.' or
                  isoneof(sub(str,i,i), 'xX') and sub(str,i-1,i-1) == '0' and i-1 == start or
                  isoneof(sub(str,i,i), '-+') and isoneof(sub(str,i-1,i-1), 'eE') do i += 1 end
            token = sub(str,start,i-1)
            while not tonum(token) do
                if isoneof(sub(str,i-1,i-1), "aAbBcCdDeEfF") then i -= 1; token = sub(str,start,i-1)
                else fail("bad number: " .. token); token='0' end
            end
            add(tokens, tonum(token))
        elseif isalnum(ch) then -- ident
            while isalnum(sub(str,i,i)) do i += 1 end
            add(tokens, sub(str,start,i-1))
        elseif ch == "'" or ch == '"' then -- string
            token, i = dequote(str, i+1, ch)
            add(tokens, {str=token})
        elseif ch == '[' and isoneof(sub(str,i+1,i+1), "=[") then -- string (long form)
            token, i = delongbracket(str, i)
            add(tokens, {str=token})
        else
            i += 1
            local ch2,ch3 = sub(str,i,i),sub(str,i+1,i+1)
            local eqopt = isoneof(ch,'+-*/%<>=')
            local repopt = isoneof(ch,'.:')
            if (eqopt or isoneof(ch,'~!')) and ch2 == '=' then i += 1
            elseif ch == '.' and ch2 == '.' and ch3 == '.' then i += 2
            elseif repopt and ch2 == ch then i += 1
            elseif eqopt or repopt or isoneof(ch,'^#(){}[];,?@') then
            else fail("bad char: " .. ch) end
            add(tokens, sub(str,start,i-1))
        end
        if (not ws) add(tlines, line); add(tstarts, start); add(tends, i-1)
        if (err) tokens[#tokens] = false; err = false;
    end
    fail = _fail
    return tokens, tlines, tstarts, tends
end

-- Input : Parse & Eval

-- a parse returns a (node, setnode, tailcallnode) tuple.
-- each node is a function with e as the first arg.

local keywords = {"and", "break", "do", "else", "elseif", "end", "false", "for", "function", "goto", "if", "in",
                  "local", "nil", "not", "or", "repeat", "return", "then", "true", "until", "while"}

local function is_op_assign(token)
    return type(token) == "string" and sub(token,2,2) == '='
end

local function eval_nodes(e, nodes)
    local results = {}
    local n = #nodes
    for i=1,n-1 do
        results[i] = nodes[i](e)
    end
    if n > 0 then
        local values = pack(nodes[n](e))
        for i=1,values.n do
            results[n + i - 1] = values[i]
        end
        n += values.n - 1
    end
    results.n = n
    return results
end

local function handle_break(retval)
    if (retval == true) return -- break
    return retval
end

local g_results = nil
local g_last_value = nil
local cmd_exec

local function parse(tokens, tlines)
    local i = 1
    local parse_expr, parse_block
    local locals = {}
    local depth = 0

    local function const_node(value)
        return function(e) assert(e, "repl failure"); return value end
    end
    local function var_node(name)
        local i = locals[name]
        if i then return function(e) return e[i][name] end
        else return function(e) return g_ENV[name] end
        end
    end
    local function vararg_node()
        local i = locals['...']
        if (not i) fail("unexpected '...'")
        return function(e) return unpack(e[i]["..."]) end
    end
    local function assign_node(name)
        local i = locals[name]
        if i then return function(e, v) e[i][name] = v end
        else return function(e, v) g_ENV[name] = v end
        end
    end

    local function require(expect, retval)
        local token = tokens[i]; i += 1
        if (token == expect) return retval
        if (token == nil) fail(false)
        fail("expected: " .. expect)
    end

    local function require_ident(token)
        if (not token) token = tokens[i]; i += 1
        if (token == nil) fail(false)
        if (type(token) == 'string' and isalnum(sub(token,1,1)) and not isin(token, keywords)) return token
        if (type(token) == 'string') fail("invalid identifier: " .. token)
        fail("identifier expected")
    end

    local function parse_list(parser)
        local list = {}
        add(list, parser())
        while tokens[i] == ',' do i += 1
            add(list, parser())
        end
        return list
    end

    local function parse_call(node, method, arg)
        local args = {}
        if arg then
            add(args, arg)
        else
            while tokens[i] != ')' do
                local token = tokens[i]
                if (token == nil) fail(false)
                add(args, parse_expr())

                if tokens[i] == ')' then break end
                require(',')
            end
            require(')')
        end

        if arg then
            return function(e) return node(e)(arg(e)) end, nil,
                   function(e) return node(e), pack(arg(e)) end
        elseif method then
            return function(e)
                local obj = node(e)
                return obj[method](obj, unpack(eval_nodes(e, args)))
            end, nil, function(e)
                local obj = node(e)
                return obj[method], pack(obj, unpack(eval_nodes(e, args)))
            end
        else
            return function(e)
                return node(e)(unpack(eval_nodes(e, args)))
            end, nil, function(e)
                return node(e), eval_nodes(e, args)
            end
        end
    end

    local function parse_table()
        local keys, values = {}, {}
        local splat_i = 0
        local index = 1
        while tokens[i] != '}' do
            local token = tokens[i]; i += 1
            if (token == nil) fail(false)

            local key, value
            if token == '[' then key = parse_expr(); require(']') require('='); value = parse_expr()
            elseif tokens[i] == '=' then key = const_node(require_ident(token)); require('='); value = parse_expr()
            else i -= 1; key = const_node(index); value = parse_expr(); index += 1; splat_i = #keys + 1
            end

            add(keys, key); add(values, value)

            if (tokens[i] == '}') break
            if (tokens[i] == ';') i += 1 else require(',')
        end
        require('}')

        return function(e)
            local table = {}
            for i=1,#keys do
                if i == splat_i then
                    local key, values = keys[i](e), pack(values[i](e))
                    for i=1,values.n do
                        table[key + i - 1] = values[i]
                    end
                else
                    table[keys[i](e)] = values[i](e)
                end
            end
            return table
        end
    end

    local function parse_function(is_stmt, is_local)
        local name, has_self, setnode
        if (is_stmt) then
            if is_local then
                name = require_ident()
                locals[name] = depth
                setnode = assign_node(name)
            else
                name = {require_ident()}
                while tokens[i] == '.' do i += 1; add(name, require_ident()) end
                if (tokens[i] == ':') i += 1; add(name, require_ident()); has_self = true

                if #name == 1 then setnode = assign_node(name[1])
                else
                    local node = var_node(name[1])
                    for i=2,#name-1 do
                        local node_i = node -- capture
                        node = function(e) return node_i(e)[name[i]] end
                    end
                    setnode = function(e,v) node(e)[name[#name]] = v end
                end
            end
        end

        local params = {}
        local vararg = false
        if (has_self) add(params, 'self')
        require("(")
        while tokens[i] != ')' do
            if (tokens[i] == '...') i += 1; vararg = true; else add(params, require_ident())
            if tokens[i] == ')' then break end
            require(',')
        end
        require(")")

        local func_locals = {}
        for param in all(params) do func_locals[param] = depth + 1 end
        if (vararg) func_locals['...'] = depth + 1

        local body = require('end', parse_block(func_locals))

        return function(e)
            local func_e = copy(e)
            local func_e_len = #func_e

            local func = function(...)
                local args = pack(...)

                local func_e = func_e
                if #func_e != func_e_len then -- recursion
                    local new_e = {}
                    for i=1,func_e_len do new_e[i] = func_e[i] end
                    func_e = new_e
                end

                local scope = {}
                for i=1,#params do scope[params[i]] = args[i] end

                if vararg then
                    local varargs = {}
                    for i=#params,args.n do
                        varargs[i - #params] = args[i]
                    end
                    varargs.n = max(args.n - #params, 0)
                    scope['...'] = varargs
                end

                local retval = body(func_e, scope)
                if (not retval) return
                if (type(retval) == "table") return unpack(retval) -- return
                if (type(retval) == "function") return retval() -- tailcall
                if (retval == true) fail("break outside of loop")
                fail("goto out of function")
            end

            if (is_stmt) setnode(e, func) else return func
        end
    end

    local function parse_core()
        local token = tokens[i]; i += 1
        local arg
        if (token == nil) fail(false)
        if (token == "nil") return const_node(nil)
        if (token == "true") return const_node(true)
        if (token == "false") return const_node(false)
        if (type(token) == "number") return const_node(token)
        if (type(token) == "table") return const_node(token.str)
        if (token == "{") return parse_table()
        if token == "(" then arg = require(')', parse_expr()); return function(e) return (arg(e)) end end
        if (token == "-") arg = parse_expr(9); return function(e) return -arg(e) end
        if (token == "not") arg = parse_expr(9); return function(e) return not arg(e) end
        if (token == "#") arg = parse_expr(9); return function(e) return #arg(e) end
        if (token == 'function') return parse_function()
        if (token == "...") return vararg_node()
        if (token == "@") arg = require_ident() return function(e) return cmd_exec(arg) end, function(e,v) cmd_exec(arg,true,v) end
        if (require_ident(token)) return var_node(token), assign_node(token)
        fail("unexpected token: " .. token)
    end

    local function parse_expr_more(prec, left)
        local token = tokens[i]; i += 1
        local right
        if token == '.' then right = require_ident(); return function(e) return left(e)[right] end, function(e,v) left(e)[right] = v end
        elseif token == '[' then right = require(']', parse_expr()); return function(e) return left(e)[right(e)] end, function(e,v) left(e)[right(e)] = v end
        elseif token == "(" then return parse_call(left)
        elseif token == ":" then right = require('(', require_ident()); return parse_call(left, right)
        elseif token == "{" or type(token) == "table" then i -= 1; right = parse_core(); return parse_call(left, nil, right)
        elseif token == "^" and prec <= 10 then right = parse_expr(10); return function(e) return left(e) ^ right(e) end
        elseif token == "*" and prec < 8 then right = parse_expr(8); return function(e) return left(e) * right(e) end
        elseif token == "/" and prec < 8 then right = parse_expr(8); return function(e) return left(e) / right(e) end
        elseif token == "%" and prec < 8 then right = parse_expr(8); return function(e) return left(e) % right(e) end
        elseif token == "+" and prec < 7 then right = parse_expr(7); return function(e) return left(e) + right(e) end
        elseif token == "-" and prec < 7 then right = parse_expr(7); return function(e) return left(e) - right(e) end
        elseif token == ".." and prec <= 6 then right = parse_expr(6); return function(e) return left(e) .. right(e) end
        elseif token == "<" and prec < 5 then right = parse_expr(5); return function(e) return left(e) < right(e) end
        elseif token == ">" and prec < 5 then right = parse_expr(5); return function(e) return left(e) > right(e) end
        elseif token == "<=" and prec < 5 then right = parse_expr(5); return function(e) return left(e) <= right(e) end
        elseif token == ">=" and prec < 5 then right = parse_expr(5); return function(e) return left(e) >= right(e) end
        elseif token == "==" and prec < 5 then right = parse_expr(5); return function(e) return left(e) == right(e) end
        elseif (token == "~=" or token == "!=") and prec < 5 then right = parse_expr(5); return function(e) return left(e) ~= right(e) end
        elseif token == "and" and prec < 4 then right = parse_expr(4); return function(e) return left(e) and right(e) end
        elseif token == "or" and prec < 3 then right = parse_expr(3); return function(e) return left(e) or right(e) end
        else i -= 1; return end
    end

    parse_expr = function(prec)
        if (not prec) prec = 0
        local node, setnode, callnode = parse_core()
        while true do
            local newnode, newsetnode, newcallnode = parse_expr_more(prec, node)
            if (not newnode) break
            node, setnode, callnode = newnode, newsetnode, newcallnode
        end
        return node, setnode, callnode
    end

    local function parse_assign_expr()
        local _, assign_expr = parse_expr()
        if (not assign_expr) fail("cannot assign to value")
        return assign_expr
    end

    local function parse_assign()
        local targets = require("=", parse_list(parse_assign_expr))
        local sources = parse_list(parse_expr)

        if #targets == 1 and #sources == 1 then return function(e)
            targets[1](e, sources[1](e))
        end else return function(e)
            local values = eval_nodes(e, sources)
            for i=1,#targets do targets[i](e, values[i]) end
        end end
    end

    local function parse_op_assign(node, setnode)
        local op = sub(tokens[i],1,1); i += 1
        local source = parse_expr()
        if (op == "+") return function(e) return setnode(e, node(e) + source(e)) end
        if (op == "-") return function(e) return setnode(e, node(e) - source(e)) end
        if (op == "*") return function(e) return setnode(e, node(e) * source(e)) end
        if (op == "/") return function(e) return setnode(e, node(e) / source(e)) end
        if (op == "%") return function(e) return setnode(e, node(e) % source(e)) end
        fail("invalid compound assignment: " .. op)
    end

    local function parse_local()
        if tokens[i] == 'function' then
            i += 1
            return parse_function(true, true)
        else
            local targets = parse_list(require_ident)
            local sources
            if (tokens[i] == '=') i += 1; sources = parse_list(parse_expr) else sources = {}

            for i=1,#targets do locals[targets[i]] = depth end
            local d = depth -- capture

            if #targets == 1 and #sources == 1 then return function(e)
                e[d][targets[1]] = sources[1](e)
            end else return function(e)
                local values = eval_nodes(e, sources)
                for i=1,#targets do e[d][targets[i]] = values[i] end
            end end
        end
    end

    local function parse_ifstmt()
        local cond = parse_expr()
        local then_b, else_b
        if tokens[i] != 'then' then
            local line = tlines[i]
            local endcb = function() return line != tlines[i] end
            then_b = parse_block(nil, {'else','end'}, endcb)
            if (tokens[i] == 'else' and not endcb()) i += 1; else_b = parse_block(nil, {'end'}, endcb)
        else
            local need_end = true
            require('then')
            then_b, else_b = parse_block(nil, {'else','elseif','end'})
            if tokens[i] == 'else' then i += 1; else_b = parse_block()
            elseif tokens[i] == 'elseif' then i += 1; else_b = parse_ifstmt(); need_end = false
            end
            if (need_end) require('end')
        end

        return function(e)
            if cond(e) then return then_b(e)
            elseif else_b then return else_b(e)
            end
        end
    end

    local function parse_while()
        local cond = require('do', parse_expr())
        local body = require('end', parse_block())

        return function(e)
            while cond(e) do
                local retval = body(e)
                if (retval) return handle_break(retval)
            end
        end
    end

    local function parse_repeat()
        local body = require('until', parse_block(nil, {'until'}))
        local cond = parse_expr()

        return function(e)
            repeat
                local retval = body(e)
                if (retval) return handle_break(retval)
            until cond(e)
        end
    end

    local function parse_for()
        if tokens[i + 1] == '=' then
            local varb = require('=', require_ident())
            local min = require(',', parse_expr())
            local max = parse_expr()
            local step
            if (tokens[i] == ',') i += 1; step = parse_expr() else step = const_node(1)
            require('do')

            local for_locals = {[varb]=depth + 1}
            local body = require('end', parse_block(for_locals))

            return function(e)
                for i=min(e),max(e),step(e) do
                    local scope = {}
                    scope[varb] = i

                    local retval = body(e, scope)
                    if (retval) return handle_break(retval)
                end
            end
        else
            local targets = require("in", parse_list(require_ident))
            local sources = require('do', parse_list(parse_expr))

            local for_locals = {}
            for target in all(targets) do for_locals[target] = depth + 1 end

            local body = require('end', parse_block(for_locals))

            return function(e)
                local exps = eval_nodes(e, sources)
                while true do
                    local scope = {}

                    local vars = {exps[1](exps[2], exps[3])}
                    if (vars[1] == nil) break
                    exps[3] = vars[1]
                    for i=1,#targets do scope[targets[i]] = vars[i] end

                    local retval = body(e, scope)
                    if (retval) return handle_break(retval)
                end
            end
        end
    end

    local function parse_return(endcb)
        if isin(tokens[i], {';','end','else','elseif','until'}) or (endcb and endcb()) then
            return function(e) return {n=0} end
        else
            local node, _, callnode = parse_expr()
            local nodes = {node}
            while tokens[i] == ',' do i += 1
                add(nodes, parse_expr())
            end

            if #nodes == 1 and callnode then
                return function(e) local func, args = callnode(e);
                    return function() return func(unpack(args)) end -- tailcall
                end
            else
                return function(e) return eval_nodes(e, nodes) end
            end
        end
    end

    local function parse_label(stmt_i)
        local label = "::" .. require('::', require_ident()) .. "::"
        locals[label] = bor(depth, lshr(stmt_i,16))
        return nil
    end

    local function parse_goto()
        local label = "::" .. require_ident() .. "::"
        local locals_c = locals -- capture

        return function(e)
            local target = locals_c[label]
            if (not target) fail("invalid label: " .. label)
            return target
        end
    end

    local function parse_stmt(stmt_i, endcb)
        local token = tokens[i]; i += 1
        if (token == ';') return nil
        if (token == 'do') return require('end', parse_block())
        if (token == 'if') return parse_ifstmt()
        if (token == 'while') return parse_while()
        if (token == 'repeat') return parse_repeat()
        if (token == 'for') return parse_for()
        if (token == 'break') return function(e) return true end
        if (token == 'return') return parse_return(endcb)
        if (token == 'local') return parse_local()
        if (token == 'goto') return parse_goto()
        if (token == '::') return parse_label(stmt_i)
        if token == 'function' and tokens[i] != '(' then return parse_function(true) end
        if token == '?' then local nodes = parse_list(parse_expr);
                          return function (e) g_ENV.print(unpack(eval_nodes(e, nodes))) end end

        -- assign/exprs
        i -= 1
        local start = i
        local node, setnode, callnode = parse_expr()
        if tokens[i] == ',' or tokens[i] == '=' then
            i = start; return parse_assign()
        elseif is_op_assign(tokens[i]) then
            return parse_op_assign(node, setnode)
        elseif depth <= 1 then
            return function (e)
                local results = pack(node(e))
                if (not (callnode and is_pack_empty(results))) add(g_results, results)
                g_last_value = results[1]
            end
        else
            return function(e) node(e) end
        end
    end

    parse_block = function(initial_locals, ends, endcb)
        if (not ends) ends = {'end'}

        local prev_locals = locals
        locals = initial_locals or {}
        depth += 1
        local block_depth = depth
        if (prev_locals) setmetatable(locals, {__index=prev_locals})

        local block = {}
        while i <= #tokens and not isin(tokens[i], ends) do
            local stmt = parse_stmt(#block, endcb)
            if (stmt) add(block, stmt)
            if (endcb and endcb()) break
        end

        locals = prev_locals
        depth -= 1

        return function (e, scope)
            local retval
            add(e, scope or {})
            local i,n = 1,#block
            while i <= n do
                retval = block[i](e)
                if retval then
                    if (type(retval) != "number") break -- return/break
                    if (band(retval,0xffff) != block_depth) break
                    i = shl(retval,16) -- goto
                    retval = nil
                end
                i += 1
            end
            e[#e] = nil
            return retval
        end
    end

    return parse_block({_=0, _env=0}, {})
end

-- Output

local g_show_max_items = 10

local function requote(str)
    local i = 1
    while i <= #str do
        local ch, nch = sub(str,i,i)
        if ch == '\\' or ch == '"' then nch = ch
        elseif ch == '\n' then nch = 'n'
        elseif ch == '\t' then nch = 't'
        elseif ch == '\x7f' then nch = 'x7f'
        elseif ch < '\x10' and ord then nch = 'x' .. sub(tostr(ord(ch), 1),5,6) end
        if (nch) str = sub(str,1,i-1) .. '\\' .. nch .. sub(str,i+1); i += #nch
        i += 1
    end
    return '"' .. str .. '"'
end

local function is_identifier(key)
    if (type(key) != 'string') return false
    if (isin(key, keywords)) return false
    if (#key == 0 or sub(key,1,1) >= '0' and sub(key,1,1) <= '9') return false
    for i=1,#key do
        if (not isalnum(sub(key,i,i))) return false
    end
    return true
end

local function value_to_str(val, depth)
    local ty = type(val)
    if (ty == 'nil') then
        return 'nil'
    elseif (ty == 'boolean') then
        return val and 'true' or 'false'
    elseif (ty == 'number') then
        return tostr(val)
    elseif (ty == 'string') then
        return requote(val)
    elseif (ty == 'table' and not depth) then
        local res = '{'
        local i = 0
        local prev = 0
        for k,v in next, val do -- pairs uses metamethods
            if (i == g_show_max_items) res = res .. ',<...>' break
            if (i > 0) res = res .. ','
            local vstr = value_to_str(v,1)
            if k == prev + 1 then res = res .. vstr; prev = k
            elseif is_identifier(k) then res = res .. k .. '=' .. vstr
            else res = res .. '[' .. value_to_str(k,1) ..']=' .. vstr end
            i += 1
        end
        return res .. '}'
    elseif (type(ty) == 'string') then
        return '<' .. ty .. '>'
    else
        return '<<' .. tostr(ty) .. '>>' -- for when things are badly borken
    end
end

local function results_to_str(str, results)
    if (results == nil) return str, nil -- no new results
    if (not str) str = ''

    local count = min(21,#results)
    for ir=1, count do
        if (#str > 0) str = str .. '\n'

        local result = results[ir]
        if type(result) == 'table' then
            local line = ''
            for i=1,result.n do
                if (#line > 0) line = line .. ', '
                line = line .. value_to_str(result[i])
            end
            str = str .. line
        else
            str = str .. result
        end
    end

    local new_results = {}
    for i=count+1, #results do new_results[i - count] = results[i] end
    return str, new_results
end

-- Console output

poke(0x5f2d,1) -- enable keyboard
cls()

local g_prompt = "> " -- currently must be valid token!
local g_input, g_input_lines = "", 1
local g_cursor_pos, g_cursor_time = 1, 20
local g_str_output, g_error_output
local g_history, g_history_i = {''}, 1
local g_num_output_lines = 0
local g_interrupt = nil
local g_notice = nil
local g_abort = false
local g_line = 1

local g_enable_pause, g_enable_interrupt = false, true
local g_pal = {7,4,3,5,6,8,5,12,14,7,11}

g_ENV.print = function(value, ...) -- override print for better output
    if (not is_pack_empty(pack(...)) or not g_enable_interrupt) return print(value, ...)

    add(g_results, tostr(value))
end

local function unpause()
    if (not g_enable_pause) poke(0x5f30,1) -- suppress pause (e.g. from p, etc.)
end

local function walk_str(str, cb)
    local i = 1
    local x, y = 0, 0
    if (not str) return i, x, y
    while i <= #str do
        local ch = sub(str,i,i)
        local spch = ch >= '\x80'
        if (x >= (spch and 31 or 32)) y += 1; x = 0
        if (cb) cb(i,ch,x,y)

        if ch == '\n' then y += 1; x = 0
        else x += (spch and 2 or 1) end
        i += 1
    end
    return i, x, y
end

local function str_i2xy(str, ci)
    local cx, cy = 0, 0
    local ei, ex, ey = walk_str(str, function(i,ch,x,y)
        if (ci == i) cx, cy = x, y
    end)
    if (ci >= ei) cx, cy = ex, ey
    if (ex > 0) ey += 1
    return cx, cy, ey
end

local function str_xy2i(str, cx, cy)
    local ci = 1
    local found = false
    local ei, ex, ey = walk_str(str, function(i,ch,x,y)
        if (cy == y and cx == x and not found) ci = i; found = true
        if ((cy < y or cy == y and cx < x) and not found) ci = i - 1; found = true
    end)
    if (not found) ci = cy >= ey and ei or ei - 1
    if (ex > 0) ey += 1
    return ci, ey
end

local function str_print(str, xpos, ypos, color)
    local c, func = color, type(color) == "function"
    walk_str(str, function(i,ch,x,y)
        if (func) c = color(i)
        print(ch, xpos + x*4, ypos + y*6, c)
    end)
end

local function str_print_input(input, xpos, ypos)
    local tokens, _, tstarts, tends = tokenize(input, true) -- tlines not reliable!
    local ti = 1
    str_print(input, xpos, ypos, function(i)
        while ti <= #tends and tends[ti] < i do ti += 1 end

        local token
        if (ti <= #tends and tstarts[ti] <= i) token = tokens[ti]

        local c = g_pal[5]
        if token == false then c = g_pal[6] -- error
        elseif token == true then c = g_pal[7] -- comment
        elseif type(token) != 'string' or isin(token, {"nil","true","false"}) then c = g_pal[8]
        elseif isin(token, keywords) then c = g_pal[9]
        elseif not isalnum(sub(token,1,1)) then c = g_pal[10]
        elseif globfuncs[token] then c = g_pal[11] end

        return c
    end)
end

local function _draw()
    local old_color = peek(0x5f25)
    local old_camx, old_camy = peek2(0x5f28), peek2(0x5f2a)
    camera()

    local function scroll(count)
        cursor(0,127)
        for i=1,count do
            rectfill(0,g_line*6,127,(g_line+1)*6-1,0)
            if g_line < 21 then
                g_line += 1
            else
                print("")
            end
        end
    end

    local function draw_cursor(x, y)
        for i=0,2 do
            local c = pget(x+i,y+5)
            pset(x+i,y+5,c==0 and 5 or 0)
        end
    end

    local function draw_input(cursor)
        local input = g_prompt .. g_input .. ' '
        local cx, cy, ilines = str_i2xy(input, #g_prompt + g_cursor_pos) -- ' ' is cursor placeholder

        if ilines > g_input_lines then
            scroll(ilines - g_input_lines)
            g_input_lines = ilines
        end

        local y = (g_line - g_input_lines)*6

        rectfill(0,y,127,y+g_input_lines*6-1,0)
        str_print_input(input,0,y)
        print(g_prompt,0,y,g_pal[4])

        if (g_cursor_time >= 10 and cursor != false and not g_interrupt) draw_cursor(cx*4, y + cy*6)
    end

    local function page_interrupt(page_olines)
        scroll(1)
        g_line -= 1
        print("[enter] ('esc' to abort)",0,g_line*6,g_pal[3])

        while true do
            flip(); unpause()
            local key = stat(31)
            if (key == '\x1b') g_abort = true; g_str_output = ''; g_results = {}; return false
            if (key == '\r' or key == '\n') g_num_output_lines += page_olines; return true
            popkeys()
        end
    end

    ::again::
    local ostart, olines
    if g_results or g_str_output then
        ostart, olines = str_xy2i(g_str_output, 0, g_num_output_lines)
        if olines - g_num_output_lines <= 20 and g_results then -- add more output
            g_str_output, g_results = results_to_str(g_str_output, g_results)
            ostart, olines = str_xy2i(g_str_output, 0, g_num_output_lines)
            if (#g_results == 0 and not g_interrupt) g_results = nil
        end
    end

    if (not g_interrupt) camera()

    if (g_num_output_lines == 0 and not g_interrupt) draw_input(not g_str_output)

    if g_str_output then
        local output = sub(g_str_output, ostart)
        local page_olines = min(olines - g_num_output_lines, 20)

        scroll(page_olines)
        str_print(output,0,(g_line - page_olines)*6,g_pal[1])

        if page_olines < olines - g_num_output_lines then
            if (page_interrupt(page_olines)) goto again
        else
            local _, _, elines = str_i2xy(g_error_output, 0)
            scroll(elines)
            str_print(g_error_output,0,(g_line - elines)*6,g_pal[2])

            if not g_interrupt then
                g_input, g_input_lines, g_cursor_pos, g_str_output, g_error_output, g_num_output_lines =
                    '', 0, 1, nil, nil, 0
                draw_input()
            end
        end
    end

    if g_interrupt then
        scroll(1)
        g_line -= 1
        print(g_interrupt,0,g_line*6,g_pal[3])
    end

    if g_notice then
        scroll(1)
        g_line -= 1
        print(g_notice,0,g_line*6,g_pal[3])
        g_notice = nil
    end

    g_cursor_time -= 1
    if (g_cursor_time == 0) g_cursor_time = 20

    color(old_color)
    camera(old_camx, old_camy)
    if (g_line <= 20) cursor(0, g_line * 6)
end

--- Execution loop

local function execute_raw(line, eval)
    local root = parse(tokenize(line))
    local retval = root({[0]={_=g_last_value, _env=g_ENV}})
    if retval then
        if (retval == true) fail("break outside of loop")
        if (type(retval) == "number") fail("goto out of program")
        if (not eval) fail("return outside of function")
        return unpack(retval)
    end
end

local function execute(line)
    g_results, g_error, g_abort = {}, nil, false

    local coro = cocreate(function () execute_raw(line) end)
    local ok, error
    while true do
        ok, error = coresume(coro)
        if (costatus(coro) == 'dead') break

        if g_enable_interrupt then
            g_interrupt = "running, press 'esc' to abort"
            _draw(); flip(); unpause()
            g_interrupt = nil
        else
            flip(); unpause()
        end

        local key = stat(31)
        if (g_abort or key == '\x1b') error = 'computation aborted'; break
        popkeys()
    end

    if (g_error == false) error, g_results = nil, nil -- incomplete
    if (g_error) error, g_error = g_error, nil
    g_error_output = error
end

-- Special ('@') commands

local function do_mainloop(env)
    -- not very compatible, mind!
    if (_set_fps) _set_fps(env._update60 and 60 or 30)
    if (env._init) env._init()
    while true do
        if (_update_buttons) _update_buttons()
        if env._update60 then env._update60() elseif env._update then env._update() end
        if (env._draw) env._draw()
        -- TODO: pausemenu handling; time() freezing
    end
end

cmd_exec = function(name, assign, value)
    local function trueish(t)
        return (t and t != 0) and true or false
    end
    if isin(name, {"i","interrupt"}) then
        if (assign) g_enable_interrupt = trueish(value)
        return g_enable_interrupt
    elseif isin(name, {"p","pause"}) then
        if (assign) g_enable_pause = trueish(value)
        return g_enable_pause
    elseif isin(name, {"mi","max_items"}) then
        if (assign) g_show_max_items = tonum(value) or -1
        return g_show_max_items
    elseif isin(name, {"c","code"}) and not assign then
        local code = {[0]=g_input}
        for i=1,#g_history-1 do code[i] = g_history[#g_history-i] end
        return code
    elseif isin(name, {"cl","colors"}) then
        if (assign) g_pal = copy(value)
        return g_pal
    elseif isin(name, {"x","exec"}) and not assign then
        return function(str) execute_raw(str) end
    elseif isin(name, {"v","eval"}) and not assign then
        return function(str) return execute_raw("return " .. str, true) end
    elseif isin(name, {"rst","reset"}) then
        run() -- full pico8 reset
    elseif isin(name, {"run"}) then
        do_mainloop(g_ENV)
    else
        fail("unknown @-command")
    end
end

-- Console input

local g_btn_frames = {}
local g_frame = 0
local g_ideal_x = nil
local g_prev_paste = stat(4)
local g_prev_gpio_paste = ''

local function get_gpio()
    if (not chr) return '' -- eh
    local addr = 0x5f80
    local str = ''
    for i=0,0x7f do
        local ch = peek(addr+i)
        if (ch == 0) break
        str = str .. chr(ch)
    end
    return str
end

local function _update()
    local input, pause = false, false

    local function go_line(dy)
        local cx, cy, h = str_i2xy(g_prompt .. g_input, #g_prompt + g_cursor_pos)
        if (g_ideal_x) cx = g_ideal_x
        cy += dy
        if (not (cy >= 0 and cy < h)) return false
        g_cursor_pos = max(str_xy2i(g_prompt .. g_input, cx, cy) - #g_prompt, 1)
        g_ideal_x = cx
        g_cursor_time = 20 -- setting input clears ideal x
        return true
    end

    local function go_edge(dx)
        local cx, cy = str_i2xy(g_prompt .. g_input, #g_prompt + g_cursor_pos)
        cx = dx > 0 and 100 or 0
        g_cursor_pos = max(str_xy2i(g_prompt .. g_input, cx, cy) - #g_prompt, 1)
        input = true
    end

    local function go_history(di)
        g_history[g_history_i] = g_input
        g_history_i += di
        g_input = g_history[g_history_i]
        if di < 0 then
            g_cursor_pos = #g_input + 1
        else
            g_cursor_pos = max(str_xy2i(g_prompt .. g_input, 32, 0) - #g_prompt, 1) -- end of first line
            local ch = sub(g_input,g_cursor_pos,g_cursor_pos)
            if (ch != '' and ch != '\n') g_cursor_pos -= 1
        end
        input = true
    end
    local function push_history()
        if #g_input > 0 then
            if (#g_history > 50) del(g_history, g_history[1])
            g_history[#g_history] = g_input
            add(g_history, '')
            g_history_i = #g_history
            input = true
        end
    end

    local function delchar()
        if (g_cursor_pos > 1) then
            g_input = sub(g_input,1,g_cursor_pos-2) .. sub(g_input,g_cursor_pos)
            g_cursor_pos -= 1
            input = true
        end
    end
    local function inschar(key)
        g_input = sub(g_input,1,g_cursor_pos-1) .. key .. sub(g_input,g_cursor_pos)
        g_cursor_pos += #key
        input = true
    end

    local function btnpfast(i)
        if btn(i) then
            if (not g_btn_frames[i]) g_btn_frames[i] = g_frame return true
            local delta = g_frame - g_btn_frames[i]
            return delta > 10 and delta % 2 == 0
        else
            g_btn_frames[i] = nil; return false
        end
    end

    local keycode = -1
    if btnpfast(0) then
        if (g_cursor_pos > 1) g_cursor_pos -= 1; input = true
    elseif btnpfast(1) then
        if (g_cursor_pos <= #g_input) g_cursor_pos += 1; input = true
    elseif btnpfast(2) then
        if (not go_line(-1) and g_history_i > 1) go_history(-1)
    elseif btnpfast(3) then
        if (not go_line(1) and g_history_i < #g_history) go_history(1)
    else
        local key = stat(31)
        if (ord) keycode = ord(key)

        if key == '\b' then delchar()
        elseif key == '\x1b' then -- escape
            if #g_input == 0 then extcmd("pause")
            else g_results, g_error_output = {}, nil; push_history() end
        elseif key == '\r' or key == '\n' then
            execute(g_input) -- sets g_results/g_error_output
            if (not g_results) inschar('\n') else push_history()
        elseif key != '' and keycode < 0x9a then -- ignore ctrl-junk
            inschar(key)
        elseif keycode == 193 then -- ctrl+b for 'better than nothing'
            inschar('\n')
        elseif keycode == 192 then -- ctrl+a
            go_edge(-1)
        elseif keycode == 196 then -- ctrl+e
            go_edge(1)
        end
    end

    local paste = stat(4)
    if (paste != g_prev_paste or keycode == 213) inschar(paste); g_prev_paste = paste

    if keycode == 194 or keycode == 215 then
        if g_input != '' and g_input != g_prev_paste then
            g_prev_paste = g_input; printh(g_input, "@clip");
            if (keycode == 215) g_input = ''; g_cursor_pos = 1;
            g_notice = "press again to put in clipboard"
        else
            g_notice = ''
        end
    end

    local gpio_paste = get_gpio() -- DEPRECATED
    if (gpio_paste != g_prev_gpio_paste) inschar(gpio_paste); g_prev_gpio_paste = gpio_paste

    if (input) g_cursor_time = 20; g_ideal_x = nil

    unpause()
    g_frame += 1
end

-- my own crummy mainloop, since time() does not seem to update if the regular mainloop goes "rogue" and flips.
while true do
    _update()
    _draw()
    flip()
end

end)()

-- features: _ is last value, ? prints as usual, esc aborts, _env is all globals, @i command to avoid interruptions