{- Bidirectionally infinite tape with an index of one focused element (first
 - element of the second list).
 -
 - Example: a tape where each cell contains its own index, looks like this:
 -
 -     Tape 0 [-1, -2 ..] [0, 1 ..]
 -}
data Tape a = Tape Int [a] [a]

{- Creates a bidirectionally infinite tape filled with a list of initial values
 - (from index 0 onwards) and a default value everywhere else (including all
 - negative indices). Initially focused on index 0.
 -
 - Example:
 -
 -     fromList 42 [1, 2, 3]  ~>*  Tape 0 [42, 42 ..] [1, 2, 3, 42, 42 ..]
 -}
fromList :: a -> [a] -> Tape a
fromList = undefined

{- Returns index of the active (focused) cell. -}
tapeIndex :: Tape a -> Int
tapeIndex = undefined

{- Returns value of the active cell. -}
readTape :: Tape a -> a
readTape = undefined

{- Changes value of the active cell. -}
writeTape :: a -> Tape a -> Tape a
writeTape = undefined

{- Focuses the next cell of the tape. -}
advanceTape :: Tape a -> Tape a
advanceTape = undefined

{- Focus the cell on the given index. -}
seekTape :: Int -> Tape a -> Tape a
seekTape = undefined

{- Registers, pseudoregisters and immediate values -}
type Value = Int
data Operand  = RA | RB | RC | RD -- general-purpose registers
              | MI                -- focused memory index
              | M                 -- focused memory (content at index MI)
              | PC                -- program counter
              | Imm Value         -- immediate value (write does nothing)
              deriving Show

{- Internal flags for the conditional instruction -}
data SignumFlag  = ZeroFlag | PosFlag | NegFlag deriving Show
data ParityFlag  = EvenFlag | OddFlag deriving Show
type TestFlags   = (SignumFlag, ParityFlag)

{- Predicates for the conditional instruction -}
data Condition   = Zero | Pos | Neg | Even | Odd deriving Show
{- The instruction set -}
data Instruction = Add    Operand Operand Operand -- r1 := r2 + r3
                 | Halve  Operand Operand         -- r1 := ⌊r2 / 2⌋
                 | Negate Operand Operand         -- r1 := - r2

                 | Test Operand                   -- Fill test flags
                 | If Condition                   -- Skip next instruction unless true

                 | Out Operand                    -- Push a value to the output
                 | Halt                           -- Cease execution
                 deriving Show

{- Machine state -}
type Machine = (Program, Data, Regs, TestFlags)
type Program = Tape Instruction
type Data = Tape Value
type Regs = (Value, Value, Value, Value)

{- Gets a value from the machine based on an operand -}
getValue :: Operand -> Machine -> Value
getValue = undefined

{- Changes the machine state based on an value assigned to an operand -}
setValue :: Operand -> Value -> Machine -> Machine
setValue = undefined

{- Performs one instruction returning the new state and a potential output,
 - unless the machine is to halt. -}
evalStep :: Machine -> Maybe (Maybe Value, Machine)
evalStep = undefined

{- Takes program and initial memory (arguments), returns results of all Out
 - instructions in order of their execution. The result must be produced lazily:
 - even if the machine does not halt, every performed Out instruction must
 - appear in the output.
 -}
eval :: [Instruction] -> [Value] -> [Value]
eval = undefined


{- Sample program: copy the initial content of the memory tape up to the first
 - zero into the output stream.
 -
 - E.g., 'eval progEcho [42, 66, 0, 99]' ~>* [42, 66]
 -}
progEcho :: [Instruction]
progEcho = [ Test M             -- check contents of the focused memory index
           , If Zero            -- ... and if it is zero,
           , Halt               -- ... halt the execution
           , Out M              -- otherwise, output the value
           , Add MI MI (Imm 1)  -- focus the next memory cell
           , Add PC RA RA       -- jump back to the first instruction (RA is 0)
           ]


{- The Show instance for Tape shows only a first few elements of each list. -}
instance Show a => Show (Tape a) where
    show (Tape i b f) = "Tape " ++ showsPrec 10 i " [" ++ showLim 10 b
                                               ++ " [" ++ showLim 10 f
        where showLim :: Show e => Int -> [e] -> String
              showLim _ [] = "]"
              showLim 0 _ = "...]"
              showLim n (x:xs) = show x ++ "," ++ showLim (n - 1) xs