diff options
| -rw-r--r-- | 2019/5.hs | 11 | ||||
| -rw-r--r-- | 2019/5.in | 1 | ||||
| -rw-r--r-- | 2019/IntCode.hs | 28 |
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 |