1 import Data.Text (Text)
2 import qualified Data.Text as T
3 import qualified Data.Text.IO as TIO
5 import qualified Data.Map.Strict as M
6 import Data.Map.Strict ((!))
8 import Control.Monad (when, unless)
9 import Control.Monad.State.Lazy
10 import Control.Monad.Reader
11 import Control.Monad.Writer
13 import Control.Concurrent.Classy.Chan
18 type Messages = State (Chan Integer)
20 data Machine = Machine { registers :: M.Map Char Integer
22 , receivedMessages :: Messages
23 , sentMessages :: Message
27 data MachinePair = MachinePair { machine0 :: Machine
31 type ProgrammedMachine = WriterT [String] (ReaderT [Instruction] (State MachinePair)) ()
34 emptyMachine rq sq = Machine { registers = M.empty, pc = 0
35 , receivedMessages = rq
40 emptyMachinePair c01 c10 = MachinePair { machine0 = emptyMachine c10 c01 { registers = M.singleton 'p' 0 }
41 , machine1 = emptyMachine c01 c10 { registers = M.singleton 'p' 1 }
47 text <- TIO.readFile "data/advent18.txt"
48 let instrs = successfulParse text
49 let ((result, l), statef) = part2 instrs
52 part2 :: [Instruction] -> (((), [String]), Machine)
56 runWriterT executeInstructions
65 let mp = empytMachinePair p0p1 p1p0
70 executeInstructions :: ProgrammedMachinePair
74 when (pc m >= 0 && pc m < length instrs)
79 executeInstruction :: Bool -> ProgrammedMachinePair
83 let mq = messageQueue m
84 let instr = instrs!!(pc m)
85 let (ma', mq') = applyInstruction instr mq ma
86 let mb' = mb {messageQueue = mq'}
87 let mp' = if m0Active then mp {machine0 = ma', machine1 = mb'}
88 else mp {machine0 = mb', machine1 = ma'}
91 applyInstruction :: Instruction -> [Integer] -> Machine -> (Machine, [Integer])
93 applyInstruction (Snd a) other m = (m {pc = pc'}, other ++ [y])
97 applyInstruction (Set (Register a) b) other m = (m {registers = reg', pc = pc'}, other)
100 reg' = M.insert a y $ registers m
102 applyInstruction (Add (Register a) b) other m = (m {registers = reg', pc = pc'}, other)
104 x = evaluate m (Register a)
106 reg' = M.insert a (x + y) $ registers m
108 applyInstruction (Mul (Register a) b) other m = (m {registers = reg', pc = pc'}, other)
110 x = evaluate m (Register a)
112 reg' = M.insert a (x * y) $ registers m
114 applyInstruction (Mod (Register a) b) other m = (m {registers = reg', pc = pc'}, other)
116 x = evaluate m (Register a)
118 reg' = M.insert a (x `mod` y) $ registers m
120 applyInstruction (Rcv (Register a)) other m = ( m {registers = reg', messageQueue = mq', pc = pc'}, other)
122 reg' = M.insert a (head $ messageQueue m) $ registers m
123 mq' = tail $ messageQueue m
125 applyInstruction (Jgz a b) other m = (m {pc = pc'}, other)
126 where x = evaluate m a
128 pc' = if x > 0 then pc m + (fromIntegral y) else pc m + 1
130 evaluate :: Machine -> Location -> Integer
131 evaluate _ (Literal i) = i
132 evaluate m (Register r) = M.findWithDefault 0 r (registers m)
134 isReceive :: Instruction -> Bool
135 isReceive (Rcv _) = True
138 isSend :: Instruction -> Bool
139 isSend (Snd _) = True