summaryrefslogtreecommitdiff
path: root/DSL.hs
diff options
context:
space:
mode:
Diffstat (limited to 'DSL.hs')
-rw-r--r--DSL.hs32
1 files changed, 22 insertions, 10 deletions
diff --git a/DSL.hs b/DSL.hs
index 06c0724..8e275ba 100644
--- a/DSL.hs
+++ b/DSL.hs
@@ -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