Day 23, part 1

23.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE BangPatterns #-}
+import Text.Read (readMaybe)
+import Data.Char (ord)
+import Data.Sequence (Seq, fromList, index)
+import Data.Vector.Unboxed (Vector, (!), (//))
+import qualified Data.Vector.Unboxed as V (replicate)
+import Debug.Trace
+
+type Registers = Vector Int
+type Instruction = State -> State
+data Value = Register Char | Number Int
+data Operation = Set | Sub | Mul deriving Eq
+data Function = Function {
+    operation :: Operation,
+    function  :: Int -> Int -> Int
+}
+data State = State {
+    registers :: Registers,
+    position  :: Int,
+    countMul  :: Int
+}
+
+getIndex :: Value -> Int
+getIndex (Register c) = ord c - ord 'a'
+
+getValue :: Registers -> Value -> Int
+getValue r v = case v of
+    Number i -> i
+    c -> r ! (getIndex c)
+
+app :: Function -> Value -> Value -> Instruction
+app (Function op fn) index value state@(State reg pos cnt) =
+    let i = getIndex index
+    in  State {
+        registers = reg // [(i, reg ! i `fn` getValue reg value)],
+        position  = pos + 1,
+        countMul  = cnt + fromEnum (op == Mul)
+    }
+
+jnz :: Value -> Value -> Instruction
+jnz x y state@(State reg pos _) = 
+    state {
+        position = pos + if getValue reg x /= 0 then getValue reg y else 1
+    }
+
+parseLine :: String -> Instruction
+parseLine str =
+    let op : vs = words str
+    in  case op of
+        "set" -> app (Function Set (flip const)) (parseValue $ head vs) (parseValue $ last vs)
+        "sub" -> app (Function Sub (-))          (parseValue $ head vs) (parseValue $ last vs)
+        "mul" -> app (Function Mul (*))          (parseValue $ head vs) (parseValue $ last vs)
+        "jnz" -> jnz                             (parseValue $ head vs) (parseValue $ last vs)
+    where parseValue s = case readMaybe s of
+            Just i  -> Number i
+            Nothing -> Register $ head s
+
+runInstructions :: Seq Instruction -> State -> Int
+runInstructions instructions state@(State reg pos cnt) =
+    if pos >= length instructions then cnt else
+    let !nextState = instructions `index` pos $ state in runInstructions instructions nextState
+
+main :: IO ()
+main = do
+    instructions <- fromList . map parseLine . lines <$> readFile "23.txt"
+    print $ runInstructions instructions (State (V.replicate 8 0) 0 0)
+    print $ runInstructions instructions (State (V.replicate 8 0 // [(0, 1)]) 0 0)

23.txt

@@ -0,0 +1,32 @@
+set b 81
+set c b
+jnz a 2
+jnz 1 5
+mul b 100
+sub b -100000
+set c b
+sub c -17000
+set f 1
+set d 2
+set e 2
+set g d
+mul g e
+sub g b
+jnz g 2
+set f 0
+sub e -1
+set g e
+sub g b
+jnz g -8
+sub d -1
+set g d
+sub g b
+jnz g -13
+jnz f 2
+sub h -1
+set g b
+sub g c
+jnz g 2
+jnz 1 3
+sub b -17
+jnz 1 -23