Generalise binary arithmetic operations

1 files changed, 8 insertions, 9 deletions

diff --git a/DSL.hs b/DSL.hs
index ea4c8c2..06c0724 100644
--- a/DSL.hs
+++ b/DSL.hs
@@ -219,19 +219,18 @@ rot = StackModifier { smName="ROT", smTypes=ts, smFunc=f }
     f (x:y:z:xs) = return $ y:z:x:xs
     f _          = unreachable
 
-plus :: StackModifier
-plus = StackModifier { smName="PLUS", smTypes=ts, smFunc=f }
+binArithmetic :: String -> (Integer -> Integer -> [Integer]) -> StackModifier
+binArithmetic name f = StackModifier { smName=name, smTypes=ts, smFunc=f' }
   where
     ts = [tInt, tInt]
-    f (StackInt x:StackInt y:xs) = return $ StackInt (x+y):xs
-    f _                          = unreachable
+    f' (StackInt x:StackInt y:xs) = return $ (StackInt <$> f x y) ++ xs
+    f' _                          = unreachable
+
+plus :: StackModifier
+plus = binArithmetic "PLUS" (\ x y -> [x + y])
 
 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
+minus = binArithmetic "MINUS" (\ x y -> [x - y])
 
 ------------------------------------------------------------------------------
 -- Core operations