{-# Language QuasiQuotes, TemplateHaskell, BlockArguments #-}
{-|
Module      : Main
Description : Day 19 solution
Copyright   : (c) Eric Mertens, 2018
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2018/day/19>

I finished part 2 with manual inspection, this only implements part 1.

-}
module Main (main) where

import           Advent               (format, stageTH)
import           Data.Bits            ((.&.), (.|.))
import           Data.IntMap          (IntMap)
import qualified Data.IntMap.Strict          as IntMap
import           Data.Map             (Map)
import qualified Data.Map             as Map
import           Data.Vector          (Vector)
import qualified Data.Vector          as Vector

data C = Caddi | Caddr | Cmuli | Cmulr | Cseti | Csetr
       | Cbani | Cbanr | Cbori | Cborr
       | Cgtir | Cgtri | Cgtrr
       | Ceqir | Ceqri | Ceqrr
  deriving (C -> C -> Bool
(C -> C -> Bool) -> (C -> C -> Bool) -> Eq C
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: C -> C -> Bool
== :: C -> C -> Bool
$c/= :: C -> C -> Bool
/= :: C -> C -> Bool
Eq, Eq C
Eq C =>
(C -> C -> Ordering)
-> (C -> C -> Bool)
-> (C -> C -> Bool)
-> (C -> C -> Bool)
-> (C -> C -> Bool)
-> (C -> C -> C)
-> (C -> C -> C)
-> Ord C
C -> C -> Bool
C -> C -> Ordering
C -> C -> C
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: C -> C -> Ordering
compare :: C -> C -> Ordering
$c< :: C -> C -> Bool
< :: C -> C -> Bool
$c<= :: C -> C -> Bool
<= :: C -> C -> Bool
$c> :: C -> C -> Bool
> :: C -> C -> Bool
$c>= :: C -> C -> Bool
>= :: C -> C -> Bool
$cmax :: C -> C -> C
max :: C -> C -> C
$cmin :: C -> C -> C
min :: C -> C -> C
Ord, Int -> C -> ShowS
[C] -> ShowS
C -> String
(Int -> C -> ShowS) -> (C -> String) -> ([C] -> ShowS) -> Show C
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> C -> ShowS
showsPrec :: Int -> C -> ShowS
$cshow :: C -> String
show :: C -> String
$cshowList :: [C] -> ShowS
showList :: [C] -> ShowS
Show)

type Registers = IntMap Int

stageTH

-- | Print the answers to day 19
main :: IO ()
IO ()
main =
 do (Int
ip, [(C, Int, Int, Int)]
pgm) <- [format|2018 19 #ip %u%n(@C %u %u %u%n)*|]
    let regs :: IntMap Int
regs = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int
0,Int
0),(Int
1,Int
0),(Int
2,Int
0),(Int
3,Int
0),(Int
4,Int
0),(Int
5,Int
0)]
    Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> Vector (C, Int, Int, Int) -> IntMap Int -> IntMap Int
run Int
ip ([(C, Int, Int, Int)] -> Vector (C, Int, Int, Int)
forall a. [a] -> Vector a
Vector.fromList [(C, Int, Int, Int)]
pgm) IntMap Int
regs IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
IntMap.! Int
0)

-- | Given a program counter register and a program, run the program
-- until the instruction pointer points outside of the program. The
-- final state of the registers is returned.
run :: Int -> Vector (C, Int, Int, Int) -> Registers -> Registers
run :: Int -> Vector (C, Int, Int, Int) -> IntMap Int -> IntMap Int
run Int
ip Vector (C, Int, Int, Int)
pgm IntMap Int
regs =
  case Vector (C, Int, Int, Int)
pgm Vector (C, Int, Int, Int) -> Int -> Maybe (C, Int, Int, Int)
forall a. Vector a -> Int -> Maybe a
Vector.!? (IntMap Int
regs IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
IntMap.! Int
ip) of
    Maybe (C, Int, Int, Int)
Nothing -> IntMap Int
regs
    Just (C
o, Int
a, Int
b, Int
c)  -> Int -> Vector (C, Int, Int, Int) -> IntMap Int -> IntMap Int
run Int
ip Vector (C, Int, Int, Int)
pgm (IntMap Int -> IntMap Int
nextIP (C -> Int -> Int -> Int -> IntMap Int -> IntMap Int
opcodes C
o Int
a Int
b Int
c IntMap Int
regs))
  where
    nextIP :: IntMap Int -> IntMap Int
nextIP = (Int -> Maybe Int) -> Int -> IntMap Int -> IntMap Int
forall a. (a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.update (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Int -> Int) -> Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+)) Int
ip

-- | Map from opcode names to opcode semantics. The functions expect
-- the operands A, B, and C as well as the current registers.
opcodes :: C -> Int -> Int -> Int -> Registers -> Registers
opcodes :: C -> Int -> Int -> Int -> IntMap Int -> IntMap Int
opcodes C
o = ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> IntMap Int -> IntMap Int
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem \Int -> Int
reg Int
a Int
b ->
  case C
o of 
    C
Caddr -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
reg Int
b
    C
Caddi -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall {p}. p -> p
val Int
b

    C
Cmulr -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
reg Int
b
    C
Cmuli -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall {p}. p -> p
val Int
b

    C
Cbanr -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
reg Int
b
    C
Cbani -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall {p}. p -> p
val Int
b

    C
Cborr -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
reg Int
b
    C
Cbori -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
forall {p}. p -> p
val Int
b

    C
Csetr -> Int -> Int
reg Int
a
    C
Cseti -> Int -> Int
forall {p}. p -> p
val Int
a

    C
Cgtir -> if Int -> Int
forall {p}. p -> p
val Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
reg Int
b then Int
1 else Int
0
    C
Cgtri -> if Int -> Int
reg Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall {p}. p -> p
val Int
b then Int
1 else Int
0
    C
Cgtrr -> if Int -> Int
reg Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
reg Int
b then Int
1 else Int
0

    C
Ceqir -> if Int -> Int
forall {p}. p -> p
val Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
reg Int
b then Int
1 else Int
0
    C
Ceqri -> if Int -> Int
reg Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
forall {p}. p -> p
val Int
b then Int
1 else Int
0
    C
Ceqrr -> if Int -> Int
reg Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
reg Int
b then Int
1 else Int
0
  where
    sem :: ((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (Int -> a) -> t -> t -> a
f t
a t
b Int
c IntMap a
regs = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
c ((Int -> a) -> t -> t -> a
f (IntMap a
regs IntMap a -> Int -> a
forall a. IntMap a -> Int -> a
IntMap.!) t
a t
b) IntMap a
regs
    val :: p -> p
val p
v            = p
v