2019-12-09 10:31:36 +01:00
import Data.List.Split
import qualified Data.List as L
import Data.Vector as V
import Data.Char
2019-12-09 11:37:51 +01:00
import Control.DeepSeq as DeepSeq
2019-12-09 10:31:36 +01:00
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 )
2019-12-09 11:37:51 +01:00
let ( tm , _ , out , _ ) = execSteps ( ( tapePreprocess tape , 0 , 0 ) , [ 2 ] , [] , Continue )
2019-12-09 10:31:36 +01:00
print $ L . reverse out
tapePreprocess :: TapeSection -> TapeSection
2019-12-09 15:42:19 +01:00
tapePreprocess t = ( V .++ ) t $ V . replicate 150 0
2019-12-09 10:31:36 +01:00
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 ) )
2019-12-09 11:37:51 +01:00
--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 )
2019-12-09 10:31:36 +01:00
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 ) =
2019-12-09 11:37:51 +01:00
let command_length = opLength $! t ! fromInteger p
2019-12-09 10:31:36 +01:00
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
2019-12-09 11:37:51 +01:00
Halt -> ( ( t_new , p_new , rbase_new ) , input_new , output_new , cond )
_ -> execSteps ( ( t_new , p_new , rbase_new ) , input_new , output_new , cond )