I was wondering when we'd have a day of implementing a virtual machine, and day 17 was it.
Part 1: implementing the machine
This followed a very similar structure to the infamous IntCode machine of 2019. Interestingly, none of the instructions change the program, which allows me to separate the machine from the program.
The machine has four registers: A, B, C, and the instruction pointer (IP); it's a record. The memory, holding the program, is an IntMap
of Int
.
type Memory = M.IntMap Int
data Machine = Machine { regA :: Int
, regB :: Int
, regC :: Int
, ip :: Int
}
deriving (Show, Eq, Ord)
Parsing the input file is standard attoparsec, albeit with more brackets than I'd like.
fullMachineP = (,) <$> machineP <* endOfLine <*> memoryP
machineP = machineify <$> regP <*> regP <*> regP
where machineify a b c = Machine a b c 0
regP = ("Register " *> letter *> ": " *> decimal) <* endOfLine
memoryP = memify <$> ("Program: " *> (decimal `sepBy` ","))
where memify = M.fromList . zip [0..]
As I'm updating the state of the machine, I wrap the whole lot in a reader-writer-state (RWS) monad. The program is in the reader, the output is in the writer, and the machine is the state.
type MachineHandler = RWS Memory [Int] Machine
I then work from the bottom up, implementing features as I go.
The first couple of functions aren't part of the monad. First is the function that finds the combo value of an operand.
comboValue :: Int -> Machine -> Int
comboValue 4 machine = regA machine
comboValue 5 machine = regB machine
comboValue 6 machine = regC machine
comboValue n _ = n
Then there's the implementation of the operations, one clause per operation. Note that the output operation (5) doesn't do anything here.
perform :: Int -> Int -> Int -> Machine -> Machine
perform 0 operand i machine = machine { regA = machine.regA `div` denom , ip=i+2 }
where denom = 2 ^ (comboValue operand machine)
perform 1 operand i machine = machine { regB = machine.regB `xor` operand , ip=i+2 }
perform 2 operand i machine = machine { regB = b , ip=i+2 }
where b = (comboValue operand machine) `mod` 8
perform 3 operand i machine
| machine.regA == 0 = machine { ip=i+2 }
| otherwise = machine { ip = operand }
perform 4 _ i machine = machine { regB = machine.regB `xor` machine.regC , ip=i+2 }
perform 5 _ i machine = machine { ip=i+2 }
perform 6 operand i machine = machine { regB = machine.regA `div` denom , ip=i+2 }
where denom = 2 ^ (comboValue operand machine)
perform 7 operand i machine = machine { regC = machine.regA `div` denom , ip=i+2 }
where denom = 2 ^ (comboValue operand machine)
putOutput
is within the RWS monad and pushes the output to the writer.
putOutput :: Int -> Int -> MachineHandler ()
putOutput 5 operand =
do machine <- get
let v = comboValue operand machine
tell [v `mod` 8]
putOutput _ _ = return ()
Running the machine involves runAll
calling runStep
until the IP goes out of range. runStep
takes the relevant values out of the monad, calls perform
, then updates the machine.
runAll :: MachineHandler ()
runAll =
do mem <- ask
ip <- gets ip
if ip `M.notMember` mem then return () else runStep >> runAll
runStep :: MachineHandler ()
runStep =
do mem <- ask
i <- gets ip
let opcode = mem!i
let operand = mem!(i+1)
putOutput opcode operand
machine <- get
let machine' = perform opcode operand i machine
put machine'
And that's about it. I put the values into the RWS monad, run them, and return the output.
part1 :: Memory -> Machine -> [Int]
part1 program machine = snd $ runMachine program machine
runMachine :: Memory -> Machine -> (Machine, [Int])
runMachine memory machine = execRWS runAll memory machine
Part 2: reverse engineering
Part 2 was the sort of reverse engineering puzzle I really don't like. I know some people do, but I try to move through them as quickly as I can, taking what help I can get.
A quick look on the Reddit thread gave the trick: the least significant three bits of register A controlled the last element of the output. That meant I had to build up the register, one octet at a time, to give the desired output. That suggested a fold
over the program, building up the register value to give the desired partial output.
There was lots of poking at machines by hand in the GHCi repl while I explored what was going on. One thing that stumped me for a while was having the machine being incapable of generating the correct digit of the sixth position.
It turns out, my logic of always taking the lowest register value that generated the desired output digit was wrong; sometimes, that led to a dead end. If there were possible register values, I had to keep all of them live in case any of them led to the desired solution.
That kind of nondeterministic programming is a natural fit for the List monad, so that's what I did. The solving is still a fold
over the digits of the program, but maintains a list of possible values that will generate the result so far.
part2 :: Memory -> Machine -> Int
part2 program machine = minimum $ foldl' go [0] target
where
target = reverse $ M.elems program
go starts t =
do start <- starts
n <- [0..7]
let res = snd $ runModified program machine (start * 8 + n)
guard (head res == t)
return $ start * 8 + n
runModified :: Memory -> Machine -> Int -> (Machine, [Int])
runModified program machine n = runMachine program (machine { regA = n })
Code
You can get the code from my locally-hosted Git repo, or from Codeberg.