{-# Language ViewPatterns, QuasiQuotes, ImportQualifiedPost #-}
module Main (main) where
import Advent.Format (format)
import Advent.Queue (Queue((:<|)))
import Advent.Queue qualified as Queue
import Data.IntMap (IntMap)
import Data.IntMap qualified as IntMap
import Intcode (Effect(..), run, new)
main :: IO ()
IO ()
main =
do [Int]
inp <- [format|2019 23 %d&,%n|]
let events :: [Event]
events = Effect -> [Event]
startup (Machine -> Effect
run ([Int] -> Machine
new [Int]
inp))
Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int
y | Pkt Bool
_ (Packet Int
255 Int
_ Int
y) <- [Event]
events])
Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Eq a => [a] -> a
firstDup [Int
y | Pkt Bool
True (Packet Int
_ Int
_ Int
y) <- [Event]
events])
data Packet = Packet !Int !Int !Int
deriving Int -> Packet -> String -> String
[Packet] -> String -> String
Packet -> String
(Int -> Packet -> String -> String)
-> (Packet -> String)
-> ([Packet] -> String -> String)
-> Show Packet
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Packet -> String -> String
showsPrec :: Int -> Packet -> String -> String
$cshow :: Packet -> String
show :: Packet -> String
$cshowList :: [Packet] -> String -> String
showList :: [Packet] -> String -> String
Show
resume :: Int -> Int -> Effect -> ([Packet], Effect)
resume :: Int -> Int -> Effect -> ([Packet], Effect)
resume Int
x Int
y (Input (((Int -> Effect) -> Int -> Effect
forall a b. (a -> b) -> a -> b
$ Int
x) -> Input (((Int -> Effect) -> Int -> Effect
forall a b. (a -> b) -> a -> b
$ Int
y) -> Effect
e))) = Effect -> ([Packet], Effect)
gather Effect
e
resume Int
_ Int
_ Effect
_ = String -> ([Packet], Effect)
forall a. HasCallStack => String -> a
error String
"resume: machine out of sync"
gather :: Effect -> ([Packet], Effect)
gather :: Effect -> ([Packet], Effect)
gather (Output Int
d (Output Int
x (Output Int
y (Effect -> ([Packet], Effect)
gather -> ([Packet]
ps, Effect
e))))) = (Int -> Int -> Int -> Packet
Packet Int
d Int
x Int
y Packet -> [Packet] -> [Packet]
forall a. a -> [a] -> [a]
: [Packet]
ps, Effect
e)
gather Effect
e = Effect -> ([Packet], Effect)
forall a. a -> ([Packet], a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Effect
e
data Event = Pkt Bool Packet
deriving Int -> Event -> String -> String
[Event] -> String -> String
Event -> String
(Int -> Event -> String -> String)
-> (Event -> String) -> ([Event] -> String -> String) -> Show Event
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Event -> String -> String
showsPrec :: Int -> Event -> String -> String
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> String -> String
showList :: [Event] -> String -> String
Show
startup :: Effect -> [Event]
startup :: Effect -> [Event]
startup Effect
mach = Queue Packet -> Packet -> IntMap Effect -> [Event]
sim
([Packet] -> Queue Packet
forall a. [a] -> Queue a
Queue.fromList [Int -> Int -> Int -> Packet
Packet Int
i Int
i (-Int
1) | Int
i <- [Int
0..Int
49]])
(String -> Packet
forall a. HasCallStack => String -> a
error String
"no NAT packet")
([(Int, Effect)] -> IntMap Effect
forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int
i, Effect
mach) | Int
i <- [Int
0..Int
49]])
sim ::
Queue Packet ->
Packet ->
IntMap Effect ->
[Event]
sim :: Queue Packet -> Packet -> IntMap Effect -> [Event]
sim (Packet
p :<| Queue Packet
q) Packet
nat IntMap Effect
net = Bool -> Packet -> Event
Pkt Bool
False Packet
p Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
: Queue Packet -> Packet -> Packet -> IntMap Effect -> [Event]
deliver Queue Packet
q Packet
nat Packet
p IntMap Effect
net
sim Queue Packet
q Packet
nat IntMap Effect
net = Bool -> Packet -> Event
Pkt Bool
True Packet
nat Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
: Queue Packet -> Packet -> Packet -> IntMap Effect -> [Event]
deliver Queue Packet
q Packet
nat Packet
nat IntMap Effect
net
deliver :: Queue Packet -> Packet -> Packet -> IntMap Effect -> [Event]
deliver :: Queue Packet -> Packet -> Packet -> IntMap Effect -> [Event]
deliver Queue Packet
q Packet
nat (Packet Int
d Int
x Int
y) IntMap Effect
net
| Int
255 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d = Queue Packet -> Packet -> IntMap Effect -> [Event]
sim Queue Packet
q (Int -> Int -> Int -> Packet
Packet Int
0 Int
x Int
y) IntMap Effect
net
| ([Packet]
ps, IntMap Effect
net') <- Int
-> (Effect -> ([Packet], Effect))
-> IntMap Effect
-> ([Packet], IntMap Effect)
forall (f :: * -> *) a.
Applicative f =>
Int -> (a -> f a) -> IntMap a -> f (IntMap a)
updateF Int
d (Int -> Int -> Effect -> ([Packet], Effect)
resume Int
x Int
y) IntMap Effect
net = Queue Packet -> Packet -> IntMap Effect -> [Event]
sim (Queue Packet -> [Packet] -> Queue Packet
forall a. Queue a -> [a] -> Queue a
Queue.appendList Queue Packet
q [Packet]
ps) Packet
nat IntMap Effect
net'
updateF :: Applicative f => Int -> (a -> f a) -> IntMap a -> f (IntMap a)
updateF :: forall (f :: * -> *) a.
Applicative f =>
Int -> (a -> f a) -> IntMap a -> f (IntMap a)
updateF Int
i a -> f a
f = (Maybe a -> f (Maybe a)) -> Int -> IntMap a -> f (IntMap a)
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Int -> IntMap a -> f (IntMap a)
IntMap.alterF ((a -> f a) -> Maybe a -> f (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse a -> f a
f) Int
i
firstDup :: Eq a => [a] -> a
firstDup :: forall a. Eq a => [a] -> a
firstDup [a]
ys = [a] -> a
forall a. HasCallStack => [a] -> a
head [a
a | (a
a,a
b) <- [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ys ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
ys), a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
b]