Day 18, part 2 - now with record syntax!

18b.hs

@@ -7,31 +7,32 @@ import qualified Data.Vector.Unboxed as V (replicate)
 -- DEFINITIONS
 
 type Registers = Vector Int
-type Program = (Registers, Int, Seq Int)
 type Instruction = ProgramId -> State -> State
-data State = State Program Program (Bool, Bool) Int
 data Value = Register Char | Number Int
 data ProgramId = Zero | One
+data Program = Program {
+    registers :: Registers,
+    position  :: Int,
+    queue     :: Seq Int
+}
+data State = State {
+    zero  :: Program,
+    one   :: Program,
+    stop  :: (Bool, Bool),
+    count :: Int
+}
 
 -- HELPERS
-
-getPos  :: ProgramId -> State -> Int
-getPos Zero (State (_, pos, _) _ _ _) = pos
-getPos One  (State _ (_, pos, _) _ _) = pos
-
-getStop :: ProgramId -> State -> Bool
-getStop Zero (State _ _ (stop, _) _) = stop
-getStop One  (State _ _ (_, stop) _) = stop
-
 setStop :: ProgramId -> Bool -> State -> State
-setStop Zero b (State p0 p1 (_, stop1) count) = State p0 p1 (b, stop1) count
+setStop Zero b state = state { stop = (b, snd $ stop state) }
-setStop One  b (State p0 p1 (stop0, _) count) = State p0 p1 (stop0, b) count
+setStop One b state = swap . setStop Zero b . swap $ state
 
-pop :: Seq Int -> (Seq Int, Int)
+getProgram :: ProgramId -> State -> Program
-pop queue = (deleteAt 0 queue, queue `index` 0)
+getProgram Zero state = zero state
+getProgram One  state = one  state
 
 swap :: State -> State
-swap (State p0 p1 (stop0, stop1) count) = State p1 p0 (stop1, stop0) count
+swap (State p0 p1 (s0, s1) c) = State p1 p0 (s1, s0) c
 
 getIndex :: Value -> Int
 getIndex (Register c) = case c of
@@ -42,36 +43,50 @@ getIndex (Register c) = case c of
     'p' -> 4
 
 getValue :: Value -> Registers -> Int
-getValue value registers = case value of
+getValue v r = case v of
     Number i -> i
-    c -> registers ! (getIndex c)
+    c -> r ! (getIndex c)
 
 -- OPERATIONS
 
-sen :: Value -> ProgramId -> State -> State
+sen :: Value -> Instruction
-sen v Zero (State (reg0, pos0, que0) (reg1, pos1, que1) stop count) =
+sen v Zero (State p0 p1 s c) =
-    setStop One  False $ State (reg0, pos0 + 1, que0) (reg1, pos1, que1 |> getValue v reg0) stop count
+    State p0 { 
-sen v One  (State (reg0, pos0, que0) (reg1, pos1, que1) stop count) =
+        position = position p0 + 1 
-    setStop Zero False $ State (reg0, pos0, que0 |> getValue v reg1) (reg1, pos1 + 1, que1) stop (count + 1)
+    } p1 { 
+        queue = queue p1 |> getValue v (registers p0) 
+    } (fst s, False) c
+sen v One state = swap . sen v Zero . swap $ state { count = count state + 1 }
 
-rcv :: Value -> ProgramId -> State -> State
+rcv :: Value -> Instruction
-rcv i Zero (State (reg0, pos0, que0) p1 stop count) =
+rcv i Zero (State p0 p1 s c) =
-    if S.null que0 then setStop Zero True $ State (reg0, pos0, que0) p1 stop count else
+    if S.null $ queue p0 then State p0 p1 (True, snd s) c else
-    let ind = getIndex i
+    let (que, val) = pop $ queue p0
-        (que, val) = pop que0
+    in  State p0 {
-    in  State (reg0 // [(ind, val)], pos0 + 1, que) p1 stop count
+        registers = registers p0 // [(getIndex i, val)],
+        position  = position  p0 + 1,
+        queue     = que
+    } p1 s c
+    where pop q = (deleteAt 0 q, q `index` 0)
 rcv i One state = swap . rcv i Zero . swap $ state
 
-app :: (Int -> Int -> Int) -> Value -> Value -> ProgramId -> State -> State
+app :: (Int -> Int -> Int) -> Value -> Value -> Instruction
-app f i v Zero (State (reg0, pos0, que0) p1 stop count) = 
+app f i v Zero (State p0 p1 s c) = 
-    let ind = getIndex i
+    let reg = registers p0
-        val = getValue v reg0
+        ind = getIndex i
-    in  State (reg0 // [(ind, reg0 ! ind `f` val)], pos0 + 1, que0) p1 stop count
+        val = getValue v reg
+    in  State p0 {
+        registers = reg // [(ind, reg ! ind `f` val)],
+        position  = position p0 + 1
+    } p1 s c
 app f i v One state = swap . app f i v Zero . swap $ state
 
-jgz :: Value -> Value -> ProgramId -> State -> State
+jgz :: Value -> Value -> Instruction
-jgz condition offset Zero (State (reg0, pos0, que0) p1 stop count) =
+jgz condition offset Zero (State p0 p1 s c) =
-    State (reg0, pos0 + if getValue condition reg0 > 0 then getValue offset reg0 else 1, que0) p1 stop count
+    let reg = registers p0
+    in State p0 {
+        position = position p0 + if getValue condition reg > 0 then getValue offset reg else 1
+    } p1 s c
 jgz condition offset One state = swap . jgz condition offset Zero . swap $ state
 
 -- PARSE
@@ -95,19 +110,19 @@ parseLine str =
 
 executeNextInstruction :: Seq Instruction -> ProgramId -> State -> State
 executeNextInstruction instructions pid state =
-    let pos = getPos pid state
+    let pos = position . getProgram pid $ state
     in  if pos >= length instructions then setStop pid True state 
         else (instructions `index` pos) pid state
 
 getCount :: Seq Instruction -> State -> Int
-getCount _ (State _ _ (True, True) count) = count
+getCount _ (State _ _ (True, True) c) = c
 getCount instructions state =
-    if not $ getStop Zero state 
+    if not . fst . stop $ state 
     then getCount instructions $ executeNextInstruction instructions Zero state
     else getCount instructions $ executeNextInstruction instructions One  state
 
 main :: IO ()
 main = do
     instructions <- fmap (fromList . map parseLine . lines) $ readFile "18.txt"
-    let initialState = (State (V.replicate 5 0, 0, empty) (V.replicate 5 0 // [(4, 1)], 0, empty) (False, False) 0) :: State
+    let initialState = (State (Program (V.replicate 5 0) 0 empty) (Program (V.replicate 5 0 // [(4, 1)]) 0 empty) (False, False) 0)
     print $ getCount instructions initialState