-- This file:
--   http://angg.twu.net/LUA/miniforth2021.lua.html
--   http://angg.twu.net/LUA/miniforth2021.lua
--           (find-angg "LUA/miniforth2021.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
--
-- (defun e (interactive) (find-angg "LUA/miniforth2021.lua"))


-- «.savevars»		(to "savevars")
-- «.Stack»		(to "Stack")
-- «.Stack-test»	(to "Stack-test")
-- «.ds»		(to "ds")
-- «._F»		(to "_F")
-- «.MiniForth»		(to "MiniForth")


spaces = function (n) return string.rep(" ", n) end

-- «savevars»  (to ".savevars")
-- (find-es "lua5" "savevars")
savevars = function (restorefromargs, ...)
    local values = pack(...)
    local restorevars = function () restorefromargs(unpack(values)) end
    return restorevars
  end



-- «Stack»  (to ".Stack")
-- (find-dn6 "stacks.lua" "Stack")
--
mystacktostring = function (stack)
    local f = function (i) return {key=i, val=stack[i]} end
    local ps = map(f, seq(#stack, 1, -1))
    return (Tos{}):ps(ps, "\n")
  end
--
Stack = Class {
  type    = "Stack",
  new     = function () return Stack {} end,
  dowords = function (f, bigstr) return Stack{doword=f}:dowords(bigstr):pop() end,
  --
  __tostring = function (s) return s:tostring() end,
  __index = {
    push  = function (s, o) table.insert(s, o); return s end,
    pushs = function (s, ...) for _,v in ipairs({...}) do s:push(v) end end,
    --
    check     = function (s) assert(#s>0, s.msg or "Empty stack"); return s end,
    drop      = function (s) s:check(); s[#s]=nil; return s end,
    dropn     = function (s, n) for i=1,n  do s:drop() end; return s end,
    dropn0    = function (s, n) for i=1,n  do s:drop() end;          end,
    dropnr    = function (s, n, ...) s:dropn(n); return ...          end,
    dropuntil = function (s, n) while #s>n do s:drop() end; return s end,
    clear     = function (s)    return s:dropn(#s) end,
    --
    pop  = function (s) return s:dropnr(1,                            s[#s]) end,
    pop2 = function (s) return s:dropnr(2,                   s[#s-1], s[#s]) end,
    pop3 = function (s) return s:dropnr(3,          s[#s-2], s[#s-1], s[#s]) end,
    pop4 = function (s) return s:dropnr(4, s[#s-3], s[#s-2], s[#s-1], s[#s]) end,
    --
    pick = function (s, offset) return s[#s-offset] end,
    pock = function (s, offset, o)     s[#s-offset] = o; return s end,
    --
    tostring = function (s)
        -- return mapconcat(tostring, s, " ")
        return mapconcat(mytostring, s, " ")
      end,
    --
    PP    = function (s) PP(s); return s end,
    print = function (s) print(s); return s end,
    --
    dowords = function (s, bigstr)
        for _,word in ipairs(split(bigstr)) do s:doword(word) end
        return s
      end,
  },
}

-- «Stack-test»  (to ".Stack-test")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth2021.lua"
ds = Stack.new()
ds:push(2):push(3):push("ab cd")
= ds 

--]]


-- «ds»  (to ".ds")
ds = Stack.new()
push = function (o) ds:push(o) end
pop  = function () return ds:pop(o) end

-- «_F»  (to "._F")
_F = {}
_F["drop"] = function () pop() end
_F["dup"] = function () push(ds:pick(0)) end
_F["*"] = function () local a,b = pop(),pop(); push(a*b) end
_F["+"] = function () local a,b = pop(),pop(); push(a+b) end
_F["-"] = function () local b,a = pop(),pop(); push(a-b) end
_F["."] = function () PP((pop())) end

_F["__"] = function () print(subj); print(mf:show()) end
_F["_"]  = function () print(mf:show().." stack: "..ds:tostring()) end



-- «MiniForth»  (to ".MiniForth")
-- (find-lua51manual "")
-- (find-lua51manual "#pdf-string.match")
--
MiniForth = Class {
  type    = "MiniForth",
  __index = {
    --
    -- Low level stuff.
    setline0 = function (mf, linestr, altpos)
	subj,pos = linestr, altpos or 1
      end,
    sub = function (mf, b, p)
        return subj:sub(b, p-1)
      end,
    show = function (mf, b, p)
        b,p = b or beg, p or pos
        return spaces(b-1) .. mf:sub(b, p) .. spaces(#subj + 1 - p)
      end,
    --
    -- Medium level stuff.
    -- Add more parsers here (and change doword).
    getword0 = function (mf)
        local b,wrd,p = subj:match("^ *()([^ ]+)()", pos)
	if b then beg,word,pos = b,wrd,p; return word end
      end,
    doword = function (mf, word)
        local action = _F[word]
        if action then action() else push(word+0) end
      end,
    doline0 = function (mf)
	while mf:getword0() do mf:doword(word) end
      end,
    --
    doline  = function (mf, linestr, altpos)
        local restore = savevars(function (...)
          subj,pos,beg,word = ... end,
          subj,pos,beg,word)
        mf:setline0(linestr, altpos)
        mf:doline0()
        restore()
      end,
  },
}



--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth2021.lua"

mf = MiniForth {}
ds = Stack.new()

mf:setline0("2 3 4 + + .")
mf:doline0()

mf:doline("2 3 4 + + .")

ds = Stack.new()
mf:doline("__ 2 3 4 _ + _ + _ drop _")

--]]