AoC presents us with another computer challenge. We conjure up some data types representing the console state as well as its instructions.
data Instruction = Acc Integer
| Jmp Integer
| Nop Integer
| Hlt
deriving (Show, Eq)
type Program = HashMap Integer Instruction
data Console =
Console
{ _acc :: Integer
, _pc :: Integer
, _prog :: Program
, _halted :: Bool
}
makeLenses ''Console
data Error = NoInst
| Reexecuted
deriving (Show, Eq, Enum, Bounded)
instance Read Instruction where
readPrec = lift $ do
ins <- choice [string "acc" >> pure Acc, string "jmp" >> pure Jmp, string "nop" >> pure Nop]
_ <- char ' '
sgn <- choice [char '+' >> pure id, char '-' >> pure negate]
arg <- read <$> munch1 isDigit
return $ ins (sgn arg)
toConsole :: [Instruction] -> Console
toConsole is = Console 0 0 (toProgram is) False
toProgram :: [Instruction] -> Program
toProgram = fromList . zip [0..] . (<>[Hlt])
The final piece of the puzzle is to interpret the instructions, which is fairly simple.
runWithHook :: (Has Console s, MonadState s m, MonadError Error m) => m () -> m ()
runWithHook hook = do
hook
cpc <- use $ hasLens . pc
mins <- preuse $ hasLens . prog . ix cpc
case mins of
Just ins -> do
case ins of
Acc i -> hasLens . acc += i >> hasLens . pc += 1
Jmp o -> hasLens . pc += o
Nop _ -> hasLens . pc += 1
Hlt -> hasLens . halted .= True
stop <- use $ hasLens . halted
unless stop (runWithHook hook)
Nothing -> throwError NoInst
run :: (Has Console s, MonadState s m, MonadError Error m) => m ()
run = runWithHook (pure ())
To check to see if a program repeats instructions, we introduce a hook that takes in some additional state and tracks the program counters visited.
repeatHook :: (Has Console s, Has (HashSet Integer) s, MonadState s m, MonadError Error m) => m ()
repeatHook = do
cpc <- use $ hasLens . pc
pcs <- use hasLens
if cpc `member` pcs then throwError Reexecuted
else hasLens .= pcs <> [cpc]
checkLoop :: Console -> (HashSet Integer, Console)
checkLoop = execState (runExceptT $ runWithHook repeatHook) . (mempty,)
The final code for part A is then
instance Solved 8 'PartA where
solve = show . view (_2 . acc) . checkLoop . toConsole . fmap read . lines
For part B, we need a function that gives us each possible transformation of the program.
progs :: [Instruction] -> [[Instruction]]
progs [] = []
progs (Jmp i:is) = (Nop i:is) : ((Jmp i:) <$> progs is)
progs (Nop i:is) = (Jmp i:is) : ((Nop i:) <$> progs is)
progs (i:is) = (i:) <$> progs is
Here progs returns a list of the programs with precisely one instruction edited. We either edit the first instruction
or we prepend the original instruction to the recursive modification which will change exactly one instruction. Solving
this part is now an exercise of checking if the program still loops and returning the accumulator of the first one that
does not. We also take advantage of the fact that the lack of conditional jumps implies that a single instruction
reexecution will result in an infinite loop.
instance Solved 8 'PartB where
solve = show . view acc . head . filter (view halted)
. fmap (view _2 . checkLoop . toConsole) . progs . fmap read . lines
Pretty neat, huh. Alternatively, we modify the entire hook process, passing the PC and instruction to the hook and giving the hook a function that will continue stepping with the updated state and an instruction to run.
type ConsoleHook s m = (Has Console s, MonadState s m, MonadError Error m)
=> (Integer -> Instruction -> (Instruction -> m ()) -> m ())
flipHook :: (Has (HashSet (Integer, Bool)) s, Has Bool s) => ConsoleHook s m
flipHook cpc inst continue = do
pcs <- use hasLens
modified <- use hasLens
when ((cpc, modified) `member` pcs) $ throwError Reexecuted
hasLens .= [(cpc, modified)] <> pcs
if not modified && modifiable inst then do
og <- get
hasLens .= [(cpc, True)] <> pcs
hasLens .= True
-- try to run the new program
-- if it fails, restore the state
continue (modify inst) `catchError` \_ -> do
npcs <- use $ hasLens @(HashSet (Integer, Bool))
put og
hasLens .= npcs
continue inst
else
continue inst
where modify (Jmp i) = Nop i
modify (Nop i) = Jmp i
modify i = i
modifiable (Jmp _) = True
modifiable (Nop _) = True
modifiable _ = False
checkFlip :: Console -> (Console, HashSet (Integer, Bool), Bool)
checkFlip = execState (runExceptT $ runWithHook flipHook) . (,mempty,False)
instance Solved 8 'PartB where
solve = show . view (_1 . acc) . checkFlip . toConsole . fmap read . lines
This runs roughly 10.5 times faster than the brute force solution. We can use the new set of seen instructions because the lack of conditional jumps means that whenever we reach a known state, which is uniquely determined by the PC and whether or not we have modified an instruction yet, we are guaranteed to loop.