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

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

-}
module Main where

import Advent (getInputLines)
import Advent.ReadS
import AsmProg
import Control.Applicative (Alternative((<|>), empty))
import Control.Lens ((^.), (&~), (+=), (-=), (.=), (<~))
import Data.Foldable (for_)
import Data.Vector (Vector)
import Data.Vector qualified as Vector

-- | >>> :main
-- 318077
-- 9227731
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
12
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Vector Inst -> Int -> Int
execute Vector Inst
program Int
0)
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Vector Inst -> Int -> Int
execute Vector Inst
program Int
1)

data Inst
  = Copy !Value !Register
  | Inc !Register
  | Dec !Register
  | Jnz !Value !Int
 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

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 -> Int -> Inst
Jnz  (Value -> Int -> Inst) -> P Value -> P (Int -> Inst)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Value
pValue P (Int -> Inst) -> P Int -> 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
<*> ReadS Int -> P Int
forall a. ReadS a -> P a
P ReadS Int
forall a. Read a => ReadS a
reads
  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
program Int
c = (Registers
zeroRegisters Registers -> State Registers () -> Registers
forall s a. s -> State s a -> s
&~ State Registers ()
entry) Registers -> Getting Int Registers Int -> Int
forall s a. s -> Getting a s a -> a
^. Register -> Getting Int Registers Int
forall a (f :: * -> *).
(HasRegisters a, Functor f) =>
Register -> LensLike' f a Int
forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Registers Int
reg Register
A
  where
    entry :: State Registers ()
entry =
     do Register -> LensLike' Identity Registers Int
forall a (f :: * -> *).
(HasRegisters a, Functor f) =>
Register -> LensLike' f a Int
forall (f :: * -> *).
Functor f =>
Register -> LensLike' f Registers Int
reg Register
C LensLike' Identity Registers Int -> Int -> State Registers ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
c
        Int -> State Registers ()
goto Int
0

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

    goto :: Int -> State Registers ()
goto Int
pc =
      Maybe Inst -> (Inst -> State Registers ()) -> State Registers ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Vector Inst
program Vector Inst -> Int -> Maybe Inst
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
pc) ((Inst -> State Registers ()) -> State Registers ())
-> (Inst -> State Registers ()) -> State Registers ()
forall a b. (a -> b) -> a -> b
$ \Inst
o ->
        do Int
offset <- Inst -> StateT Registers Identity Int
step Inst
o
           Int -> State Registers ()
goto (Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)