1 module Main(main) where
3 import Text.Parsec hiding (State)
4 import Text.ParserCombinators.Parsec.Number
5 import Data.List (partition, union, intersect, tails)
6 import Data.Char (isDigit)
7 import Control.Monad.State.Lazy
9 data Location = Literal Int | Register Char deriving (Show)
10 data Instruction = Cpy Location Location |
16 data Machine = Machine { a :: Int
21 , instructions :: [Instruction]}
24 emptyMachine :: Machine
25 emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
29 text <- readFile "data/advent12.txt"
30 let instructions = successfulParse $ parseIfile text
35 part1 :: [Instruction] -> IO ()
37 do let m0 = emptyMachine {instructions=instrs}
38 let mf = snd $ runState runMachine m0
41 part2 :: [Instruction] -> IO ()
43 do let m0 = emptyMachine {instructions=instrs, c=1}
44 let mf = snd $ runState runMachine m0
49 runMachine :: State Machine ()
52 if (pc m) >= (length $ instructions m)
57 executeStep :: State Machine ()
60 let i = (instructions m)!!(pc m)
61 put (executeInstruction i m)
63 executeInstruction :: Instruction -> Machine -> Machine
64 executeInstruction (Inc (Register r)) m = m' {pc=pc1}
65 where pc1 = (pc m) + 1
66 v = evaluate m (Register r)
67 m' = writeValue m (Register r) (v+1)
68 executeInstruction (Dec (Register r)) m = m' {pc=pc1}
69 where pc1 = (pc m) + 1
70 v = evaluate m (Register r)
71 m' = writeValue m (Register r) (v-1)
72 executeInstruction (Cpy s d) m = m' {pc=pc1}
73 where pc1 = (pc m) + 1
76 executeInstruction (Jnz s d) m
78 | otherwise = m {pc=pcj}
79 where pc1 = (pc m) + 1
84 evaluate :: Machine -> Location -> Int
85 evaluate _ (Literal i) = i
86 evaluate m (Register r) =
93 writeValue :: Machine -> Location -> Int -> Machine
94 writeValue m (Literal i) _ = m
95 writeValue m (Register r) v =
103 instructionFile = instructionLine `endBy` newline
104 -- instructionLine = choice [cpyL, incL, decL, jnzL]
105 instructionLine = incL <|> decL <|> cpyL <|> jnzL
107 incL = incify <$> (string "inc" *> spaces *> (oneOf "abcd"))
108 where incify r = Inc (Register r)
109 decL = decify <$> (string "dec" *> spaces *> (oneOf "abcd"))
110 where decify r = Dec (Register r)
111 cpyL = cpyify <$> (string "cpy" *> spaces *> ((many1 letter) <|> (many1 digit)))
112 <*> (spaces *> (oneOf "abcd"))
113 where cpyify s r = Cpy (readLocation s) (Register r)
114 jnzL = jnzify <$> (string "jnz" *> spaces *> ((many1 letter) <|> (many1 digit)))
116 where jnzify r d = Jnz (readLocation r) d
119 readLocation :: String -> Location
121 | all (isDigit) l = Literal (read l)
122 | otherwise = Register (head l)
126 parseIfile :: String -> Either ParseError [Instruction]
127 parseIfile input = parse instructionFile "(unknown)" input
129 parseIline :: String -> Either ParseError Instruction
130 parseIline input = parse instructionLine "(unknown)" input
132 successfulParse :: Either ParseError [a] -> [a]
133 successfulParse (Left _) = []
134 successfulParse (Right a) = a