Add PLUS intrinsic

1 files changed, 10 insertions, 1 deletions

diff --git a/DSL.hs b/DSL.hs
index 46ab664..2b3b5a1 100644
--- a/DSL.hs
+++ b/DSL.hs
@@ -21,13 +21,15 @@ instance Show StackData where
 type Stack = [StackData]
 
 data Intrinsic
-  -- core/stack operations
+  -- core stack operations
   = I_DUMP
   | I_DROP
   | I_SWAP
   | I_DUP
   | I_OVER
   | I_ROT
+  -- core arithmetic operations
+  | I_PLUS
     deriving (Show, Eq)
 
 data Operation
@@ -86,6 +88,7 @@ mainLexer = phrase $ mult1 $ firstOf subLexers
                                           , ("DUP",  I_DUP)
                                           , ("OVER", I_OVER)
                                           , ("ROT",  I_ROT)
+                                          , ("+",    I_PLUS)
                                           ]
 
 ------------------------------------------------------------------------------
@@ -163,6 +166,11 @@ rot :: Machine -> IO Machine
 rot m@Machine{ stack=x:y:z:xs } = return m{ stack=y:z:x:xs }
 rot m                           = hcf m "ROT: stack underflow"
 
+plus :: Machine -> IO Machine
+plus m@Machine{ stack=StackInt x:StackInt y:xs } = return m{ stack=StackInt (x + y):xs }
+plus m@Machine{ stack=_:_:_ }                    = hcf m "PLUS: type mis-match"
+plus m                                           = hcf m "PLUS: stack underflow"
+
 ------------------------------------------------------------------------------
 -- Core operations
 ------------------------------------------------------------------------------
@@ -181,6 +189,7 @@ applyIntrinsic I_SWAP = swap
 applyIntrinsic I_DUP  = dup
 applyIntrinsic I_OVER = over
 applyIntrinsic I_ROT  = rot
+applyIntrinsic I_PLUS = plus
 
 ------------------------------------------------------------------------------
 -- Interpretation