07-interpreter/day07.hs

   1 module Main(main) where
   2
   3 import Text.Parsec hiding (State)
   4 import Text.ParserCombinators.Parsec.Number
   5 import Control.Monad.State.Lazy
   6 -- import Debug.Trace
   7
   8 type Register = Char
   9 type Location = Int
  10
  11 data Instruction =   Inc Register
  12                    | Dec Register
  13                    | Set Register Int
  14                    | Cpy Register Register
  15                    | Jmp Int
  16                    | Jpz Register Int
  17                    deriving (Show, Eq)
  18
  19 data Machine = Machine { a :: Int
  20                        , b :: Int
  21                        , c :: Int
  22                        , d :: Int
  23                        , pc :: Int
  24                        , instructions :: [Instruction]}
  25                deriving (Show, Eq)
  26
  27 -- testInstructions = "set c 0\n\
  28 -- \sto a 1"
  29
  30 testInstructions = "set c 0\n\
  31 \cpy a d\n\
  32 \jpz b 8\n\
  33 \dec b\n\
  34 \cpy d a\n\
  35 \jpz a 4\n\
  36 \inc c\n\
  37 \dec a\n\
  38 \jmp -3\n\
  39 \jmp -7\n\
  40 \cpy a d"
  41
  42 emptyMachine :: Machine
  43 emptyMachine = Machine {a=0, b=0, c=0, d=0, pc=0, instructions=[]}
  44
  45 main :: IO ()
  46 main = do
  47     text <- readFile "07-program.txt"
  48     let instructions = successfulParse $ parseIfile text
  49     part1 instructions
  50     part2 instructions
  51     -- let text = testInstructions
  52     -- let instrs = successfulParse $ parseIfile text
  53     -- let m0 = emptyMachine {instructions=instrs, a = 7, b = 3}
  54     -- let mf = snd $ runState runMachine m0
  55     -- print mf
  56
  57 part1 :: [Instruction] -> IO ()
  58 part1 instrs =
  59     do  let m0 = emptyMachine {instructions=instrs, a = 7}
  60         let mf = snd $ runState runMachine m0
  61         print (a mf)
  62
  63 part2 :: [Instruction] -> IO ()
  64 part2 instrs =
  65     do  let m0 = emptyMachine {instructions=instrs, a = 937}
  66         let mf = snd $ runState runMachine m0
  67         print (a mf)
  68
  69
  70 runMachine :: State Machine ()
  71 runMachine =
  72     do  m <- get
  73         if (pc m) >= (length $ instructions m)
  74             then return ()
  75             else do executeStep
  76                     runMachine
  77
  78 executeStep :: State Machine ()
  79 executeStep =
  80     do  m <- get
  81         let i = (instructions m)!!(pc m)
  82         put (executeInstruction i m)
  83
  84
  85 executeInstruction :: Instruction -> Machine -> Machine
  86 -- executeInstruction i m | trace (show i ++ " " ++ show m) False = undefined
  87 executeInstruction (Inc r) m = m' {pc=pc1}
  88     where pc1 = (pc m) + 1
  89           v = readRegister m r
  90           m' = writeRegister m r (v+1)
  91 executeInstruction (Dec r) m = m' {pc=pc1}
  92     where pc1 = (pc m) + 1
  93           v = readRegister m r
  94           m' = writeRegister m r (v-1)
  95 executeInstruction (Set r v) m = m' {pc=pc1}
  96     where pc1 = (pc m) + 1
  97           m' = writeRegister m r v
  98 executeInstruction (Cpy s d) m = m' {pc=pc1}
  99     where pc1 = (pc m) + 1
 100           v = readRegister m s
 101           m' = writeRegister m d v
 102 executeInstruction (Jmp d) m = m {pc=pcj}
 103     where pcj = (pc m) + d
 104 executeInstruction (Jpz r d) m
 105     | v == 0 = m {pc=pcj}
 106     | otherwise = m {pc=pc1}
 107     where pc1 = (pc m) + 1
 108           pcj = (pc m) + d
 109           v = readRegister m r
 110
 111
 112
 113 readRegister :: Machine -> Register -> Int
 114 readRegister m r =
 115      case r of
 116         'a' -> (a m)
 117         'b' -> (b m)
 118         'c' -> (c m)
 119         'd' -> (d m)
 120
 121 writeRegister :: Machine -> Register -> Int -> Machine
 122 writeRegister m r v =
 123     case r of
 124         'a' -> m {a=v}
 125         'b' -> m {b=v}
 126         'c' -> m {c=v}
 127         'd' -> m {d=v}
 128
 129
 130 instructionFile = instructionLine `sepEndBy` newline
 131 instructionLine = incL <|> decL <|> setL <|> cpyL <|> jmpL <|> jpzL
 132
 133 incL = Inc <$> (try (string "inc") *> spaces *> register)
 134 decL = Dec <$> (try (string "dec") *> spaces *> register)
 135 setL = Set <$> (try (string "set") *> spaces *> register) <*> (spaces *> location)
 136 cpyL = Cpy <$> (try (string "cpy") *> spaces *> register) <*> (spaces *> register)
 137 jmpL = Jmp <$> (try (string "jmp") *> spaces *> location)
 138 jpzL = Jpz <$> (try (string "jpz") *> spaces *> register) <*> (spaces *> location)
 139
 140 location = int
 141 register = oneOf "abcd"
 142
 143 parseIfile :: String -> Either ParseError [Instruction]
 144 parseIfile input = parse instructionFile "(unknown)" input
 145
 146 parseIline :: String -> Either ParseError Instruction
 147 parseIline input = parse instructionLine "(unknown)" input
 148
 149 successfulParse :: Either ParseError [a] -> [a]
 150 successfulParse (Left _) = []
 151 successfulParse (Right a) = a