{-# Language TemplateHaskell, LambdaCase #-}
module AsmProg where

import Advent.ReadS ( P(..) )
import Control.Applicative ( Alternative(empty, (<|>)) )
import Control.Lens ( LensLike', use, makeLenses )
import Control.Monad.State ( MonadState )

data Registers = Registers { Registers -> Int
_regA, Registers -> Int
_regB, Registers -> Int
_regC, Registers -> Int
_regD :: !Int }
  deriving (ReadPrec [Registers]
ReadPrec Registers
Int -> ReadS Registers
ReadS [Registers]
(Int -> ReadS Registers)
-> ReadS [Registers]
-> ReadPrec Registers
-> ReadPrec [Registers]
-> Read Registers
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Registers
readsPrec :: Int -> ReadS Registers
$creadList :: ReadS [Registers]
readList :: ReadS [Registers]
$creadPrec :: ReadPrec Registers
readPrec :: ReadPrec Registers
$creadListPrec :: ReadPrec [Registers]
readListPrec :: ReadPrec [Registers]
Read, Int -> Registers -> ShowS
[Registers] -> ShowS
Registers -> String
(Int -> Registers -> ShowS)
-> (Registers -> String)
-> ([Registers] -> ShowS)
-> Show Registers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Registers -> ShowS
showsPrec :: Int -> Registers -> ShowS
$cshow :: Registers -> String
show :: Registers -> String
$cshowList :: [Registers] -> ShowS
showList :: [Registers] -> ShowS
Show, Registers -> Registers -> Bool
(Registers -> Registers -> Bool)
-> (Registers -> Registers -> Bool) -> Eq Registers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Registers -> Registers -> Bool
== :: Registers -> Registers -> Bool
$c/= :: Registers -> Registers -> Bool
/= :: Registers -> Registers -> Bool
Eq, Eq Registers
Eq Registers =>
(Registers -> Registers -> Ordering)
-> (Registers -> Registers -> Bool)
-> (Registers -> Registers -> Bool)
-> (Registers -> Registers -> Bool)
-> (Registers -> Registers -> Bool)
-> (Registers -> Registers -> Registers)
-> (Registers -> Registers -> Registers)
-> Ord Registers
Registers -> Registers -> Bool
Registers -> Registers -> Ordering
Registers -> Registers -> Registers
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 :: Registers -> Registers -> Ordering
compare :: Registers -> Registers -> Ordering
$c< :: Registers -> Registers -> Bool
< :: Registers -> Registers -> Bool
$c<= :: Registers -> Registers -> Bool
<= :: Registers -> Registers -> Bool
$c> :: Registers -> Registers -> Bool
> :: Registers -> Registers -> Bool
$c>= :: Registers -> Registers -> Bool
>= :: Registers -> Registers -> Bool
$cmax :: Registers -> Registers -> Registers
max :: Registers -> Registers -> Registers
$cmin :: Registers -> Registers -> Registers
min :: Registers -> Registers -> Registers
Ord)

makeLenses ''Registers

zeroRegisters :: Registers
zeroRegisters :: Registers
zeroRegisters = Int -> Int -> Int -> Int -> Registers
Registers Int
0 Int
0 Int
0 Int
0

class HasRegisters a where
  reg :: Functor f => Register -> LensLike' f a Int

data Register = A|B|C|D
  deriving (Int -> Register -> ShowS
[Register] -> ShowS
Register -> String
(Int -> Register -> ShowS)
-> (Register -> String) -> ([Register] -> ShowS) -> Show Register
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Register -> ShowS
showsPrec :: Int -> Register -> ShowS
$cshow :: Register -> String
show :: Register -> String
$cshowList :: [Register] -> ShowS
showList :: [Register] -> ShowS
Show, Register -> Register -> Bool
(Register -> Register -> Bool)
-> (Register -> Register -> Bool) -> Eq Register
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Register -> Register -> Bool
== :: Register -> Register -> Bool
$c/= :: Register -> Register -> Bool
/= :: Register -> Register -> Bool
Eq, Eq Register
Eq Register =>
(Register -> Register -> Ordering)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Register)
-> (Register -> Register -> Register)
-> Ord Register
Register -> Register -> Bool
Register -> Register -> Ordering
Register -> Register -> Register
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 :: Register -> Register -> Ordering
compare :: Register -> Register -> Ordering
$c< :: Register -> Register -> Bool
< :: Register -> Register -> Bool
$c<= :: Register -> Register -> Bool
<= :: Register -> Register -> Bool
$c> :: Register -> Register -> Bool
> :: Register -> Register -> Bool
$c>= :: Register -> Register -> Bool
>= :: Register -> Register -> Bool
$cmax :: Register -> Register -> Register
max :: Register -> Register -> Register
$cmin :: Register -> Register -> Register
min :: Register -> Register -> Register
Ord)

instance HasRegisters Registers where
  reg :: forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Registers Int
reg Register
A = (Int -> f Int) -> Registers -> f Registers
Lens' Registers Int
regA
  reg Register
B = (Int -> f Int) -> Registers -> f Registers
Lens' Registers Int
regB
  reg Register
C = (Int -> f Int) -> Registers -> f Registers
Lens' Registers Int
regC
  reg Register
D = (Int -> f Int) -> Registers -> f Registers
Lens' Registers Int
regD
  {-# INLINE reg #-}

data Value = Int !Int | Reg !Register
  deriving Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show

rval :: (MonadState r m, HasRegisters r) => Value -> m Int
rval :: forall r (m :: * -> *).
(MonadState r m, HasRegisters r) =>
Value -> m Int
rval Value
v =
  case Value
v of
    Int Int
i -> Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
    Reg Register
r -> Getting Int r Int -> m Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Register -> Getting Int r Int
forall a (f :: * -> *).
(HasRegisters a, Functor f) =>
Register -> LensLike' f a Int
forall (f :: * -> *). Functor f => Register -> LensLike' f r Int
reg Register
r)
{-# INLINE rval #-}

pValue :: P Value
pValue :: P Value
pValue = Int -> Value
Int (Int -> Value) -> P Int -> P Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadS Int -> P Int
forall a. ReadS a -> P a
P ReadS Int
forall a. Read a => ReadS a
reads P Value -> P Value -> P Value
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Register -> Value
Reg (Register -> Value) -> P Register -> P Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Register
pReg

pReg :: P Register
pReg :: P Register
pReg = ReadS String -> P String
forall a. ReadS a -> P a
P ReadS String
lex P String -> (String -> P Register) -> P Register
forall a b. P a -> (a -> P b) -> P b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  String
"a" -> Register -> P Register
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
A
  String
"b" -> Register -> P Register
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
B
  String
"c" -> Register -> P Register
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
C
  String
"d" -> Register -> P Register
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
D
  String
_   -> P Register
forall a. P a
forall (f :: * -> *) a. Alternative f => f a
empty