Warning: this is an htmlized version!
The original is across this link,
and the conversion rules are here.
-- About "Boostrapping a Forth in 40 lines of Lua code"...
-- In 2008 I published an article with the title above in the "Lua
-- Gems" book. Here are links to the article and the book:
--
--    http://angg.twu.net/miniforth-article.html
--    http://angg.twu.net/miniforth/miniforth-article.pdf
--    http://www.lua.org/gems/
--
-- The core of Miniforth became the basis for the language for 2D
-- diagrams in Dednat6. Here are the links to the home page of Dednat6
-- and to my article on TUGboat about it, called "Dednat6: an
-- extensible (semi-)preprocessor for LuaLaTeX that understands
-- diagrams in ASCII art":
--
--    http://angg.twu.net/dednat6.html
--    https://tug.org/TUGboat/tb39-3/tb123ochs-dednat.pdf
--
-- This file contains an updated version of the source code for
-- Miniforth, in a format that should be very easy to run
-- interactively by anyone who knows a bit of Emacs and who is willing
-- to try eev. Eev is an extension for Emacs that I usually describe
-- as "a tool for recording executable notes and playing them back".
-- If you access the htmlized version of this file, at:
--
--   http://angg.twu.net/miniforth/miniforth6.lua.html
--
-- then most of the elisp hyperlinks in this file will point to
-- sections in the eev tutorials that explain them. The main eev
-- features that are used here are explained at:
--
--   (find-eev-quick-intro "3. Elisp hyperlinks")
--   (find-eev-quick-intro "3.1. Non-elisp hyperlinks")
--   (find-eev-quick-intro "6. Controlling shell-like programs")
--   (find-eev-quick-intro "6.2. Other targets")
--   (find-eev-quick-intro "8. Anchors")
--   (find-eev-quick-intro "8.1. Introduction: `to'")
--   (find-refining-intro "2. Refining hyperlinks")
--   (find-pdf-like-intro "2. Preparation")
--   (find-pdf-like-intro "4. Hyperlinks to pages of PDF files")
--   (find-pdf-like-intro "7. Shorter hyperlinks to PDF files")
--
-- Author, version, etc:
-- Eduardo Ochs <eduardoochs@gmail.com>, 2019sep15, GPL3.
-- Feedback VERY welcome!



-- «.downloads»			(to "downloads")
-- «.PP»			(to "PP")
-- «.bootstrapping»		(to "bootstrapping")
-- «.outer-interpreter»		(to "outer-interpreter")
-- «.printstate»		(to "printstate")
-- «.modes»			(to "modes")
-- «.inner-interpreter»		(to "inner-interpreter")
-- «.numbers»			(to "numbers")
-- «.virtual-modes»		(to "virtual-modes")
-- «.polynomials»		(to "polynomials")
-- «.propositional-calculus»	(to "propositional-calculus")



