this repo has no description
1module Lib
2 ( howManyMuls
3 ) where
4
5import qualified Data.Map.Strict as M
6
7type Registers = M.Map Char Int
8type RQITuple = (Int, [Int], Registers)
9
10initRegisters :: Registers
11initRegisters = M.fromList
12 [ ('a', 0)
13 , ('b', 0)
14 , ('c', 0)
15 , ('d', 0)
16 , ('e', 0)
17 , ('f', 0)
18 , ('g', 0)
19 , ('h', 0)
20 ]
21
22howManyMuls :: [String] -> Int
23howManyMuls instructions = go 0 (0, [], initRegisters)
24 where outOfBounds :: Int -> Bool
25 outOfBounds i = i < 0 || i >= length instructions
26
27 doJnz :: RQITuple -> RQITuple
28 doJnz (i, q, r) =
29 let v = getVorR 1 (instructions !! i) r
30 in if v == 0 then (i + 1, q, r)
31 else let offset = getVorR 2 (instructions !! i) r
32 in (i + offset, q, r)
33
34 go :: Int -> RQITuple -> Int
35 go mulCount p@(i, _, _)
36 -- p1 clear to proceed
37 | not (outOfBounds i) = case head $ words (instructions !! i) of
38 "jnz" -> go mulCount (doJnz p)
39 _ -> let operation = parseOp (instructions !! i)
40 isMul = (head $ words (instructions !! i)) == "mul"
41 in go (if isMul then mulCount + 1 else mulCount) (operation p)
42 | otherwise = mulCount
43
44
45getR :: String -> Char
46getR i = head $ (words i) !! 1
47
48getVorR :: Int -> String -> Registers -> Int
49getVorR idx i registers =
50 let wrd = (words i) !! idx
51 in if (head wrd) `elem` ['a'..'z'] then M.findWithDefault 0 (head wrd) registers
52 else strToInt wrd
53
54parseOp :: String -> RQITuple -> RQITuple
55parseOp str p@(_, _, registers) = case head $ words str of
56 "set" -> doSet (getR str) (getVorR 2 str registers) p
57 "sub" -> doOp (-) (getR str) (getVorR 2 str registers) p
58 "mul" -> doOp (*) (getR str) (getVorR 2 str registers) p
59 _ -> p
60
61doSet :: Char -> Int -> RQITuple -> RQITuple
62doSet r v (i, q, registers) =
63 if M.member r registers then (i + 1, q, M.adjust (\_ -> v) r registers)
64 else (i + 1, q, M.insert r v registers)
65
66doOp :: (Int -> Int -> Int) -> Char -> Int -> RQITuple -> RQITuple
67doOp op r v (i, q, registers) =
68 case M.lookup r registers of
69 Just _ -> (i + 1, q, M.adjust (\x -> op x v) r registers)
70 Nothing -> (i + 1, q, M.insert r (op 0 v) registers)
71
72strToInt :: String -> Int
73strToInt s = (read s :: Int)