From c13fd647884fc8b7737fe2e65dd7a52d2d09239a Mon Sep 17 00:00:00 2001 From: Jonathan Chan Date: Mon, 18 Dec 2017 21:58:37 -0800 Subject: [PATCH] Day 18, part 2 - now with record syntax! --- 18b.hs | 101 +++++++++++++++++++++++++++++++++------------------------ 1 file changed, 58 insertions(+), 43 deletions(-) diff --git a/18b.hs b/18b.hs index 601a67f..06693d1 100644 --- a/18b.hs +++ b/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 One b (State p0 p1 (stop0, _) count) = State p0 p1 (stop0, b) count +setStop Zero b state = state { stop = (b, snd $ stop state) } +setStop One b state = swap . setStop Zero b . swap $ state -pop :: Seq Int -> (Seq Int, Int) -pop queue = (deleteAt 0 queue, queue `index` 0) +getProgram :: ProgramId -> State -> Program +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 v Zero (State (reg0, pos0, que0) (reg1, pos1, que1) stop count) = - setStop One False $ State (reg0, pos0 + 1, que0) (reg1, pos1, que1 |> getValue v reg0) stop count -sen v One (State (reg0, pos0, que0) (reg1, pos1, que1) stop count) = - setStop Zero False $ State (reg0, pos0, que0 |> getValue v reg1) (reg1, pos1 + 1, que1) stop (count + 1) +sen :: Value -> Instruction +sen v Zero (State p0 p1 s c) = + State p0 { + position = position p0 + 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 i Zero (State (reg0, pos0, que0) p1 stop count) = - if S.null que0 then setStop Zero True $ State (reg0, pos0, que0) p1 stop count else - let ind = getIndex i - (que, val) = pop que0 - in State (reg0 // [(ind, val)], pos0 + 1, que) p1 stop count +rcv :: Value -> Instruction +rcv i Zero (State p0 p1 s c) = + if S.null $ queue p0 then State p0 p1 (True, snd s) c else + let (que, val) = pop $ queue p0 + in State p0 { + 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 f i v Zero (State (reg0, pos0, que0) p1 stop count) = - let ind = getIndex i - val = getValue v reg0 - in State (reg0 // [(ind, reg0 ! ind `f` val)], pos0 + 1, que0) p1 stop count +app :: (Int -> Int -> Int) -> Value -> Value -> Instruction +app f i v Zero (State p0 p1 s c) = + let reg = registers p0 + ind = getIndex i + 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 condition offset Zero (State (reg0, pos0, que0) p1 stop count) = - State (reg0, pos0 + if getValue condition reg0 > 0 then getValue offset reg0 else 1, que0) p1 stop count +jgz :: Value -> Value -> Instruction +jgz condition offset Zero (State p0 p1 s c) = + 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 @@ -80,12 +95,12 @@ parseLine :: String -> Instruction parseLine str = let op : vs = words str in case op of - "snd" -> sen $ parseValue $ head vs + "snd" -> sen $ parseValue $ head vs "set" -> app (flip const) (parseValue $ head vs) (parseValue $ last vs) "add" -> app (+) (parseValue $ head vs) (parseValue $ last vs) "mul" -> app (*) (parseValue $ head vs) (parseValue $ last vs) "mod" -> app mod (parseValue $ head vs) (parseValue $ last vs) - "rcv" -> rcv $ parseValue $ head vs + "rcv" -> rcv $ parseValue $ head vs "jgz" -> jgz (parseValue $ head vs) (parseValue $ last vs) where parseValue s = case readMaybe s of Just i -> Number i @@ -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 \ No newline at end of file