Day 5

3 files changed, 34 insertions, 6 deletions

diff --git a/2019/5.hs b/2019/5.hs
new file mode 100644
index 0000000..25137d8
--- /dev/null
+++ b/2019/5.hs
@@ -0,0 +1,11 @@
+module Main where
+
+import Input
+import IntCode
+
+
+main :: IO ()
+main = do
+    initMem <- parse . head <$> getInput 5
+    print (snd (run initMem [1]))
+    print (snd (run initMem [5]))
diff --git a/2019/5.in b/2019/5.in
new file mode 100644
index 0000000..e8a9180
--- /dev/null
+++ b/2019/5.in
@@ -0,0 +1 @@
+3,225,1,225,6,6,1100,1,238,225,104,0,1001,191,50,224,101,-64,224,224,4,224,1002,223,8,223,101,5,224,224,1,224,223,223,2,150,218,224,1001,224,-1537,224,4,224,102,8,223,223,1001,224,2,224,1,223,224,223,1002,154,5,224,101,-35,224,224,4,224,1002,223,8,223,1001,224,5,224,1,224,223,223,1102,76,17,225,1102,21,44,224,1001,224,-924,224,4,224,102,8,223,223,1001,224,4,224,1,224,223,223,101,37,161,224,101,-70,224,224,4,224,1002,223,8,223,101,6,224,224,1,223,224,223,102,46,157,224,1001,224,-1978,224,4,224,102,8,223,223,1001,224,5,224,1,224,223,223,1102,5,29,225,1101,10,7,225,1101,43,38,225,1102,33,46,225,1,80,188,224,1001,224,-73,224,4,224,102,8,223,223,101,4,224,224,1,224,223,223,1101,52,56,225,1101,14,22,225,1101,66,49,224,1001,224,-115,224,4,224,1002,223,8,223,1001,224,7,224,1,224,223,223,1101,25,53,225,4,223,99,0,0,0,677,0,0,0,0,0,0,0,0,0,0,0,1105,0,99999,1105,227,247,1105,1,99999,1005,227,99999,1005,0,256,1105,1,99999,1106,227,99999,1106,0,265,1105,1,99999,1006,0,99999,1006,227,274,1105,1,99999,1105,1,280,1105,1,99999,1,225,225,225,1101,294,0,0,105,1,0,1105,1,99999,1106,0,300,1105,1,99999,1,225,225,225,1101,314,0,0,106,0,0,1105,1,99999,108,226,226,224,1002,223,2,223,1005,224,329,101,1,223,223,108,677,677,224,1002,223,2,223,1006,224,344,1001,223,1,223,8,677,677,224,102,2,223,223,1006,224,359,101,1,223,223,7,226,677,224,102,2,223,223,1005,224,374,101,1,223,223,107,226,226,224,102,2,223,223,1006,224,389,101,1,223,223,7,677,226,224,1002,223,2,223,1006,224,404,1001,223,1,223,1107,677,226,224,1002,223,2,223,1006,224,419,1001,223,1,223,1007,226,226,224,102,2,223,223,1005,224,434,101,1,223,223,1008,226,677,224,102,2,223,223,1005,224,449,1001,223,1,223,1007,677,677,224,1002,223,2,223,1006,224,464,1001,223,1,223,1008,226,226,224,102,2,223,223,1006,224,479,101,1,223,223,1007,226,677,224,1002,223,2,223,1005,224,494,1001,223,1,223,108,226,677,224,1002,223,2,223,1006,224,509,101,1,223,223,8,226,677,224,102,2,223,223,1005,224,524,1001,223,1,223,107,677,677,224,1002,223,2,223,1005,224,539,101,1,223,223,107,226,677,224,1002,223,2,223,1006,224,554,101,1,223,223,1107,226,677,224,1002,223,2,223,1006,224,569,1001,223,1,223,1108,677,226,224,102,2,223,223,1005,224,584,1001,223,1,223,1008,677,677,224,102,2,223,223,1005,224,599,1001,223,1,223,1107,677,677,224,102,2,223,223,1006,224,614,101,1,223,223,7,226,226,224,102,2,223,223,1005,224,629,1001,223,1,223,1108,677,677,224,102,2,223,223,1006,224,644,1001,223,1,223,8,677,226,224,1002,223,2,223,1005,224,659,101,1,223,223,1108,226,677,224,102,2,223,223,1005,224,674,101,1,223,223,4,223,99,226
diff --git a/2019/IntCode.hs b/2019/IntCode.hs
index 904e961..89b54a2 100644
--- a/2019/IntCode.hs
+++ b/2019/IntCode.hs
@@ -17,6 +17,10 @@ data IC
     | Mul Arg Arg Arg
     | Inp Arg
     | Out Arg
