Haskell栈溢出问题排查：2023 AoC第8天Part2代码故障

正在解决2023年Advent of Code第8天第二部分问题，编写了如下Haskell代码，但运行时出现栈溢出。已尝试给step函数添加多个bang pattern消除thunk积累，问题仍未解决：

main = readFile "8.txt" >>= print . proc . lines

proc (ds:_:xs) = step 1 ds m as ds where
  m = (foldl' parse) M.empty xs
  as = map (\x -> ((m ! x), False)) $ filter (\x -> (last x) == 'A') $ M.keys m

parse m s = M.insert n (l,r) m where
  (n, ns) = splitAt 3 s
  (l, ls) = splitAt 3 $ drop 4 ns
  r = take 3 $ drop 2 ls

step !i dds m !xs [] = step i dds m xs dds
step !i dds m !xs (d:ds) = if clear xs' then (i + 1) else step (i + 1) dds m xs' ds where
  !xs' = map (move m d) xs
  clear !cs = all (\(_,t) -> t) cs

move m 'L' ((!x,_),_) = ((m ! x), (last x) == 'Z')
move m 'R' ((_,!x),_) = ((m ! x), (last x) == 'Z')

栈溢出的核心原因 #

1. all函数的非尾递归导致栈积累
   clear函数依赖的all并非尾递归实现：all p (x:xs) = p x && all p xs。当需要遍历较长的列表（比如所有元素的t都为True，必须遍历完整个列表）时，all的递归调用会不断创建栈帧，最终引发栈溢出。

2. 惰性列表与未求值的thunk积累

   • xs'是map生成的惰性列表，每个元素的第二个布尔值（last x == 'Z'）是未求值的thunk，直到clear遍历才会被计算，这会在栈中积累大量未处理的计算单元。
   • clear函数的!cs仅严格求值列表头部，列表尾部仍为惰性，进一步加剧了thunk的积累。

修复建议 #

• 替换all为严格的尾递归实现
  用foldl'实现clear，避免非尾递归的栈积累：

  clear !cs = foldl' (\acc (_, t) -> acc && t) True cs
  

  foldl'是严格左折叠，每一步都会求值当前结果，不会保留栈帧。

• 提前严格求值布尔值
  修改move函数，强制提前计算last x == 'Z'，避免thunk延迟到clear阶段：

  move m 'L' ((!x,_),_) = let b = last x == 'Z' in b `seq` ((m ! x), b)
  move m 'R' ((_,!x),_) = let b = last x == 'Z' in b `seq` ((m ! x), b)
  

• 使用严格列表生成xs'
  导入Data.List.Strict并使用严格版map，确保xs'的每个元素都被提前求值：

  import Data.List.Strict (map)
  -- 在step中替换为：
  !xs' = Data.List.Strict.map (move m d) xs
  

内容的提问来源于stack exchange，提问作者Arii