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) type Tape = Vector Integer type TapeSection = Vector Integer type TuringMachine = (Tape,Integer,Integer) main = do content <- readFile "input" let tape = fromList $ L.concatMap (L.map read . splitOn ",") (lines content) let (tm,_,out,_) = execSteps ((tapePreprocess tape,0,0),[2],[],Continue) print $ L.reverse out tapePreprocess :: TapeSection -> TapeSection tapePreprocess t = (V.++) t $ V.replicate 99999 0 opLength :: Integer -> Integer opLength x | n`L.elem`"1278"=4 | n`L.elem`"56"=3 | n`L.elem`"349"=2 | otherwise=1 where n = L.last $ show x parseModes :: String -> [Mode] parseModes m = L.replicate (3 - L.length l) Position L.++ l where l = L.map (toEnum . digitToInt) m paramChange :: [Mode] -> Integer -> TapeSection -> Tape -> TapeSection 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 :: TapeSection -> (String, [Mode]) getOpModes opvec = (op_dedup,parsed_modes) where (op,modes) = L.splitAt 2 $ L.reverse $ show $ opvec ! 0 parsed_modes = L.reverse $ parseModes $ L.reverse modes op_dedup = if L.last op == '0' then [L.head op] else op step :: TapeSection -> (TuringMachine, [Integer], [Integer]) -> (TuringMachine, OutAction, [Integer], [Integer]) step opvec ((t,p,rbase),input,val) = case op of "1" -> (tm_binop (+),Continue,input,val) "2" -> (tm_binop (*),Continue,input,val) "3" -> (new_tm t $ L.head input,Continue,L.tail input,val) "4" -> ((t,p,rbase),Output,input,V.last params:val) "5" -> ((t, if params ! 0/=0 then params ! 1 else p,rbase),Continue,input,val) "6" -> ((t, if params ! 0==0 then params ! 1 else p,rbase),Continue,input,val) "7" -> (new_tm t (if (params ! 0)<(params ! 1) then 1 else 0),Continue,input,val) "8" -> (new_tm t (if (params ! 0)==(params ! 1) then 1 else 0),Continue,input,val) "9" -> ((t,p,rbase + (params ! 0)),Continue,input,val) "99" -> ((t,p,rbase),Halt,input,val) where (op,m) = getOpModes opvec params = paramChange m rbase opvec t tm_binop x = new_tm t ((params ! 0) `x` (params ! 1)) --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 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 Halt -> ((t_new,p_new,rbase_new),input_new,output_new,cond) _ -> execSteps ((t_new,p_new,rbase_new),input_new,output_new,cond)