{-# LANGUAGE FlexibleInstances #-}

module Nes.CPU.Monad (
    -- * Monad
    CPU (..),

    -- * State
    reset,

    -- * Program counter
    incrementPC,
    readAtPC,
    --- * Ticks
    tick,
    tickOnce,

    -- * Stack
    popStackAddr,
    popStackByte,
    pushAddrStack,
    pushByteStack,

    -- * Status register
    popStatusRegister,
    pushStatusRegister,

    -- * Bus
    liftBus,
    unsafeLiftBus,
) where

import Control.Monad.IO.Class
import Data.Bits (Bits (shiftR))
import Nes.Bus.Constants
import Nes.Bus.Monad (Bus, runBus)
import qualified Nes.Bus.Monad as BusM
import Nes.Bus.State (BusState (..))
import Nes.CPU.State
import Nes.FlagRegister
import Nes.Internal.MonadState
import Nes.Interrupt
import Nes.Memory

-- | Note: we use IO because it is likely to read/write from/to memory, which is not pure
newtype CPU r a = MkCPU
    { forall r a.
CPU r a
-> CPUState
-> BusState
-> (CPUState -> BusState -> a -> IO r)
-> IO r
unCPU ::
        CPUState ->
        BusState ->
        (CPUState -> BusState -> a -> IO r) ->
        IO r
    }
    deriving ((forall a b. (a -> b) -> CPU r a -> CPU r b)
-> (forall a b. a -> CPU r b -> CPU r a) -> Functor (CPU r)
forall a b. a -> CPU r b -> CPU r a
forall a b. (a -> b) -> CPU r a -> CPU r b
forall r a b. a -> CPU r b -> CPU r a
forall r a b. (a -> b) -> CPU r a -> CPU r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r a b. (a -> b) -> CPU r a -> CPU r b
fmap :: forall a b. (a -> b) -> CPU r a -> CPU r b
$c<$ :: forall r a b. a -> CPU r b -> CPU r a
<$ :: forall a b. a -> CPU r b -> CPU r a
Functor)

instance Applicative (CPU r) where
    {-# INLINE pure #-}
    pure :: forall a. a -> CPU r a
pure a
a = (CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
 -> CPU r a)
-> (CPUState
    -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> a -> IO r
cont -> CPUState -> BusState -> a -> IO r
cont CPUState
st BusState
bus a
a
    {-# INLINE (<*>) #-}
    (MkCPU CPUState
-> BusState -> (CPUState -> BusState -> (a -> b) -> IO r) -> IO r
f) <*> :: forall a b. CPU r (a -> b) -> CPU r a -> CPU r b
<*> (MkCPU CPUState -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r
a) = (CPUState
 -> BusState -> (CPUState -> BusState -> b -> IO r) -> IO r)
-> CPU r b
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> b -> IO r) -> IO r)
 -> CPU r b)
-> (CPUState
    -> BusState -> (CPUState -> BusState -> b -> IO r) -> IO r)
-> CPU r b
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> b -> IO r
cont -> CPUState
-> BusState -> (CPUState -> BusState -> (a -> b) -> IO r) -> IO r
f CPUState
st BusState
bus ((CPUState -> BusState -> (a -> b) -> IO r) -> IO r)
-> (CPUState -> BusState -> (a -> b) -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$
        \CPUState
st' BusState
prog' a -> b
f' -> CPUState -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r
a CPUState
st' BusState
prog' ((CPUState -> BusState -> a -> IO r) -> IO r)
-> (CPUState -> BusState -> a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$
            \CPUState
st'' BusState
prog'' a
a' -> CPUState -> BusState -> b -> IO r
cont CPUState
st'' BusState
prog'' (b -> IO r) -> b -> IO r
forall a b. (a -> b) -> a -> b
$ a -> b
f' a
a'

instance Monad (CPU r) where
    {-# INLINE (>>=) #-}
    (MkCPU CPUState -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r
a) >>= :: forall a b. CPU r a -> (a -> CPU r b) -> CPU r b
>>= a -> CPU r b
next = (CPUState
 -> BusState -> (CPUState -> BusState -> b -> IO r) -> IO r)
-> CPU r b
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> b -> IO r) -> IO r)
 -> CPU r b)
-> (CPUState
    -> BusState -> (CPUState -> BusState -> b -> IO r) -> IO r)
-> CPU r b
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> b -> IO r
cont -> CPUState -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r
a CPUState
st BusState
bus ((CPUState -> BusState -> a -> IO r) -> IO r)
-> (CPUState -> BusState -> a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$
        \CPUState
st' BusState
bus' a
a' -> CPU r b
-> CPUState
-> BusState
-> (CPUState -> BusState -> b -> IO r)
-> IO r
forall r a.
CPU r a
-> CPUState
-> BusState
-> (CPUState -> BusState -> a -> IO r)
-> IO r
unCPU (a -> CPU r b
next a
a') CPUState
st' BusState
bus' CPUState -> BusState -> b -> IO r
cont

instance MonadFail (CPU r) where
    {-# INLINE fail #-}
    fail :: forall a. String -> CPU r a
fail String
s = (CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
 -> CPU r a)
-> (CPUState
    -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall a b. (a -> b) -> a -> b
$ \CPUState
_ BusState
_ CPUState -> BusState -> a -> IO r
_ -> String -> IO r
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s

instance MonadIO (CPU r) where
    {-# INLINE liftIO #-}
    liftIO :: forall a. IO a -> CPU r a
liftIO IO a
io = (CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
 -> CPU r a)
-> (CPUState
    -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> a -> IO r
cont -> IO a
io IO a -> (a -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CPUState -> BusState -> a -> IO r
cont CPUState
st BusState
bus

instance MonadState CPUState (CPU r) where
    {-# INLINE set #-}
    set :: CPUState -> CPU r ()
set CPUState
st' = (CPUState
 -> BusState -> (CPUState -> BusState -> () -> IO r) -> IO r)
-> CPU r ()
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> () -> IO r) -> IO r)
 -> CPU r ())
-> (CPUState
    -> BusState -> (CPUState -> BusState -> () -> IO r) -> IO r)
-> CPU r ()
forall a b. (a -> b) -> a -> b
$ \CPUState
_ BusState
bus CPUState -> BusState -> () -> IO r
cont -> CPUState -> BusState -> () -> IO r
cont CPUState
st' BusState
bus ()
    {-# INLINE get #-}
    get :: CPU r CPUState
get = (CPUState
 -> BusState -> (CPUState -> BusState -> CPUState -> IO r) -> IO r)
-> CPU r CPUState
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> CPUState -> IO r) -> IO r)
 -> CPU r CPUState)
-> (CPUState
    -> BusState -> (CPUState -> BusState -> CPUState -> IO r) -> IO r)
-> CPU r CPUState
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> CPUState -> IO r
cont -> CPUState -> BusState -> CPUState -> IO r
cont CPUState
st BusState
bus CPUState
st

instance MonadState BusState (CPU r) where
    {-# INLINE set #-}
    set :: BusState -> CPU r ()
set BusState
bus' = (CPUState
 -> BusState -> (CPUState -> BusState -> () -> IO r) -> IO r)
-> CPU r ()
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> () -> IO r) -> IO r)
 -> CPU r ())
