From a1256221e3193303591f7ce42bc55deda80a2155 Mon Sep 17 00:00:00 2001
From: Laura Orvokki Kursula <lav@vampires.gay>
Date: Tue, 17 Dec 2024 17:36:34 +0100
Subject: 17-1
---
17-1.hs | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 85 insertions(+)
create mode 100644 17-1.hs
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
--
cgit v1.2.3