Less than/greater than

1 files changed, 46 insertions, 14 deletions

diff --git a/DSL.hs b/DSL.hs
index 72e48fe..06d895c 100644
--- a/DSL.hs
+++ b/DSL.hs
@@ -12,6 +12,7 @@ import Parsers
 data StackData
   = StackInt Integer
   | StackBool Bool
+    deriving (Eq)
 
 instance Show StackData where
   show (StackInt x)      = show x
@@ -40,6 +41,10 @@ data Intrinsic
   | I_AND
   | I_OR
   | I_XOR
+  -- core logical operations
+  | I_EQUAL
+  | I_LESSTHAN
+  | I_GREATERTHAN
     deriving (Show, Eq)
 
 data Operation
@@ -145,6 +150,9 @@ mainLexer = phrase $ mult1 $ firstOf subLexers
                                           , ("&&",   I_AND)
                                           , ("||",   I_OR)
                                           , ("^",    I_XOR)
+                                          , ("==",   I_EQUAL)
+                                          , ("<",    I_LESSTHAN)
+                                          , (">",    I_GREATERTHAN)
                                           ]
 
 stripWhitespace :: [DSLToken] -> [DSLToken]
@@ -323,6 +331,27 @@ or' = binBoolean "OR" $ \ x y -> [x || y]
 xor :: StackModifier
 xor = binBoolean "XOR" $ \ x y -> [x /= y]
 
+equal :: StackModifier
+equal = StackModifier { smName="EQUAL", smTypes=ts, smFunc=f }
+  where
+    ts = [tAny, tAny]
+    f (x:y:xs) = return $ StackBool (x == y):xs
+    f _        = unreachable
+
+lessThan :: StackModifier
+lessThan = StackModifier { smName="LESSTHAN", smTypes=ts, smFunc=f }
+  where
+    ts = [tInt, tInt]
+    f (StackInt x:StackInt y:xs) = return $ StackBool(x < y):xs
+    f _                          = unreachable
+
+greaterThan :: StackModifier
+greaterThan = StackModifier { smName="GREATERTHAN", smTypes=ts, smFunc=f }
+  where
+    ts = [tInt, tInt]
+    f (StackInt x:StackInt y:xs) = return $ StackBool(x > y):xs
+    f _                          = unreachable
+
 ------------------------------------------------------------------------------
 -- Core operations
 ------------------------------------------------------------------------------
@@ -350,20 +379,23 @@ 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_TIMES  -> times
-      I_DIVMOD -> divMod'
-      I_NOT    -> not'
-      I_AND    -> and'
-      I_OR     -> or'
-      I_XOR    -> xor
+      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'
+      I_NOT         -> not'
+      I_AND         -> and'
+      I_OR          -> or'
+      I_XOR         -> xor
+      I_EQUAL       -> equal
+      I_LESSTHAN    -> lessThan
+      I_GREATERTHAN -> greaterThan
 
 ------------------------------------------------------------------------------
 -- Interpretation