1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
import Control.Monad.Writer
import Data.Bits (xor)
import Data.Vector hiding ((++), drop, last, map, take)
type Instruction = (Int,Int)
data State = State { regA :: Int
, regB :: Int
, regC :: Int
, ip :: Int
}
type Op = State -> Int -> Writer [Int] State
combo :: State -> Int -> Int
combo (State a b c _) x | x <= 3 = x
| x == 4 = a
| x == 5 = b
| x == 6 = c
| otherwise = undefined
adv :: Op
adv s@(State a b c i) op = return $ State (a `div` 2 ^ combo s op) b c (i + 2)
bdv :: Op
bdv s@(State a _ c i) op = return $ State a (a `div` 2 ^ combo s op) c (i + 2)
cdv :: Op
cdv s@(State a b _ i) op = return $ State a b (a `div` 2 ^ combo s op) (i + 2)
bxl :: Op
bxl (State a b c i) op = return $ State a (xor b op) c (i + 2)
bst :: Op
bst s@(State a _ c i) op = return $ State a (combo s op `mod` 8) c (i + 2)
jnz :: Op
jnz (State a b c i) op | a == 0 = return $ State a b c (i + 2)
| otherwise = return $ State a b c op
bxc :: Op
bxc (State a b c i) _ = return $ State a (xor b c) c (i + 2)
out :: Op
out s@(State a b c i) op = (tell . pure) (combo s op `mod` 8) >> return (State a b c (i + 2))
opcode :: Int -> Op
opcode 0 = adv
opcode 1 = bxl
opcode 2 = bst
opcode 3 = jnz
opcode 4 = bxc
opcode 5 = out
opcode 6 = bdv
opcode 7 = cdv
run :: Vector Instruction -> State -> Writer [Int] State
run is s@(State _ _ _ i) =
let i' = ceiling $ fromIntegral i / 2
in case is !? i' of
Nothing -> return s
Just (o,a) -> opcode o s a >>= run is
parseState :: [String] -> State
parseState ls = let a = read . drop 12 $ ls !! 0
b = read . drop 12 $ ls !! 1
c = read . drop 12 $ ls !! 2
in State a b c 0
pairs :: [a] -> [(a,a)]
pairs [] = []
pairs (x:y:xs) = (x,y) : pairs xs
parseProgram :: String -> Vector Instruction
parseProgram s = fromList . pairs . read $ '[' : drop 9 s ++ "]"
parse :: String -> (Vector Instruction, State)
parse s = let ls = take 3 $ lines s
l = last $ lines s
in (parseProgram l, parseState ls)
main :: IO ()
main = do
input <- getContents
print . execWriter . uncurry run $ parse input
|
