https://adventofcode.com/2019/day/5
In [1]:
inputLine = head . lines <$> readFile "input/day05.txt"
In [2]:
import Data.Array
type Memory = Array Int Int
In [3]:
listToProgram :: [Int] -> Memory
listToProgram numbers = listArray (0, length numbers - 1) numbers
In [4]:
import Data.List.Split
parseProgram :: String -> Memory
parseProgram = listToProgram . map read . splitOn ","
In [5]:
data Parameter = Position Int | Immediate Int deriving (Show)
In [6]:
readValue :: Memory -> Parameter -> Int
readValue memory (Position index) = memory ! index
readValue _ (Immediate value) = value
In [7]:
import Control.Lens
writeValue :: Memory -> Parameter -> Int -> Memory
writeValue memory (Position index) value = set (element index) value memory
writeValue _ (Immediate _) _ = error "writeValue: cannot write to immediate value"
In [8]:
data ComputerState = Ready | Halted | WaitingForInput | ExecutingInstruction [Int]
In [9]:
data Computer = Computer {
state :: ComputerState,
memory :: Memory,
currentIndex :: Int,
inputBuffer :: [Int],
reversedOutputBuffer :: [Int] }
In [10]:
loadProgram :: String -> Computer
loadProgram program = Computer {
state = Ready,
memory = parseProgram program,
currentIndex = 0,
inputBuffer = [],
reversedOutputBuffer = [] }
In [11]:
import Control.Monad.State
In [12]:
setState :: ComputerState -> State Computer ()
setState newState = do
computer <- get
put computer { state = newState }
In [13]:
changeCurrentIndex :: (Int -> Int) -> State Computer ()
changeCurrentIndex f = do
computer <- get
put computer { currentIndex = f . currentIndex $ computer }
moveCurrentIndexForward = changeCurrentIndex succ
moveCurrentIndexBackward = changeCurrentIndex pred
In [14]:
writeToMemory :: Parameter -> Int -> State Computer ()
writeToMemory parameter value = do
computer <- get
put computer { memory = writeValue (memory computer) parameter value }
In [15]:
readInput :: State Computer Int
readInput = do
computer <- get
case inputBuffer computer of [] -> error "readInput: input buffer is empty"
(i:is) -> do
put computer { inputBuffer = is }
return i
In [16]:
writeOutput :: Int -> State Computer ()
writeOutput value = do
computer <- get
put computer { reversedOutputBuffer = value:reversedOutputBuffer computer }
In [17]:
getNextInt :: State Computer Int
getNextInt = do
computer <- get
let result = memory computer ! currentIndex computer
moveCurrentIndexForward
return result
In [18]:
loadNextOpcode :: State Computer Int
loadNextOpcode = do
computerState <- gets state
case computerState of
Halted -> error "halted computer cannot execute instructions"
WaitingForInput -> error "computer is waiting for input, cannot execute instructions"
ExecutingInstruction _ -> error "computer is already executing an instruction"
Ready -> do
n <- getNextInt
let parameterModes = map (`mod` 10) . iterate (`div` 10) $ n `div` 100
setState $ ExecutingInstruction parameterModes
return $ n `mod` 100
In [19]:
getNextParameter :: State Computer Parameter
getNextParameter = do
computerState <- gets state
case computerState of
ExecutingInstruction (pm:pms) -> do
n <- getNextInt
setState $ ExecutingInstruction pms
return $ parameterMode pm n
_ -> error "getNextParameter: not executing an instruction"
where
parameterMode 0 = Position
parameterMode 1 = Immediate
In [20]:
loadParameterValue :: State Computer Int
loadParameterValue = do
parameter <- getNextParameter
memory <- gets memory
return $ readValue memory parameter
In [21]:
provideInput :: [Int] -> State Computer ()
provideInput values = do
computer <- get
put computer { inputBuffer = inputBuffer computer ++ values }
In [22]:
consumeOutput :: State Computer [Int]
consumeOutput = do
computer <- get
put computer { reversedOutputBuffer = [] }
return $ reverse $ reversedOutputBuffer computer
In [23]:
add :: State Computer ()
add = do
a <- loadParameterValue
b <- loadParameterValue
c <- getNextParameter
writeToMemory c (a + b)
In [24]:
mul :: State Computer ()
mul = do
a <- loadParameterValue
b <- loadParameterValue
c <- getNextParameter
writeToMemory c (a * b)
In [25]:
input :: State Computer ()
input = do
inputBufferEmpty <- gets (null . inputBuffer)
if inputBufferEmpty then do
computer <- get
setState WaitingForInput
-- Move the instruction pointer back. The opcode can then
-- be loaded again if there is input data in the buffer.
moveCurrentIndexBackward
else do
a <- getNextParameter
readInput >>= writeToMemory a
In [26]:
output :: State Computer ()
output = loadParameterValue >>= writeOutput
In [27]:
jumpIfTrue :: State Computer ()
jumpIfTrue = do
computer <- get
a <- loadParameterValue
b <- loadParameterValue
when (a /= 0) $ put computer { currentIndex = b }
In [28]:
jumpIfFalse :: State Computer ()
jumpIfFalse = do
computer <- get
a <- loadParameterValue
b <- loadParameterValue
when (a == 0) $ put computer { currentIndex = b }
In [29]:
lessThan :: State Computer ()
lessThan = do
a <- loadParameterValue
b <- loadParameterValue
c <- getNextParameter
writeToMemory c $ if a < b then 1 else 0
In [30]:
equals :: State Computer ()
equals = do
a <- loadParameterValue
b <- loadParameterValue
c <- getNextParameter
writeToMemory c $ if a == b then 1 else 0
In [31]:
halt :: State Computer ()
halt = setState Halted
In [32]:
import qualified Data.Map as Map
opcodes :: Map.Map Int (State Computer ())
opcodes = Map.fromList [( 1, add),
( 2, mul),
( 3, input),
( 4, output),
( 5, jumpIfTrue),
( 6, jumpIfFalse),
( 7, lessThan),
( 8, equals),
(99, halt)]
In [33]:
import Data.Maybe (fromJust)
executeNextInstruction :: State Computer ()
executeNextInstruction = do
opcode <- loadNextOpcode
fromJust $ Map.lookup opcode opcodes
computer <- get
case state computer of
-- the instruction did not abort with a custom state
ExecutingInstruction _ -> setState Ready
-- the instruction did set a custom state -> keep it
_ -> return ()
In [34]:
run :: State Computer [Int]
run = do
computerState <- gets state
case computerState of
Ready -> do
executeNextInstruction
run
_ -> consumeOutput
In [35]:
runWithInput :: [Int] -> State Computer [Int]
runWithInput inputBuffer = do
provideInput inputBuffer
run
In [36]:
computer = loadProgram <$> inputLine
In [37]:
evalState (runWithInput [1]) <$> computer
In [38]:
evalState (runWithInput [5]) <$> computer