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.