Additional control structures

CoreHelpers.tl

@@ -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,11 +162,21 @@ 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 = CoreHelpers.searchDictionaries(env, token)
-		local wordinfo = dictionary:lookup(token)
 	if wordinfo then
 		-- XT
 		dataStack:push((wordinfo as WordInfo).func)
@@ -184,14 +195,13 @@ function CoreHelpers.recWord(env: Environment)
 		dataStack:push(true)
 		return
 	end
-	end
 	dataStack:push(token)
 	dataStack:push(false)
 end
 
-function CoreHelpers.ack(e: Environment)
+--function CoreHelpers.ack(e: Environment)
-	io.write("ok\n")
+--	io.write("ok\n")
-end
+--end
 
 return CoreHelpers
 

CoreWords.tl

@@ -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)

DataStructures.tl

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

ForthMachine.tl

@@ -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(istream:new(standardInputRefill), core_dicts)
-local env = Environment:new(fileStream("codetest.forth"), core_dicts)
+--local env = Environment:new(fileStream("codetest.forth"), core_dicts)
 --local env = Environment:new(oneReadInputStream("14 11 + ."), core_dicts)
 
 interpreters.start(env)

tests.lua

@@ -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)