Haskell
Runs in 10 ms. I was stuck for most of the day on the bdv and cdv instructions, as I didn't read that the numerator was still register A. Once I got past that, it was pretty straight forward.
Code
import Control.Monad.State.Lazy
import Data.Bits (xor)
import Data.List (isSuffixOf)
import qualified Data.Vector as V
data Instr =
ADV Int | BXL Int | BST Int | JNZ Int | BXC | OUT Int | BDV Int | CDV Int
type Machine = (Int, Int, Int, Int, V.Vector Int)
parse :: String -> Machine
parse s =
let (la : lb : lc : _ : lp : _) = lines s
[a, b, c] = map (read . drop 12) [la, lb, lc]
p = V.fromList $ read $ ('[' :) $ (++ "]") $ drop 9 lp
in (a, b, c, 0, p)
getA, getB, getC, getIP :: State Machine Int
getA = gets $ \(a, _, _, _ , _) -> a
getB = gets $ \(_, b, _, _ , _) -> b
getC = gets $ \(_, _, c, _ , _) -> c
getIP = gets $ \(_, _, _, ip, _) -> ip
setA, setB, setC, setIP :: Int -> State Machine ()
setA a = modify $ \(_, b, c, ip, p) -> (a, b, c, ip, p)
setB b = modify $ \(a, _, c, ip, p) -> (a, b, c, ip, p)
setC c = modify $ \(a, b, _, ip, p) -> (a, b, c, ip, p)
setIP ip = modify $ \(a, b, c, _ , p) -> (a, b, c, ip, p)
incIP :: State Machine ()
incIP = getIP >>= (setIP . succ)
getMem :: State Machine (Maybe Int)
getMem = gets (\(_, _, _, ip, p) -> p V.!? ip) <* incIP
getCombo :: State Machine (Maybe Int)
getCombo = do
n <- getMem
case n of
Just 4 -> Just <$> getA
Just 5 -> Just <$> getB
Just 6 -> Just <$> getC
Just n | n <= 3 -> return $ Just n
_ -> return Nothing
getInstr :: State Machine (Maybe Instr)
getInstr = do
opcode <- getMem
case opcode of
Just 0 -> fmap ADV <$> getCombo
Just 1 -> fmap BXL <$> getMem
Just 2 -> fmap BST <$> getCombo
Just 3 -> fmap JNZ <$> getMem
Just 4 -> fmap (const BXC) <$> getMem
Just 5 -> fmap OUT <$> getCombo
Just 6 -> fmap BDV <$> getCombo
Just 7 -> fmap CDV <$> getCombo
_ -> return Nothing
execInstr :: Instr -> State Machine (Maybe Int)
execInstr (ADV n) = (getA >>= (setA . (`div` (2^n)))) *> return Nothing
execInstr (BDV n) = (getA >>= (setB . (`div` (2^n)))) *> return Nothing
execInstr (CDV n) = (getA >>= (setC . (`div` (2^n)))) *> return Nothing
execInstr (BXL n) = (getB >>= (setB . xor n)) *> return Nothing
execInstr (BST n) = setB (n `mod` 8) *> return Nothing
execInstr (JNZ n) = do
a <- getA
case a of
0 -> return ()
_ -> setIP n
return Nothing
execInstr BXC = ((xor <$> getB <*> getC) >>= setB) *> return Nothing
execInstr (OUT n) = return $ Just $ n `mod` 8
run :: State Machine [Int]
run = do
mInstr <- getInstr
case mInstr of
Nothing -> return []
Just instr -> do
mOut <- execInstr instr
case mOut of
Nothing -> run
Just n -> (n :) <$> run
solve2 :: Machine -> Int
solve2 machine@(_, _, _, _, p') = head [a | x <- [1 .. 7], a <- go [x]]
where
p = V.toList p'
go as =
let a = foldl ((+) . (* 8)) 0 as
in case evalState (setA a *> run) machine of
ns | ns == p -> [a]
| ns `isSuffixOf` p ->
concatMap go [as ++ [a] | a <- [0 .. 7]]
| otherwise -> []
main :: IO ()
main = do
machine@(_, _, _, _, p) <- parse <$> getContents
putStrLn $ init $ tail $ show $ evalState run machine
print $ solve2 machine