--[[
--  ____                      _                 _ 
-- |  _ \  _____      ___ __ | | ___   __ _  __| |
-- | | | |/ _ \ \ /\ / / '_ \| |/ _ \ / _` |/ _` |
-- | |_| | (_) \ V  V /| | | | | (_) | (_| | (_| |
-- |____/ \___/ \_/\_/ |_| |_|_|\___/ \__,_|\__,_|
--                                                
-- «downloads»  (to ".downloads")
-- The shell commands below downloads a local copy of the PDF of the
-- article; the `code-pdf-{page,text}' sexps define the functions
-- `find-miniforth{page,text}'. See:
--    (find-eev-quick-intro "6. Controlling shell-like programs")
--    (find-eev-quick-intro "6.2. Other targets")
--    (find-pdf-like-intro "2. Preparation")
--    (find-pdf-like-intro "7. Shorter hyperlinks to PDF files")

* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
rm -Rfv /tmp/miniforth/
mkdir   /tmp/miniforth/
cd      /tmp/miniforth/
wget http://angg.twu.net/miniforth/miniforth-article.pdf
wget http://angg.twu.net/miniforth/miniforth6.lua

# (find-fline "/tmp/miniforth/")
# (code-pdf-page "miniforth" "/tmp/miniforth/miniforth-article.pdf")
# (code-pdf-text "miniforth" "/tmp/miniforth/miniforth-article.pdf")
# (find-miniforthpage)
# (find-miniforthtext)
# (find-miniforthpage 2 "Introduction")
# (find-miniforthtext 2 "Introduction")
# (find-miniforthpage 2 "Forth via examples")
# (find-miniforthtext 2 "Forth via examples")
# (find-miniforthpage 5 "Bootstrapping miniforth")
# (find-miniforthtext 5 "Bootstrapping miniforth")
# (find-miniforthpage 7 "Modes")
# (find-miniforthtext 7 "Modes")
# (find-miniforthpage 8 "Virtual modes")
# (find-miniforthtext 8 "Virtual modes")
# (find-miniforthpage 10 "A bytecode for polynomials")
# (find-miniforthtext 10 "A bytecode for polynomials")
# (find-miniforthpage 11 "A bytecode language for propositional calculus")
# (find-miniforthtext 11 "A bytecode language for propositional calculus")

--]]




-- «PP»  (to ".PP")
-- A simple pretty-printer that can print tables.
-- From: (find-es "lua5" "tos-standalone")
--       (find-angg "LUA/lua50init.lua" "compat")
--       (find-angg "LUA/lua50init.lua" "split")
write  = io.write
format = string.format
pack   = table.pack or function (...) return {n=select("#", ...), ...} end
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
printf = function (...) write(format(...)) end

map = function (f, A)
    local B = {}
    for i=1,#A do table.insert(B, (f(A[i]))) end
    return B
  end
mapconcat = function (f, A, sep)
    return table.concat(map(f, A), sep)
  end

sorted = function (tbl, lt) table.sort(tbl, lt); return tbl end
keys = function (tbl)
    local ks = {}
    for k,_ in pairs(tbl) do table.insert(ks, k) end
    return ks
  end

tos_compare_pairs = function (pair1, pair2)
    local key1,  key2  = pair1.key,  pair2.key
    local type1, type2 = type(key1), type(key2)
    if type1 == type2 then
      if type1 == "number" then return key1 < key2 end
      if type1 == "string" then return key1 < key2 end
      return tostring(key1) < tostring(key2)  -- fast
    else
      return type1 < type2   -- numbers before strings before tables, etc
    end
  end
tos_sorted_pairs = function (T)
    local Tpairs = {}
    for key,val in pairs(T) do
      table.insert(Tpairs, {key=key, val=val})
    end
    table.sort(Tpairs, tos_compare_pairs)
    return Tpairs
  end
tos_pair = function (pair)
    return tos(pair.key).."="..tos(pair.val)
  end
tos_table = function (T, sep)
    return "{"..mapconcat(tos_pair, tos_sorted_pairs(T), sep or ", ").."}"
  end
tos = function (o)
    local t = type(o)
    if t=="number" then return tostring(o) end
    if t=="string" then return format("%q", o) end
    if t=="table"  then return tos_table(o) end
    return "<"..tostring(o)..">"
  end

PP = function (...)
    local arg = pack(...)
    for i=1,arg.n do printf(" %s", tos(arg[i])) end
    print()
  end

--[[
-- Some tests from: (find-es "lua-intro" "intro:table-constructors")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"

a = {10, 20, 30}
print(a[2])                      --> 20
print(200, "some string", a)     --> 200  some string  table: 0x8e2eee0
PP   (200, "some string", a)     --> 200 "some string" {1=10, 2=20, 3=30}
b = {11, a, "foo", print}
PP(b)   --> {1=11, 2={1=10, 2=20, 3=30}, 3="foo", 4=<function: 0x8e1e020>}
function foo() return 30, 40, 50 end
c = {10, 20, foo()}              --> {1=10, 2=20, 3=30, 4=40, 5=50}
PP(c)

--]]






--  ____              _       _                         _             
-- | __ )  ___   ___ | |_ ___| |_ _ __ __ _ _ __  _ __ (_)_ __   __ _ 
-- |  _ \ / _ \ / _ \| __/ __| __| '__/ _` | '_ \| '_ \| | '_ \ / _` |
-- | |_) | (_) | (_) | |_\__ \ |_| | | (_| | |_) | |_) | | | | | (_| |
-- |____/ \___/ \___/ \__|___/\__|_|  \__,_| .__/| .__/|_|_| |_|\__, |
--                                         |_|   |_|            |___/ 
--
-- «bootstrapping»  (to ".bootstrapping")
-- «outer-interpreter»  (to ".outer-interpreter")
-- From: (find-miniforthpage 5 "Bootstrapping miniforth")
--       (find-miniforthtext 5 "Bootstrapping miniforth")
-- Here we define the outer interpreter.

-- Global variables that hold the input:
subj = "5 DUP * ."      -- what we are interpreting (example)
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 word 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 II.
_F = {}
_F["%L"] = function () eval(parserestofline()) end

-- The "processor". It can be in any of several "modes".
-- Its initial behavior is to run modes[mode]() - i.e.,
-- modes.interpret() - until `mode' becomes "stop".
mode  = "interpret"
modes = {}
run = function () while mode ~= "stop" do modes[mode]() end end

-- Initially the processor knows only this mode, "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
p_s_i = function () end  -- print state, for "interpret" (stub)
modes.interpret = function ()
    word = getwordornewline() or ""
    p_s_i()
    local _ = interpretprimitive() or
              interpretnonprimitive() or
              interpretnumber() or
              error("Can't interpret: "..word)
  end

-- Our first program in MiniForth.
-- First it defines a behavior for newlines (just skip them),
-- for "" (change mode 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 () mode = "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
mode = "interpret"
run()

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


--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"
= subj
PP(_F)

--]]





