Bad Haskell, Debug.Trace ftw!

day8/main.hs

@@ -37,13 +37,19 @@ initialVM :: Vector Op -> VirtualMachine
 initialVM ins = VM 1 0 ins VMRun
 
 stepVM :: VirtualMachine -> Maybe (VirtualMachine, VirtualMachine)
-stepVM vm@(VM c a ins VMRun) = Just (vm, checkHalt (go (ins V.! (c-1))))
+stepVM current@(VM c a ins VMRun) = Just (current, checkHalt next)
   where
+    next = go (ins V.! (c-1))
+
     go (OpNop _)        = VM (c+1) a     ins VMRun
     go (OpJmp n)        = VM (c+n) a     ins VMRun
     go (OpAcc n)        = VM (c+1) (a+n) ins VMRun
-    checkHalt vm0@(VM c0 _ _ _) | c0 == lastCount = vm0 { vmState = VMHalt}
-    checkHalt vm0@(VM _ _ _ _)  | otherwise = vm0
+
+    checkHalt vm0@(VM c0 a0 _ _) | c0 == lastCount + 1 =
+      trace ("halted, acc="<>show a0) $ vm0 { vmState = VMHalt }
+    checkHalt vm0@(VM _ _ _ _)  | otherwise =
+      vm0
+
     lastCount = V.length ins
 stepVM (VM _ _ _ VMHalt) = Nothing
 
@@ -102,16 +108,15 @@ shortestCycleVm vx = (\(a,b,c,d) -> VM a b c d) <$> zip4 (shortestCycle cx) ax i
 
 -- Try lots of permutations of OpNop -> OpJmp, or OpJmp -> OpNop
 -- until the VirtualMachine halts, and read the value of the accumulator
-solvePart2 :: Vector Op -> Vector Int
-solvePart2 = fmap (pgmAccumulator . last . shortestCycleVm . unfoldr stepVM . initialVM) . swapInstructions
+solvePart2 :: Vector Op -> Vector VMState
+solvePart2 = fmap (vmState . last . shortestCycleVm . unfoldr stepVM . initialVM) . swapInstructions
 
 swapInstructions :: Vector Op -> Vector (Vector Op)
-swapInstructions ins = V.imapM swap ins
+swapInstructions ins = V.imap swap ins
   where
-    -- swap i (OpNop v) = ins V.// [(i,OpJmp v)]
-    -- swap i (OpJmp v) = ins V.// [(i,OpNop v)]
-    -- swap _ (OpAcc _) = ins
-    swap _ _ = ins
+    swap i (OpNop v) = ins V.// [(i,OpJmp v)]
+    swap i (OpJmp v) = ins V.// [(i,OpNop v)]
+    swap _ (OpAcc _) = ins
 
 main :: IO ()
 main = do
@@ -126,7 +131,10 @@ main = do
   putStrLn ":: Tests"
   let miniIns = V.fromList [OpJmp 2, OpNop 0, OpAcc (-8)]
   pPrint $ length $ swapInstructions $ miniIns
-  pPrint $ miniIns V.// [(0,OpNop (-1))]
+  let miniVM = initialVM $ V.fromList [ OpNop 0 ]
+  pPrint $ miniVM { vmState = VMHalt }
+  pPrint $ (unfoldr stepVM) $ miniVM
   putStrLn ":: Solving part 2"
-  --pPrint $ solvePart2 $ V.fromList $ parseOp <$> exampleData
+  pPrint $ solvePart2 $ V.fromList $ parseOp <$> exampleData
+  pPrint $ solvePart2 $ V.fromList $ parseOp <$> input