-- miniforth4.lua - 2007jun13, Edrx
-- For Lua-5.1 (because of string.match)
-- http://angg.twu.net/miniforth/miniforth4.lua.html
-- http://angg.twu.net/miniforth/miniforth3.abs.txt.html
-- (find-a2ps (buffer-file-name))

split = function (str, pat)
    local A = {}
    local f = function (word) table.insert(A, word) end
    string.gsub(str, pat or "([^%s]+)", f)
    return A
  end
eval = function (str) return assert(loadstring(str))() end

-- Part I: The outer interpreter.

-- Global variables that hold the input:
subj = "5 DUP * ."      -- what we are interpreting
pos  = 1                -- where are are (1 = "at the beginning")

-- Low-level functions to read things from "pos" and advance "pos".
-- Note: the "pat" argument in "parsebypattern" is a pattern with
-- one "real" capture and then an empty capture.
parsebypattern = function (pat)
    local capture, newpos = string.match(subj, pat, pos)
    if newpos then pos = newpos; return capture end
  end
parsespaces     = function () return parsebypattern("^([ \t]*)()") end
parseword       = function () return parsebypattern("^([^ \t\n]+)()") end
parsenewline    = function () return parsebypattern("^(\n)()") end
parserestofline = function () return parsebypattern("^([^\n]*)()") end
parsewordornewline = function () return parseword() or parsenewline() end

-- A "word" is a sequence of one or more non-whitespace characters.
-- The outer interpreter reads one words at a time and executes it.
-- Note that `getwordornewline() or ""' returns a word, or a newline, or "".
getword          = function () parsespaces(); return parseword() end
getwordornewline = function () parsespaces(); return parsewordornewline() end

-- The dictionary.
-- Entries whose values are functions are primitives.
-- We will only introduce non-primitives in part III.
_F = {}
_F["%L"] = function () eval(parserestofline()) end

-- The "processor", as a state machine.
-- Its initial behavior is to run states[state]() - i.e.,
-- states.interpret() - until `state' becomes "stop".
state  = "interpret"
states = {}
printstate = function () end                           -- stub
runstate   = function () printstate(); states[state]() end
run        = function () while state ~= "stop" do runstate() end end

-- Initially the processor knows only this state, "interpret"...
-- Note that "word" is a global variable.
interpretprimitive = function ()
    if type(_F[word]) == "function" then _F[word](); return true end
  end
interpretnonprimitive = function () return false end   -- stub
interpretnumber       = function () return false end   -- stub
PSI = function () end            -- print state for "interpret"
states.interpret = function ()
    word = getwordornewline() or ""
    PSI()
    local _ = interpretprimitive() or
              interpretnonprimitive() or
              intrpretnumber() or
              error("Can't interpret: "..(word or "(EOT)"))
  end

-- Our first program in MiniForth.
-- First it defines a behavior for newlines (just skip them),
-- for "" (change state to "stop"; note that `word' becomes "" on
-- end of text), and for "[L ... L]" blocks (eval "..." as Lua code).
-- Then it creates a data stack - DS - and four words - "5", "DUP",
-- "*", "." - that operate on it.
--
subj = [==[
%L _F["\n"] = function () end
%L _F[""]   = function () state = "stop" end
%L _F["[L"] = function () eval(parsebypattern("^(.-)%sL]()")) end
[L
  DS = { n = 0 }
  push = function (stack, x) stack.n = stack.n + 1; stack[stack.n] = x end
  pop  = function (stack) local x = stack[stack.n]; stack[stack.n] = nil;
                          stack.n = stack.n - 1; return x end
  _F["5"]   = function () push(DS, 5) end
  _F["DUP"] = function () push(DS, DS[DS.n]) end
  _F["*"]   = function () push(DS, pop(DS) * pop(DS)) end
  _F["."]   = function () io.write(" "..pop(DS)) end
L]
]==]

-- Now run it. There's no visible output.
pos = 1
state = "interpret"
run()

-- At this point the dictionary (_F) has eight words.









---             _       _       _        _       
---  _ __  _ __(_)_ __ | |_ ___| |_ __ _| |_ ___ 
--- | '_ \| '__| | '_ \| __/ __| __/ _` | __/ _ \
--- | |_) | |  | | | | | |_\__ \ || (_| | ||  __/
--- | .__/|_|  |_|_| |_|\__|___/\__\__,_|\__\___|
--- |_|                                          

vardiag   = function (varname) return varname.."=".._G[varname] end
varDiag   = function (varname) return varname.."="..mytostring(_G[varname]) end
stackdiag = function (stackname) return format("%s={ %s }", stackname, table.concat(_G[stackname])) end
diags3 = function () return format("%22s%18s%22s", stackdiag("RS"), vardiag("state"), stackdiag("DS")) end
diags4 = function (extravar) return diags3()..format("%12s", varDiag(extravar)) end
PSI = function () print(diags4("word")) end
PSC = function () print(diags4("word")) end
PSF = function () print(diags4("instr")) end
PSH = function () print(diags4("head")) end

RS = { n = 0 }


---  _ _ ____  ____  
--- (_) |___ \| ___| 
--- | | | __) |___ \ 
--- | | |/ __/ ___) |
--- |_|_|_____|____/ 
---                  

subj = [[ 5 DUP DUP * * . ]]
DS = { n = 0 }; pos = 1; state = "interpret"; run()


---                                            
---  _ __ ___   ___ _ __ ___   ___  _ __ _   _ 
--- | '_ ` _ \ / _ \ '_ ` _ \ / _ \| '__| | | |
--- | | | | | |  __/ | | | | | (_) | |  | |_| |
--- |_| |_| |_|\___|_| |_| |_|\___/|_|   \__, |
---                                      |___/ 

memory = { n = 0 }
here = 1

compile  = function (...) for i = 1,arg.n do compile1(arg[i]) end end
compile1 = function (x)
    memory[here] = x; here = here + 1
    memory.n = math.max(memory.n, here)
  end

---            _     ___ _____ 
---  _    _   | |   |_ _|_   _|
--- (_)  (_)  | |    | |  | |  
---  _    _   | |___ | |  | |  
--- (_)  ( )  |_____|___| |_|  
---      |/                    

IMMEDIATE = {}

_F[":"] = function ()
    _F[parseword()] = here
    compile("DOCOL")
    state = "compile"
  end
_F[";"] = function ()
    compile("EXIT")
    state = "interpret"
  end
IMMEDIATE[";"] = true


---      _        _                                       _ _      
---  ___| |_ __ _| |_ ___  ___   ___ ___  _ __ ___  _ __ (_) | ___ 
--- / __| __/ _` | __/ _ \/ __| / __/ _ \| '_ ` _ \| '_ \| | |/ _ \
--- \__ \ || (_| | ||  __/\__ \| (_| (_) | | | | | | |_) | | |  __/
--- |___/\__\__,_|\__\___||___(_)___\___/|_| |_| |_| .__/|_|_|\___|
---                                                |_|             

compileimmediateword = function ()
    if word and _F[word] and IMMEDIATE[word] then
      if type(_F[word]) == "function" then   -- primitive
        _F[word]()
      else
        push(RS, state)
        push(RS, _F[word])
        state = "head"
      end
    end
  end
compilenonimmediateword = function ()
    if word and _F[word] and not IMMEDIATE[word] then
      compile1(_F[word]); return true
    end
  end
compilenumber = function ()
    if word and tonumber(word) then
      compile1("LIT"); compile1(tonumber(word)); return true
    end
  end
states.compile = function ()
    word = parseword()
    PSC()
    local _ = compileimmediateword() or
              compilenonimmediateword() or
              compilenumber() or
              error("Can't compile: "..(word or EOT))
  end

RS = { n = 0 }


---       ____ _   _ ____  _____             
---  _   / ___| | | | __ )| ____|          _ 
--- (_) | |   | | | |  _ \|  _|           (_)
---  _  | |___| |_| | |_) | |___   _ _ _   _ 
--- (_)  \____|\___/|____/|_____| (_|_|_) ( )
---                                       |/ 

memory = { n = 0 }; here = 1
subj = [[
  : SQUARE DUP * ;
  : CUBE DUP SQUARE * ;
  5 CUBE .
]]
DS = { n = 0 }; pos = 1; state = "interpret"; run()


---  _     ___ _____ 
--- | |   |_ _|_   _|
--- | |    | |  | |  
--- | |___ | |  | |  
--- |_____|___| |_|  
---                  

_F["LIT"] = function ()
    push(DS, RS[RS.n])
    RS[RS.n] = RS[RS.n + 1]
  end

interpretnumber = function ()
    if word and tonumber(word) then push(DS, tonumber(word)); return true end
  end


---  ____   ___  _  _    ___  _  _   
--- |___ \ / _ \| || |  ( _ )| || |  
---   __) | | | | || |_ / _ \| || |_ 
---  / __/| |_| |__   _| (_) |__   _|
--- |_____|\___/   |_|  \___/   |_|  
---                                  

memory = { n = 0 }; here = 1
subj = [[
  : +20000 20000 + ;
  22 SQUARE +20000 .
]]
DS = { n = 0 }; pos = 1; state = "interpret"; run()










--[=[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth4.lua"
DSstate    = function () return "DS={ "..table.concat(DS, " ").. " }" end
printstate = function () print("state="..state.."  "..DSstate()) end
DS = { n = 0 }
subj = [[ 5 DUP DUP * * . ]]
pos = 1
state = "interpret"
run()



subj = [[ 5 DUP * . ]]
pos = 1
state = "interpret"


run = function () while state ~= "stop" do printstate(); states[state]() end end


--]=]





--[=====[

  interpretnumber = function ()
      if tonumber(word) then push(DS, tonumber(word)); return true end
  end

---  ____  ____  
--- |  _ \/ ___| 
--- | | | \___ \ 
--- | |_| |___) |
--- |____/|____/ 
---              

DS = { n = 0 }
push = function (stack, x) stack.n = stack.n + 1; stack[stack.n] = x end
pop  = function (stack) local x = stack[stack.n]; stack[stack.n] = nil;
                        stack.n = stack.n - 1; return x end
_F["5"]   = function () push(DS, 5) end
_F["DUP"] = function () push(DS, DS[DS.n]) end
_F["*"]   = function () push(DS, pop(DS) * pop(DS)) end
_F["."]   = function () io.write(" "..pop(DS)) end

interpretnumber = function ()
    if word and tonumber(word) then push(DS, tonumber(word)); return true end
  end






(/ 55000.0 (* 14 365))


* (eepitch-lua51)


-- RS={interpret 5 1 2 3} state=interpret

RS = { n = 0 }

memory = { n = 0 }
here = 1
_F["SQUARE"] = here; compile("DOCOL", "DUP", "*", "EXIT")
_F["CUBE"]   = here; compile("DOCOL", "DUP", _F["SQUARE"], "*", "EXIT")

_H = {}
_H["DOCOL"] = function ()
    RS[RS.n] = RS[RS.n] + 1
    state = "forth"
  end

_F["EXIT"] = function ()
    pop(RS)
    if type(RS[RS.n]) == "string" then state = pop(RS) end
  end

interpretnonprimitive = function ()
    if type(_F[word]) == "number" then
      push(RS, "interpret")
      puhs(RS, _F[word])
      state = "head"
      return true
    end

states.head = function ()
    head = memory[RS[RS.n]]
    head()
  end


--[=[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile(ee_expand("~/miniforth/miniforth4.lua"))
--]=]
--[=[
DS = { n = 0 }
subj = [[ 5 DUP DUP * * . ]]
pos = 1
state = "interpret"
run()

-- state=interpret  DS={  }
-- state=interpret  DS={ 5 }
-- state=interpret  DS={ 5 5 }
-- state=interpret  DS={ 5 5 5 }
-- state=interpret  DS={ 5 25 }
-- state=interpret  DS={ 125 }    125
-- state=interpret  DS={  }

subj = [==[ 5 . [lua print "foo" lua] 5 . ]==]
DS = { n = 0 }; pos = 1; state = "interpret"; run()

--]=]
--[=[
PP(memory)
PP(_F)

RS = { n = 0 }

      if type(semantics) == "number" then   -- "5", "22", etc
        push(RS, "interpret")
        push(RS, semantics)
        state = "head"
        return
      end
    -- what about numbers?

parseluablock = function () eval(parsebypattern("^(.-)lua%]")) end


readfile = function (fname)
    local f = assert(io.open(fname, "r"))
    local fcontents = f:read("*a"); f:close(); return fcontents
  end
setsubjto = function (str) subj = str; pos = 1 end
runstring = function (str) setsubjto(str); outerloop() end
runfile   = function (fname) runstring(readfile(fname)) end
-- runfile(arg[1])
-- (find-blogmefile "")
-- (find-blogmefile "blogme2-middle.lua")
-- (find-luamanualw3m "#pdf-string.match")
-- ee = function () runfile(ee_expand("$EEVTMPDIR/ee.mf3")) end

compile = function (...)
    for i = 1,arg.n do
      if type(arg[i]) == "string" then
        for _,word in ipairs(split(arg[i])) do compile1(word) end
      else
        compile(arg[i])
      end
    end
  end


--]=]

--]=====]