{-# Language ImportQualifiedPost, TemplateHaskell, LambdaCase #-}
{-|
Module      : Main
Description : Day 23 solution
Copyright   : (c) Eric Mertens, 2021
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2016/day/23>

-}
module Main where

import Advent ( getInputLines )
import Advent.ReadS ( P(..), runP )
import AsmProg
import Control.Lens
import Control.Applicative (Alternative((<|>), empty))
import Control.Monad.Trans.State.Strict ( evalState, State )
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Vector (Vector)
import Data.Vector qualified as Vector

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

data Machine = Machine
  { Machine -> Registers
_machRegisters :: !Registers
  , Machine -> Vector Inst
_machProgram   :: !(Vector Inst)
  }

makeLenses '' Machine

instance HasRegisters Machine where
  reg :: forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Machine Int
reg Register
r = (Registers -> f Registers) -> Machine -> f Machine
Lens' Machine Registers
machRegisters ((Registers -> f Registers) -> Machine -> f Machine)
-> ((Int -> f Int) -> Registers -> f Registers)
-> (Int -> f Int)
-> Machine
-> f Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> (Int -> f Int) -> Registers -> f Registers
forall a (f :: * -> *).
(HasRegisters a, Functor f) =>
Register -> LensLike' f a Int
forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Registers Int
reg Register
r
  {-# INLINE reg #-}

-- | >>> :main
-- 13050
-- 479009610
main :: IO ()
IO ()
main =
  do Vector Inst
program <- [Inst] -> Vector Inst
forall a. [a] -> Vector a
Vector.fromList ([Inst] -> Vector Inst)
-> ([String] -> [Inst]) -> [String] -> Vector Inst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Inst) -> [String] -> [Inst]
forall a b. (a -> b) -> [a] -> [b]
map (P Inst -> String -> Inst
forall a. P a -> String -> a
runP P Inst
pInst) ([String] -> Vector Inst) -> IO [String] -> IO (Vector Inst)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> IO [String]
getInputLines Int
2016 Int
23
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Vector Inst -> Int -> Int
execute Vector Inst
program Int
7)
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Vector Inst -> Int -> Int
execute Vector Inst
program Int
12)

pInst :: P Inst
pInst :: P Inst
pInst = ReadS String -> P String
forall a. ReadS a -> P a
P ReadS String
lex P String -> (String -> P Inst) -> P Inst
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
"cpy" -> Value -> Register -> Inst
Copy (Value -> Register -> Inst) -> P Value -> P (Register -> Inst)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Value
pValue P (Register -> Inst) -> P Register -> P Inst
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Register
pReg
  String
"jnz" -> Value -> Value -> Inst
Jnz  (Value -> Value -> Inst) -> P Value -> P (Value -> Inst)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Value
pValue P (Value -> Inst) -> P Value -> P Inst
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Value
pValue
  String
"tgl" -> Value -> Inst
Tgl  (Value -> Inst) -> P Value -> P Inst
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Value
pValue
  String
"inc" -> Register -> Inst
Inc  (Register -> Inst) -> P Register -> P Inst
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Register
pReg
  String
"dec" -> Register -> Inst
Dec  (Register -> Inst) -> P Register -> P Inst
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Register
pReg
  String
_     -> P Inst
forall a. P a
forall (f :: * -> *) a. Alternative f => f a
empty

execute :: Vector Inst -> Int -> Int
execute :: Vector Inst -> Int -> Int
execute Vector Inst
program0 Int
a =
  State Machine Int -> Machine -> Int
forall s a. State s a -> s -> a
evalState State Machine Int
mainEntry (Registers -> Vector Inst -> Machine
Machine Registers
zeroRegisters Vector Inst
program0)
  where
    mainEntry :: State Machine Int
mainEntry =
      do Register -> LensLike' Identity Machine Int
forall a (f :: * -> *).
(HasRegisters a, Functor f) =>
Register -> LensLike' f a Int
forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Machine Int
reg Register
A LensLike' Identity Machine Int -> Int -> StateT Machine Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
a
         Int -> State Machine Int
goto Int
0

    step :: Int -> Inst -> State Machine Int
step Int
pc = \case
      Copy Value
