## Problem

The problem definition is here. For a quick summary:

• an IntCode program is an array of ints
• the program counter starts from index 0, where it reads an opcode, followed by 0 or more arguments at the next indices, then proceeds to the index after the last argument
• opcode 1 takes 3 arguments, a, b, and z, and sets program[z] = program[a] + program[b]
• opcode 2 does the same but multiplies instead
• opcode 99 takes 0 arguments and halts the program

In part 1, we take the input, replace index 1 with 12 and index 2 with 2 (restore 12 2), run the program and return index 0.

In part 2 (not shown in the link unless you solve part 1), we find which ints to replace index 1 and 2 with to produce a result where index 0 equals 19690720.

My thoughts on this code are that it could probably be simpler. I tried to separate the program counter logic from the instruction execution logic (interpret vs step), but it seems like that resulted in the need for a strange combinator whileWith. I was wondering whether there are better combinators to express this kind of loop, or if there's another approach entirely.

I considered wrapping step in ContT or ExceptT, which would allow some of the nesting to be flattened by using early exit instead, but I wasn't sure which way is best in terms of extensibility.

Any suggestions on this code are welcome, including style, structure, algorithm, etc!

## Code

import Control.Arrow (second)
import Data.Array
import Data.Array.ST
import Data.List (find)

data Status = InvalidOp | Terminated | Running | InvalidAddress
deriving (Show, Eq)

newtype Program = Program {
getInts :: Array Int Int
} deriving (Show)

-- Execute the instruction starting at start
step :: STArray s Int Int -> Int -> Int -> ST s Status
step arr len start = do
case op of
99 -> return Terminated
_ -> do
[i, j, store] <- forM [start+1..start+3] (readArray arr)
if not $all inBounds [i, j, store] then return InvalidAddress else do [a, b] <- forM [i, j] (readArray arr) case op of 1 -> writeArray arr store (a+b) >> return Running 2 -> writeArray arr store (a*b) >> return Running _ -> return InvalidOp where inBounds ix = 0 <= ix && ix < len interpret :: Program -> Program interpret (Program prog) = Program$ runSTArray $do let len = succ . uncurry subtract$ bounds prog
mArr <- thaw prog
whileWith (== Running) [0, 4..len-1]
(step mArr len)
return mArr

let nums = fmap read $split ',' str in Program$ listArray (0, length nums - 1) nums

restore :: Int -> Int -> Program -> Program
restore a b = Program . (// [(1, a), (2, b)]) . getInts

-- pt 2

findNounVerb :: Program -> Int -> Maybe (Int, Int)
findNounVerb prog target =
find ((== target) . (! 0) . getInts . interpret . ($prog) . uncurry restore)$
[(n, v) | n <- [0..1000], v <- [0..n]]

-- util --

split :: Eq a => a -> [a] -> [[a]]
split _ [] = []
split k xs = curr : split k rest
where (curr, rest) = second (drop 1) $span (/= k) xs whileWith :: (Monad m) => (ret -> Bool) -> [inp] -> (inp -> m ret) -> m () whileWith _ [] _ = return () whileWith pred (x:xs) step = do res <- step x when (pred res)$
whileWith pred xs step

-- end util --

main :: IO ()
main = do
prog <- readProgram <$> getContents -- pt 1: putStrLn "Part 1:" let output = (! 0) . getInts . interpret . restore 12 2$ prog
putStrLn $"Output: " ++ show output putStrLn "" -- pt 2: putStrLn "Part 2:" let Just (noun, verb) = findNounVerb prog 19690720 putStrLn$ "Noun: " ++ show noun ++ "\n" ++ "Verb: " ++ show verb
print \$ 100*noun + verb

• – Gurkenglas Jan 16 at 13:39