--- /dev/null
+module Main(main) where
+
+import Text.Parsec hiding (State)
+import Text.ParserCombinators.Parsec.Number
+import Control.Monad.State.Lazy
+-- import Debug.Trace
+
+data Location = Literal Int | Register Char deriving (Show, Eq)
+data Instruction = Cpy Location Location
+ | Inc Location
+ | Dec Location
+ | Jnz Location Location
+ | Tgl Location
+ deriving (Show, Eq)
+
+data Machine = Machine { a :: Int
+ , b :: Int
+ , c :: Int
+ , d :: Int
+ , pc :: Int
+ , instructions :: [Instruction]}
+ deriving (Show, Eq)
+
+
+testInstructions = "cpy 2 a\n\
+\tgl a\n\
+\tgl a\n\
+\tgl a\n\
+\cpy 1 a\n\
+\dec a\n\
+\dec a"
+
+
+emptyMachine :: Machine
+emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
+
+main :: IO ()
+main = do
+ text <- readFile "data/advent23.txt"
+ let instructions = successfulParse $ parseIfile text
+ part1 instructions
+ part2 instructions
+
+
+part1 :: [Instruction] -> IO ()
+part1 instrs =
+ do let m0 = emptyMachine {instructions=instrs, a = 7}
+ let mf = snd $ runState runMachine m0
+ print (a mf)
+
+part2 :: [Instruction] -> IO ()
+part2 instrs =
+ do let m0 = emptyMachine {instructions=instrs, a = 12}
+ let mf = snd $ runState runMachine m0
+ print (a mf)
+
+
+runMachine :: State Machine ()
+runMachine =
+ do m <- get
+ if (pc m) >= (length $ instructions m)
+ then return ()
+ else do executeStep
+ runMachine
+
+executeStep :: State Machine ()
+executeStep =
+ do m <- get
+ let i = (instructions m)!!(pc m)
+ put (executeInstructionPeep i m)
+ -- put (executeInstruction i m)
+
+executeInstructionPeep :: Instruction -> Machine -> Machine
+executeInstructionPeep i m =
+ if sample1 == sample1Target
+ -- then trace ("Peeping 1 " ++ (show m) ++ " to " ++ (show m1)) m1
+ then m1
+ else if sample2 == sample2Target
+ -- then trace ("Peeping 2 " ++ (show m) ++ " to " ++ (show m2)) m2
+ then m2
+ else executeInstruction i m
+ where sample1 = take (length sample1Target) $ drop (pc m) $ instructions m
+ sample1Target = [ Cpy (Literal 0) (Register 'a')
+ , Cpy (Register 'b') (Register 'c')
+ , Inc (Register 'a')
+ , Dec (Register 'c')
+ , Jnz (Register 'c') (Literal (-2))
+ , Dec (Register 'd')
+ , Jnz (Register 'd') (Literal (-5)) ]
+ m1 = m {a = b m * d m, c = 0, d = 0, pc = pc m + (length sample1)}
+ sample2 = take (length sample2Target) $ drop (pc m) $ instructions m
+ sample2Target = [ Dec (Register 'b')
+ , Cpy (Register 'b') (Register 'c')
+ , Cpy (Register 'c') (Register 'd')
+ , Dec (Register 'd')
+ , Inc (Register 'c')
+ , Jnz (Register 'd') (Literal (-2)) ]
+ m2 = m {b = b m - 1, c = (b m - 1) * 2, d = 0, pc = pc m + (length sample2)}
+
+
+executeInstruction :: Instruction -> Machine -> Machine
+executeInstruction (Inc r@(Register _)) m = m' {pc=pc1}
+ where pc1 = (pc m) + 1
+ v = evaluate m r
+ m' = writeValue m r (v+1)
+executeInstruction (Inc (Literal _)) m = m {pc=pc1}
+ where pc1 = (pc m) + 1
+executeInstruction (Dec r@(Register _)) m = m' {pc=pc1}
+ where pc1 = (pc m) + 1
+ v = evaluate m r
+ m' = writeValue m r (v-1)
+executeInstruction (Dec (Literal _)) m = m {pc=pc1}
+ where pc1 = (pc m) + 1
+executeInstruction (Cpy s d@(Register _)) m = m' {pc=pc1}
+ where pc1 = (pc m) + 1
+ v = evaluate m s
+ m' = writeValue m d v
+executeInstruction (Cpy s (Literal _)) m = m {pc=pc1}
+ where pc1 = (pc m) + 1
+executeInstruction (Jnz s d) m
+ | v == 0 = m {pc=pc1}
+ | otherwise = m {pc=pcj}
+ where pc1 = (pc m) + 1
+ ed = evaluate m d
+ pcj = (pc m) + ed
+ v = evaluate m s
+executeInstruction (Tgl a) m
+ | v < (length $ instructions m) = m {instructions = (replace (instructions m) i' v),
+ pc=pc1}
+ | otherwise = m {pc=pc1}
+ where pc1 = pc m + 1
+ v = evaluate m a + pc m
+ i = (instructions m)!!v
+ i' = case i of
+ Inc x -> Dec x
+ Dec x -> Inc x
+ Tgl x -> Inc x
+ Cpy x y -> Jnz x y
+ Jnz x y -> Cpy x y
+ replace xs x i = take i xs ++ [x] ++ drop (i+1) xs
+
+
+evaluate :: Machine -> Location -> Int
+evaluate _ (Literal i) = i
+evaluate m (Register r) =
+ case r of
+ 'a' -> (a m)
+ 'b' -> (b m)
+ 'c' -> (c m)
+ 'd' -> (d m)
+
+writeValue :: Machine -> Location -> Int -> Machine
+writeValue m (Literal i) _ = m
+writeValue m (Register r) v =
+ case r of
+ 'a' -> m {a=v}
+ 'b' -> m {b=v}
+ 'c' -> m {c=v}
+ 'd' -> m {d=v}
+
+
+instructionFile = instructionLine `sepEndBy` newline
+-- instructionLine = choice [cpyL, incL, decL, jnzL]
+instructionLine = incL <|> decL <|> cpyL <|> jnzL <|> tglL
+
+-- incL = incify <$> (string "inc" *> spaces *> (oneOf "abcd"))
+-- where incify r = Inc (Register r)
+incL = (Inc . Register) <$> (string "inc" *> spaces *> (oneOf "abcd"))
+-- decL = decify <$> (string "dec" *> spaces *> (oneOf "abcd"))
+-- where decify r = Dec (Register r)
+decL = (Dec . Register) <$> (string "dec" *> spaces *> (oneOf "abcd"))
+cpyL = cpyify <$> (string "cpy" *> spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
+ <*> (spaces *> (oneOf "abcd"))
+ where cpyify s r = Cpy s (Register r)
+jnzL = jnzify <$> (string "jnz" *> spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
+ <*> (spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
+ where jnzify r o = Jnz r o
+tglL = Tgl <$> (string "tgl" *> spaces *> ((Literal <$> int) <|> ((Register . head) <$> (many1 letter))))
+ -- where tglify r = Tgl r
+
+
+-- readLocation :: Int -> Location
+-- readLocation l = Literal l
+
+-- readLocation :: String -> Location
+-- readLocation l
+-- | all (isDigit) l = Literal (read l)
+-- | otherwise = Register (head l)
+
+parseIfile :: String -> Either ParseError [Instruction]
+parseIfile input = parse instructionFile "(unknown)" input
+
+parseIline :: String -> Either ParseError Instruction
+parseIline input = parse instructionLine "(unknown)" input
+
+successfulParse :: Either ParseError [a] -> [a]
+successfulParse (Left _) = []
+successfulParse (Right a) = a
\ No newline at end of file
projects / advent-of-code-16.git / blobdiff