From 873c294497c74e85eae5310cbf19269807c75e6d Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Sun, 15 Apr 2018 00:12:01 +0200 Subject: Build with stack --- Interpreter.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 Interpreter.hs (limited to 'Interpreter.hs') 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 -- cgit v1.2.3-54-g00ecf