adventofcode1612/app/advent12.hs

   1 module Main(main) where
   2
   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
   8
   9 data Location = Literal Int | Register Char deriving (Show)
  10 data Instruction = Cpy Location Location |
  11                    Inc Location |
  12                    Dec Location |
  13                    Jnz Location Int
  14                    deriving (Show)
  15
  16 data Machine = Machine { a :: Int
  17                        , b :: Int
  18                        , c :: Int
  19                        , d :: Int
  20                        , pc :: Int
  21                        , instructions :: [Instruction]}
  22                deriving (Show)
  23
  24 emptyMachine :: Machine
  25 emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
  26
  27 main :: IO ()
  28 main = do
  29     text <- readFile "data/advent12.txt"
  30     let instructions = successfulParse $ parseIfile text
  31     part1 instructions
  32     part2 instructions
  33
  34
  35 part1 :: [Instruction] -> IO ()
  36 part1 instrs =
  37     do  let m0 = emptyMachine {instructions=instrs}
  38         let mf = snd $ runState runMachine m0
  39         print (a mf)
  40
  41 part2 :: [Instruction] -> IO ()
  42 part2 instrs =
  43     do  let m0 = emptyMachine {instructions=instrs, c=1}
  44         let mf = snd $ runState runMachine m0
  45         print (a mf)
  46
  47
  48
  49 runMachine :: State Machine ()
  50 runMachine =
  51     do  m <- get
  52         if (pc m) >= (length $ instructions m)
  53             then return ()
  54             else do executeStep
  55                     runMachine
  56
  57 executeStep :: State Machine ()
  58 executeStep =
  59     do  m <- get
  60         let i = (instructions m)!!(pc m)
  61         put (executeInstruction i m)
  62
  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
  74           v = evaluate m s
  75           m' = writeValue m d v
  76 executeInstruction (Jnz s d) m
  77     | v == 0 = m {pc=pc1}
  78     | otherwise = m {pc=pcj}
  79     where pc1 = (pc m) + 1
  80           pcj = (pc m) + d
  81           v = evaluate m s
  82
  83
  84 evaluate :: Machine -> Location -> Int
  85 evaluate _ (Literal i) = i
  86 evaluate m (Register r) =
  87     case r of
  88         'a' -> (a m)
  89         'b' -> (b m)
  90         'c' -> (c m)
  91         'd' -> (d m)
  92
  93 writeValue :: Machine -> Location -> Int -> Machine
  94 writeValue m (Literal i) _ = m
  95 writeValue m (Register r) v =
  96     case r of
  97         'a' -> m {a=v}
  98         'b' -> m {b=v}
  99         'c' -> m {c=v}
 100         'd' -> m {d=v}
 101
 102
 103 instructionFile = instructionLine `endBy` newline
 104 -- instructionLine = choice [cpyL, incL, decL, jnzL]
 105 instructionLine = incL <|> decL <|> cpyL <|> jnzL
 106
 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)))
 115                   <*> (spaces *> int)
 116         where jnzify r d = Jnz (readLocation r) d
 117
 118
 119 readLocation :: String -> Location
 120 readLocation l
 121     | all (isDigit) l = Literal (read l)
 122     | otherwise = Register (head l)
 123
 124
 125
 126 parseIfile :: String -> Either ParseError [Instruction]
 127 parseIfile input = parse instructionFile "(unknown)" input
 128
 129 parseIline :: String -> Either ParseError Instruction
 130 parseIline input = parse instructionLine "(unknown)" input
 131
 132 successfulParse :: Either ParseError [a] -> [a]
 133 successfulParse (Left _) = []
 134 successfulParse (Right a) = a