---  ____            _     ___ ___ 
--- |  _ \ __ _ _ __| |_  |_ _|_ _|
--- | |_) / _` | '__| __|  | | | | 
--- |  __/ (_| | |  | |_   | | | | 
--- |_|   \__,_|_|   \__| |___|___|
---                                
-- Part II: add to miniforth several features of a real Forth.

---             _       _       _        _       
---  _ __  _ __(_)_ __ | |_ ___| |_ __ _| |_ ___ 
--- | '_ \| '__| | '_ \| __/ __| __/ _` | __/ _ \
--- | |_) | |  | | | | | |_\__ \ || (_| | ||  __/
--- | .__/|_|  |_|_| |_|\__|___/\__\__,_|\__\___|
--- |_|                                          
--
-- «printstate»  (to ".printstate")
-- In this block "d" is as a shorthand for "dump"...

format = string.format
d = {}
d.q = function (obj)
    if type(obj) == "string" then return format("%q", obj) end
    if type(obj) == "number" then return format("%s", obj) end
  end
d.qw = function (obj, w) return format("%-"..w.."s", d.q(obj)) end
d.o  = function (obj)    return string.gsub(d.q(obj),     "\\\n", "\\n") end
d.ow = function (obj, w) return string.gsub(d.qw(obj, w), "\\\n", "\\n") end
d.arr = function (array) return "{ "..table.concat(array, " ").." }" end
d.RS = function (w) return format("RS=%-"..w.."s", d.arr(RS)) end
d.DS = function (w) return format("DS=%-"..w.."s", d.arr(DS)) end
d.PS = function (w) return format("PS=%-"..w.."s", d.arr(PS)) end
d.mode = function (w) return format("mode=%-"..w.."s", mode) end
d.v = function (varname) return varname.."="..d.o(_G[varname]) end

d.subj   = function () print((string.gsub(subj, "\n$", ""))) end
d.memory = function () print(" memory ="); PP(memory) end

d.base = function () return d.RS(9)..d.mode(11)..d.DS(11) end

p_s_i = function () print(d.base()..d.v("word")) end
p_s_c = function () print(d.base()..d.v("here").." "..d.v("word")) end
p_s_f = function () print(d.base()..d.v("instr")) end
p_s_h = function () print(d.base()..d.v("head")) end
p_s_lit   = function () print(d.base()..d.v("data")) end
p_s_pcell = function () print(d.base()..d.v("pdata")) end

t = 0
d.t = function (w) return format("t=%-"..w.."d", t) end
d.tick = function () t = t + 1; return "" end

_F["."] = function () io.write(" "..pop(DS)) end  -- original
_F["."] = function () print(" "..pop(DS)) end     -- better for when we're always printing the mode

-- d._F(): print the dictionary.
-- TODO: make it print the primitives and non-primitives separately.
d._F = function ()
    local tos1 = function (s) return (format("%q", s):gsub("\n", "n")) end
    local f = function (k) return format("%-10s %s", tos1(k), tos(_F[k])) end
    return " _F =\n"..mapconcat(f, sorted(keys(_F)), "\n")
  end

test1 = function ()
    d.base = function () return d.mode(11)..d.DS(11) end
    print()
    print("First test:")
    subj = [[  5 DUP DUP * * .  ]]
    d.subj()
    DS = { n = 0 }; pos = 1; mode = "interpret"; run()
  end

--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"
test1()
= d._F()

--]]





