1 module Main(main) where
3 import Text.Parsec hiding (State)
4 import Text.ParserCombinators.Parsec.Number
5 import Control.Monad.State.Lazy
8 data Location = Literal Int | Register Char deriving (Show, Eq)
9 data Instruction = Cpy Location Location
12 | Jnz Location Location
16 data Machine = Machine { a :: Int
21 , instructions :: [Instruction]}
25 testInstructions = "cpy 2 a\n\
34 emptyMachine :: Machine
35 emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
39 text <- readFile "data/advent23.txt"
40 let instructions = successfulParse $ parseIfile text
45 part1 :: [Instruction] -> IO ()
47 do let m0 = emptyMachine {instructions=instrs, a = 7}
48 let mf = snd $ runState runMachine m0
51 part2 :: [Instruction] -> IO ()
53 do let m0 = emptyMachine {instructions=instrs, a = 12}
54 let mf = snd $ runState runMachine m0
58 runMachine :: State Machine ()
61 if (pc m) >= (length $ instructions m)
66 executeStep :: State Machine ()
69 let i = (instructions m)!!(pc m)
70 put (executeInstructionPeep i m)
71 -- put (executeInstruction i m)
73 executeInstructionPeep :: Instruction -> Machine -> Machine
74 executeInstructionPeep i m =
75 if sample1 == sample1Target
76 -- then trace ("Peeping 1 " ++ (show m) ++ " to " ++ (show m1)) m1
78 else if sample2 == sample2Target
79 -- then trace ("Peeping 2 " ++ (show m) ++ " to " ++ (show m2)) m2
81 else executeInstruction i m
82 where sample1 = take (length sample1Target) $ drop (pc m) $ instructions m
83 sample1Target = [ Cpy (Literal 0) (Register 'a')
84 , Cpy (Register 'b') (Register 'c')
87 , Jnz (Register 'c') (Literal (-2))
89 , Jnz (Register 'd') (Literal (-5)) ]
90 m1 = m {a = b m * d m, c = 0, d = 0, pc = pc m + (length sample1)}
91 sample2 = take (length sample2Target) $ drop (pc m) $ instructions m
92 sample2Target = [ Dec (Register 'b')
93 , Cpy (Register 'b') (Register 'c')
94 , Cpy (Register 'c') (Register 'd')
97 , Jnz (Register 'd') (Literal (-2)) ]
98 m2 = m {b = b m - 1, c = (b m - 1) * 2, d = 0, pc = pc m + (length sample2)}
101 executeInstruction :: Instruction -> Machine -> Machine
102 executeInstruction (Inc r@(Register _)) m = m' {pc=pc1}
103 where pc1 = (pc m) + 1
105 m' = writeValue m r (v+1)
106 executeInstruction (Inc (Literal _)) m = m {pc=pc1}
107 where pc1 = (pc m) + 1
108 executeInstruction (Dec r@(Register _)) m = m' {pc=pc1}
109 where pc1 = (pc m) + 1
111 m' = writeValue m r (v-1)
112 executeInstruction (Dec (Literal _)) m = m {pc=pc1}
113 where pc1 = (pc m) + 1
114 executeInstruction (Cpy s d@(Register _)) m = m' {pc=pc1}
115 where pc1 = (pc m) + 1
117 m' = writeValue m d v
118 executeInstruction (Cpy s (Literal _)) m = m {pc=pc1}
119 where pc1 = (pc m) + 1
120 executeInstruction (Jnz s d) m
121 | v == 0 = m {pc=pc1}
122 | otherwise = m {pc=pcj}
123 where pc1 = (pc m) + 1
127 executeInstruction (Tgl a) m
128 | v < (length $ instructions m) = m {instructions = (replace (instructions m) i' v),
130 | otherwise = m {pc=pc1}
132 v = evaluate m a + pc m
133 i = (instructions m)!!v
140 replace xs x i = take i xs ++ [x] ++ drop (i+1) xs
143 evaluate :: Machine -> Location -> Int
144 evaluate _ (Literal i) = i
145 evaluate m (Register r) =
152 writeValue :: Machine -> Location -> Int -> Machine
153 writeValue m (Literal i) _ = m
154 writeValue m (Register r) v =
162 instructionFile = instructionLine `sepEndBy` newline
163 -- instructionLine = choice [cpyL, incL, decL, jnzL]
164 instructionLine = incL <|> decL <|> cpyL <|> jnzL <|> tglL
166 -- incL = incify <$> (string "inc" *> spaces *> (oneOf "abcd"))
167 -- where incify r = Inc (Register r)
168 incL = (Inc . Register) <$> (string "inc" *> spaces *> (oneOf "abcd"))
169 -- decL = decify <$> (string "dec" *> spaces *> (oneOf "abcd"))
170 -- where decify r = Dec (Register r)
171 decL = (Dec . Register) <$> (string "dec" *> spaces *> (oneOf "abcd"))
172 cpyL = cpyify <$> (string "cpy" *> spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
173 <*> (spaces *> (oneOf "abcd"))
174 where cpyify s r = Cpy s (Register r)
175 jnzL = jnzify <$> (string "jnz" *> spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
176 <*> (spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
177 where jnzify r o = Jnz r o
178 tglL = Tgl <$> (string "tgl" *> spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
179 -- where tglify r = Tgl r
182 -- readLocation :: Int -> Location
183 -- readLocation l = Literal l
185 -- readLocation :: String -> Location
187 -- | all (isDigit) l = Literal (read l)
188 -- | otherwise = Register (head l)
190 parseIfile :: String -> Either ParseError [Instruction]
191 parseIfile input = parse instructionFile "(unknown)" input
193 parseIline :: String -> Either ParseError Instruction
194 parseIline input = parse instructionLine "(unknown)" input
196 successfulParse :: Either ParseError [a] -> [a]
197 successfulParse (Left _) = []
198 successfulParse (Right a) = a