diff options
author | Tom Smeding <tom.smeding@gmail.com> | 2018-04-15 00:12:01 +0200 |
---|---|---|
committer | Tom Smeding <tom.smeding@gmail.com> | 2018-04-15 00:12:01 +0200 |
commit | 873c294497c74e85eae5310cbf19269807c75e6d (patch) | |
tree | bc8558a62559b449ff702593cdc40314359ae2db /Interpreter.hs | |
parent | 6489f93d146d7b6a381fc2815158240d26b5febc (diff) |
Build with stack
Diffstat (limited to 'Interpreter.hs')
-rw-r--r-- | Interpreter.hs | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/Interpreter.hs b/Interpreter.hs new file mode 100644 index 0000000..4f3f3aa --- /dev/null +++ b/Interpreter.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE BangPatterns #-} + +module Interpreter(interpret) where + +import qualified Data.Vector.Mutable as MV + +import AST + + +type Tape = MV.IOVector Byte + + +interpret :: Program -> [Byte] -> IO [Byte] +interpret (Program inss) inp = MV.replicate 60000 0 >>= \tape -> interInss 0 tape 30000 inss inp + +interInss :: Int -> Tape -> Int -> [Instruction] -> [Byte] -> IO [Byte] +interInss _ _ _ [] _ = return [] +-- interInss count _ _ _ _ | count > 2000000000 = return [] +interInss !count !tape !memp allinss@(ins:rest) inp = case ins of + (IAdd value offset) -> do + MV.modify tape (+ value) (memp + offset) + interInss (count + 1) tape memp rest inp + (ISet value offset) -> do + MV.write tape (memp + offset) value + interInss (count + 1) tape memp rest inp + (ICopy from to mult) -> do + value <- MV.read tape (memp + from) + MV.modify tape ((+) (mult * value)) (memp + to) + interInss (count + 1) tape memp rest inp + (ISlide offset) -> do + interInss (count + 1) tape (memp + offset) rest inp + (ILoop iins offset) -> do + value <- MV.read tape (memp + offset) + if value /= 0 + then interInss (count + 1) tape memp (iins ++ allinss) inp + else interInss (count + 1) tape memp rest inp + (IInput offset) -> do + let (c:cs) = inp + MV.write tape (memp + offset) c + interInss (count + 1) tape memp rest cs + (IOutput offset) -> do + value <- MV.read tape (memp + offset) + (value :) <$> interInss (count + 1) tape memp rest inp + IStart -> do + interInss (count + 1) tape memp rest inp |