---                                            
---  _ __ ___   ___ _ __ ___   ___  _ __ _   _ 
--- | '_ ` _ \ / _ \ '_ ` _ \ / _ \| '__| | | |
--- | | | | | |  __/ | | | | | (_) | |  | |_| |
--- |_| |_| |_|\___|_| |_| |_|\___/|_|   \__, |
---                                      |___/ 
--
-- «modes»  (to ".modes")
-- The return stack, the memory, and "here".
-- (find-miniforthpage 7 "Modes")
-- (find-miniforthtext 7 "Modes")

RS     = { n = 0 }
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


---  _                         _       _                  
--- (_)_ __  _ __   ___ _ __  (_)_ __ | |_ ___ _ __ _ __  
--- | | '_ \| '_ \ / _ \ '__| | | '_ \| __/ _ \ '__| '_ \ 
--- | | | | | | | |  __/ |    | | | | | ||  __/ |  | |_) |
--- |_|_| |_|_| |_|\___|_|    |_|_| |_|\__\___|_|  | .__/ 
---                                                |_|    
--
-- «inner-interpreter»  (to ".inner-interpreter")
-- The bytecode of a Forth word starts with the head
-- "DOCOL" and ends with the Forth instruction "EXIT".
-- We store heads in the memory as strings, and the
-- table _H converts the name of a head into its code.

_H = {}
_H["DOCOL"] = function ()
    -- RS[RS.n] = RS[RS.n] + 1
    mode = "forth"
  end
_F["EXIT"] = function ()
    pop(RS)
    if type(RS[RS.n]) == "string" then mode = pop(RS) end
    -- if mode == nil then mode = "stop" end    -- hack
  end

-- Modes for the inner interpreter.
-- Remember that heads are always strings,
-- Forth instructions that are strings are primitives (-> "_F[str]()"), and
-- Forth instructions that are numbers are calls to non-primitives.
modes.head = function ()
    head = memory[RS[RS.n]]
    p_s_h()
    RS[RS.n] = RS[RS.n] + 1
    _H[head]()
  end
modes.forth = function ()
    instr = memory[RS[RS.n]]
    p_s_f()
    RS[RS.n] = RS[RS.n] + 1
    if type(instr) == "number" then push(RS, instr); mode = "head"; return end
    if type(instr) == "string" then _F[instr](); return end
    error("Can't run forth instr: "..mytostring(instr))
  end

-- This was a stub. Now that we know how to execute non-primitives,
-- replace it with the real definition.
interpretnonprimitive = function ()
    if type(_F[word]) == "number" then
      push(RS, "interpret")
      push(RS, _F[word])
      mode = "head"
      return true
    end
  end

-- ":" starts a definition, and switches from "interpret" to "compile".
-- ";" closes a definition, and switches from "compile" to "interpret".
_F[":"] = function ()
    _F[getword()] = here
    compile("DOCOL")
    mode = "compile"
  end
_F[";"] = function ()
    compile("EXIT")
    mode = "interpret"
  end
IMMEDIATE = {}
IMMEDIATE[";"] = true

-- Define a new mode: "compile".
compileimmediateword = function ()
    if word and _F[word] and IMMEDIATE[word] then
      if type(_F[word]) == "function" then   -- primitive
        _F[word]()
      else
        push(RS, mode)
        push(RS, _F[word])
        mode = "head"
      end
      return true
    end
  end
compilenonimmediateword = function ()
    if word and _F[word] and not IMMEDIATE[word] then
      if type(_F[word]) == "function" then
        compile1(word)	    -- primitive: compile its name (string)
      else
        compile1(_F[word])  -- non-primitive: compile its address (a number)
      end
      return true
    end
  end
compilenumber = function ()
    if word and tonumber(word) then
      compile1("LIT"); compile1(tonumber(word)); return true
    end
  end
modes.compile = function ()
    word = getword()
    p_s_c()
    local _ = compileimmediateword() or
              compilenonimmediateword() or
              compilenumber() or
              error("Can't compile: "..(word or EOT))
  end





test2 = function ()
    d.base = function () return d.RS(9)..d.mode(8)..d.DS(11) end
    print()
    print('Run "5 CUBE" (from the inner interpreter):')
    memory = { n = 0 }
    here = 1
    _F["SQUARE"] = here; compile("DOCOL", "DUP", "*", "EXIT")
    _F["CUBE"]   = here; compile("DOCOL", "DUP", _F["SQUARE"], "*", "EXIT")
    RS = { [0]="stop", _F["CUBE"]; n = 1 }; mode = "head"; DS = { 5; n = 1 }
    run()
    d.memory()
  end

--[[
-- (find-miniforthpage 3 "when we run CUBE")
-- (find-miniforthtext 3 "when we run CUBE")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"
test2()
= d._F()

--]]

test3 = function ()
    d.base = function () return d.RS(19)..d.mode(11)..d.DS(11) end
    print()
    print('Compile SQUARE and CUBE; run "5 CUBE ." (from the outer interpreter):')
    memory = { n = 0 }; here = 1; RS = { n = 0 }
    subj = [[
      : SQUARE DUP * ;
      : CUBE DUP SQUARE * ;
      5 CUBE .
    ]]
    d.subj()
    DS = { n = 0 }; pos = 1; mode = "interpret"; run()
    d.memory()
  end

--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"
test3()
= d._F()

--]]





---                        _                   
---  _ __  _   _ _ __ ___ | |__   ___ _ __ ___ 
--- | '_ \| | | | '_ ` _ \| '_ \ / _ \ '__/ __|
--- | | | | |_| | | | | | | |_) |  __/ |  \__ \
--- |_| |_|\__,_|_| |_| |_|_.__/ \___|_|  |___/
---                                            
-- «numbers»  (to ".numbers")
-- How to interpret arbritrary numbers.
-- In our simplest examples the "5" worked because it was in the dictionary.
-- As the bootstrap code didn't define a data stack (DS), and
-- "interpretnumber" uses DS, it was cleaner to define it there as a stub.
-- Now we replace the stub by the real definition.
interpretnumber = function ()
    if word and tonumber(word) then push(DS, tonumber(word)); return true end
  end

