diff options
Diffstat (limited to '2019')
| -rw-r--r-- | 2019/IntCode.hs | 41 |
1 files changed, 28 insertions, 13 deletions
diff --git a/2019/IntCode.hs b/2019/IntCode.hs index 71fa3b1..2096bcc 100644 --- a/2019/IntCode.hs +++ b/2019/IntCode.hs @@ -137,29 +137,44 @@ runContinue (Continuation frozen ptr offset) moreinput = runST $ do runArray :: SA.STArray s Int Integer -> Int -> [Integer] -> Int -> ST s (Either Continuation [Integer], [Integer]) runArray arr ptr inp offset = do (ic, len) <- decode' arr ptr - let continueInp inp' = runArray arr (ptr + len) inp' offset - continueOff off' = runArray arr (ptr + len) inp (fromIntegral off') - continue = continueInp inp - jump ptr' = runArray arr (fromIntegral ptr') inp offset + let continue = runArray arr (ptr + len) inp offset + continueArr arr' = runArray arr' (ptr + len) inp offset + jump ptr' = runArray arr (fromIntegral ptr') inp offset + continueOff off' = runArray arr (ptr + len) inp (fromIntegral off') + continueInpArr inp' arr' = runArray arr' (ptr + len) inp' offset + resize arr1 idx = do + (_, right) <- SA.getBounds arr1 + if idx < right + then return arr1 + else SA.getElems arr1 >>= \els -> SA.newListArray (0, 2 * idx) (els ++ replicate (idx - right + 1) 0) + performWrite arr1 idx value = do + arr' <- resize arr1 (fromIntegral idx) + SA.writeArray arr' (fromIntegral idx) value + return arr' case ic of - Add a b (Addr c) -> (+) <$> resolve a <*> resolve b >>= SA.writeArray arr (fromIntegral c) >> continue - Mul a b (Addr c) -> (*) <$> resolve a <*> resolve b >>= SA.writeArray arr (fromIntegral c) >> continue - Inp (Addr a) -> case inp of - val : rest -> SA.writeArray arr (fromIntegral a) val >> continueInp rest + Add a b c -> (+) <$> resolve a <*> resolve b >>= performWrite arr (resolveAddr c) >>= continueArr + Mul a b c -> (*) <$> resolve a <*> resolve b >>= performWrite arr (resolveAddr c) >>= continueArr + Inp a -> case inp of + val : rest -> performWrite arr (resolveAddr a) val >>= continueInpArr rest [] -> do frozen <- SA.freeze arr return (Left (Continuation frozen ptr offset), []) Out a -> resolve a >>= \val -> fmap (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) -> (((fromIntegral . fromEnum) .) . (<)) <$> resolve a <*> resolve b >>= SA.writeArray arr (fromIntegral c) >> continue - Ceq a b (Addr c) -> (((fromIntegral . fromEnum) .) . (==)) <$> resolve a <*> resolve b >>= SA.writeArray arr (fromIntegral c) >> continue + Clt a b c -> (((fromIntegral . fromEnum) .) . (<)) <$> resolve a <*> resolve b >>= performWrite arr (resolveAddr c) >>= continueArr + Ceq a b c -> (((fromIntegral . fromEnum) .) . (==)) <$> resolve a <*> resolve b >>= performWrite arr (resolveAddr c) >>= continueArr Adj a -> resolve a >>= \add -> continueOff (fromIntegral offset + add) Hlt -> do mem <- SA.getElems arr return (Right mem, []) - ins -> error $ "IC: Invalid instruction " ++ show ins where - resolve (Addr n) = SA.readArray arr (fromIntegral n) + resolve (Addr n) = do + (_, right) <- SA.getBounds arr + let n' = fromIntegral n + if n' >= right then return 0 else SA.readArray arr n' resolve (Imm n) = return n - resolve (Rel n) = return (fromIntegral offset + n) + resolve (Rel n) = resolve (Addr (fromIntegral offset + n)) + resolveAddr (Addr n) = n + resolveAddr (Rel n) = fromIntegral offset + n + resolveAddr (Imm _) = error "IC: Using immediate value as address operand" |