advent12.hs

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