|
Warning: this is an htmlized version!
The original is here, 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: