Day seventeen part one

day-17-haskell/src/Lib.hs

@@ -0,0 +1,100 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Lib where
+
+import Control.Monad (join)
+import Data.Bits (xor)
+import Data.Char (isNumber)
+import qualified Data.Map.Strict as Map
+import Flow
+import Text.ParserCombinators.ReadP
+
+type IntType = Int
+
+type Registers = Map.Map Char IntType
+data DebuggerInfo = DebuggerInfo { dRegs :: Registers, dInstructions :: [IntType] }
+
+task1 :: String -> IO IntType
+task1 input =
+  let di = readInput input
+  in do
+    outs <- tick 0 (dRegs di) di
+    print outs
+    outs |> map show |> join |> read |> return
+
+tick :: IntType -> Registers -> DebuggerInfo -> IO [IntType]
+tick pos regs di@DebuggerInfo { dInstructions } = do
+  print regs
+  case drop pos dInstructions of 
+    [] -> return []
+    (0:operand:_) ->
+      let result = (regs Map.! 'A') `div` (2 ^ comboValue operand)
+      in tick (pos+2) (Map.insert 'A' result regs) di
+    (1:operand:_) ->
+      let result = (regs Map.! 'B') `xor` operand
+      in tick (pos+2) (Map.insert 'B' result regs) di
+    (2:operand:_) ->
+      let result = comboValue operand `mod` 8
+      in tick (pos+2) (Map.insert 'B' result regs) di
+    (3:operand:_) ->
+      if regs Map.! 'A' == 0
+      then tick (pos+2) regs di
+      else tick operand regs di
+    (4:_:_) ->
+      let result = (regs Map.! 'B') `xor` (regs Map.! 'C')
+      in tick (pos+2) (Map.insert 'B' result regs) di
+    (5:operand:_) -> do
+      rest <- tick (pos+2) regs di
+      return $ (comboValue operand `mod` 8) : rest
+    (6:operand:_) ->
+      let result = (regs Map.! 'A') `div` (2 ^ comboValue operand)
+      in tick (pos+2) (Map.insert 'B' result regs) di
+    (7:operand:_) ->
+      let result = (regs Map.! 'A') `div` (2 ^ comboValue operand)
+      in tick (pos+2) (Map.insert 'C' result regs) di
+    (opcode) -> error $ "Illegal opcode (" ++ (show opcode) ++ ") at " ++ (show pos)
+
+  where
+    comboValue :: IntType -> IntType
+    comboValue 0 = 0
+    comboValue 1 = 1
+    comboValue 2 = 2
+    comboValue 3 = 3
+    comboValue 4 = regs Map.! 'A'
+    comboValue 5 = regs Map.! 'B'
+    comboValue 6 = regs Map.! 'C'
+    comboValue other = error $ "Illegal combo operand (" ++ (show other) ++ ") at " ++ (show pos)
+
+task2 :: String -> IO IntType
+task2 _ = return 2
+
+readInput :: String -> DebuggerInfo
+readInput input = case readP_to_S parseDebuggerInfo input of
+  [] -> error "Failed to parse input"
+  ((res,_):_) -> res
+
+parseDebuggerInfo :: ReadP DebuggerInfo
+parseDebuggerInfo = do
+  registers <- sepBy1 parseRegister (char '\n')
+  _ <- munch isNewLine
+  _ <- string "Program: "
+  instrs <- sepBy1 parseInt (char ',') 
+  _ <- munch isNewLine
+  _ <- eof
+  return DebuggerInfo { dRegs = Map.fromList registers, dInstructions = instrs }
+
+parseRegister :: ReadP (Char, IntType)
+parseRegister = do
+  _ <- string "Register "
+  name <- get
+  _ <- string ": "
+  initial <- parseInt
+  return (name, initial)
+
+parseInt :: ReadP IntType
+parseInt = do
+  digits <- munch1 isNumber
+  return $ read digits
+
+isNewLine :: Char -> Bool
+isNewLine = (==) '\n'