意外添加循环语句导致栈空间持续增长，是否属于GHC预期行为？

问题复现代码 #

{-# OPTIONS_GHC -fno-full-laziness #-}

module Main where

import Control.Concurrent.Async (async,waitCatch)
import Data.IORef
import GHC.Conc

main :: IO ()
main = do
  val <- newIORef 0 :: IO (IORef Int)
  let loop1 = do
          cval <- readIORef val
          threadDelay 1
          writeIORef val (cval + 1)
          case cval > 100000000 of
            True -> error "done"
            False -> loop1
          loop1 -- 刻意添加以引发空间泄漏，但由于上方case分支逻辑，该语句永远不会执行

  loop1Async <- async loop1
  res <- waitCatch loop1Async

  return ()

上述代码在ghc-8.8.4版本下，用-O2 -rtsopts -threaded参数编译，加+RTS -s -hT -N参数运行时，会出现栈持续增长的内存泄漏问题。

结论 #

该行为属于GHC的正常预期表现，不是缺陷。

底层原理说明 #

1. Do语法糖的语义拆解 #

loop1函数的do块本质是用>>（IO顺序组合算子）拼接的操作序列：

loop1 = 
  readIORef val >>= \cval ->
  threadDelay 1 >>
  writeIORef val (cval + 1) >>
  (case cval > 100000000 of
    True -> error "done"
    False -> loop1)
  >> loop1 -- 对应刻意添加的最后一行语句

>>算子的语义是：先完整执行左边的IO操作，忽略其返回值，再执行右边的IO操作。

2. 栈增长的核心原因 #

从上面的拆解可以看到，最后一行的冗余loop1，和前面的case表达式通过>>绑定。当代码走到case的False分支时：

• 分支返回的IO操作是loop1本身，作为>>的左操作数
• 运行时需要等待左操作数loop1执行完成后，才能执行>>右操作数的loop1
  但loop1永远不会正常执行完成：要么触发error终止，要么继续递归调用自身。每一次递归调用，都会在栈上压入一个「等待当前loop1返回后执行后续loop1」的上下文，栈空间就会随着循环次数持续增长，最终引发内存泄漏。

3. join point的作用 #

观测到的join point是GHC优化阶段生成的控制流跳转标记，对应>>右操作数的loop1。它本身不会产生额外堆内存开销，但每次递归时，这个跳转目标都会作为返回上下文被压入栈，是栈增长的直接表现而非根本原因。

修复方案 #

移除loop1最后一行的冗余loop1语句即可。删除后case表达式的结果就是整个do块的返回值，False分支的loop1调用属于尾递归，GHC会直接将其优化为原地循环，不会产生额外栈上下文，内存泄漏自然消失。

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