|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
-- This file:
-- http://angg.twu.net/SRF/srfa.lua.html
-- http://angg.twu.net/SRF/srfa.lua
-- (find-angg "SRF/srfa.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
--
-- [A]nother attempt to reimplement Marc's srfish.lua.
-- This is just the core of my reimplementation; only a few of Marc's
-- primitives and colon definitions were ported and tested, and I'm
-- currently rewriting the Terp class again. My code looks big, but
-- that's because it has lots of printing functions that are used in
-- the test blocks. Practically all its documentation is in test
-- blocks - see:
--
-- http://angg.twu.net/LATEX/2021emacsconf.pdf
-- http://angg.twu.net/eev-videos/emacsconf2021.mp4
-- http://angg.twu.net/emacsconf2021.html
--
-- Version: 2022feb09
--
-- (defun a () (interactive) (find-angg "SRF/srfa.lua"))
-- (defun b () (interactive) (find-angg "SRF/srfb.lua"))
-- (defun c () (interactive) (find-angg "SRF/srfc.lua"))
--
-- To test this, run: (find-angg "SRF/srfa.lua" "download")
-- then run its test block.
-- «.download» (to "download")
--
-- «.Throw» (to "Throw")
-- «.utils» (to "utils")
-- «.Stack» (to "Stack")
-- «.Stack-tests» (to "Stack-tests")
-- «.Toknz» (to "Toknz")
-- «.Toknz-tests» (to "Toknz-tests")
-- «.Code» (to "Code")
-- «.Code-tests» (to "Code-tests")
-- «.Vocab» (to "Vocab")
-- «.Vocab-test» (to "Vocab-test")
-- «.marcsprims» (to "marcsprims")
-- «.marcspreamble» (to "marcspreamble")
-- «.aux» (to "aux")
-- «.Terp» (to "Terp")
-- «.Terp-tests» (to "Terp-tests")
-- «.Terp-loop-test» (to "Terp-loop-test")
-- «.Terp-break-test» (to "Terp-break-test")
-- «.Terp-prim:-test» (to "Terp-prim:-test")
-- «download» (to ".download")
--[[
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
rm -Rv /tmp/srfa/
mkdir /tmp/srfa/
cd /tmp/srfa/
wget -O edrxlib.lua http://angg.twu.net/LUA/lua50init.lua
wget http://angg.twu.net/SRF/srfa.lua
* (setenv "LUA_INIT" "@/tmp/srfa/edrxlib.lua")
* (find-anchor "/tmp/srfa/srfa.lua" "Terp-tests")
--]]
require "edrxlib" -- (find-angg "LUA/lua50init.lua" "edrxlib")
-- «Throw» (to ".Throw")
--
Throw = Class {
type = "Throw",
__index = {
bool = function(_) error('logical value must be 0 or 1', 0) end,
brk = function() error('break', 0) end, -- todo
host = function(err) error('host interpretation failed: ' .. err, 0) end,
underflow = function() error('stack underflow', 0) end,
unknown = function(w) error('unknown word: ' .. w, 0) end,
eol = function(w) error('eol', 0) end,
},
}
throw = Throw {}
-- «utils» (to ".utils")
--
loadstr = -- load with environment
setfenv and function(s, env)
local fn, err = loadstring(s)
if fn then setfenv(fn, env) end
return fn, err
end
or function(s, env) return load(s, nil, nil, env) end
toBool = function(i)
if i == 0 then return false
elseif i == 1 then return true
else throw.bool(i) end
end
fromBool = function(b) return b and 1 or 0 end
copyTable = function(tbl)
local t = {}
for k, v in pairs(tbl) do t[k]=v end
return t
end
trim = bitrim
image = function(v)
if v == nil then return '(nil)'
elseif tonumber(v) then return v
else return quote(v) end
end
quote = function(s)
return "'" .. string.gsub(s, "'", "''") .. "'"
end
spaces = function (n) return (" "):rep(n) end
-- «Stack» (to ".Stack")
-- Marc's version.
-- Compare with: (find-dn6 "stacks.lua" "Stack")
--
Stack = Class {
type = "Stack",
new = function () return Stack {} end,
__tostring = function(s) return s:image() end, -- marc
__tostring = function(s) return mapconcat(mytostring, s, " ") end, -- edrx
--
__index = { -- s: a stack object
depth = function(s) return #s end,
dup = function(s) s:push(s:peek(#s)) end,
over = function(s) s:push(s:peek(#s-1)) end,
push = table.insert,
peek = function(s, n)
if n <= 0 then throw.underflow() end
return s[n]
end,
pop = function(s)
local v = table.remove(s)
if v == nil then throw.underflow() end
return v
end,
reset = function(s) for i, v in ipairs(s) do s[i] = nil end end,
rot = function(s)
if #s < 3 then throw.underflow() end
s[#s], s[#s-1], s[#s-2] = s[#s-2], s[#s], s[#s-1]
end,
swap = function(s) s[#s], s[#s-1] = s:peek(#s-1), s:peek(#s) end,
image = function(s)
local img = '<' .. #s .. '> '
for _, v in ipairs(s) do img = img .. image(v) .. ' ' end
return img
end,
},
}
stack = Stack.new()
-- «Stack-tests» (to ".Stack-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
s = Stack.new()
= s
s:push(10)
s:push(20)
s:push("30")
s:push("a b c")
= s
= tonumber(30)
= tonumber("30")
--]]
-- _____ _
-- |_ _|__ | | ___ __ ____
-- | |/ _ \| |/ / '_ \|_ /
-- | | (_) | <| | | |/ /
-- |_|\___/|_|\_\_| |_/___|
--
-- «Toknz» (to ".Toknz")
-- A tokenizer class that can use both Lua patterns and Lpeg.
-- Half of its code is made of printing functions.
Toknz = Class {
type = "Toknz",
new = function (line, pos)
return Toknz {subj=line, pos=pos or 1}
end,
__tostring = function (tknz) return tknz:tostring() end,
__index = {
--
-- Low-level parsers.
setlasttoken = function (tknz, o)
tknz.lasttoken = o
tknz.pos = o.e
return o
end,
parsepat0 = function (tknz, pat, kind)
local b,body,e = tknz.subj:match(pat, tknz.pos)
local o = {b=b, kind=kind, body=body, e=e}
if b then return o end
end,
parsepat = function (tknz, pat, kind)
local b,body,e = tknz.subj:match(pat, tknz.pos)
local o = {b=b, kind=kind, body=body, e=e}
if b then return tknz:setlasttoken(o) end
end,
parselpegpat = function (tknz, lpegpat)
local o = lpegpat:match(tknz.subj, tknz.pos)
if o then return tknz:setlasttoken(o) end
end,
--
-- Simple parsers with predefined patterns.
-- Parsers with more complex patterns, like one that parses either
-- a word in the vocabulary or a number, can be added later.
word = function (tknz)
return tknz:parsepat("^%s*()(%S+)()", "word")
end,
rest = function (tknz) -- rest of the line
return tknz:parsepat("^%s()(.*)()$", "rest") -- note the initial "%s"!
end,
dqstring = function (tknz) -- doubly-quoted string
return tknz:parsepat('^%s*()"([^"]*)"()', "strlit")
end,
sqstring = function (tknz) -- singly-quoted string
return tknz:parsepat("^%s*()'([^']*)'()", "strlit")
end,
wordsuchthat = function (tknz, validator, kind)
local o = tknz:parsepat0("^%s*()(%S+)()", "word")
if o and validator(o.body) then
o = {b=o.b, kind=kind, body=o.body, e=o.e}
return tknz:setlasttoken(o)
end
end,
--
-- Several ways to convert a tknz to a string.
tostring = function (tknz)
local last = ""
local bigstr = tknz.subj .. "\n" .. tknz:caretunderpos()
if tknz.lasttoken then bigstr = bigstr.."\n"..tknz:last() end
return bigstr
end,
caretunderpos = function (tknz, pos)
pos = pos or tknz.pos
return (" "):rep(#tknz.subj):replace(pos-1, "^")
end,
last = function (tknz)
return tknz:carets("usecopy")..tknz:shortfields()
end,
carets = function (tknz, usecopy, b, e)
b = b or tknz.lasttoken.b
e = e or tknz.lasttoken.e
local cars = usecopy and tknz.subj:sub(b, e-1) or ("^"):rep(e-b)
return (" "):rep(#tknz.subj):replace(b-1, cars)
end,
shortfields = function (tknz, o)
o = o or tknz.lasttoken
local f = function (field, q)
if not o[field] then return "" end
return " "..field..":"..(q or "")..o[field]..(q or "")
end
return f("kind")..f("body", '"')..f("base")
end,
--
-- Run method several times and print tknz after each one.
test = function (tknz, verbose, method)
method = method or "word"
print(tknz.subj) -- print subj only once
local lt = tknz[method](tknz)
while lt do
print(tknz:last())
if verbose then PP(lt); print() end
lt = tknz[method](tknz)
end
end,
},
}
-- «Toknz-tests» (to ".Toknz-tests")
--
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
line = [=[ : 5* 5 * ; 'foo bar' + 0x23 ]=]
tk = Toknz.new(line)
= tk
PP(tk:word())
= tk
PP(tk:word())
= tk
Toknz.new(line):test()
Toknz.new(line):test(nil, "rest")
Toknz.new(line, 12):test(nil, "rest")
-- Toknz.new(line):test("verbose")
line = [=[ 'foo "" bar' 'plic bletch' "qux" ]=]
Toknz.new(line):test(nil, "sqstring")
line = [=[ "foo '' bar" "plic bletch" 'qux' ]=]
Toknz.new(line):test(nil, "dqstring")
Toknz.__index.num = function (tknz)
local isnum = function (str) return str:match("^[0-9]+$") end
return tknz:wordsuchthat(isnum, "num")
end
Toknz.__index.complextoken = function (tknz)
return tknz:dqstring() or tknz:sqstring() or tknz:num() or tknz:word()
end
line = [=[ : 5* 5 * ; "foo bar" 'plic bletch' ]=]
Toknz.new(line):test(nil, "complextoken")
--]==]
-- ____ _
-- / ___|___ __| | ___
-- | | / _ \ / _` |/ _ \
-- | |__| (_) | (_| | __/
-- \____\___/ \__,_|\___|
--
-- «Code» (to ".Code")
-- See: (find-es "lua5" "lambda-with-Code")
-- An object of class Code contains source code in Lua both in an
-- abbreviated form (in the ".src" field) and as standard Lua code
-- (the ".code" field).
--
-- TA-DA: an object of the class Code does NOT contain a compiled
-- version of its .code field! 8-O
Code = Class {
type = "Code",
parse2 = function (src)
local vars,rest = src:match("^%s*([%w_,]+)%s*=>(.*)$")
if not vars then error("Code.parse2 can't parse: "..src) end
return vars, rest
end,
format2 = function (fmt, src)
return format(fmt, Code.parse2(src))
end,
ve = function (src) -- src is "vars => expression"
local fmt = "local %s=...; return %s"
return Code {src=src, code=Code.format2(fmt, src)}
end,
vc = function (src) -- src is "vars => code"
local fmt = "local %s=...; %s"
return Code {src=src, code=Code.format2(fmt, src)}
end,
__tostring = function (c) return c.src end,
__call = function (c, ...) return assert(loadstring(c.code))(...) end,
__index = {
},
}
ve = Code.ve
vc = Code.vc
-- «Code-tests» (to ".Code-tests")
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
= ve [[ a,b => a*b ]]
= ve [[ a,b => a*b ]] .src
= ve [[ a,b => a*b ]] .code
= ve [[ a,b => a*b ]] (2, 3)
= vc [[ a,b => print(a*b) ]] (2, 3)
= vc [[ a,b => print('hi'); return a*b ]] (2, 3)
= vc [[ a,b => print('hi'); return a*b ]] .src
= vc [[ a,b => print('hi'); return a*b ]] .code
= ve [[ a,b => a*b ]] .code
--]==]
-- __ __ _
-- \ \ / /__ ___ __ _| |__
-- \ \ / / _ \ / __/ _` | '_ \
-- \ V / (_) | (_| (_| | |_) |
-- \_/ \___/ \___\__,_|_.__/
--
-- «Vocab» (to ".Vocab")
-- Both the set of primitives and the set of colon definitions are
-- implemented as objects of the class Vocab.
Vocab = Class {
type = "Vocab",
newprims = function (width) return Vocab {_ = {}, width = width or 11} end,
newcolons = function (width)
return Vocab { _ = {}, width = width or 12,
tostring1 = function (p, name) return p:colontostring(name) end,
}
end,
--
__tostring = function (p) return p:tostring() end,
__index = {
width = 8,
primtostring = function (p, name, src)
return name:replace(p.width, src or p._[name].src)
end,
colontostring = function (p, name, def)
return (": "..name):replace(p.width, def or p._[name])
end,
-- or: tostring1 = function (p, name) return p:colontostring(name) end,
tostring1 = function (p, name) return p:primtostring(name) end,
tostring = function (p)
local f = function (name) return p:tostring1(name) end
return mapconcat(f, sorted(keys(p._)), "\n")
end,
--
toset = function (p) return Set.from(keys(p._)) end,
--
add = function (p, name, o) p._[name] = o; return p; end,
addvc = function (p, name, src) p._[name] = vc(src); return p; end,
addtovc = function (p, name, src, prefix)
p._[name] = vc(p._[name].src .. p:vcprefix(prefix) .. src)
return p
end,
vcprefix = function (p, prefix)
if type(prefix) == "string" then return prefix end
if type(prefix) == "number" then return "\n"..spaces(prefix) end
return "\n"..spaces(p.vcnspaces)
end,
vcnspaces = 15,
--
addprims = function (p, bigstr)
for _,line in ipairs(splitlines(bigstr)) do
local name,src = line:match "^%s*(%S+)%s*(.*)$"
if name then p:add(name, vc(src)) end
end
return p
end,
addcolons = function (p, bigstr)
for _,line in ipairs(splitlines(bigstr)) do
local name,def = line:match "^%s*:%s+(%S+)%s*(.*)$"
if name then p:add(name, def) end
end
return p
end,
},
}
prims = Vocab.newprims()
vocab = Vocab.newcolons()
-- «Vocab-test» (to ".Vocab-test")
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
prims = Vocab.newprims():addprims [=[
abc a,b,c => return 100*a + 10*b + c
ab a,b => return 10*a + b
]=]
= prims
= prims._["abc"]
= prims._["abc"] .src
= prims._["abc"] .code
= prims._["abc"] (2, 3, 4)
= prims:addvc ("hello", "o => print 'Hello'")
= prims:addtovc("hello", " print 'there!'")
vocab = Vocab.newcolons():addcolons [=[
: square dup *
: cube dup square *
]=]
= vocab
= vocab._["cube"]
= prims:toset()
= vocab:toset()
= (prims:toset() + vocab:toset())
= (prims:toset() + vocab:toset()):ksc(" ")
--]==]
-- __ __ _ _
-- | \/ | __ _ _ __ ___( )___ _ __ _ __(_)_ __ ___ ___
-- | |\/| |/ _` | '__/ __|// __| | '_ \| '__| | '_ ` _ \/ __|
-- | | | | (_| | | | (__ \__ \ | |_) | | | | | | | | \__ \
-- |_| |_|\__,_|_| \___| |___/ | .__/|_| |_|_| |_| |_|___/
-- |_|
--
-- (find-angg "SRF/srfx-interpreter.lua" "interpreter_primitives")
-- «marcsprims» (to ".marcsprims")
marcsprims = [=[
* o => o:push(o:pop() * o:pop())
** o => o.stack:swap(); o:push(o:pop() ^ o:pop())
+ o => o:push(o:pop() + o:pop())
- o => o.stack:swap(); o:push(o:pop() - o:pop())
/ o => o.stack:swap(); o:push(o:pop() / o:pop())
// o => o.stack:swap(); o:push(o:pop() % o:pop())
. o => print(o:pop())
.s o => print(o.stack)
.vocab o => print(o.vocab) -- edrx
< o => o:push(fromBool(o:pop() > o:pop()))
<= o => o:push(fromBool(o:pop() >= o:pop()))
<> o => o:push(fromBool(o:pop() ~= o:pop()))
= o => o:push(fromBool(o:pop() == o:pop()))
> o => o:push(fromBool(o:pop() < o:pop()))
>= o => o:push(fromBool(o:pop() <= o:pop()))
and o => o:push(fromBool(toBool(o:pop()) and toBool(o:pop())))
break o => throw.brk()
clear o => o.vocab._[o:pop()]=nil
concat o => o.stack:swap(); o:push(o:pop() .. o:pop())
defined? o => o:push(fromBool(o.vocab._[o:pop()] ~= nil))
do o => o:dophrase(o:pop())
drop o => o.stack:pop()
dup o => o.stack:dup()
either o => if not toBool(o:pop()) then o.stack:swap() end; o:pop()
fetch o => o:push(o.vocab._[o:pop()] or '')
not o => o:push(fromBool(not toBool(o:pop())))
or o => o:push(fromBool(toBool(o:pop()) or toBool(o:pop())))
over o => o.stack:over()
quote o => o:push(quote(o:pop()))
repeat o => o.aux_loop(o)
repeat# o => o.aux_loop(o, true)
reset o => o.stack:reset() -- edrx
reverse o => o:push(string.reverse(o:pop()))
rot o => o.stack:rot()
sentence o => o:push((o. tknz:rest() or throw.eol()).body) -- edrx
sentencep o => o:push((o.p.tknz:rest() or throw.eol()).body) -- edrx
store o => o.vocab._[o:pop()] = o:pop() -- edrx
swap o => o.stack:swap()
trim o => o:push(trim(o:pop()))
version o => o:push(_VERSION)
word o => o:push((o. tknz:word() or throw.eol()).body) -- edrx?
wordp o => o:push((o.p.tknz:word() or throw.eol()).body) -- edrx?
words o => print((o.prims:toset() + o.vocab:toset()):ksc(" ")) -- edrx
words o => print(( prims:toset() + o.vocab:toset()):ksc(" ")) -- edrx
]=]
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
= prims
prims = Vocab.newprims():addprims(marcsprims)
= print((prims:toset() + vocab:toset()):ksc(" "))
= prims._["words"]
= prims._["words"]()
--]==]
-- TODO: reimplement this one..
--
-- ['host'] = function(o)
-- local env = copyTable(_ENV or _G); env.self = o
-- local fn, err = loadstr(o.stack:pop(), env)
-- if not fn then throw.host(err) end
-- fn()
-- end,
-- __ __ _ _ _
-- | \/ | __ _ _ __ ___( )___ _ __ _ __ ___ __ _ _ __ ___ | |__ | | ___
-- | |\/| |/ _` | '__/ __|// __| | '_ \| '__/ _ \/ _` | '_ ` _ \| '_ \| |/ _ \
-- | | | | (_| | | | (__ \__ \ | |_) | | | __/ (_| | | | | | | |_) | | __/
-- |_| |_|\__,_|_| \___| |___/ | .__/|_| \___|\__,_|_| |_| |_|_.__/|_|\___|
-- |_|
--
-- (find-angg "SRF/srfx-interpreter.lua" "interpreter_preamble")
-- «marcspreamble» (to ".marcspreamble")
--
marcspreamble = [[
-- 'word sentence swap store' ':' store
: : wordp sentencep swap store
: if either do
: when '' swap if
: unless not when
: until 'break' swap when
: while 'break' swap unless
: nip swap drop
: tuck swap over
: shell 'os.execute(self:pop())' host
: value swap quote swap store
: drops 'drop' swap repeat
: inc 1 +
: dec 1 -
]]
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
vocab = Vocab.newcolons():addcolons(marcspreamble)
= vocab
--]==]
-- _____
-- |_ _|__ _ __ _ __
-- | |/ _ \ '__| '_ \
-- | | __/ | | |_) |
-- |_|\___|_| | .__/
-- |_|
--
-- «Terp» (to ".Terp")
-- A class for defining interpreters that can work like the standard
-- outer interpreter of Forth, like the interpreter of %D lines in
-- dednat6, like Marc's srf, etc etc.
Terp = Class {
type = "Terp",
newsrf = function (line, pos, parent)
return Terp {tknz = Toknz.new(line or "", pos or 1),
stack = stack, vocab = vocab, aux = aux, p = parent}
end,
__index = {
push = function (terp, o) return terp.stack:push(o) end,
pop = function (terp) return terp.stack:pop() end,
--
declit = function (terp) -- decimal literals; no floats yet
local pat = "^[0-9]+$"
local v = function (str) return str:match(pat) end
return terp.tknz:wordsuchthat(v, "declit")
end,
prim = function (terp)
local v = function (str) return prims._[str] end
return terp.tknz:wordsuchthat(v, "prim")
end,
nonprim = function (terp)
local v = function (str) return vocab._[str] end
return terp.tknz:wordsuchthat(v, "nonprim")
end,
unknownword = function (terp)
local v = function (str) return true end
return terp.tknz:wordsuchthat(v, "unknown")
end,
--
token = function (terp)
terp.lasttoken = terp:nonprim()
or terp:prim()
or terp:declit()
or terp.tknz:dqstring()
or terp.tknz:sqstring()
or terp:unknownword()
return terp.lasttoken
end,
--
doprim = function (terp, primname)
prims._[primname](terp)
end,
dophrase = function (terp, line)
Terp.newsrf(line, nil, terp):dotokens()
end,
dononprim = function (terp, name)
terp:dophrase(terp.vocab._[name])
end,
dolines = function (terp, bigstr)
for _,line in ipairs(splitlines(bigstr)) do
terp:dophrase(line)
end
end,
--
dotoken = function (terp) -- for srf
local t = terp.lasttoken
local k = terp.lasttoken.kind
if k == "declit" then terp:push(tonumber(t.body))
elseif k == "strlit" then terp:push(t.body)
elseif k == "prim" then terp:doprim(t.body)
elseif k == "nonprim" then terp:dononprim(t.body)
elseif k == "unknown" then throw.unknown(t.body)
else PP("Error in dotoken:", t); error()
end
end,
dotokens = function (terp, verbose)
if verbose then
print(terp.tknz.subj)
print(terp.tknz:caretunderpos())
end
while terp:token() do
terp:dotoken()
if verbose then
print(terp.tknz:carets("usecopy").." stack: "..tostring(stack))
end
end
end,
--
aux_loop = function (o, dopush)
local n,str = o:pop(), o:pop()
for i=1,n do
if dopush then o:push(i) end
o:dophrase(str)
end
end,
aux_word = function (o)
return (o.tknz:word() or throw.eol()).body
end,
aux_sentence = function (o)
return (o.tknz:rest() or throw.eol()).body
end,
},
}
-- «Terp-tests» (to ".Terp-tests")
--
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
stack = Stack.new()
tp = Terp.newsrf [=[ 'boo' 42 99 'foo "" bar' "plic ' bletch" ]=]
tp = Terp.newsrf [=[ 20 50 * . ]=] --> unknown word *
tp:dotokens("verbose")
= stack
= stack
stack = Stack.new()
prims = Vocab.newprims():addprims(marcsprims)
vocab = Vocab.newcolons():addcolons(marcspreamble)
dosrf_v = function (line) Terp.newsrf(line):dotokens("verbose") end
dosrf = function (bigstr) Terp.newsrf(""):dolines(bigstr) end
stack = Stack.new()
dosrf_v [=[ 20 50 * . ]=]
dosrf [=[ 20 50 * . ]=]
dosrf [=[ word ploft . ]=]
dosrf [=[ sentence foo bar ]=]
dosrf [=[ . ]=]
dosrf [=[ .vocab ]=]
dosrf [=[ words ]=]
dosrf [=[ : ab swap 10 * +
3 4 ab .
]=]
dosrf [=[ : :0bad word sentence .s reset
: :0 wordp sentencep .s reset
:0bad
:0 foo bar plic
]=]
--]==]
-- «Terp-loop-test» (to ".Terp-loop-test")
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
stack = Stack.new()
prims = Vocab.newprims():addprims(marcsprims)
vocab = Vocab.newcolons():addcolons(marcspreamble)
dosrf_v = function (line) Terp.newsrf(line):dotokens("verbose") end
dosrf = function (bigstr) Terp.newsrf(""):dolines(bigstr) end
= prims
= otype(prims)
prims:addprims [[ HELLO o => print 'hello' ]]
prims:addprims [[ HELLO o => print(otype(o)) ]]
= prims
dosrf [=[ HELLO ]=]
prims:addprims [[ HELLO o => o:aux_loop() ]]
dosrf [=[ '42 .' 4 HELLO ]=]
dosrf [=[ '42 .' 4 repeat ]=]
dosrf [=[ '.' 4 repeat# ]=]
--]==]
-- «Terp-break-test» (to ".Terp-break-test")
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
stack = Stack.new()
prims = Vocab.newprims():addprims(marcsprims)
vocab = Vocab.newcolons():addcolons(marcspreamble)
dosrf_v = function (line) Terp.newsrf(line):dotokens("verbose") end
dosrf = function (bigstr) Terp.newsrf(""):dolines(bigstr) end
PP(keys(prims))
PP(keys(prims._))
PPPV(prims._.drop)
= prims._.drop
prims:add("4times", vc [[o =>
local str=o:pop(); for i=1,4 do o:dophrase(str) end ]])
= prims
dosrf [=[ '2 3 * .' 4times ]=]
dosrf [=[ '2 3 * .' do ]=]
dosrf [=[ 1 . 'break' do 2 .]=]
--]==]
-- «Terp-prim:-test» (to ".Terp-prim:-test")
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfa.lua"
stack = Stack.new()
prims = Vocab.newprims():addprims(marcsprims)
vocab = Vocab.newcolons():addcolons(marcspreamble)
dosrf_v = function (line) Terp.newsrf(line):dotokens("verbose") end
dosrf = function (bigstr) Terp.newsrf(""):dolines(bigstr) end
prims:add("Test0", vc [[o => PP(o:aux_word(), o:aux_sentence()) ]])
dosrf [=[ Test0 foo bar plic ]=]
prims:addvc ("Test1", [[o => print("Line1") ]])
prims:addtovc("Test1", [[ print("Line2") ]])
prims:addtovc("Test1", [[ print("Line3") ]], "")
prims:addtovc("Test1", [[ print("Line4") ]], 10)
= prims
prims:addvc("prim:", [[o =>
prim_name = o:aux_word()
prim_rest = o:aux_sentence()
prims:addvc (prim_name, prim_rest) ]])
prims:addvc("prim\\", [[o =>
prim_rest = o:aux_sentence()
prims:addtovc(prim_name, prim_rest) ]])
dosrf [=[
prim: Test2 o => print("foo")
prim\ print("bar")
prim\ print("plic")
]=]
= prims
dosrf [=[
prim: host: o => eval(o:aux_sentence())
prim: .prims o => print(prims)
.prims
host: print("Foo")
]=]
dosrf [=[
prim: host/ o => host_code = o:aux_sentence()
prim: host| o => host_code = host_code.."\n"..o:aux_sentence()
prim: host\ o => host_code = host_code.."\n"..o:aux_sentence(); eval(host_code)
.prims
host/ print([[ Line 1
host| Line 2
host| Line 3
host\ Line 4 ]])
]=]
--]==]
-- Local Variables:
-- coding: utf-8-unix
-- End: