From 12dbaa90ae2f8c43fd69caaf7d1665ca0182b962 Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Fri, 28 Jan 2022 23:40:22 +0200
Subject: Implement loop

---
 samples/conditional.sample |  7 +++++++
 samples/if.sample          |  7 -------
 samples/loop.sample        |  9 +++++++++
 src/main.hs                | 43 +++++++++++++++++++++++++++++++++++++++----
 4 files changed, 55 insertions(+), 11 deletions(-)
 create mode 100644 samples/conditional.sample
 delete mode 100644 samples/if.sample
 create mode 100644 samples/loop.sample

diff --git a/samples/conditional.sample b/samples/conditional.sample
new file mode 100644
index 0000000..fb67d66
--- /dev/null
+++ b/samples/conditional.sample
@@ -0,0 +1,7 @@
+define eq10?
+    10 eq?
+        [ true ]
+        [ false ] cond ;
+
+10 eq10? .
+5 eq10? .
\ No newline at end of file
diff --git a/samples/if.sample b/samples/if.sample
deleted file mode 100644
index fb67d66..0000000
--- a/samples/if.sample
+++ /dev/null
@@ -1,7 +0,0 @@
-define eq10?
-    10 eq?
-        [ true ]
-        [ false ] cond ;
-
-10 eq10? .
-5 eq10? .
\ No newline at end of file
diff --git a/samples/loop.sample b/samples/loop.sample
new file mode 100644
index 0000000..dce412e
--- /dev/null
+++ b/samples/loop.sample
@@ -0,0 +1,9 @@
+define ,    dup . ;
+
+-- load idx value and print it (w/o consume)
+-- calc idx - 1 and store in idx
+10 $idx !
+[ $idx @ 0 gt? ] [
+    $idx @ ,
+    1 - $idx !
+] loop
diff --git a/src/main.hs b/src/main.hs
index 2659cff..6cb8fc0 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -55,7 +55,7 @@ parseWord rawStr
 parseSource source = source $> words .> map parseWord
 
 interpretSource :: LState -> IO ()
-interpretSource LState {lSource = []} = putStrLn "done"
+interpretSource LState {lSource = []} = pure ()
 interpretSource state@LState {lSource = (word : rest)} = do
   newState <- interpretWord state {lSource = rest} word
   -- putStrLn $ "[debug] processed " ++ show word ++ ", newState ="
@@ -134,20 +134,39 @@ interpretWord state@LState {lDefs = defs, lDict = dict, lSource = source, lPhras
             pure $ state {lStack = stack'}
           "+" ->
             let (a : b : stack') = stack
-                result = lAddNumbers a b
+                result = lAddNumbers b a
+             in pure $ state {lStack = result : stack'}
+          "-" ->
+            let (a : b : stack') = stack
+                result = lSubNumbers b a
              in pure $ state {lStack = result : stack'}
           "*" ->
             let (a : b : stack') = stack
                 result = lMultiplyNumbers a b
              in pure $ state {lStack = result : stack'}
+          "/" ->
+            let (a : b : stack') = stack
+                result = lDivideNumbers a b
+             in pure $ state {lStack = result : stack'}
           "eq?" ->
             let (a : b : stack') = stack
              in pure $ state {lStack = LBool (a == b) : stack'}
+          "gt?" ->
+            let (a : b : stack') = stack
+             in pure $ state {lStack = lGreaterThan b a : stack'}
+          "lt?" ->
+            let (a : b : stack') = stack
+             in pure $ state {lStack = lLesserThan b a : stack'}
           "cond" ->
             let (fb : tb : (LBool cond) : stack') = stack
                 LPhrase branch = if cond then tb else fb
                 newSource = reverse branch ++ source
              in pure $ state {lStack = stack', lSource = newSource}
+          "loop" ->
+            let (bodyP@(LPhrase body) : condP@(LPhrase cond) : stack') = stack
+                ifWords = reverse cond ++ [LPhrase $ reverse (reverse body ++ [condP, bodyP, LSymbol "loop"])] ++ [LPhrase [], LSymbol "cond"]
+                newSource = ifWords ++ source
+             in pure $ state {lStack = stack', lSource = newSource}
           _ -> error $ "[error] not defined: " ++ symbol
   | otherwise = pure $ state {lStack = word : stack}
 
@@ -156,11 +175,27 @@ interpretWord state@LState {lDefs = defs, lDict = dict, lSource = source, lPhras
 
 lAddNumbers (LInteger a) (LInteger b) = LInteger (a + b)
 lAddNumbers (LFloat a) (LFloat b) = LFloat (a + b)
-lAddNumbers a b = error $ "[error] sum not defined for " ++ show a ++ ", " ++ show b
+lAddNumbers a b = error $ "[error] sum it not defined for " ++ show a ++ ", " ++ show b
+
+lSubNumbers (LInteger a) (LInteger b) = LInteger (a - b)
+lSubNumbers (LFloat a) (LFloat b) = LFloat (a - b)
+lSubNumbers a b = error $ "[error] difference it not defined for " ++ show a ++ ", " ++ show b
 
 lMultiplyNumbers (LInteger a) (LInteger b) = LInteger (a * b)
 lMultiplyNumbers (LFloat a) (LFloat b) = LFloat (a * b)
-lMultiplyNumbers a b = error $ "[error] product not defined for " ++ show a ++ ", " ++ show b
+lMultiplyNumbers a b = error $ "[error] product it not defined for " ++ show a ++ ", " ++ show b
+
+lDivideNumbers (LInteger a) (LInteger b) = LInteger (a `div` b)
+lDivideNumbers (LFloat a) (LFloat b) = LFloat (a / b)
+lDivideNumbers a b = error $ "[error] product it not defined for " ++ show a ++ ", " ++ show b
+
+lGreaterThan (LInteger a) (LInteger b) = LBool (a > b)
+lGreaterThan (LFloat a) (LFloat b) = LBool (a > b)
+lGreaterThan a b = error $ "[error] greater-than it not defined for " ++ show a ++ ", " ++ show b
+
+lLesserThan (LInteger a) (LInteger b) = LBool (a < b)
+lLesserThan (LFloat a) (LFloat b) = LBool (a < b)
+lLesserThan a b = error $ "[error] lesser-than it not defined for " ++ show a ++ ", " ++ show b
 
 main :: IO ()
 main = do
-- 
cgit v1.3