Conditionals

CoreWords.tl

@@ -176,15 +176,117 @@ local function colon(e: Environment)
 end
 
 local function semicolon(e: Environment)
-  table.insert(e.currentDefinition, helpers.ret)
+  table.insert(e.currentDefinition as {function(Environment)}, helpers.ret)
   local instrs = e.currentDefinition
-  local call = helpers.makeCall(instrs)
+  local call = helpers.makeCall(instrs as {function(Environment)})
   local dict = e.dictionaries[1]
   defineWord(dict, e.currentDefinitionName, call, false)
   e.currentDefinitionName = nil
   e.currentDefinition = {}
   exitCompileMode(e)
 end
+local function toCompileStack(e: Environment)
+  local dataStack = getActiveDataStack(e)
+  local compileStack = e.compilerStack
+  local val = dataStack:pop()
+  compileStack:push(val)
+end
+
+local function fromCompileStack(e: Environment)
+  e.activeDataStack:push(e.compilerStack:pop())
+end
+
+local function getDefinitionIndex(e: Environment)
+  e.activeDataStack:push(#e.currentDefinition)
+end
+
+local function unresolvedZeroBranch(e: Environment)
+  helpers.noop(e)
+end
+
+local function unresolvedUncondBranch(e: Environment)
+  helpers.noop(e)
+end
+
+local function getResolvedZeroBranch(destinationIndex: integer): function(Environment)
+  return function(e: Environment)
+    local flag = e.activeDataStack:pop()
+    if flag == 0 or not flag then
+      e.instructionPointer.index = destinationIndex
+    end
+  end
+end
+
+local function resolveBranch(e: Environment, sourceIndex: integer, destinationIndex: integer): function(Environment)
+  if e.currentDefinition[sourceIndex] == unresolvedZeroBranch then
+    return function(e: Environment)
+      local flag = e.activeDataStack:pop()
+      if flag == 0 or not flag then
+        e.instructionPointer.index = destinationIndex
+      end
+    end
+  elseif e.currentDefinition[sourceIndex] == unresolvedUncondBranch then
+    return function(e: Environment)
+      e.instructionPointer.index = destinationIndex
+    end
+  end
+  -- TODO: abort if none of the checks succeed
+end
+
+
+local function forthIf(e: Environment)
+  table.insert(e.currentDefinition as {function(Environment)}, unresolvedZeroBranch)
+  getDefinitionIndex(e)
+  toCompileStack(e)
+end
+
+local function patchBranch(e: Environment)
+  local branchIndex = e.activeDataStack:pop() as integer
+  local destinationIndex = e.activeDataStack:pop() as integer
+  e.currentDefinition[branchIndex as integer] = resolveBranch(e,branchIndex,destinationIndex)
+end
+
+
+local function forthThen(e: Environment)
+  getDefinitionIndex(e)
+  fromCompileStack(e)
+  patchBranch(e)
+end
+local function forthElse(e: Environment)
+  table.insert(e.currentDefinition as {function(Environment)}, unresolvedUncondBranch)
+  getDefinitionIndex(e)
+  fromCompileStack(e)
+  patchBranch(e)
+  getDefinitionIndex(e)
+  toCompileStack(e)
+end
+
+
+local function cmplt(e: Environment)
+  local a, b = popTwoOperands(e)
+  e.activeDataStack:push((a as number) < (b as number))
+end
+local function cmplte(e: Environment)
+  local a, b = popTwoOperands(e)
+  e.activeDataStack:push((a as number) <= (b as number))
+end
+local function cmpe(e: Environment)
+  local a, b = popTwoOperands(e)
+  e.activeDataStack:push((a as number) == (b as number))
+end
+local function cmpgte(e: Environment)
+  local a, b = popTwoOperands(e)
+  e.activeDataStack:push((a as number) >= (b as number))
+end
+local function cmpgt(e: Environment)
+  local a, b = popTwoOperands(e)
+  e.activeDataStack:push((a as number) > (b as number))
+end
+local function cmpne(e: Environment)
+  local a, b = popTwoOperands(e)
+  e.activeDataStack:push((a as number) ~= (b as number))
+end
+
 
 
 local CoreWords = Dictionary:new()
@@ -213,6 +315,20 @@ defineWord(CoreWords, "COMPILE,", compile, true)
 defineWord(CoreWords, "LITERAL", literal, true)
 defineWord(CoreWords, ":", colon, true)
 defineWord(CoreWords, ";", semicolon, true)
+defineWord(CoreWords, ">C",toCompileStack, false)
+defineWord(CoreWords, "C>", fromCompileStack, false)
+defineWord(CoreWords, "DP", getDefinitionIndex, false)
+defineWord(CoreWords, "IF", forthIf, true)
+defineWord(CoreWords, "THEN", forthThen, true)
+defineWord(CoreWords, "ELSE", forthElse, true)
+
+defineWord(CoreWords,"<", cmplt, false)
+defineWord(CoreWords,"<=", cmplte, false)
+defineWord(CoreWords,"=", cmpe, false)
+defineWord(CoreWords,">=", cmpgte, false)
+defineWord(CoreWords,">", cmpgt, false)
+defineWord(CoreWords,"<>", cmpne, false)
+
 
 CoreWords:define("+", addInfo)
 CoreWords:define("-", subInfo)

ForthMachine.tl

@@ -4,13 +4,13 @@ local interpreters = require("Interpreters")
 local standardInputRefill = helpers.standardInputRefill
 local CoreWords = require("CoreWords")
 local oneReadInputStream = helpers.oneReadInputStream
--- local fileStream = helpers.fileStream
+local fileStream = helpers.fileStream
 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(oneReadInputStream("14 11 + ."), core_dicts)
 
 interpreters.start(env)

codetest.forth

@@ -0,0 +1,12 @@
+: 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 DROP ;
+
+23 EGGSIZE
+29 EGGSIZE
+40 EGGSIZE

tests.lua

@@ -411,6 +411,87 @@ describe("Interpreter tests", function()
             assert.are.equal(true, testEnv.compileState)
          end)
       end)
