--
-- Much of this implementation is following "Bootstrapping a Forth in 40 lines 
-- of Lua code" by Eduardo Ochs
--
-- http://angg.twu.net/miniforth-article.html
--
_F = {}
DS, POS = { n = 0 }, 1

LOAD = function (code) return assert(load(code)) end
EVAL = function (code) (LOAD(code))() end
TOS  = function (s) return s[s.n] end
POP  = function (s) local x = TOS(s) s[s.n], s.n = nil, s.n - 1 return x end
PSH  = function (s, x) s.n = s.n + 1 s[s.n] = x end

local __tostring = function (self) return self:compile() end
LUA_QUOTE = function (source)
    return setmetatable(
           { source = source
           , func   = assert(load(source))
           , interpret
                = function (self) self.func() end
           , compile
                = function (self) return self.source end
           }, {__tostring = __tostring})
end

LUPA_QUOTE = function (body)
    return setmetatable(
           { body  = body
           , interpret
                = function (self)
                    for _, item in self.body do
                        item:interpret()
                    end
                end
           , compile
                = function (self)
                    local code = {}
                    for _, item in self.body do
                        code[#code+1] = item:compile()
                    end
                    return table.concat(code, "\n")
                end
           }, {__tostring = __tostring})
end

---@param args { name: string, def: table, parsing: boolean }
---@return table
WORD = function (args)
    return setmetatable(
           { name = args.name
           , def = args.def
           , parsing = (args.parsing ~= nil) and args.parsing or false
           , interpret
                = function (self)
                    self.def:interpret()
                end
           , compile
                = function (self)
                    return self.def:compile()
                end
           }, {__tostring = __tostring})
end

NOP = WORD{ name = "NOP", def = LUA_QUOTE("") }

function parse_pattern(pat)
    local capture, newpos = PROG:match(pat, POS)
    if newpos then POS = newpos return capture end
end

-- Allow quotes to be parsed on their own
function parse_squote () return parse_pattern("^(')()")         end
function parse_dquote () return parse_pattern("^(\")()")        end

-- A word can `"`, `'`, or any space seperated token
function parse_word   () return parse_squote() or
                                      parse_dquote() or
                                      parse_pattern("^([^ \t\n]+)()") end

-- Parsing words to handle whitespace 
function parse_spaces () return parse_pattern("^([ \t]*)()")    end
function parse_nl     () return parse_pattern("^(\n)()")        end
function parse_to_nl  () return parse_pattern("^([^\n]*)()")    end

function parse_word_or_nl () return parse_word() or parse_nl()        end
function get_word         () parse_spaces() return  parse_word()      end
function get_word_or_nl   () parse_spaces() return parse_word_or_nl() end


_F["%L"] = WORD{name = "%L", def = LUA_QUOTE([[ parse_spaces() EVAL(parse_to_nl()) ]]), parsing = true}

RUNNING = true MODES = {}
RUN = function() while RUNNING do INTERPRET() end end

INTERPRET_WORD = function()
    if _F[word] then _F[word]:interpret() return true end
end

INTERPRET_NUMBER = function()
    local n = tonumber(word) if n then PSH(DS, n) return true end
end

INTERPRET = function()
    word = get_word_or_nl() or ""
    local _ = INTERPRET_WORD() or INTERPRET_NUMBER() or error("Can't interpret: " .. word)
end


PROG = [=[
%L _F["\n"] = NOP -- Enable us to handle new lines

%L -- Enable use to handle the of the input stream
%L _F[""] = WORD{ name = "HALT",   def = LUA_QUOTE([[ RUNNING = false ]]) }

%L -- Define the core primitives: Lua Quotation, Symbols, and DEFINE.
%L -- These two need to execute at parse time, otherwise we can't build 
%L -- future literals containing them.
%L _F["L["]     = WORD{ name = "L[", def = LUA_QUOTE([[ PSH(DS, LUA_QUOTE(parse_pattern("^(.-)%s]()"))) ]]), parsing = true }
%L _F["'"]      = WORD{ name = "'",  def = LUA_QUOTE([[ PSH(DS, parse_word()) ]]), parsing = true }

%L -- Finally, create the definition for DEFINE. With all three primitives
%L -- we can drop down into Lupa and define new words directly on the stack.
%L _F["DEFINE"] = WORD{ name = "DEFINE",   def = LUA_QUOTE([[ local name = POP(DS) _F[name] = WORD{ name = name, def = POP(DS) } ]]) }

%L -- Implement CALL, DIP, and ? primitives
L[ POP(DS):interpret() ] 'CALL DEFINE
L[ local x, q = POP2(DS) q:interpret() PSH(DS, x) ] 'DIP DEFINE
L[ local b, f, t = POP3(DS) if b then PSH(DS, t) else PSH(DS, f) end ] '? DEFINE

%L -- This is enough to write a primitive hello, world
L[ print("Hello, World!") ] CALL
]=]

POS = 1
MODE = "interpret"
RUN()