Day 18, part 2 - now with record syntax!

This commit is contained in:
Jonathan Chan 2017-12-18 21:58:37 -08:00
parent 022008fdd1
commit c13fd64788
1 changed files with 58 additions and 43 deletions

97
18b.hs
View File

@ -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
@ -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