+      describe(": tests", function()
+         it("Places the name to be defined in currentDefinitionName",function()
+            local testEnv = buildEnvironment(": TESTWORD")
+            interpreters.start(testEnv)
+            assert.are.equal("TESTWORD", testEnv.currentDefinitionName)
+         end)
+         it("Gives us a XT when we compile a word.", function()
+            local cw = CoreWords
+            local testEnv = buildEnvironment(": TESTWORD +")
+            interpreters.start(testEnv)
+            assert.are.equal(type(function() end), type(testEnv.currentDefinition[1]))
+         end)
+      end)
+      describe("; tests", function()
+         it("Gives us a word we can then use in the future", function()
+            local testEnv = buildEnvironment(": SQR DUP * ; 4 SQR")
+            interpreters.start(testEnv)
+            assert.are.equal(16, testEnv.activeDataStack.contents[1])
+         end)
+      end)
+      describe(">C tests", function()
+         it("Consumes from datastack, produces onto compilerstack", function()
+            local testEnv = buildEnvironment("4 >C")
+            interpreters.start(testEnv)
+            assert.are.same({4}, testEnv.compilerStack.contents)
+         end)
+      end)
+      describe("C> tests", function()
+         it("Consumes from compilerstack, produces that value onto datastack", function()
+            local testEnv = buildEnvironment("C>")
+            testEnv.compilerStack:push(4)
+            interpreters.start(testEnv)
+            assert.are.same({4}, testEnv.activeDataStack.contents)
+         end)
+      end)
+      describe("DP tests", function()
+         it("Produces the current dictionary pointer", function()
+            local testEnv = buildEnvironment(": WORT 1 1 + DROP [ DP ]")
+            interpreters.start(testEnv)
+            assert.are.same({4}, testEnv.activeDataStack.contents)
+         end)
+      end)
+      describe("IF tests", function()
+         it("Pushes the DP  to the compile stack.", function()
+            local testEnv = buildEnvironment(": TEST 1 . IF")
+            interpreters.start(testEnv)
+            assert.are.same({3}, testEnv.compilerStack.contents)
+         end)
+         it("Pushes any function to the currentDefinition.", function()
+            local testEnv = buildEnvironment(": TEST 1 . IF")
+            interpreters.start(testEnv)
+            assert.are.same(type(function() end), type(testEnv.currentDefinition[3]))
+         end)
+      end)
+      describe("THEN tests", function()
+         it("Removes one item from the compile stack.", function()
+            local testEnv = buildEnvironment(": WORT THEN")
+            testEnv.compilerStack:push(1)
+            interpreters.start(testEnv)
+            assert.are.same({}, testEnv.compilerStack.contents)
+         end)
+      end)
+      describe("IF... then tests", function()
+         it("does CLAMP properly", function()
+            local testEnv = buildEnvironment(": CLAMP 2DUP > IF ROT 2DUP < IF SWAP THEN THEN DROP NIP ; 1 3 2 CLAMP 1 3 4 CLAMP 1 3 0 CLAMP")
+            interpreters.start(testEnv)
+            assert.are.same({2, 3, 1}, testEnv.activeDataStack.contents)
+         end)
+      end)
+      describe("< tests", function()
+         it("Pushes true for 1 < 2", function()
+            local testEnv = buildEnvironment("1 2 <")
+            interpreters.start(testEnv)
+            assert.are.same({true}, testEnv.activeDataStack.contents)
+         end)
+         it("Pushes false for 2 < 1", function()
+            local testEnv = buildEnvironment("2 1 <")
+            interpreters.start(testEnv)
+            assert.are.same({false}, testEnv.activeDataStack.contents)
+         end)
+      end)
    end)
 end)