From 86d4ffc8a450a1679a8304cc2f2ab9559c38d919 Mon Sep 17 00:00:00 2001
From: Matthew Hall <hallmatthew314@gmail.com>
Date: Tue, 14 Feb 2023 16:54:38 +1300
Subject: Add MINUS intrinsic

---
 DSL.hs | 28 +++++++++++++++++++---------
 1 file changed, 19 insertions(+), 9 deletions(-)

diff --git a/DSL.hs b/DSL.hs
index e608bbe..3244c7f 100644
--- a/DSL.hs
+++ b/DSL.hs
@@ -32,6 +32,7 @@ data Intrinsic
   | I_ROT
   -- core arithmetic operations
   | I_PLUS
+  | I_MINUS
     deriving (Show, Eq)
 
 data Operation
@@ -96,6 +97,7 @@ mainLexer = phrase $ mult1 $ firstOf subLexers
                                           , ("OVER", I_OVER)
                                           , ("ROT",  I_ROT)
                                           , ("+",    I_PLUS)
+                                          , ("-",    I_MINUS)
                                           ]
 
 ------------------------------------------------------------------------------
@@ -133,9 +135,9 @@ operationP = firstOf [ pushDataP
 
 programP :: DSLParser Program
 programP = do
-  optional wsP
+  () <$ optional wsP
   ops <- operationP `sepBy1` wsP
-  optional wsP
+  () <$ optional wsP
   eof
   return ops
 
@@ -219,6 +221,13 @@ plus = StackModifier { smName="PLUS", smTypes=ts, smFunc=f }
     f (StackInt x:StackInt y:xs) = return $ StackInt (x+y):xs
     f _                          = unreachable
 
+minus :: StackModifier
+minus = StackModifier { smName="MINUS", smTypes=ts, smFunc=f }
+  where
+    ts = [tInt, tInt]
+    f (StackInt x:StackInt y:xs) = return $ StackInt (x-y):xs
+    f _                          = unreachable
+
 ------------------------------------------------------------------------------
 -- Core operations
 ------------------------------------------------------------------------------
@@ -246,13 +255,14 @@ 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_DUMP  -> dump
+      I_DROP  -> drop'
+      I_SWAP  -> swap
+      I_DUP   -> dup
+      I_OVER  -> over
+      I_ROT   -> rot
+      I_PLUS  -> plus
+      I_MINUS -> minus
 
 ------------------------------------------------------------------------------
 -- Interpretation
-- 
cgit v1.2.1