+    | Jnz Arg Arg
+    | Jez Arg Arg
+    | Clt Arg Arg Arg
+    | Ceq Arg Arg Arg
     | Hlt
   deriving (Show)
 
@@ -51,7 +55,9 @@ insModeSplit :: Int -> (Int, [Int])
 insModeSplit n = (n `mod` 100, map (`mod` 10) (iterate (`div` 10) (n `div` 100)))
 
 insNArgs :: Int -> Int
-insNArgs n = case n of { 1 -> 3; 2 -> 3; 3 -> 1; 4 -> 1; 99 -> 0;
+insNArgs n = case n of { 1 -> 3; 2 -> 3; 3 -> 1; 4 -> 1;
+                         5 -> 2; 6 -> 2; 7 -> 3; 8 -> 3;
+                         99 -> 0;
                          _ -> error $ "IC: Unknown instruction " ++ show n }
 
 decodeBase :: Int -> [Int] -> [Int] -> IC
@@ -59,6 +65,10 @@ decodeBase  1 (am:bm:cm:_) (a:b:c:_) = Add (insArg am a) (insArg bm b) (insArg c
 decodeBase  2 (am:bm:cm:_) (a:b:c:_) = Mul (insArg am a) (insArg bm b) (insArg cm c)
 decodeBase  3 (am:      _) (a:    _) = Inp (insArg am a)
 decodeBase  4 (am:      _) (a:    _) = Out (insArg am a)
+decodeBase  5 (am:bm:   _) (a:b:  _) = Jnz (insArg am a) (insArg bm b)
+decodeBase  6 (am:bm:   _) (a:b:  _) = Jez (insArg am a) (insArg bm b)
+decodeBase  7 (am:bm:cm:_) (a:b:c:_) = Clt (insArg am a) (insArg bm b) (insArg cm c)
+decodeBase  8 (am:bm:cm:_) (a:b:c:_) = Ceq (insArg am a) (insArg bm b) (insArg cm c)
 decodeBase 99 (         _) (      _) = Hlt
 decodeBase ic _            _         = error $ "IC: Unknown instruction " ++ show ic
 
@@ -77,14 +87,20 @@ run initMem input = runST $ do
     run' :: SA.STUArray s Int Int -> Int -> [Int] -> ST s [Int]
     run' arr ptr inp = do
         (ic, len) <- decode' arr ptr
-        let continue i' = run' arr (ptr + len) i'
+        let continueInp inp' = run' arr (ptr + len) inp'
+            continue = continueInp inp
+            jump ptr' = run' arr ptr' inp
         case ic of
-            Add a b (Addr c) -> (+) <$> resolve a <*> resolve b >>= SA.writeArray arr c >> continue inp
-            Mul a b (Addr c) -> (*) <$> resolve a <*> resolve b >>= SA.writeArray arr c >> continue inp
+            Add a b (Addr c) -> (+) <$> resolve a <*> resolve b >>= SA.writeArray arr c >> continue
+            Mul a b (Addr c) -> (*) <$> resolve a <*> resolve b >>= SA.writeArray arr c >> continue
             Inp (Addr a) -> case inp of
-                         val : rest -> SA.writeArray arr a val >> continue rest
+                         val : rest -> SA.writeArray arr a val >> continueInp rest
                          _ -> error "IC: Not enough input"
-            Out a -> resolve a >>= \val -> (val :) <$> continue inp
+            Out a -> resolve a >>= \val -> (val :) <$> continue
+            Jnz a b -> resolve a >>= \val -> if val /= 0 then resolve b >>= jump else continue
+            Jez a b -> resolve a >>= \val -> if val == 0 then resolve b >>= jump else continue
+            Clt a b (Addr c) -> ((fromEnum .) . (<)) <$> resolve a <*> resolve b >>= SA.writeArray arr c >> continue
+            Ceq a b (Addr c) -> ((fromEnum .) . (==)) <$> resolve a <*> resolve b >>= SA.writeArray arr c >> continue
             Hlt -> return []
             ins -> error $ "IC: Invalid instruction " ++ show ins
       where