1 import Text.Parsec hiding (State)
2 import Text.ParserCombinators.Parsec.Number
3 import Control.Applicative ((<$), (<*), (*>), (<*>), liftA)
4 import Data.List (partition, union, intersect, tails)
5 import Data.Char (isDigit)
6 import Control.Monad.State.Lazy
8 data Location = Literal Int | Register Char deriving (Show)
9 data Instruction = Cpy Location Location |
15 data Machine = Machine { a :: Int
20 , instructions :: [Instruction]}
23 emptyMachine :: Machine
24 emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
28 text <- readFile "advent12.txt"
29 let instructions = successfulParse $ parseIfile text
34 part1 :: [Instruction] -> IO ()
36 do let m0 = emptyMachine {instructions=instrs}
37 let mf = snd $ runState runMachine m0
40 part2 :: [Instruction] -> IO ()
42 do let m0 = emptyMachine {instructions=instrs, c=1}
43 let mf = snd $ runState runMachine m0
48 runMachine :: State Machine ()
51 if (pc m) >= (length $ instructions m)
56 executeStep :: State Machine ()
59 let i = (instructions m)!!(pc m)
60 put (executeInstruction i m)
62 executeInstruction :: Instruction -> Machine -> Machine
63 executeInstruction (Inc (Register r)) m = m' {pc=pc1}
64 where pc1 = (pc m) + 1
65 v = evaluate m (Register r)
66 m' = writeValue m (Register r) (v+1)
67 executeInstruction (Dec (Register r)) m = m' {pc=pc1}
68 where pc1 = (pc m) + 1
69 v = evaluate m (Register r)
70 m' = writeValue m (Register r) (v-1)
71 executeInstruction (Cpy s d) m = m' {pc=pc1}
72 where pc1 = (pc m) + 1
75 executeInstruction (Jnz s d) m
77 | otherwise = m {pc=pcj}
78 where pc1 = (pc m) + 1
83 evaluate :: Machine -> Location -> Int
84 evaluate _ (Literal i) = i
85 evaluate m (Register r) =
92 writeValue :: Machine -> Location -> Int -> Machine
93 writeValue m (Literal i) _ = m
94 writeValue m (Register r) v =
102 instructionFile = instructionLine `endBy` newline
103 -- instructionLine = choice [cpyL, incL, decL, jnzL]
104 instructionLine = incL <|> decL <|> cpyL <|> jnzL
106 incL = incify <$> (string "inc" *> spaces *> (oneOf "abcd"))
107 where incify r = Inc (Register r)
108 decL = decify <$> (string "dec" *> spaces *> (oneOf "abcd"))
109 where decify r = Dec (Register r)
110 cpyL = cpyify <$> (string "cpy" *> spaces *> ((many1 letter) <|> (many1 digit)))
111 <*> (spaces *> (oneOf "abcd"))
112 where cpyify s r = Cpy (readLocation s) (Register r)
113 jnzL = jnzify <$> (string "jnz" *> spaces *> ((many1 letter) <|> (many1 digit)))
115 where jnzify r d = Jnz (readLocation r) d
118 readLocation :: String -> Location
120 | all (isDigit) l = Literal (read l)
121 | otherwise = Register (head l)
125 parseIfile :: String -> Either ParseError [Instruction]
126 parseIfile input = parse instructionFile "(unknown)" input
128 parseIline :: String -> Either ParseError Instruction
129 parseIline input = parse instructionLine "(unknown)" input
131 successfulParse :: Either ParseError [a] -> [a]
132 successfulParse (Left _) = []
133 successfulParse (Right a) = a