module Main where

import qualified Data.Sequence as S
import Control.Monad.State
import Data.Word ( Word16 )
import Data.Maybe (isNothing)
import Data.Bits ( Bits((.&.), complement, shiftR) )
import Data.Sequence ((!?))
import Debug.Trace


data Machine = Machine {
    pc :: Int,
    registers :: S.Seq Int,
    memory :: S.Seq Int
} deriving Show

mkMachine :: [String] -> Machine
mkMachine f = Machine 0 (S.replicate 8 0) (S.fromList $ map read f)

data MachineError = Halt | MemoryAccessError deriving (Show,Eq)
execute :: State Machine (Maybe MachineError)
execute = do
    inst <- gets (S.lookup.pc<*>memory)
    -- increment pc
    -- modify $ Machine.((+1).pc)<*>memory<*>registers
    regs <- gets registers
    mem <- gets memory
    pc <- gets $ (+1).pc
    case inst of
        Nothing -> return $ Just MemoryAccessError
        Just inst ->
            let Just regA = S.lookup (inst `shiftR` 19 .&. 0b111) regs
                Just regB = S.lookup (inst `shiftR` 16 .&. 0b111) regs
                destReg = inst .&. 0b111
                offsetField = inst .&. 0b1111111111111111
                wrapAdd x y = (fromIntegral (fromIntegral (x+y) :: Word16) :: Int)
                 in case inst `shiftR` 22 .&. 0b111 of
                -- ADD
                0 -> do
                    put $ Machine pc (S.update destReg (regA+regB) regs) mem
                    return Nothing
                -- NAND
                1 -> do
                    put $ Machine pc (S.update destReg (complement regA.&.regB) regs) mem
                    return Nothing
                -- LW
                2 -> do
                    case S.lookup (wrapAdd offsetField regA) mem of
                        Nothing -> return $ Just MemoryAccessError
                        Just v -> do
                            put $ Machine pc (S.update (inst `shiftR` 16 .&. 0b11) v regs) mem
                            return Nothing
                -- SW
                3 -> do
                    put $ Machine pc regs (S.update (wrapAdd offsetField regA) regB mem)
                    return Nothing
                --- BEQ
                4 -> do
                    if regA==regB then 
                        put $ Machine (wrapAdd offsetField pc)  regs mem
                    else put $ Machine pc regs mem
                    return Nothing
                -- XXX
                5 -> return Nothing
                -- HALT
                6 -> return $ Just Halt
                -- NOOP
                7 -> return Nothing


main :: IO ()
main = do
    input <- getContents
    let m = until ((/=Nothing).evalState execute) (execState execute) $ mkMachine (lines input)
    case evalState execute m of
        Just Halt -> putStrLn "Machine halted"
        Just MemoryAccessError -> putStrLn "Out of bounds memory access"
    print m