{-# 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