-> (CPUState
    -> BusState -> (CPUState -> BusState -> () -> IO r) -> IO r)
-> CPU r ()
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
_ CPUState -> BusState -> () -> IO r
cont -> CPUState -> BusState -> () -> IO r
cont CPUState
st BusState
bus' ()
    {-# INLINE get #-}
    get :: CPU r BusState
get = (CPUState
 -> BusState -> (CPUState -> BusState -> BusState -> IO r) -> IO r)
-> CPU r BusState
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> BusState -> IO r) -> IO r)
 -> CPU r BusState)
-> (CPUState
    -> BusState -> (CPUState -> BusState -> BusState -> IO r) -> IO r)
-> CPU r BusState
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> BusState -> IO r
cont -> CPUState -> BusState -> BusState -> IO r
cont CPUState
st BusState
bus BusState
bus

instance MonadState InterruptStatus (CPU r) where
    {-# INLINE set #-}
    set :: InterruptStatus -> CPU r ()
set InterruptStatus
is = (CPUState
 -> BusState -> (CPUState -> BusState -> () -> IO r) -> IO r)
-> CPU r ()
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> () -> IO r) -> IO r)
 -> CPU r ())
-> (CPUState
    -> BusState -> (CPUState -> BusState -> () -> IO r) -> IO r)
