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]}
24 testInstructions = "cpy 2 a\n\
32 emptyMachine :: Machine
33 emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
37 text <- readFile "data/advent23.txt"
38 let instructions = successfulParse $ parseIfile text
43 part1 :: [Instruction] -> IO ()
45 do let m0 = emptyMachine {instructions=instrs, a = 7}
46 let mf = snd $ runState runMachine m0
49 part2 :: [Instruction] -> IO ()
51 do let m0 = emptyMachine {instructions=instrs, a = 12}
52 let mf = snd $ runState runMachine m0
56 runMachine :: State Machine ()
59 if (pc m) >= (length $ instructions m)
64 executeStep :: State Machine ()
67 let i = (instructions m)!!(pc m)
68 put (executeInstructionPeep i m)
69 -- put (executeInstruction i m)
71 executeInstructionPeep :: Instruction -> Machine -> Machine
72 executeInstructionPeep i m =
73 if sample1 == sample1Target
74 -- then trace ("Peeping 1 " ++ (show m) ++ " to " ++ (show m1)) m1
76 else if sample2 == sample2Target
77 -- then trace ("Peeping 2 " ++ (show m) ++ " to " ++ (show m2)) m2
79 else executeInstruction i m
80 where sample1 = take (length sample1Target) $ drop (pc m) $ instructions m
81 sample1Target = [ Cpy (Literal 0) (Register 'a')
82 , Cpy (Register 'b') (Register 'c')
85 , Jnz (Register 'c') (Literal (-2))
87 , Jnz (Register 'd') (Literal (-5)) ]
88 m1 = m {a = b m * d m, c = 0, d = 0, pc = pc m + (length sample1)}
89 sample2 = take (length sample2Target) $ drop (pc m) $ instructions m
90 sample2Target = [ Dec (Register 'b')
91 , Cpy (Register 'b') (Register 'c')
92 , Cpy (Register 'c') (Register 'd')
95 , Jnz (Register 'd') (Literal (-2)) ]
96 m2 = m {b = b m - 1, c = (b m - 1) * 2, d = 0, pc = pc m + (length sample2)}
99 executeInstruction :: Instruction -> Machine -> Machine
100 executeInstruction (Inc r@(Register _)) m = m' {pc=pc1}
101 where pc1 = (pc m) + 1
103 m' = writeValue m r (v+1)
104 executeInstruction (Inc (Literal _)) m = m {pc=pc1}
105 where pc1 = (pc m) + 1
106 executeInstruction (Dec r@(Register _)) m = m' {pc=pc1}
107 where pc1 = (pc m) + 1
109 m' = writeValue m r (v-1)
110 executeInstruction (Dec (Literal _)) m = m {pc=pc1}
111 where pc1 = (pc m) + 1
112 executeInstruction (Cpy s d@(Register _)) m = m' {pc=pc1}
113 where pc1 = (pc m) + 1
115 m' = writeValue m d v
116 executeInstruction (Cpy s (Literal _)) m = m {pc=pc1}
117 where pc1 = (pc m) + 1
118 executeInstruction (Jnz s d) m
119 | v == 0 = m {pc=pc1}
120 | otherwise = m {pc=pcj}
121 where pc1 = (pc m) + 1
125 executeInstruction (Tgl a) m
126 | v < (length $ instructions m) = m {instructions = (replace (instructions m) i' v),
128 | otherwise = m {pc=pc1}
130 v = evaluate m a + pc m
131 i = (instructions m)!!v
138 replace xs x i = take i xs ++ [x] ++ drop (i+1) xs
141 evaluate :: Machine -> Location -> Int
142 evaluate _ (Literal i) = i
143 evaluate m (Register r) =
150 writeValue :: Machine -> Location -> Int -> Machine
151 writeValue m (Literal i) _ = m
152 writeValue m (Register r) v =
160 instructionFile = instructionLine `sepEndBy` newline
161 instructionLine = incL <|> decL <|> cpyL <|> jnzL <|> tglL
163 incL = Inc <$> (string "inc" *> spaces *> register)
164 decL = Dec <$> (string "dec" *> spaces *> register)
165 cpyL = Cpy <$> (string "cpy" *> spaces *> location) <*> (spaces *> register)
166 jnzL = Jnz <$> (string "jnz" *> spaces *> location) <*> (spaces *> location)
167 tglL = Tgl <$> (string "tgl" *> spaces *> location)
169 location = (Literal <$> int) <|> register
170 register = Register <$> (oneOf "abcd")
172 parseIfile :: String -> Either ParseError [Instruction]
173 parseIfile input = parse instructionFile "(unknown)" input
175 parseIline :: String -> Either ParseError Instruction
176 parseIline input = parse instructionLine "(unknown)" input
178 successfulParse :: Either ParseError [a] -> [a]
179 successfulParse (Left _) = []
180 successfulParse (Right a) = a