i Register
o -> (Register -> LensLike' Identity Machine Int
forall a (f :: * -> *).
(HasRegisters a, Functor f) =>
Register -> LensLike' f a Int
forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Machine Int
reg Register
o LensLike' Identity Machine Int
-> State Machine Int -> StateT Machine Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> m b -> m ()
<~ Value -> State Machine Int
forall r (m :: * -> *).
(MonadState r m, HasRegisters r) =>
Value -> m Int
rval Value
i) StateT Machine Identity ()
-> State Machine Int -> State Machine Int
forall a b.
StateT Machine Identity a
-> StateT Machine Identity b -> StateT Machine Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> State Machine Int
goto (Int
pcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      Inc Register
r    -> (Register -> LensLike' Identity Machine Int
forall a (f :: * -> *).
(HasRegisters a, Functor f) =>
Register -> LensLike' f a Int
forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Machine Int
reg Register
r LensLike' Identity Machine Int -> Int -> StateT Machine Identity ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1)      StateT Machine Identity ()
-> State Machine Int -> State Machine Int
forall a b.
StateT Machine Identity a
-> StateT Machine Identity b -> StateT Machine Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> State Machine Int
goto (Int
pcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      Dec Register
r    -> (Register -> LensLike' Identity Machine Int
forall a (f :: * -> *).
(HasRegisters a, Functor f) =>
Register -> LensLike' f a Int
forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Machine Int
reg Register
r LensLike' Identity Machine Int -> Int -> StateT Machine Identity ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= Int
1)      StateT Machine Identity ()
-> State Machine Int -> State Machine Int
forall a b.
StateT Machine Identity a
-> StateT Machine Identity b -> StateT Machine Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> State Machine Int
goto (Int
pcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      Tgl Value
r    -> do Int
v <- Value -> State Machine Int
forall r (m :: * -> *).
(MonadState r m, HasRegisters r) =>
Value -> m Int
rval Value
r
                     Int -> StateT Machine Identity ()
toggle (Int
pcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
v)
                     Int -> State Machine Int
goto (Int
pcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      Jnz Value
i Value
o  -> do Int
v  <- Value -> State Machine Int
forall r (m :: * -> *).
(MonadState r m, HasRegisters r) =>
Value -> m Int
rval Value
i
                     Int
o' <- Value -> State Machine Int
forall r (m :: * -> *).
(MonadState r m, HasRegisters r) =>
Value -> m Int
rval Value
o
                     Int -> State Machine Int
goto (if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
pcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 else Int
pcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o')

    toggle :: Int -> State Machine ()
    toggle :: Int -> StateT Machine Identity ()
toggle Int
pc =
      (Vector Inst -> Identity (Vector Inst))
-> Machine -> Identity Machine
Lens' Machine (Vector Inst)
machProgram ((Vector Inst -> Identity (Vector Inst))
 -> Machine -> Identity Machine)
-> ((Inst -> Identity Inst)
    -> Vector Inst -> Identity (Vector Inst))
-> (Inst -> Identity Inst)
-> Machine
-> Identity Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Vector Inst)
-> Traversal' (Vector Inst) (IxValue (Vector Inst))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Vector Inst)
pc ((Inst -> Identity Inst) -> Machine -> Identity Machine)
-> (Inst -> Inst) -> StateT Machine Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \case
        Inc Register
x         -> Register -> Inst
Dec Register
x
        Dec Register
x         -> Register -> Inst
Inc Register
x
        Tgl   (Reg Register
x) -> Register -> Inst
Inc Register
x
        Jnz Value
x (Reg Register
y) -> Value -> Register -> Inst
Copy Value
x Register
y
        Copy Value
x Register
y      -> Value -> Value -> Inst
Jnz Value
x (Register -> Value
Reg Register
y)
        Inst
oper -> String -> Inst
forall a. HasCallStack => String -> a
error (String
"Nonsense toggle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
pc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Inst -> String
forall a. Show a => a -> String
show Inst
oper)

    goto :: Int -> State Machine Int
goto Int
pc =
     do Vector Inst
program <- Getting (Vector Inst) Machine (Vector Inst)
-> StateT Machine Identity (Vector Inst)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Vector Inst) Machine (Vector Inst)
Lens' Machine (Vector Inst)
machProgram
        case Vector Inst
program Vector Inst -> Int -> Maybe Inst
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
pc of
          Just Inst
o -> Int -> Inst -> State Machine Int
step Int
pc Inst
o
          Maybe Inst
Nothing -> Getting Int Machine Int -> State Machine Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Register -> Getting Int Machine Int
forall a (f :: * -> *).
(HasRegisters a, Functor f) =>
Register -> LensLike' f a Int
forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Machine Int
reg Register
A)