-> CPU r ()
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> () -> IO r
cont -> CPUState -> BusState -> () -> IO r
cont CPUState
st BusState
bus{_cpuInterrupt = is} ()
    {-# INLINE get #-}
    get :: CPU r InterruptStatus
get = (CPUState
 -> BusState
 -> (CPUState -> BusState -> InterruptStatus -> IO r)
 -> IO r)
-> CPU r InterruptStatus
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState
  -> (CPUState -> BusState -> InterruptStatus -> IO r)
  -> IO r)
 -> CPU r InterruptStatus)
-> (CPUState
    -> BusState
    -> (CPUState -> BusState -> InterruptStatus -> IO r)
    -> IO r)
-> CPU r InterruptStatus
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> InterruptStatus -> IO r
cont -> CPUState -> BusState -> InterruptStatus -> IO r
cont CPUState
st BusState
bus (BusState -> InterruptStatus
_cpuInterrupt BusState
bus)

liftBus :: Bus (a, BusState) a -> CPU r a
liftBus :: forall a r. Bus (a, BusState) a -> CPU r a
liftBus Bus (a, BusState) a
f = (CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
 -> CPU r a)
-> (CPUState
    -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> a -> IO r
cont -> do
    (a
res, BusState
bus') <- BusState -> Bus (a, BusState) a -> IO (a, BusState)
forall a. BusState -> Bus (a, BusState) a -> IO (a, BusState)
runBus BusState
bus Bus (a, BusState) a
f
    CPUState -> BusState -> a -> IO r
cont CPUState
st BusState
bus' a
res

-- | Unsafe action that provides access to Bus
--
-- When using it, ticks ARE NOT taken into account.
-- For testing purposes
{-# INLINE unsafeLiftBus #-}
unsafeLiftBus :: Bus (a, BusState) a -> CPU r a
unsafeLiftBus :: forall a r. Bus (a, BusState) a -> CPU r a
unsafeLiftBus Bus (a, BusState) a
f = (CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall r a.
(CPUState
 -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
MkCPU ((CPUState
  -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
 -> CPU r a)
-> (CPUState
    -> BusState -> (CPUState -> BusState -> a -> IO r) -> IO r)
-> CPU r a
forall a b. (a -> b) -> a -> b
$ \CPUState
st BusState
bus CPUState -> BusState -> a -> IO r
cont -> do
    (a
res, BusState
_) <- BusState -> Bus (a, BusState) a -> IO (a, BusState)
forall a. BusState -> Bus (a, BusState) a -> IO (a, BusState)
runBus BusState
bus Bus (a, BusState) a
f
    CPUState -> BusState -> a -> IO r
cont CPUState
st BusState
bus a
res

{-# INLINE tick #-}
tick :: Int -> CPU r ()
tick :: forall r. Int -> CPU r ()
tick = Bus ((), BusState) () -> CPU r ()
forall a r. Bus (a, BusState) a -> CPU r a
liftBus (Bus ((), BusState) () -> CPU r ())
-> (Int -> Bus ((), BusState) ()) -> Int -> CPU r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bus ((), BusState) ()
forall r. Int -> Bus r ()
BusM.tick

{-# INLINE tickOnce #-}
tickOnce :: CPU r ()
tickOnce :: forall r. CPU r ()
tickOnce = Int -> CPU r ()
forall r. Int -> CPU r ()
Nes.CPU.Monad.tick Int
1

instance MemoryInterface () (CPU r) where
    {-# INLINE readByte #-}
    readByte :: Addr -> () -> CPU r Byte
readByte Addr
n () = do
        Byte
res <- Bus (Byte, BusState) Byte -> CPU r Byte
forall a r. Bus (a, BusState) a -> CPU r a
liftBus (Addr -> () -> Bus (Byte, BusState) Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
Nes.Memory.readByte Addr
n ())
        CPU r ()
forall r. CPU r ()
tickOnce
        Byte -> CPU r Byte
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res

    {-# INLINE readAddr #-}
    readAddr :: Addr -> () -> CPU r Addr
readAddr Addr
n () = do
        Addr
res <- Bus (Addr, BusState) Addr -> CPU r Addr
forall a r. Bus (a, BusState) a -> CPU r a
liftBus (Addr -> () -> Bus (Addr, BusState) Addr
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Addr
Nes.Memory.readAddr Addr
n ())
        Int -> CPU r ()
forall r. Int -> CPU r ()
tick Int
2
        Addr -> CPU r Addr
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Addr
res

    {-# INLINE writeByte #-}
    writeByte :: Byte -> Addr -> () -> CPU r ()
writeByte Byte
byte Addr
dest () = do
        Bus ((), BusState) () -> CPU r ()
forall a r. Bus (a, BusState) a -> CPU r a
liftBus (Byte -> Addr -> () -> Bus ((), BusState) ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
Nes.Memory.writeByte Byte
byte Addr
dest ())
        CPU r ()
forall r. CPU r ()
tickOnce

    {-# INLINE writeAddr #-}
    writeAddr :: Addr -> Addr -> () -> CPU r ()
writeAddr Addr
byte Addr
dest () = do
        Bus ((), BusState) () -> CPU r ()
forall a r. Bus (a, BusState) a -> CPU r a
liftBus (Addr -> Addr -> () -> Bus ((), BusState) ()
forall a (m :: * -> *).
MemoryInterface a m =>
Addr -> Addr -> a -> m ()
Nes.Memory.writeAddr Addr
byte Addr
dest ())
        Int -> CPU r ()
forall r. Int -> CPU r ()
tick Int
2

{-# INLINE incrementPC #-}
incrementPC :: CPU r ()
incrementPC :: forall r. CPU r ()
incrementPC = (Addr -> Identity Addr) -> CPUState -> Identity CPUState
Lens' CPUState Addr
pc ((Addr -> Identity Addr) -> CPUState -> Identity CPUState)
-> Addr -> CPU r ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Addr
1

-- | Read Word8 from memory, using the program counter as offset
{-# INLINE readAtPC #-}
readAtPC :: CPU r Byte
readAtPC :: forall r. CPU r Byte
readAtPC = Getting Addr CPUState Addr -> (Addr -> CPU r Byte) -> CPU r Byte
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> m r) -> m r
usesM Getting Addr CPUState Addr
Lens' CPUState Addr
pc (Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())

popStackByte :: CPU r Byte
popStackByte :: forall r. CPU r Byte
popStackByte = do
    Byte
newRegS <- Getting Byte CPUState Byte -> (Byte -> Byte) -> CPU r Byte
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting Byte CPUState Byte
Lens' CPUState Byte
registerS (Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
1)
    (Byte -> Identity Byte) -> CPUState -> Identity CPUState
Lens' CPUState Byte
registerS ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
newRegS
    Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte (Addr
stackAddr Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
+ Byte -> Addr
byteToAddr Byte
newRegS) ()

{-# INLINE popStackAddr #-}
popStackAddr :: CPU r Addr
popStackAddr :: forall r. CPU r Addr
popStackAddr = (Byte -> Byte -> Addr) -> CPU r Byte -> CPU r Byte -> CPU r Addr
forall a b c. (a -> b -> c) -> CPU r a -> CPU r b -> CPU r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Byte -> Byte -> Addr
bytesToAddr CPU r Byte
forall r. CPU r Byte
popStackByte CPU r Byte
forall r. CPU r Byte
popStackByte

pushByteStack :: Byte -> CPU r ()
pushByteStack :: forall r. Byte -> CPU r ()
pushByteStack Byte
byte = do
    Byte
regS <- Getting Byte CPUState Byte -> CPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte CPUState Byte
Lens' CPUState Byte
registerS
    Byte -> Addr -> () -> CPU r ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
writeByte Byte
byte (Addr
stackAddr Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
+ Byte -> Addr
byteToAddr Byte
regS) ()
    Register -> Lens' CPUState Byte
register Register
S ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= (-Byte
1)

-- | If the argument is True, the pushed value will have the B Flag set
pushStatusRegister :: Bool -> CPU r ()
pushStatusRegister :: forall r. Bool -> CPU r ()
pushStatusRegister Bool
b = do
    StatusRegister
s <- Getting StatusRegister CPUState StatusRegister
-> CPU r StatusRegister
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting StatusRegister CPUState StatusRegister
Lens' CPUState StatusRegister
status
    let value :: Byte
value = StatusRegister -> Byte
unSR (StatusRegister -> Byte) -> StatusRegister -> Byte
forall a b. (a -> b) -> a -> b
$ Flag StatusRegister -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
setFlag Flag StatusRegister
StatusRegisterFlag
Unusued (StatusRegister -> StatusRegister)
-> StatusRegister -> StatusRegister
forall a b. (a -> b) -> a -> b
$ Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
BFlag Bool
b StatusRegister
s
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
pushByteStack Byte
value

-- | Pops value on the stack, clear BFlag and sets the results value as status register
popStatusRegister :: CPU r ()
popStatusRegister :: forall r. CPU r ()
popStatusRegister = do
    StatusRegister
value <- Byte -> StatusRegister
forall a. FlagRegister a => Byte -> a
fromByte (Byte -> StatusRegister) -> CPU r Byte -> CPU r StatusRegister
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CPU r Byte
forall r. CPU r Byte
popStackByte
    -- TODO Breaks Nestest
    let s :: StatusRegister
s = Flag StatusRegister -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
clearFlag Flag StatusRegister
StatusRegisterFlag
Unusued (StatusRegister -> StatusRegister)
-> StatusRegister -> StatusRegister
forall a b. (a -> b) -> a -> b
$ Flag StatusRegister -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
clearFlag Flag StatusRegister
StatusRegisterFlag
BFlag StatusRegister
value
    (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> StatusRegister -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= StatusRegister
s

{-# INLINE pushAddrStack #-}
pushAddrStack :: Addr -> CPU r ()
pushAddrStack :: forall r. Addr -> CPU r ()
pushAddrStack Addr
addr = do
    let high :: Byte
high = Addr -> Byte
unsafeAddrToByte (Addr -> Int -> Addr
forall a. Bits a => a -> Int -> a
shiftR Addr
addr Int
8)
        low :: Byte
low = Addr -> Byte
unsafeAddrToByte Addr
addr
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
pushByteStack Byte
high
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
pushByteStack Byte
low

-- | Resets the state of the CPU
reset :: CPU r ()
reset :: forall r. CPU r ()
reset = do
    CPUState -> CPU r ()
forall s (m :: * -> *). MonadState s m => s -> m ()
set CPUState
newCPUState
    ((Addr -> Identity Addr) -> CPUState -> Identity CPUState
Lens' CPUState Addr
pc ((Addr -> Identity Addr) -> CPUState -> Identity CPUState)
-> Addr -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.=) (Addr -> CPU r ()) -> CPU r Addr -> CPU r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Addr -> () -> CPU r Addr
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Addr
readAddr Addr
0xfffc ()