-- "compilenumber", above, defines the behavior of numbers in compile mode.
-- It compiles first a "LIT" - a Forth primitive that eats bytecode - and
-- then the value of the number. Now we define how "LIT" works.
_F["LIT"] = function ()
    push(DS, memory[RS[RS.n]])
    RS[RS.n] = RS[RS.n] + 1
  end

_F["LIT"] = function () mode = "lit" end
modes.lit = function ()
    data = memory[RS[RS.n]]
    p_s_lit()
    push(DS, memory[RS[RS.n]])
    RS[RS.n] = RS[RS.n] + 1
    mode = "forth"
  end

_F["+"] = function () push(DS, pop(DS) + pop(DS)) end

-- (find-miniforthpage 7 "Modes")
-- (find-miniforthtext 7 "Modes")
-- (find-miniforthpage 8 "LIT")
-- (find-miniforthtext 8 "LIT")

test4 = function ()
    d.base = function () return d.RS(17)..d.mode(11)..d.DS(14) end
    print()
    print("Test the support for arbitrary numbers:")
    memory = { n = 0 }; here = 1
    subj = [[
      : SQUARE DUP * ;
      : +20000 20000 + ;
      22 SQUARE +20000 .
    ]]
    d.subj()
    DS = { n = 0 }; RS = { n = 0 }; pos = 1; mode = "interpret"; run()
    d.memory()
  end

