From 775d5cd3a313ddac799c187e518bf6925023c3ee Mon Sep 17 00:00:00 2001 From: Matthew Hall Date: Tue, 14 Feb 2023 17:15:05 +1300 Subject: Generalise binary arithmetic operations --- DSL.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) (limited to 'DSL.hs') 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 -- cgit v1.2.1