{-# Language Trustworthy #-}
{-|
Module      : Intcode.Machine
Description : Intcode machine representation
Copyright   : (c) Eric Mertens, 2019
License     : ISC
Maintainer  : emertens@gmail.com

The module implements the representation of the intcode machine state.

The 'Machine' type stores the initial memory image in an array and
only stores changes to that initial image. This allows for more efficient
comparisons of machine states for equality when there are few changes to
memory.

This implementation of the machine supports negative memory addresses.
These are defined not to be used in the Advent of Code problems.

This implementation stores machine-sized 'Int' values in memory.

-}
module Intcode.Machine
  (
  -- * Machine state
  Machine(..), new,

  -- * Register operations
  jmp, addRelBase,

  -- * Memory operations
  (!), set, memoryList,
  )
 where

import           Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.Primitive.PrimArray as P

-- | Machine state is comprised of the program counter, relative base
-- pointer, and memory.
--
-- * Interact with registers using: 'jmp', 'addRelBase'
-- * Interact with memory using: ('!'), 'set'
-- * Build new machines with: 'new'
--
-- Updates to memory are stored separately from the initial values
-- which can enable equality comparisons to be relatively efficient.
-- This efficiency comes from being able to compare the inital memory
-- using only pointer equality when two machines are created by the
-- same call to 'new'.
data Machine = Machine
  { Machine -> Int
pc         :: !Int          -- ^ program counter
  , Machine -> Int
relBase    :: !Int          -- ^ relative base pointer
  , Machine -> IntMap Int
memUpdates :: !(IntMap Int) -- ^ memory updates
  , Machine -> PrimArray Int
memInitial :: {-# Unpack #-} !(P.PrimArray Int) -- ^ initial memory
  }
  deriving (Machine -> Machine -> Bool
(Machine -> Machine -> Bool)
-> (Machine -> Machine -> Bool) -> Eq Machine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Machine -> Machine -> Bool
== :: Machine -> Machine -> Bool
$c/= :: Machine -> Machine -> Bool
/= :: Machine -> Machine -> Bool
Eq, Eq Machine
Eq Machine =>
(Machine -> Machine -> Ordering)
-> (Machine -> Machine -> Bool)
-> (Machine -> Machine -> Bool)
-> (Machine -> Machine -> Bool)
-> (Machine -> Machine -> Bool)
-> (Machine -> Machine -> Machine)
-> (Machine -> Machine -> Machine)
-> Ord Machine
Machine -> Machine -> Bool
Machine -> Machine -> Ordering
Machine -> Machine -> Machine
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Machine -> Machine -> Ordering
compare :: Machine -> Machine -> Ordering
$c< :: Machine -> Machine -> Bool
< :: Machine -> Machine -> Bool
$c<= :: Machine -> Machine -> Bool
<= :: Machine -> Machine -> Bool
$c> :: Machine -> Machine -> Bool
> :: Machine -> Machine -> Bool
$c>= :: Machine -> Machine -> Bool
>= :: Machine -> Machine -> Bool
$cmax :: Machine -> Machine -> Machine
max :: Machine -> Machine -> Machine
$cmin :: Machine -> Machine -> Machine
min :: Machine -> Machine -> Machine
Ord, Int -> Machine -> ShowS
[Machine] -> ShowS
Machine -> String
(Int -> Machine -> ShowS)
-> (Machine -> String) -> ([Machine] -> ShowS) -> Show Machine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Machine -> ShowS
showsPrec :: Int -> Machine -> ShowS
$cshow :: Machine -> String
show :: Machine -> String
$cshowList :: [Machine] -> ShowS
showList :: [Machine] -> ShowS
Show)

-- | Value stored in initial memory image at given index.
indexImage ::
  Machine {- ^ machine  -} ->
  Int     {- ^ position -} ->
  Int     {- ^ value    -}
indexImage :: Machine -> Int -> Int
indexImage Machine
m Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
P.sizeofPrimArray PrimArray Int
a, Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
P.indexPrimArray PrimArray Int
a Int
i
  | Bool
otherwise                       = Int
0
  where
    a :: PrimArray Int
a = Machine -> PrimArray Int
memInitial Machine
m
{-# INLINE indexImage #-}

-- | Memory lookup.
(!) ::
  Machine {- ^ machine  -} ->
  Int     {- ^ position -} ->
  Int     {- ^ value    -}
Machine
m ! :: Machine -> Int -> Int
! Int
i = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault (Machine -> Int -> Int
indexImage Machine
m Int
i) Int
i (Machine -> IntMap Int
memUpdates Machine
m)
{-# INLINE (!) #-}

-- | Construct machine from a list of initial values starting
-- at address 0. Program counter and relative base start at 0.
new ::
  [Int] {- ^ initial memory -} ->
  Machine
new :: [Int] -> Machine
new [Int]
initialValues = Machine
  { pc :: Int
pc         = Int
0
  , relBase :: Int
relBase    = Int
0
  , memUpdates :: IntMap Int
memUpdates = IntMap Int
forall a. IntMap a
IntMap.empty
  , memInitial :: PrimArray Int
memInitial = [Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
P.primArrayFromList [Int]
initialValues
  }

-- | Store value at given memory position.
set ::
  Int {- ^ position -} ->
  Int {- ^ value    -} ->
  Machine -> Machine
set :: Int -> Int -> Machine -> Machine
set Int
i Int
v Machine
m
  | Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
o    = Machine
m { memUpdates = IntMap.delete i   (memUpdates m) }
  | Bool
otherwise = Machine
m { memUpdates = IntMap.insert i v (memUpdates m) }
  where
    o :: Int
o = Machine -> Int -> Int
indexImage Machine
m Int
i

-- | Add offset to relative base pointer.
addRelBase ::
  Int {- ^ offset -} ->
  Machine -> Machine
addRelBase :: Int -> Machine -> Machine
addRelBase Int
i Machine
mach = Machine
mach { relBase = relBase mach + i }
{-# INLINE addRelBase #-}

-- | Set program counter to a new address.
jmp ::
  Int {- ^ program counter -} ->
  Machine -> Machine
jmp :: Int -> Machine -> Machine
jmp Int
i Machine
mach = Machine
mach { pc = i }
{-# INLINE jmp #-}

-- | Generate a list representation of memory starting from
-- zero. This can get big for sparsely filled memory using
-- large addresses. Returned values start at position 0.
--
-- >>> memoryList (set 8 10 (new [1,2,3]))
-- [1,2,3,0,0,0,0,0,10]
memoryList ::
  Machine ->
  [Int] {- ^ memory values -}
memoryList :: Machine -> [Int]
memoryList Machine
mach
  | IntMap Int -> Bool
forall a. IntMap a -> Bool
IntMap.null (Machine -> IntMap Int
memUpdates Machine
mach) = PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
P.primArrayToList (Machine -> PrimArray Int
memInitial Machine
mach)
  | Bool
otherwise                  = [Machine
mach Machine -> Int -> Int
! Int
i | Int
i <- [Int
0 .. Int
top]]
  where
    top :: Int
top = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
P.sizeofPrimArray (Machine -> PrimArray Int
memInitial Machine
mach) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (IntMap Int -> (Int, Int)
forall a. IntMap a -> (Int, a)
IntMap.findMax (Machine -> IntMap Int
memUpdates Machine
mach)))