--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"
test4()
= d._F()

--]]







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

push_1 = function (S, a)
    S[S.n], S[S.n+1], S.n =
    a,      S[S.n],   S.n+1
  end
push_2 = function (S, a)
    S[S.n-1], S[S.n],   S[S.n+1], S.n =
    a,        S[S.n-1], S[S.n],   S.n+1
  end
pop_1 = function (S)
    local a = S[S.n-1]; S[S.n-1], S[S.n], S.n =
                        S[S.n],   nil,    S.n-1
    return a
  end
pop_2 = function (S)
    local a = S[S.n-2]; S[S.n-2], S[S.n-1], S[S.n], S.n =
                        S[S.n-1], S[S.n],   nil,    S.n-1
    return a
  end



---                 _ _ 
---  _ __   ___ ___| | |
--- | '_ \ / __/ _ \ | |
--- | |_) | (_|  __/ | |
--- | .__/ \___\___|_|_|
--- |_|                 
--
-- «virtual-modes»  (to ".virtual-modes")
-- (find-miniforthpage 8 "Virtual modes")
-- (find-miniforthtext 8 "Virtual modes")
-- (find-miniforthpage 9 "PCELL")
-- (find-miniforthtext 9 "PCELL")

pcellread = function () return memory[PS[PS.n]] end
pcell     = function ()
    local p = memory[PS[PS.n]]
    PS[PS.n] = PS[PS.n] + 1
    return p
  end
_F["R>P"] = function () push(PS, pop_1(RS)) end
_F["P>R"] = function () push_1(RS, pop(PS)) end
_F["PCELL"] = function () mode = "pcell" end
modes.pcell = function ()
    pdata = memory[PS[PS.n]]
    p_s_pcell()
    push(DS, memory[PS[PS.n]])
    PS[PS.n] = PS[PS.n] + 1
    mode = "forth"
  end


test6 = function ()
    d.base = function () return d.RS(17)..d.mode(11)..d.DS(14) end
    d.base = function () return d.t(3)..d.tick()..d.RS(10)..d.mode(8)..d.PS(8)..d.DS(13) end
    print()
    print("Virtual modes (LIT vs. VLIT):")
    memory = { n = 0 }; here = 1
    _F["VLIT"] = here
    compile("DOCOL", "R>P", "PCELL", "P>R", "EXIT")
    _F["TESTLITS"] = here
    compile("DOCOL", "LIT", 123, _F["VLIT"], 234, "EXIT")
    t = 0
    PS = { n = 0 }
    DS = { n = 0 }; RS = { [0] = "stop", _F["TESTLITS"], n = 1 }; mode = "head"; run()
    d.memory()
  end

--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"
test6()
= d._F()

--]]






---                    _       
---  _ __  _ __   ___ | |_   _ 
--- | '_ \| '_ \ / _ \| | | | |
--- | |_) | |_) | (_) | | |_| |
--- | .__/| .__/ \___/|_|\__, |
--- |_|   |_|            |___/ 
--
-- «polynomials»  (to ".polynomials")
-- (find-miniforthpage 10 "A bytecode for polynomials")
-- (find-miniforthtext 10 "A bytecode for polynomials")
-- (find-miniforthpage 10 "PPOLY")
-- (find-miniforthtext 10 "PPOLY")

p_s_polyn = function () print(d.base().."n="..polyncoefs) end
p_s_polyc = function ()
    print(d.base().."n="..polyncoefs.." acc="..polyacc.." coef="..polycoef)
  end
p_s_polye = function () print(d.base().."n="..polyncoefs) end
p_s_polye = function () print(d.base().."acc="..polyacc) end

