Starfflame
/
forth-stuff
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Additional control structures

This commit is contained in:
Starfflame 2021-05-29 02:12:29 -05:00
parent aa5eb4640d
commit 4812f51700
5 changed files with 137 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
CoreHelpers.tl
View File

@ -11,6 +11,7 @@ function CoreHelpers.defineWord(dict: Dictionary, str: string, func: function(En
end
function CoreHelpers.standardInputRefill(): string
io.write("ok\n")
local input = io.read().."\n"
return input
end
@ -161,37 +162,46 @@ function CoreHelpers.recNumber(env: Environment)
dataStack:push(token)
dataStack:push(false)
end
function CoreHelpers.searchDictionaries(e: Environment, token: string): WordInfo, Dictionary
for _, dictionary in ipairs(e.dictionaries) do
local wordinfo = dictionary:lookup(token)
if wordinfo then
return wordinfo
end
end
end
function CoreHelpers.recWord(env: Environment)
local dataStack = CoreHelpers.getActiveDataStack(env)
local token = dataStack:pop() as string
for _, dictionary in ipairs(env.dictionaries) do
local wordinfo = dictionary:lookup(token)
if wordinfo then
-- XT
dataStack:push((wordinfo as WordInfo).func)
-- interpret
local wordinfo = CoreHelpers.searchDictionaries(env, token)
if wordinfo then
-- XT
dataStack:push((wordinfo as WordInfo).func)
-- interpret
dataStack:push(CoreHelpers.execute)
-- compile
if (wordinfo as WordInfo).immediate then
dataStack:push(CoreHelpers.execute)
-- compile
if (wordinfo as WordInfo).immediate then
dataStack:push(CoreHelpers.execute)
else
dataStack:push(CoreHelpers.compile)
end
-- immediate
dataStack:push(CoreHelpers.postpone)
-- return success
dataStack:push(true)
return
else
dataStack:push(CoreHelpers.compile)
end
-- immediate
dataStack:push(CoreHelpers.postpone)
-- return success
dataStack:push(true)
return
end
dataStack:push(token)
dataStack:push(false)
end
function CoreHelpers.ack(e: Environment)
io.write("ok\n")
end
--function CoreHelpers.ack(e: Environment)
-- io.write("ok\n")
--end
return CoreHelpers

47
CoreWords.tl
View File

@ -81,7 +81,7 @@ end
-- I/O operations
local function dot(env: Environment)
local out = env.activeDataStack:pop()
io.write(tostring(out) as string.."\n")
io.write(tostring(out) as string)
end
local twoDup = helpers.makeCall{over, over, ret}
@ -181,6 +181,7 @@ local function semicolon(e: Environment)
local call = helpers.makeCall(instrs as {function(Environment)})
local dict = e.dictionaries[1]
defineWord(dict, e.currentDefinitionName, call, false)
e.mostRecentDefinition = e.currentDefinitionName
e.currentDefinitionName = nil
e.currentDefinition = {}
exitCompileMode(e)
@ -287,6 +288,44 @@ local function cmpne(e: Environment)
e.activeDataStack:push((a as number) ~= (b as number))
end
local function markImmediate(e: Environment)
helpers.searchDictionaries(e, e.mostRecentDefinition).immediate = true
end
local function forthBegin(e: Environment)
getDefinitionIndex(e)
toCompileStack(e)
end
local function forthUntil(e: Environment)
fromCompileStack(e)
table.insert(e.currentDefinition as {function(Environment)}, unresolvedZeroBranch)
getDefinitionIndex(e)
patchBranch(e)
end
local function forthAgain(e: Environment)
fromCompileStack(e)
table.insert(e.currentDefinition as {function(Environment)}, unresolvedUncondBranch)
getDefinitionIndex(e)
patchBranch(e)
end
local function forthWhile(e: Environment)
fromCompileStack(e)
table.insert(e.currentDefinition as {function(Environment)}, unresolvedZeroBranch)
getDefinitionIndex(e)
toCompileStack(e)
toCompileStack(e)
end
local function forthRepeat(e: Environment)
fromCompileStack(e)
table.insert(e.currentDefinition as {function(Environment)}, unresolvedUncondBranch)
getDefinitionIndex(e)
patchBranch(e)
getDefinitionIndex(e)
fromCompileStack(e)
patchBranch(e)
end
local CoreWords = Dictionary:new()
@ -321,6 +360,12 @@ defineWord(CoreWords, "DP", getDefinitionIndex, false)
defineWord(CoreWords, "IF", forthIf, true)
defineWord(CoreWords, "THEN", forthThen, true)
defineWord(CoreWords, "ELSE", forthElse, true)
defineWord(CoreWords, "IMMEDIATE", markImmediate, false)
defineWord(CoreWords, "BEGIN", forthBegin, true)
defineWord(CoreWords, "UNTIL", forthUntil, true)
defineWord(CoreWords, "WHILE", forthWhile, true)
defineWord(CoreWords, "REPEAT", forthRepeat, true)
defineWord(CoreWords, "AGAIN", forthAgain, true)
defineWord(CoreWords,"<", cmplt, false)
defineWord(CoreWords,"<=", cmplte, false)

1
DataStructures.tl
View File

@ -48,6 +48,7 @@ local type DataStructures = record
running: boolean
currentDefinitionName: string | nil
currentDefinition: {function(Environment)}
mostRecentDefinition: string
end
end

4
ForthMachine.tl
View File

@ -9,8 +9,8 @@ local Environment = require("DataStructures").Environment
--interpreters.start(fileStream("codetest.txt"))
local core_dicts = {CoreWords}
--local env = Environment:new(istream:new(standardInputRefill), core_dicts)
local env = Environment:new(fileStream("codetest.forth"), core_dicts)
local env = Environment:new(istream:new(standardInputRefill), core_dicts)
--local env = Environment:new(fileStream("codetest.forth"), core_dicts)
--local env = Environment:new(oneReadInputStream("14 11 + ."), core_dicts)
interpreters.start(env)

57
tests.lua
View File

@ -480,6 +480,13 @@ describe("Interpreter tests", function()
assert.are.same({2, 3, 1}, testEnv.activeDataStack.contents)
end)
end)
describe("IF...ELSE...THEN tests", function()
it("Handles the eggsize properly", function()
local testEnv = buildEnvironment(": EGGSIZE DUP 18 < IF 1 ELSE DUP 21 < IF 2 ELSE DUP 24 < IF 3 ELSE DUP 27 < IF 4 ELSE DUP 30 < IF 5 ELSE -1 THEN THEN THEN THEN THEN NIP ; 23 EGGSIZE 29 EGGSIZE 40 EGGSIZE")
interpreters.start(testEnv)
assert.are.same({3,5,-1}, testEnv.activeDataStack.contents)
end)
end)
describe("< tests", function()
it("Pushes true for 1 < 2", function()
local testEnv = buildEnvironment("1 2 <")
@ -492,6 +499,56 @@ describe("Interpreter tests", function()
assert.are.same({false}, testEnv.activeDataStack.contents)
end)
end)
describe("IMMEDIATE tests", function()
it("Marks a defined word as immediate", function()
local testEnv = buildEnvironment(": BOGUSNUTS 1 . ; IMMEDIATE")
interpreters.start(testEnv)
assert.are.same(true, CoreHelpers.searchDictionaries(testEnv, "BOGUSNUTS").immediate)
end)
end)
describe("BEGIN ... UNTIL tests", function()
it("GI4", function()
local testEnv = buildEnvironment([[: GI4 BEGIN DUP 1 + DUP 5 > UNTIL ;
3 GI4
5 GI4
6 GI4]])
interpreters.start(testEnv)
assert.are.same({3,4,5,6,5,6,6,7}, testEnv.activeDataStack.contents)
end)
end)
describe("BEGIN ... WHILE tests", function()
it("Puts a new orig under the existing dest.", function()
local testEnv = buildEnvironment([[: TEST BEGIN 1 2 3 WHILE]])
interpreters.start(testEnv)
assert.are.same({4, 0}, testEnv.compilerStack.contents)
end)
end)
describe("BEGIN ... WHILE ... REPEAT tests", function()
it("Does GI3. Single level loop", function()
local testEnv = buildEnvironment([[
: GI3 BEGIN DUP 5 < WHILE DUP 1 + REPEAT ;
0 GI3
4 GI3
5 GI3
6 GI3]])
interpreters.start(testEnv)
assert.are.same({0, 1, 2, 3, 4, 5, 4, 5, 5, 6}, testEnv.activeDataStack.contents)
end)
it("Does GI5. Two loops, with some weird logic using THEN and ELSE...?",function()
local testEnv = buildEnvironment([[
: GI5 BEGIN DUP 2 > WHILE
DUP 5 < WHILE DUP 1 + REPEAT
123 ELSE 345 THEN ;
1 GI5
2 GI5
3 GI5
4 GI5
5 GI5]])
interpreters.start(testEnv)
assert.are.same({1, 345, 2, 345, 3, 4, 5, 123, 4, 5, 123, 5, 123}, testEnv.activeDataStack.contents)
end)
end)
end)
end)