From 7b70f24bf54ec9ef1754695ad278730c59f8d4e9 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Mon, 9 Dec 2019 19:55:25 +0100
Subject: You now have a complete Intcode computer.
---
2019/IntCode.hs | 41 ++++++++++++++++++++++++++++-------------
1 file 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"
--
cgit v1.2.3-70-g09d2