-- There's a new trick here. When we run "ppoly" we pass by several
-- modes that only occur here; instead of implementing this as several
-- modes in the "modes" table, and letting the main loop call these
-- modes, we run everything in a single function.

ppoly = function ()
    polyacc = 0
    polyncoefs = pcellread()
    mode = "ppolyn"
    p_s_polyn()
    pcell()
    mode = "ppolyc"
    while polyncoefs > 0 do
      polycoef = pcellread()
      p_s_polyc()
      pcell()
      polyacc = polyacc * DS[DS.n] + polycoef
      polyncoefs = polyncoefs - 1
    end
    mode = "ppolye"
    p_s_polye()
    DS[DS.n] = polyacc
    mode = pop(RS)
    return polyacc
  end
-- (find-sh "lua51 ~/miniforth/miniforth5.lua")

---  ____   ___  ____   ___  _  __   __
--- |  _ \ / _ \|  _ \ / _ \| | \ \ / /
--- | | | | | | | |_) | | | | |  \ V / 
--- | |_| | |_| |  __/| |_| | |___| |  
--- |____/ \___/|_|    \___/|_____|_|  
---                                    
-- To do: write down a honest explanation for this... I created these
-- words half by writing down traces (by hand!) and then trying to
-- create functions that did the transitions that were happening
-- there, and half by luck...

_F["PPOLY"] = function () push(RS, mode); DS[DS.n] = ppoly() end
_H["DOPOLY"] = function ()
    push(PS, pop(RS) + 1)
    push(RS, "forth")
    return ppoly()    -- tail call
  end

test7 = function ()
    print()
    print("A bytecode for polynomials, 1: PPOLY")
    d.base = function () return d.RS(10)..d.mode(8)..d.PS(8)..d.DS(13) end
    memory = { n = 0 }; here = 1
    -- _F["P1"]     = here; compile("DOPOL")
    _F["P1ADDR"]    = here; compile("DOADDR", 4, 2, 3, 4, 5.5 )
    -- _F["P1TEST"] = here; compile("DOCOL", "LIT", 10, _F["P1"], "EXIT")
    PS = { _F["P1ADDR"] + 1, n = 1 }
    DS = { 10, n = 1 }
    RS = { [0] = "stop", n = 0 }
    d.memory()
    ppoly()
    print(polyacc)
  end

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

--]]

test8 = function ()
    print()
    print("A bytecode for polynomials, 2: POLY")
    d.base = function () return d.RS(13)..d.mode(8)..d.PS(8)..d.DS(12) end
    memory = { n = 0 }; here = 1
    _F["POLY"] = here; compile("DOCOL", "R>P", "PPOLY", "P>R", "EXIT")
    _F["POLYTEST"]  = here; compile("DOCOL", _F["POLY"], 4, 2, 3, 4, 5.5, "EXIT")
    d.memory()
    PS = { n = 0 }
    DS = { 10, n = 1 }
    RS = { [0] = "stop", _F["POLYTEST"], n = 1 }
    mode = "head"
    run()
  end

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

--]]

test9 = function ()
    print()
    print("A bytecode for polynomials 3: DOPOLY")
    d.base = function () return d.RS(14)..d.mode(8)..d.PS(7)..d.DS(12) end
    memory = { n = 0 }; here = 1
    _F["P1(X)"]  = here; compile("DOPOLY")
    _F["P1ADDR"] = here; compile("DOADDR", 4, 2, 3, 4, 5.5 )
    _F["DOPOLYTEST"] = here; compile("DOCOL", "LIT", 10, _F["P1(X)"], "EXIT")
    PS = { n = 0 }
    DS = { n = 0 }
    RS = { [0] = "stop", _F["DOPOLYTEST"], n = 1 }
    mode = "head"
    d.memory()
    xxcall(run)
  end

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

--]]





