diff options
| author | Matthew Hall <hallmatthew314@gmail.com> | 2023-02-14 17:58:02 +1300 |
|---|---|---|
| committer | Matthew Hall <hallmatthew314@gmail.com> | 2023-02-14 17:58:02 +1300 |
| commit | 78756ee806b02500eb7c484ff921605414fca906 (patch) | |
| tree | 07cef6d1004dad7b0334b1a55beec8f7f79314f1 | |
| parent | 775d5cd3a313ddac799c187e518bf6925023c3ee (diff) | |
Implement TIMES and DIVMOD
| -rw-r--r-- | DSL.hs | 32 |
1 files changed, 22 insertions, 10 deletions
@@ -33,6 +33,8 @@ data Intrinsic -- core arithmetic operations | I_PLUS | I_MINUS + | I_TIMES + | I_DIVMOD deriving (Show, Eq) data Operation @@ -103,6 +105,8 @@ mainLexer = phrase $ mult1 $ firstOf subLexers , ("ROT", I_ROT) , ("+", I_PLUS) , ("-", I_MINUS) + , ("*", I_TIMES) + , ("/%", I_DIVMOD) ] ------------------------------------------------------------------------------ @@ -227,10 +231,16 @@ binArithmetic name f = StackModifier { smName=name, smTypes=ts, smFunc=f' } f' _ = unreachable plus :: StackModifier -plus = binArithmetic "PLUS" (\ x y -> [x + y]) +plus = binArithmetic "PLUS" $ \ x y -> [x + y] minus :: StackModifier -minus = binArithmetic "MINUS" (\ x y -> [x - y]) +minus = binArithmetic "MINUS" $ \ x y -> [x - y] + +times :: StackModifier +times = binArithmetic "TIMES" $ \ x y -> [x * y] + +divMod' :: StackModifier +divMod' = binArithmetic "DIVMOD" $ \ x y -> [mod x y, div x y] ------------------------------------------------------------------------------ -- Core operations @@ -259,14 +269,16 @@ 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_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' ------------------------------------------------------------------------------ -- Interpretation |