1 {-# LANGUAGE NegativeLiterals #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE TypeFamilies #-}
6 import Data.Text (Text)
7 import qualified Data.Text as T
8 import qualified Data.Text.IO as TIO
10 import qualified Data.Map.Strict as M
11 import Data.Map.Strict ((!))
13 import Control.Monad (when)
14 import Control.Monad.State.Lazy
15 import Control.Monad.Reader
16 import Control.Monad.Writer
20 data Machine = Machine { registers :: M.Map Char Integer
21 , lastSound :: Integer
26 type ProgrammedMachine = WriterT [Integer] (ReaderT [Instruction] (State Machine)) ()
28 emptyMachine = Machine {registers = M.empty, lastSound = 0, pc = 0}
32 text <- TIO.readFile "data/advent18.txt"
33 let instrs = successfulParse text
34 let ((result, l), machinef) = part1 instrs
37 part1 :: [Instruction] -> (((), [Integer]), Machine)
41 runWriterT executeInstructions
47 executeInstructions :: ProgrammedMachine
51 when (pc m >= 0 && pc m < length instrs)
53 do let rt = recoverTriggers instrs m
55 then tell [lastSound m]
56 else do executeInstruction
59 executeInstruction :: ProgrammedMachine
63 let instr = instrs!!(pc m)
64 put (applyInstruction instr m)
67 isRecover :: Instruction -> Bool
68 isRecover (Rcv _) = True
72 recoverTriggers :: [Instruction] -> Machine -> Bool
73 recoverTriggers instrs m =
77 where instr = instrs!!(pc m)
82 applyInstruction :: Instruction -> Machine -> Machine
84 applyInstruction (Snd sound) m = m {lastSound = freq, pc = pc'}
86 freq = evaluate m sound
88 applyInstruction (Set (Register a) b) m = m {registers = reg', pc = pc'}
91 reg' = M.insert a y $ registers m
93 applyInstruction (Add (Register a) b) m = m {registers = reg', pc = pc'}
95 x = evaluate m (Register a)
97 reg' = M.insert a (x + y) $ registers m
99 applyInstruction (Mul (Register a) b) m = m {registers = reg', pc = pc'}
101 x = evaluate m (Register a)
103 reg' = M.insert a (x * y) $ registers m
105 applyInstruction (Mod (Register a) b) m = m {registers = reg', pc = pc'}
107 x = evaluate m (Register a)
109 reg' = M.insert a (x `mod` y) $ registers m
111 applyInstruction (Rcv _a) m = m {pc = pc'}
114 applyInstruction (Jgz a b) m = m {pc = pc'}
115 where x = evaluate m a
117 pc' = if x > 0 then pc m + (fromIntegral y) else pc m + 1
120 evaluate :: Machine -> Location -> Integer
121 evaluate _ (Literal i) = i
122 evaluate m (Register r) = M.findWithDefault 0 r (registers m)