---  ____                     ____      _      
--- |  _ \ _ __ ___  _ __    / ___|__ _| | ___ 
--- | |_) | '__/ _ \| '_ \  | |   / _` | |/ __|
--- |  __/| | | (_) | |_) | | |__| (_| | | (__ 
--- |_|   |_|  \___/| .__/   \____\__,_|_|\___|
---                 |_|                        
--
-- «propositional-calculus»  (to ".propositional-calculus")
-- (find-miniforthpage 11 "A bytecode language for propositional calculus")
-- (find-miniforthtext 11 "A bytecode language for propositional calculus")

atomicformulas = { ["P"]=true, ["Q"]=true, ["R"]=true }
isatomicformula = function (name) return atomicformulas[name] end

d.ff  = function (field)    return field.."="..d.o (formula[field])    end
d.ffw = function (field, w) return field.."="..d.ow(formula[field], w) end
d.formulafields = function ()
    if formula.cc then return table.concat({
        d.ff("addr"), d.ff("cc"), d.ff("l"), d.ff("r"), d.ff("next"), d.ff("name")
      }, ", ")
    end
    if not formula.cc then return table.concat({
        d.ff("addr"), d.ff("next"), d.ff("name")
      }, ", ")
    end
  end
d.formula = function (n)
    -- formula = formulas[n]
    formula = props[n]
    -- print(format("formulas["..n.."] = { "..d.formulafields().." }"))
    print(format(n..": { "..d.formulafields().." }"))
  end

formula  = {}
formulas = {}
-- formulas[100] = { addr=100, cc="&", l=101, r=102, name="(P&Q)" }
-- formulas[101] = { addr=101, atomic="P" }
-- for i=100,101 do d.formula(i) end

atomicprops = { ["P"] = true, ["Q"] = true, ["R"] = true }
isatomicprop = function (propname) return atomicprops[propname] end

-- pprop: parse a proposition (in Proposition Calculus, in Polish Notation).
-- This function memoizes already-parsed propositions using the table "props".
-- 
pprop = function ()
    local addr = PS[PS.n]
    if props[addr] then
      PS[PS.n] = props[addr].next
    else
      local propword = pcell()
      if isatomicprop(propword) then
        local next = PS[PS.n]
        props[addr] = { addr=addr, next=next, name=propword }
      else
        local cc, l, r = propword, pprop(), pprop()
        local next = PS[PS.n]
        local name = "("..props[l].name..cc..props[r].name..")"
        props[addr] = { addr=addr, next=next, cc=cc, l=l, r=r, name=name }
      end
    end
    return addr
  end

test10 = function ()
    print()
    print("Recursive immediate data: propositional calculus")
    memory = { n = 0 }; here = 1
    compile("=>", "=>", "Q", "R", "=>", "&", "P", "Q", "&", "P", "R")
    d.memory()
    props  = {}
    PS = { 1, n = 1 }
    pprop()
    print(" props =")
    for i=1,11 do d.formula(i) end
  end

--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"
test10()
= d._F()

--]]





---  _____         _       
--- |_   _|__  ___| |_ ___ 
---   | |/ _ \/ __| __/ __|
---   | |  __/\__ \ |_\__ \
---   |_|\___||___/\__|___/
---                        




test5 = function ()
    d.base = function () return d.RS(18)..d.mode(11)..d.DS(11) end
    print()
    print("A simple test for LIT: MINUTES")
    subj = [[
      : MINUTES 60 * ;
      20 MINUTES .
    ]]
    d.subj()
    -- memory = { n = 0 }; here = 1; RS = { n = 0 }
    -- DS = { n = 0 }; pos = 1; mode = "interpret"; run()
    --
    d.base = function () return d.RS(7)..d.mode(7)..d.DS(11) end
    memory = {"DOCOL", "LIT", 60, "*", "EXIT"}
    RS = { [0] = "stop", 1, n = 1 }; mode = "head"; DS = { 20, n = 1 }; run()
    d.memory()
  end

--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"
test5()
= d._F()

--]]







-- PP("args:", ...)
if ({...})[1] then eval(({...})[1]) end



--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "miniforth6.lua"
test1()
test2()
test3()
test4()
test5()
test6()
test7()
test8()
test9()
test10()

--]]


-- Local Variables:
-- coding: raw-text-unix
-- End: