80 lines
3.4 KiB
Haskell
80 lines
3.4 KiB
Haskell
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)
|