Day 9: Cleanup, fix memory leak

This commit is contained in:
shu 2019-12-09 11:37:51 +01:00
parent 2609de6861
commit af544aaec9

View File

@ -2,6 +2,7 @@ import Data.List.Split
import qualified Data.List as L
import Data.Vector as V
import Data.Char
import Control.DeepSeq as DeepSeq
data OutAction = Continue | Output | Halt deriving (Enum, Eq, Show)
data Mode = Position | Immediate | Relative deriving (Enum, Eq, Show)
@ -12,32 +13,11 @@ type TuringMachine = (Tape,Integer,Integer)
main = do
content <- readFile "input"
let tape = fromList $ L.concatMap (L.map read . splitOn ",") (lines content)
let (tm,_,out,_) = runAmp ((tapePreprocess tape,0,0),[2],[],Continue)
let (tm,_,out,_) = execSteps ((tapePreprocess tape,0,0),[2],[],Continue)
print $ L.reverse out
findMax :: Tape -> [Integer] -> Integer
findMax tape range = L.maximum [runAmps tape xs | xs <- L.permutations range]
runAmps :: Tape -> [Integer] -> Integer
runAmps tape intseq = L.head $ runAmps' tms intseq [0]
where tms = L.replicate 5 (tape,0,0)
runAmps' :: [TuringMachine] -> [Integer] -> [Integer] -> [Integer]
runAmps' ((t,p,rbase):tms) intseq prev =
if halt == Halt then prev else
runAmps' (tms L.++ [tm_new]) tailseq tm_out
where (tm_new,tm_in,tm_out,halt) = execSteps ((t,p,rbase),xprev,[],Continue)
tailseq = if L.null intseq then [] else L.tail intseq
xprev = if L.null intseq then prev else L.head intseq:prev
runAmp :: (TuringMachine, [Integer], [Integer], OutAction) -> (TuringMachine, [Integer], [Integer], OutAction)
runAmp (tm,input,output,cond) = case cond_new of
Output -> runAmp (tm_new,input_new,output_new,cond_new)
_ -> (tm_new,input_new,output_new,cond_new)
where (tm_new,input_new,output_new,cond_new) = execSteps (tm,input,output,Continue)
tapePreprocess :: TapeSection -> TapeSection
tapePreprocess t = (V.++) t $ V.replicate 9999 0
tapePreprocess t = (V.++) t $ V.replicate 99999 0
opLength :: Integer -> Integer
opLength x
@ -81,17 +61,19 @@ step opvec ((t,p,rbase),input,val) = case op of
where (op,m) = getOpModes opvec
params = paramChange m rbase opvec t
tm_binop x = new_tm t ((params ! 0) `x` (params ! 1))
new_tm t x = (t // [(target, x)],p,rbase)
--without the following DeepSeq call, thunks build up eternally
--and the vectors won’t be garbage collected (>4GB RAM usage)
new_tm t x = DeepSeq.force (t // [(target, x)],p,rbase)
target = fromInteger $ case m !! (L.length params -1) of
Relative -> V.last opvec + rbase
_ -> V.last opvec
execSteps :: (TuringMachine, [Integer], [Integer], OutAction) -> (TuringMachine, [Integer], [Integer], OutAction)
execSteps ((t,p,rbase),input,output,halt) =
let command_length = opLength $ t ! fromInteger p
let command_length = opLength $! t ! fromInteger p
opvec = slice (fromInteger p) (fromInteger command_length) t
((t_new,p_new,rbase_new),cond,input_new,output_new) =
step opvec ((t,p+command_length,rbase),input,output) in
case cond of
Continue -> execSteps ((t_new,p_new,rbase_new),input_new,output_new,cond)
_ -> ((t_new,p_new,rbase_new),input_new,output_new,cond)
Halt -> ((t_new,p_new,rbase_new),input_new,output_new,cond)
_ -> execSteps ((t_new,p_new,rbase_new),input_new,output_new,cond)