Day 9: Even more refactor

2019/day9/Intcode.hs

@@ -3,7 +3,7 @@ module Intcode
               state)
   , step
   , tapePreprocess
-  , TMAction(Continue, Output, Halt)
+  , TMOutState(Continue, AwaitInput, Halt)
   , execSteps
   ) where
 
@@ -23,9 +23,9 @@ import Data.Vector as V hiding
   )
 import qualified Data.Vector as V ((++), last)
 
-data TMAction
+data TMOutState
   = Continue
-  | Output
+  | AwaitInput
   | Halt
   deriving (Enum, Eq, Show)
 
@@ -41,8 +41,8 @@ data TuringMachine =
     , pointer :: Integer
     , pointerOffset :: Integer
     , output :: [Integer]
-    , input :: [Integer]
-    , state :: TMAction
+    , input :: Maybe Integer
+    , state :: TMOutState
     }
   deriving (Show)
 
@@ -88,7 +88,7 @@ step tm =
   case op of
     "1" -> tmBinop (+)
     "2" -> tmBinop (*)
-    "3" -> (getNewTM $ head $ input tm) {input = L.tail $ input tm}
+    "3" -> maybe tm{state = AwaitInput} getNewTM (input tm)
     "4" -> tmn {output = V.last params : output tm}
     "5" ->
       tm
@@ -133,7 +133,7 @@ step tm =
     {-without the following DeepSeq call, thunks build up eternally and
     the vectors won’t be garbage collected: >4GB RAM usage, god knows
     how much with larger tapes (my laptop crashed), now it’s a cozy ~20mB-}
-    getNewTM x = tmn {tape = DeepSeq.force (tape tm // [(target, x)])}
+    getNewTM x = tmn {tape = DeepSeq.force (tape tm // [(target, x)]), state = Continue}
     target =
       fromInteger $
       case m !! (length params - 1) of

2019/day9/day9.hs

@@ -15,14 +15,18 @@ main = do
              , pointer = 0
              , pointerOffset = 0
              , output = []
-             , input = [x]
+             , input = Nothing
              , state = Continue
-             })
-  let out1 = output $ run 1
-  let out2 = output $ run 2
+             }) x
+  let out1 = output $ run $ Just 1
+  let out2 = output $ run $ Just 2
   print $
     concat
       ["Part 1: " ++ show a ++ ", Part 2: " ++ show b | a <- out1, b <- out2]
 
-runIntcode :: TuringMachine -> TuringMachine
-runIntcode = execSteps
+runIntcode :: TuringMachine -> Maybe Integer -> TuringMachine
+runIntcode tm x = case state tmNew of
+    Continue -> runIntcode tmNew x
+    AwaitInput -> runIntcode (tmNew{input = x}) x
+    _ -> tmNew
+    where tmNew = execSteps tm