From 78756ee806b02500eb7c484ff921605414fca906 Mon Sep 17 00:00:00 2001
From: Matthew Hall <hallmatthew314@gmail.com>
Date: Tue, 14 Feb 2023 17:58:02 +1300
Subject: Implement TIMES and DIVMOD

---
 DSL.hs | 32 ++++++++++++++++++++++----------
 1 file changed, 22 insertions(+), 10 deletions(-)

diff --git a/DSL.hs b/DSL.hs
index 06c0724..8e275ba 100644
--- a/DSL.hs
+++ b/DSL.hs
@@ -33,6 +33,8 @@ data Intrinsic
   -- core arithmetic operations
   | I_PLUS
   | I_MINUS
+  | I_TIMES
+  | I_DIVMOD
     deriving (Show, Eq)
 
 data Operation
@@ -103,6 +105,8 @@ mainLexer = phrase $ mult1 $ firstOf subLexers
                                           , ("ROT",  I_ROT)
                                           , ("+",    I_PLUS)
                                           , ("-",    I_MINUS)
+                                          , ("*",    I_TIMES)
+                                          , ("/%",   I_DIVMOD)
                                           ]
 
 ------------------------------------------------------------------------------
@@ -227,10 +231,16 @@ binArithmetic name f = StackModifier { smName=name, smTypes=ts, smFunc=f' }
     f' _                          = unreachable
 
 plus :: StackModifier
-plus = binArithmetic "PLUS" (\ x y -> [x + y])
+plus = binArithmetic "PLUS" $ \ x y -> [x + y]
 
 minus :: StackModifier
-minus = binArithmetic "MINUS" (\ x y -> [x - y])
+minus = binArithmetic "MINUS" $ \ x y -> [x - y]
+
+times :: StackModifier
+times = binArithmetic "TIMES" $ \ x y -> [x * y]
+
+divMod' :: StackModifier
+divMod' = binArithmetic "DIVMOD" $ \ x y -> [mod x y, div x y]
 
 ------------------------------------------------------------------------------
 -- Core operations
@@ -259,14 +269,16 @@ applyIntrinsic i m = do
     Right s' -> return m{ stack=s' }
   where
     sm = case i of
-      I_DUMP  -> dump
-      I_DROP  -> drop'
-      I_SWAP  -> swap
-      I_DUP   -> dup
-      I_OVER  -> over
-      I_ROT   -> rot
-      I_PLUS  -> plus
-      I_MINUS -> minus
+      I_DUMP   -> dump
+      I_DROP   -> drop'
+      I_SWAP   -> swap
+      I_DUP    -> dup
+      I_OVER   -> over
+      I_ROT    -> rot
+      I_PLUS   -> plus
+      I_MINUS  -> minus
+      I_TIMES  -> times
+      I_DIVMOD -> divMod'
 
 ------------------------------------------------------------------------------
 -- Interpretation
-- 
cgit v1.2.1