Day 8 - Thinking ahead

A first glance at today's assignment meant that it was going to be fun. We are going to build our own CPU emulator. Last year on day 2 there was also a CPU emulator, which got extended and reused every other day starting from day 5. These assignments were very much fun to do and I had already hoped to see such an assignment again this year, and maybe even a series of assignments. If you also did join last year, let me know your thoughts on this, did you also liked it just like me?

Our computer for today has only three instructions, no memory, and only one accumulator register. The instructions are a 'nop', which does nothing and just goes to the next instruction. An 'acc' instruction, which changes the acc register, and finally a 'jmp' instruction which jumps a few instructions relative to the current instruction. We have to run the program until it gets into a loop. The output is the value of the acc register. The first step was parsing the input, which although I only learned to do yesterday went quite easy.

type Instruction = (String, Int)
format :: Parser Instruction
format = (,) <$> many letterChar <* " " <*> number <* eof

The implementation of the CPU emulator was also very straight forward and turned out quite nicely. Some duplication in the exit condition though.

solve input = go ([], 0, 0) (input !! 0) where
  go :: ([Int], Int, Int) -> Instruction -> Int
  go (hit, acc, ip) ("nop", param) | elem ip hit = acc
                                   | otherwise ((ip:hit), acc, ip + 1) (input !! (ip + 1))
  go (hit, acc, ip) ("acc", param) | elem ip hit = acc
                                   | otherwise ((ip:hit), acc+param, ip + 1) (input !! (ip + 1))
  go (hit, acc, ip) ("jmp", param) | elem ip hit = acc
                                   | otherwise ((ip:hit), acc, ip + param) (input !! (ip + param))

In part 2 we are going to change the input instructions a little, because of this the computer now can also result in a normal program terminationm which means the CPU runs out of instructions. We had to make a few changes and in the meanwhile got rid of the duplication.

solve input = go ([], 0, 0) where
  go :: ([Int], Int, Int) -> (Int, Bool)
  go (hit, acc, ip) | elem ip hit = (acc, True)
                    | ip >= (length input) = (acc, False)
                    | otherwise = go2 (hit, acc, ip) (input !! ip)
  go2 (hit, acc, ip) ("nop", param) = go ((ip:hit), acc, ip + 1)
  go2 (hit, acc, ip) ("acc", param) = go ((ip:hit), acc+param, ip + 1)
  go2 (hit, acc, ip) ("jmp", param) = go ((ip:hit), acc, ip + param)

We now exit with the acc register and a boolean to indicate a loop. With the new emulator, we have to change one instruction from a jmp to a nop or vice versa. We add another function to change the instructions list. And we have our solution for part 2.

changeInstruction :: [Instruction] -> Int -> [Instruction]
changeInstruction input ip = xs ++ [new] ++ ys where
  (xs,(old:ys)) = splitAt ip input
  new = c old
  c ("nop", param) = ("jmp", param)
  c ("jmp", param) = ("nop", param)
  c ins = ins

Today I was quite fast with my solution, and I was also quite content with the result of the code. But still I wanted to do a refactoring to make the CPU more generic in case we get more assignments in one of the following days. So I spend quite some time in extending this simple CPU into something more complex. I introduced types for the instructions. Extracted the instruction implementation, as well as the CPU state, registers. and the exit/running state. The code increased in code size from 32 to 61 lines, but I'm sure that if we get another assignment it will make me more flexible. Let me know if you like it, and if you also did something similar to your code for the next days? See you tomorrow or go back to Day 1 of the series.

data Param = Direct Int | Relative Int deriving (Show, Eq)
data Instruction = Nop Param | Acc Param | Jmp Param deriving (Show, Eq)
data RunState = Normal | Halt | Loop deriving (Show, Eq)
data Registers = Registers { acc :: Int} deriving (Show, Eq)
data State = State { usedIp :: [Int], regs :: Registers, ip :: Int, runState :: RunState} deriving (Show, Eq)

format, fNop, fAcc, fJmp  :: Parser Instruction
fNop = Nop . Direct <$ "nop " <*> number <* eof
fAcc = Acc . Direct <$ "acc " <*> number <* eof
fJmp = Jmp . Relative <$ "jmp " <*> number <* eof
format = fNop <|> fAcc <|> fJmp

process :: State -> Instruction -> State
process state (Nop (Direct param))   = changeIpBy 1 state
process state (Acc (Direct param))   = changeIpBy 1 (changeAccBy param state)
process state (Jmp (Relative param)) = changeIpBy param state

initState :: State
initState = State [] (Registers 0) 0 Normal

updateRunState :: RunState -> State -> State
updateRunState new (State usedIp (Registers acc) ip runState) = State usedIp (Registers acc) ip new
loop = updateRunState Loop
halt = updateRunState Halt

updateUsedIp :: Int -> State -> State
updateUsedIp added (State usedIp (Registers acc) ip runState) = State (added:usedIp) (Registers acc) ip runState

changeAccBy :: Int -> State -> State
changeAccBy new (State usedIp (Registers acc) ip runState) = State usedIp (Registers (acc + new)) ip runState

changeIpBy :: Int -> State -> State
changeIpBy diff (State usedIp regs ip runState) = State usedIp regs (ip + diff) runState

solve :: [Instruction] -> State
solve instructions = go initState where
  go :: State -> State
  go state@(State usedIp (Registers acc) ip' runState)
    | ip' `elem` usedIp = loop state
    | ip' >= length instructions = halt state
    | otherwise = go (updateUsedIp ip' (process state (instructions !! (ip state))))

solve1 = acc . regs . solve

changeInstruction :: [Instruction] -> Int -> [Instruction]
changeInstruction input ip = xs ++ [new] ++ ys where
  (xs,(instr:ys)) = splitAt ip input
  new = change instr
  change (Nop (Direct param)) = Jmp (Relative param)
  change (Jmp (Relative param)) = Nop (Direct param)
  change instr = instr

solve2 input = go 0 where
  go :: Int -> Int
  go cip = go' (runState state) where
     state = solve $ changeInstruction input cip
     go' Halt = (acc . regs) state
     go' Loop = go (cip + 1)