You now have a complete Intcode computer.

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"