this repo has no description
1module Lib
2 ( howManyDidP1Send
3 ) where
4
5import qualified Data.Map.Strict as M
6
7type Registers = M.Map Char Int
8type RQITuple = (Int, [Int], Registers)
9
10howManyDidP1Send :: [String] -> Int
11howManyDidP1Send instructions = go 0 (0, [], M.singleton 'p' 0) (0, [], M.singleton 'p' 1)
12 where outOfBounds :: Int -> Bool
13 outOfBounds i = i < 0 || i >= length instructions
14
15 waiting :: RQITuple -> Bool
16 waiting (i, [], _) = (head $ words (instructions !! i)) == "rcv"
17 waiting (_, _, _) = False
18
19 doRcv :: RQITuple -> RQITuple
20 doRcv (i, [], r) = (i, [], r)
21 doRcv (i, q:qs, r) = doSet (getR (instructions !! i)) q (i, qs, r)
22
23 doJgz :: RQITuple -> RQITuple
24 doJgz (i, q, r) =
25 let v = getVorR 1 (instructions !! i) r
26 in if v <= 0 then (i + 1, q, r)
27 else let offset = getVorR 2 (instructions !! i) r
28 in (i + offset, q, r)
29
30 go :: Int -> RQITuple -> RQITuple -> Int
31 go p1count p1@(i1, q1, r1) p2@(i2, q2, r2)
32 -- p1 clear to proceed
33 | not (waiting p1) && not (outOfBounds i1) = case head $ words (instructions !! i1) of
34 "snd" -> let r = head $ words (instructions !! i1) !! 1
35 v = M.findWithDefault 0 r r1
36 in go p1count (i1 + 1, q1, r1) (i2, q2 ++ [v], r2)
37 "rcv" -> go p1count (doRcv p1) p2
38 "jgz" -> go p1count (doJgz p1) p2
39 _ -> let operation = parseOp (instructions !! i1)
40 in go p1count (operation p1) p2
41
42 -- p2 clear to proceed
43 | not (waiting p2) && not (outOfBounds i2) = case head $ words (instructions !! i2) of
44 "snd" -> let r = head $ words (instructions !! i2) !! 1
45 v = M.findWithDefault 0 r r2
46 in go (p1count + 1) (i1, q1 ++ [v], r1) (i2 + 1, q2, r2)
47 "rcv" -> go p1count p1 (doRcv p2)
48 "jgz" -> go p1count p1 (doJgz p2)
49 _ -> let operation = parseOp (instructions !! i2)
50 in go p1count p1 (operation p2)
51
52 | otherwise = p1count
53
54
55getR :: String -> Char
56getR i = head $ (words i) !! 1
57
58getVorR :: Int -> String -> Registers -> Int
59getVorR idx i registers =
60 let wrd = (words i) !! idx
61 in if (head wrd) `elem` ['a'..'z'] then M.findWithDefault 0 (head wrd) registers
62 else strToInt wrd
63
64parseOp :: String -> RQITuple -> RQITuple
65parseOp str p@(_, _, registers) = case head $ words str of
66 "set" -> doSet (getR str) (getVorR 2 str registers) p
67 "add" -> doOp (+) (getR str) (getVorR 2 str registers) p
68 "mul" -> doOp (*) (getR str) (getVorR 2 str registers) p
69 "mod" -> doOp mod (getR str) (getVorR 2 str registers) p
70 _ -> p
71
72doSet :: Char -> Int -> RQITuple -> RQITuple
73doSet r v (i, q, registers) =
74 if M.member r registers then (i + 1, q, M.adjust (\_ -> v) r registers)
75 else (i + 1, q, M.insert r v registers)
76
77doOp :: (Int -> Int -> Int) -> Char -> Int -> RQITuple -> RQITuple
78doOp op r v (i, q, registers) =
79 case M.lookup r registers of
80 Just _ -> (i + 1, q, M.adjust (\x -> op x v) r registers)
81 Nothing -> (i + 1, q, M.insert r (op 0 v) registers)
82
83strToInt :: String -> Int
84strToInt s = (read s :: Int)