From 1c971d7bbe17e716cfd58d0ae19a348142fb299c Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Tue, 8 Dec 2020 21:48:08 +0100
Subject: Day 8

---
 2020/8.hs     |  35 ++++
 2020/8.in     | 611 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2020/Asm.hs   |  78 ++++++++
 2020/Makefile |   6 +-
 2020/hie.yaml |   2 +-
 5 files changed, 728 insertions(+), 4 deletions(-)
 create mode 100644 2020/8.hs
 create mode 100644 2020/8.in
 create mode 100644 2020/Asm.hs

diff --git a/2020/8.hs b/2020/8.hs
new file mode 100644
index 0000000..bc90351
--- /dev/null
+++ b/2020/8.hs
@@ -0,0 +1,35 @@
+module Main where
+
+import Data.Maybe (catMaybes)
+import qualified Data.Set as Set
+
+import Asm
+import Input
+
+
+main :: IO ()
+main = do
+    input <- getInput 8
+    let prog = programFrom (map parseIns input)
+
+    let nodupPredicate set state
+          | sIP state `Set.member` set = (set, True)
+          | sIP state == programLength prog = (set, True)
+          | otherwise = (Set.insert (sIP state) set, False)
+
+    print (sAcc (evalUntil nodupPredicate prog mempty initState))
+
+    let overriders = catMaybes
+            [case programGet prog i of
+               NOP a -> Just $ \j -> if j == i then Just (JMP a) else Nothing
+               JMP a -> Just $ \j -> if j == i then Just (NOP a) else Nothing
+               _     -> Nothing
+            | i <- [0 .. programLength prog - 1]]
+
+        results =
+            [state
+            | ovr <- overriders
+            , let state = evalUntil nodupPredicate (prog `withOverrider` ovr) mempty initState
+            , sIP state == programLength prog]
+
+    print (sAcc (head results))
diff --git a/2020/8.in b/2020/8.in
new file mode 100644
index 0000000..48bff35
--- /dev/null
+++ b/2020/8.in
@@ -0,0 +1,611 @@
+acc +22
+acc +42
+nop +456
+jmp +5
+acc +31
+acc +49
+acc +10
+jmp +519
+nop +390
+jmp +418
+nop +29
+acc -4
+jmp +156
+jmp +85
+acc +5
+acc +26
+jmp +497
+acc -6
+acc -18
+acc +20
+acc +4
+jmp -8
+jmp +372
+jmp +371
+jmp -1
+jmp +1
+nop +378
+acc +18
+jmp +388
+jmp +1
+acc +29
+acc +37
+jmp +1
+jmp +425
+acc +19
+acc +13
+jmp +477
+acc +7
+jmp +469
+nop +495
+nop +141
+acc +22
+jmp +517
+jmp +125
+nop +30
+acc +37
+acc +23
+nop +238
+jmp +110
+jmp +411
+acc +2
+acc -19
+acc -19
+jmp +296
+acc +0
+acc +14
+acc +20
+jmp +75
+nop +88
+acc -16
+acc +40
+acc +27
+jmp +131
+acc +33
+nop +252
+acc +5
+acc +0
+jmp +101
+nop +219
+acc +50
+acc +40
+jmp +49
+nop +74
+jmp +327
+acc +47
+jmp +206
+acc -15
+jmp +449
+acc -17
+acc -13
+acc +46
+jmp +417
+jmp +160
+acc -7
+acc -11
+acc +16
+acc +14
+jmp -37
+acc -12
+acc +15
+acc -14
+nop +110
+jmp +1
+acc -4
+nop +287
+nop -82
+jmp +30
+jmp +490
+acc +34
+jmp +305
+nop +90
+jmp +1
+nop -4
+nop -95
+jmp -46
+acc +26
+acc +13
+acc +47
+jmp +350
+acc +11
+jmp -102
+acc -2
+jmp +489
+acc +28
+acc +24
+nop +486
+jmp +485
+nop +170
+jmp +66
+jmp +411
+acc +30
+acc +48
+acc +48
+jmp -6
+acc +11
+jmp -51
+jmp +1
+jmp -10
+nop +411
+acc -17
+acc +32
+jmp +9
+jmp +398
+nop +82
+jmp +6
+acc +45
+acc +34
+jmp -44
+acc -13
+jmp -122
+acc +25
+nop +286
+acc +5
+jmp +144
+acc +0
+jmp -122
+acc -11
+acc -6
+jmp -123
+acc +16
+acc +1
+jmp -58
+nop +242
+acc -11
+jmp +257
+nop +231
+acc +46
+jmp +301
+acc -6
+acc +20
+acc -7
+jmp +365
+acc +32
+acc +0
+jmp -66
+jmp +110
+acc -18
+jmp +118
+acc +33
+nop -125
+acc +49
+acc +36
+jmp +188
+acc +9
+acc -11
+jmp +100
+acc +35
+jmp +55
+acc +38
+acc -1
+jmp +312
+jmp +157
+acc +17
+jmp +177
+nop -126
+acc +30
+acc -3
+jmp +211
+acc -3
+jmp -164
+jmp -112
+acc +50
+jmp +268
+nop +290
+acc -8
+acc +35
+jmp -44
+acc -6
+acc +11
+nop +327
+jmp +155
+acc +10
+acc +35
+nop +233
+jmp +330
+acc +31
+acc +8
+jmp +124
+acc -5
+jmp +300
+nop +171
+nop +4
+acc +19
+acc +41
+jmp -156
+nop +179
+acc +12
+jmp +160
+jmp -92
+acc -11
+acc -10
+jmp +95
+nop +94
+acc -8
+jmp -199
+acc +16
+acc +30
+nop +73
+acc +36
+jmp -53
+jmp +1
+jmp -6
+nop +369
+acc +29
+acc +47
+jmp +32
+acc +35
+jmp -61
+acc +41
+jmp +352
+acc -1
+jmp +75
+acc -10
+acc +28
+acc -15
+jmp -187
+acc +6
+jmp +1
+nop +112
+jmp +273
+nop +186
+acc +11
+acc +40
+jmp +128
+acc +17
+acc +23
+acc -8
+nop +277
+jmp +42
+acc +11
+nop -237
+acc +36
+acc +32
+jmp +287
+acc +16
+acc -19
+jmp +115
+acc -6
+acc +16
+nop -2
+acc +23
+jmp -160
+acc -10
+acc -10
+jmp +26
+acc -7
+jmp -95
+nop -160
+acc -2
+acc +44
+jmp -236
+jmp -198
+jmp +1
+acc +1
+jmp -9
+jmp -95
+jmp +273
+acc -19
+jmp -46
+acc +12
+acc +2
+jmp -145
+acc -14
+acc +3
+acc +3
+jmp +250
+acc +4
+acc +40
+jmp +1
+jmp +17
+acc +6
+acc +47
+jmp -77
+nop -192
+acc +11
+jmp +296
+acc -14
+jmp +64
+acc +35
+jmp +134
+acc -8
+nop +228
+acc +24
+acc +15
+jmp -64
+jmp -241
+acc +19
+acc +22
+acc +49
+nop -193
+jmp +219
+acc -1
+acc -11
+nop +211
+acc +0
+jmp -106
+nop +101
+jmp -222
+acc +20
+acc +45
+jmp +70
+acc +19
+acc +21
+jmp -23
+acc +8
+nop +92
+acc +47
+jmp -144
+acc +0
+acc -1
+jmp -81
+acc +23
+jmp -274
+acc +14
+acc +26
+acc +9
+jmp +79
+acc +22
+jmp -331
+acc -10
+jmp -311
+acc +16
+acc +30
+acc -8
+jmp +176
+acc -19
+acc +43
+jmp -222
+nop -116
+jmp +18
+acc +26
+acc +23
+acc +6
+jmp -162
+acc +34
+jmp +95
+acc +27
+acc +40
+acc +9
+jmp -77
+jmp +137
+acc -13
+acc +21
+acc +17
+acc -5
+jmp +91
+jmp -95
+acc +18
+acc -1
+jmp +70
+jmp -355
+nop -166
+acc -19
+acc +16
+jmp -146
+jmp -135
+jmp +57
+acc +45
+jmp -62
+acc -14
+jmp -382
+nop -172
+acc +45
+jmp -77
+acc +13
+jmp +65
+acc -4
+jmp +112
+jmp +107
+jmp +26
+jmp -326
+acc +25
+jmp +1
+jmp +179
+acc +33
+acc +2
+jmp -222
+nop +36
+acc +25
+nop -244
+jmp -376
+jmp -203
+acc +26
+nop +109
+acc +38
+jmp +135
+acc +7
+acc +40
+acc -18
+jmp -113
+nop -294
+acc +0
+acc +40
+nop -265
+jmp +81
+jmp -99
+jmp +32
+acc -17
+acc +25
+acc -12
+acc +26
+jmp -125
+acc -3
+acc -7
+acc +25
+jmp -410
+acc +47
+acc +36
+jmp +35
+acc +2
+acc +18
+acc -3
+jmp -38
+acc +29
+acc +49
+jmp -299
+acc -4
+nop -422
+jmp +50
+acc +11
+acc +2
+acc +49
+jmp -233
+acc +12
+acc +43
+acc -19
+acc +11
+jmp -264
+jmp +124
+jmp -361
+acc +35
+jmp -118
+acc +23
+acc -16
+acc -14
+jmp -22
+jmp -135
+jmp -309
+acc +6
+jmp -44
+acc -12
+acc +0
+jmp -23
+acc +29
+acc -8
+acc +18
+acc +35
+jmp -111
+acc +22
+acc +23
+acc +0
+acc -8
+jmp -55
+acc +14
+jmp +1
+acc +44
+acc +17
+jmp -272
+acc +39
+nop +37
+acc -19
+jmp -323
+acc +24
+acc +28
+acc +29
+acc +37
+jmp +110
+jmp -386
+nop -352
+acc +23
+acc +38
+jmp -369
+acc -5
+acc -14
+jmp +83
+jmp +17
+jmp -151
+jmp -118
+jmp -104
+jmp -341
+acc +32
+acc +43
+jmp -52
+acc -4
+acc +42
+acc +5
+jmp -116
+acc +13
+jmp +1
+nop -361
+acc +41
+jmp -386
+jmp -241
+nop -449
+acc +46
+jmp -176
+acc +6
+jmp +60
+jmp +1
+jmp -3
+jmp -62
+acc -14
+acc +17
+jmp -340
+acc +31
+acc -13
+acc +7
+jmp -54
+jmp -80
+acc +14
+acc +49
+acc +34
+jmp +24
+acc +11
+jmp -158
+acc -13
+jmp -261
+acc +33
+nop -171
+jmp -106
+acc +0
+acc +9
+acc +16
+acc +34
+jmp +18
+acc -2
+acc +47
+acc +39
+jmp -232
+acc +23
+nop -229
+acc +30
+acc +32
+jmp -147
+acc -8
+jmp -460
+jmp -498
+nop -218
+acc +31
+acc +44
+acc +30
+jmp -105
+acc +8
+acc -19
+acc +45
+nop -49
+jmp -140
+nop -43
+acc +42
+jmp +1
+acc -14
+jmp -42
+jmp -389
+acc +39
+acc +26
+acc +38
+jmp -77
+acc +48
+jmp -83
+acc +5
+jmp -81
+nop -242
+acc +35
+acc +0
+acc +19
+jmp -430
+acc +11
+nop -226
+acc +13
+acc +23
+jmp -575
+acc +44
+acc +50
+nop -303
+jmp -112
+jmp -305
+acc +23
+acc -11
+nop -376
+acc +50
+jmp +1
diff --git a/2020/Asm.hs b/2020/Asm.hs
new file mode 100644
index 0000000..af10605
--- /dev/null
+++ b/2020/Asm.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE LambdaCase #-}
+module Asm where
+
+import qualified Data.Vector.Unboxed as U
+import Data.List
+import Data.Word
+
+
+data Ins
+    = NOP Int
+    | ACC Int
+    | JMP Int
+  deriving (Show)
+
+parseIns :: String -> Ins
+parseIns line
+  | Just idx <- findIndex (== ' ') line
+  = case parseArg . tail <$> splitAt idx line of
+      ("nop", arg) -> NOP arg
+      ("acc", arg) -> ACC arg
+      ("jmp", arg) -> JMP arg
+      _ -> error ("Invalid instruction: '" ++ line ++ "'")
+  where
+    parseArg :: String -> Int
+    parseArg ('+':s) = read s
+    parseArg s = read s
+parseIns line = error ("Invalid instruction (no space): '" ++ line ++ "'")
+
+data State
+    = State { sAcc :: Int
+            , sIP  :: Int }
+  deriving (Show)
+
+initState :: State
+initState = State 0 0
+
+evalIns :: Ins -> State -> State
+evalIns = \case
+    NOP _ -> jmprel 1
+    ACC i -> jmprel 1 . (\s -> s { sAcc = sAcc s + i })
+    JMP i -> jmprel i
+  where
+    jmprel :: Int -> State -> State
+    jmprel off state = state { sIP = sIP state + off }
+
+data Program = Program (U.Vector (Word8, Int)) (Int -> Maybe Ins)
+
+programLength :: Program -> Int
+programLength (Program vec _) = U.length vec
+
+programGet :: Program -> Int -> Ins
+programGet (Program _ overrider) i | Just ins <- overrider i = ins
+programGet (Program vec _) i =
+    case vec U.! i of
+      (0, a) -> NOP a
+      (1, a) -> ACC a
+      (2, a) -> JMP a
+      _ -> error "Invalid program element"
+
+programFrom :: [Ins] -> Program
+programFrom l =
+    Program (U.fromList [case ins of
+                           NOP a -> (0, a)
+                           ACC a -> (1, a)
+                           JMP a -> (2, a)
+                        | ins <- l])
+            (const Nothing)
+
+withOverrider :: Program -> (Int -> Maybe Ins) -> Program
+withOverrider (Program vec _) overrider = Program vec overrider
+
+evalUntil :: (s -> State -> (s, Bool)) -> Program -> s -> State -> State
+evalUntil predicate prog aux state =
+    let (aux', cont) = predicate aux state
+        state' = evalIns (programGet prog (sIP state)) state
+    in if cont
+           then state
+           else evalUntil predicate prog aux' state'
diff --git a/2020/Makefile b/2020/Makefile
index ff844f6..b85c185 100644
--- a/2020/Makefile
+++ b/2020/Makefile
@@ -1,12 +1,12 @@
 GHC = ghc
-GHCBASEFLAGS = -package parsec -package array
-GHCFLAGS = $(GHCBASEFLAGS) -Wall -O2 -threaded
+GHCBASEFLAGS = -package parsec -package array -package vector
+GHCFLAGS = $(GHCBASEFLAGS) -Wall -O2 -threaded -fdefer-typed-holes
 CXX = g++
 CXXFLAGS = -Wall -Wextra -std=c++17 -O2
 
 OBJDIR = obj
 
-HASKELL_AUX := Input.hs
+HASKELL_AUX := Input.hs Asm.hs
 CPP_AUX     :=
 HASKELL_SRC := $(filter-out $(HASKELL_AUX),$(wildcard *.hs))
 CPP_SRC     := $(filter-out $(CPP_AUX),$(wildcard *.cpp))
diff --git a/2020/hie.yaml b/2020/hie.yaml
index 96da3aa..29471fa 100644
--- a/2020/hie.yaml
+++ b/2020/hie.yaml
@@ -1,3 +1,3 @@
 cradle:
   direct:
-    arguments: ["-package", "parsec", "-package", "array", "-Wall", "-i."]
+    arguments: ["-package", "parsec", "-package", "array", "-package", "vector", "-Wall", "-i."]
-- 
cgit v1.2.3-54-g00ecf