17-1

1 files changed, 85 insertions, 0 deletions

diff --git a/17-1.hs b/17-1.hs
new file mode 100644
index 0000000..9334faa
--- /dev/null
+++ b/17-1.hs
@@ -0,0 +1,85 @@
+import Control.Monad.Writer
+import Data.Bits (xor)
+import Data.Vector hiding ((++), drop, last, map, take)
+
+type Instruction = (Int,Int)
+
+data State = State { regA :: Int
+                   , regB :: Int
+                   , regC :: Int
+                   , ip   :: Int
+                   }
+
+type Op = State -> Int -> Writer [Int] State
+
+combo :: State -> Int -> Int
+combo (State a b c _) x | x <= 3 = x
+                        | x == 4 = a
+                        | x == 5 = b
+                        | x == 6 = c
+                        | otherwise = undefined
+
+adv :: Op
+adv s@(State a b c i) op = return $ State (a `div` 2 ^ combo s op) b c (i + 2)
+
+bdv :: Op
+bdv s@(State a _ c i) op = return $ State a (a `div` 2 ^ combo s op) c (i + 2)
+
+cdv :: Op
+cdv s@(State a b _ i) op = return $ State a b (a `div` 2 ^ combo s op) (i + 2)
+
+bxl :: Op
+bxl (State a b c i) op = return $ State a (xor b op) c (i + 2)
+
+bst :: Op
+bst s@(State a _ c i) op = return $ State a (combo s op `mod` 8) c (i + 2)
+
+jnz :: Op
+jnz (State a b c i) op | a == 0 = return $ State a b c (i + 2)
+                       | otherwise = return $ State a b c op
+
+bxc :: Op
+bxc (State a b c i) _ = return $ State a (xor b c) c (i + 2)
+
+out :: Op
+out s@(State a b c i) op = (tell . pure) (combo s op `mod` 8) >> return (State a b c (i + 2))
+
+opcode :: Int -> Op
+opcode 0 = adv
+opcode 1 = bxl
+opcode 2 = bst
+opcode 3 = jnz
+opcode 4 = bxc
+opcode 5 = out
+opcode 6 = bdv
+opcode 7 = cdv
+
+run :: Vector Instruction -> State -> Writer [Int] State
+run is s@(State _ _ _ i) =
+  let i' = ceiling $ fromIntegral i / 2
+  in case is !? i' of
+    Nothing    -> return s
+    Just (o,a) -> opcode o s a >>= run is
+
+parseState :: [String] -> State
+parseState ls = let a = read . drop 12 $ ls !! 0
+                    b = read . drop 12 $ ls !! 1
+                    c = read . drop 12 $ ls !! 2
+                in State a b c 0
+
+pairs :: [a] -> [(a,a)]
+pairs [] = []
+pairs (x:y:xs) = (x,y) : pairs xs
+
+parseProgram :: String -> Vector Instruction
+parseProgram s = fromList . pairs . read $ '[' : drop 9 s ++ "]"
+
+parse :: String -> (Vector Instruction, State)
+parse s = let ls = take 3 $ lines s
+              l  = last $ lines s
+          in (parseProgram l, parseState ls)
+
+main :: IO ()
+main = do
+  input <- getContents
+  print . execWriter . uncurry run $ parse input