Haskell单子环境下tie-the-knot模式调试与实现问题问询

我正在用Haskell实现一个支持延迟绑定的编程语言解释器，采用tying-the-knot模式处理表达式求值，但该模式的调试与推理难度极大。我已投入至少40小时研究，虽对惰性求值和tying-the-knot模式有了更多理解，但核心问题仍未解决，部分行为也存在疑惑。

问题 #

• 有没有合理的方法调试tying-the-knot模式，找出导致bottom（求值失败/死循环）的原因？启用profiling选项后，GHC的堆栈跟踪仅显示死循环触发的内部函数，无法明确定义中哪里出现了严格求值，定位问题非常困难。
• 如何在单子上下文（monadic context）中正确使用tying-the-knot模式？已知traverse这类函数对多数类型是严格的，会导致模式触发bottom。目前我想到的解决方案是移除该模式，但会增加复杂度（需要重复计算值）；虽然可以用STRef做缓存优化，但我希望能利用Haskell的惰性求值特性，避免这种方案。
• 为什么提供的代码中evalSt e1能正常终止，而evalSt e2会陷入死循环？我无法理解两者的差异。

语言AST #

data Expr = Int Int | Negate Expr | Id String | Obj (M.Map String Expr)
  deriving (Eq, Ord, Show)

pprint :: Expr -> String
pprint e = case e of
  Int i -> show i
  Negate i -> "(-" ++ pprint i ++ ")"
  Id i -> i
  Obj obj -> "{" ++ intercalate ", "
    [ k ++ ":" ++ pprint v | (k,v) <- M.toList obj ] ++ "}"

示例程序 #

--         表达式: {a:{aa1:(-b), aa2:ab, ab:(-b)}, b:3}
-- 预期求值结果: {a:{aa1:-3,   aa2:-3, ab:-3  }, b:3}
e1 = Obj $ M.fromList [
  ("a", Obj $ M.fromList [
    ("aa1", Negate $ Id "b"),
    ("aa2", Id "ab"),
    ("ab", Negate $ Id "b")
    ]),
  ("b", Int 3)
  ]

--         表达式: {a:{aa:(-ab), ab:b}, b:3}
-- 预期求值结果: {a:{aa:-3,    ab:3}, b:3}
e2 = Obj $ M.fromList [
  ("a", Obj $ M.fromList [
    ("aa", Negate $ Id "ab"),
    ("ab", Id "b")
    ]),
  ("b", Int 3)
  ]

纯求值函数 #

type Scope = M.Map String Expr

eval :: Scope -> Expr -> Expr
eval scope expr = case expr of
  Int i -> Int i
  Id str -> case M.lookup str scope of
    Just e  -> e
    Nothing -> error $ str ++ " not in scope"
  Negate aE -> do
    case (eval scope aE) of
      Int i -> Int $ -i
      _   -> error $ "Can only negate ints. Found: " ++ pprint aE
  Obj kvMap -> Obj $
    let resMap = fmap (eval (M.union resMap scope)) kvMap
    in resMap

单子求值 #

State单子实现 #

evalSt' :: Expr -> State Scope Expr
evalSt' expr = do
  scope <- get
  case expr of
    Int i -> pure $ Int i
    Id str -> case M.lookup str scope of
      Just e  -> pure e
      Nothing -> error $ str ++ " not in scope"
    Negate aE -> do
      a <- evalSt' aE
      case a of
        Int i -> pure $ Int $ -i
        _     -> error $ "Can only negate ints. Found: " ++ pprint aE
    Obj obj -> mdo
      put $ M.union newScope scope
      newScope <- traverse evalSt' obj
      put scope
      pure $ Obj newScope

evalSt scope expr = evalState (evalSt' expr) scope

IO单子实现 #

evalM :: Scope -> Expr -> IO Expr
evalM scope expr = case expr of
  Int i -> pure $ Int i
  Id str -> case M.lookup str scope of
    Just e  -> pure e
    Nothing -> error $ str ++ " not in scope"
  Negate aE -> do
    a <- evalM scope aE
    case a of
      Int i -> pure $ Int $ -i
      _     -> error $ "Can only negate ints. Found: " ++ pprint aE
  Obj kvMap -> mdo
    resMap <- traverse (evalM (M.union resMap scope)) kvMap
    pure $ Obj resMap

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