AoC/2019/day9/Intcode.hs

150 lines
3.5 KiB
Haskell
Raw Normal View History

2019-12-11 20:21:55 +01:00
module Intcode
( TuringMachine(TM, tape, pointer, pointerOffset, output, input,
state)
, step
, tapePreprocess
2019-12-12 17:43:55 +01:00
, TMOutState(Continue, AwaitInput, Halt)
, execSteps
2019-12-11 20:21:55 +01:00
) where
import Control.DeepSeq as DeepSeq
import Data.Char
import Data.List as L
import Data.Vector as V hiding
( (++)
, concatMap
, elem
, head
, last
, length
, map
, reverse
, splitAt
)
import qualified Data.Vector as V ((++), last)
2019-12-12 17:43:55 +01:00
data TMOutState
2019-12-11 20:21:55 +01:00
= Continue
2019-12-12 17:43:55 +01:00
| AwaitInput
2019-12-11 20:21:55 +01:00
| Halt
deriving (Enum, Eq, Show)
data Mode
= Position
| Immediate
| Relative
deriving (Enum, Eq, Show)
data TuringMachine =
TM
{ tape :: Vector Integer
, pointer :: Integer
, pointerOffset :: Integer
, output :: [Integer]
2019-12-12 17:43:55 +01:00
, input :: Maybe Integer
, state :: TMOutState
2019-12-11 20:21:55 +01:00
}
deriving (Show)
tapePreprocess :: Vector Integer -> Vector Integer
tapePreprocess t = (V.++) t $ V.replicate 105 0
opLength :: Integer -> Integer
opLength x
| n `elem` "1278" = 4
| n `elem` "56" = 3
| n `elem` "349" = 2
| otherwise = 1
where
n = last $ show x
parseModes :: String -> [Mode]
parseModes m = L.replicate (3 - length l) Position ++ l
where
l = map (toEnum . digitToInt) m
paramChange ::
[Mode] -> Integer -> Vector Integer -> Vector Integer -> Vector Integer
paramChange m rbase opvec t = imap f (V.tail opvec)
where
f i a =
case m !! i of
Immediate -> a
Position -> t ! fromInteger a
Relative -> t ! fromInteger (a + rbase)
getOpModes :: Vector Integer -> (String, [Mode])
getOpModes opvec = (op_dedup, parsed_modes)
where
(op, modes) = splitAt 2 $ reverse $ show $ opvec ! 0
parsed_modes = reverse $ parseModes $ reverse modes
op_dedup =
if last op == '0'
then [head op]
else op
step :: TuringMachine -> TuringMachine
step tm =
case op of
"1" -> tmBinop (+)
"2" -> tmBinop (*)
2019-12-12 17:43:55 +01:00
"3" -> maybe tm{state = AwaitInput} getNewTM (input tm)
2019-12-11 20:21:55 +01:00
"4" -> tmn {output = V.last params : output tm}
"5" ->
tm
{ pointer =
if params ! 0 /= 0
then params ! 1
else pNew
}
"6" ->
tm
{ pointer =
if params ! 0 == 0
then params ! 1
else pNew
}
"7" ->
tmBinop
(\x y ->
if x < y
then 1
else 0)
"8" ->
tmBinop
(\x y ->
if x == y
then 1
else 0)
"9" -> tmn {pointerOffset = pointerOffset tm + (params ! 0)}
"99" -> tm {state = Halt}
_ -> error "Illegal Opcode."
2019-12-11 20:21:55 +01:00
where
pNew = pointer tm + opLength (tape tm ! fromInteger (pointer tm))
tmn = tm {pointer = pNew}
opvec =
slice
(fromInteger (pointer tm))
(fromInteger (pNew - pointer tm))
(tape tm)
(op, m) = getOpModes opvec
params = paramChange m (pointerOffset tm) opvec (tape tm)
tmBinop x = getNewTM ((params ! 0) `x` (params ! 1))
{-without the following DeepSeq call, thunks build up eternally and
the vectors wont be garbage collected: >4GB RAM usage, god knows
how much with larger tapes (my laptop crashed), now its a cozy ~20mB-}
2019-12-12 17:43:55 +01:00
getNewTM x = tmn {tape = DeepSeq.force (tape tm // [(target, x)]), state = Continue}
2019-12-11 20:21:55 +01:00
target =
fromInteger $
case m !! (length params - 1) of
Relative -> V.last opvec + pointerOffset tm
_ -> V.last opvec
execSteps :: TuringMachine -> TuringMachine
execSteps tm =
case state tmNew of
Continue -> execSteps tmNew
_ -> tmNew
where
tmNew = step tm