Haskell 中的简单搜索树：为什么堆栈溢出？

Question

我对 Haskell 完全陌生，正在努力学习。我决定编写一个简短的（不平衡的）二叉搜索树代码来开始。它将文本分解为单词，将单词添加到二叉树（丢弃重复项），然后遍历树以打印出文本中单词的排序列表。

data BinTree t = ExternalNode
               | InternalNode (BinTree t) t (BinTree t)

treeInsert :: Ord t => BinTree t -> t -> BinTree t
treeInsert ExternalNode                     w = InternalNode ExternalNode w ExternalNode
treeInsert tree@(InternalNode left v right) w
  | w == v    = tree
  | w < v     = InternalNode (treeInsert left w) v right
  | otherwise = InternalNode left v (treeInsert right w)

treeFromList :: Ord t => [t] -> BinTree t
treeFromList l = go ExternalNode l
  where
    go acc []       = acc
    go acc (x : xs) = acc `seq` go (treeInsert acc x) xs

inOrderList :: BinTree t -> [t]
inOrderList ExternalNode                = []
inOrderList (InternalNode left v right) = (inOrderList left) ++ [ v ] ++ (inOrderList right)

main :: IO ()
main = do
  tmp <- readFile "words.txt"
  printList . inOrderList . treeFromList $ words tmp

  where
    printList []       = return ()
    printList (x : xs) = do
      putStrLn x
      printList xs

该程序适用于小文本。然后我给它喂了詹姆士国王圣经。它崩溃抱怨堆栈大小太小。我必须将堆栈大小增加到 200M 才能使其工作！

我的错误在哪里？我想这可能与懒惰的评估搞砸了一些事情有关。无论如何，问题不在于二叉搜索树的深度，对于圣经示例，二叉搜索树的深度仅为 163。

Answer 1

问题在于您构建的 thunk 嵌套太深。

此版本在treeInsert 中添加了seq 调用，以强制在树的每个级别进行评估 并且可以在很少的堆栈中运行：

import System.Environment
import Control.Monad

data BinTree t = ExternalNode
               | InternalNode (BinTree t) !t (BinTree t)

treeInsert :: Ord t => BinTree t -> t -> BinTree t
treeInsert ExternalNode                     w = InternalNode ExternalNode w ExternalNode
treeInsert tree@(InternalNode left v right) w
  | w == v    = tree
  | w < v     = let t = treeInsert left w  in t `seq` InternalNode t v right
  | otherwise = let t = treeInsert right w in t `seq` InternalNode left v t

treeFromList :: Ord t => [t] -> BinTree t
treeFromList l = go ExternalNode l
  where
    go acc []       = acc
    go acc (x : xs) = let t = treeInsert acc x in t `seq` go t xs

inOrderList :: BinTree t -> [t]
inOrderList ExternalNode                = []
inOrderList (InternalNode left v right) = (inOrderList left) ++ [ v ] ++ (inOrderList right)

main1 = do
  (arg0:_) <- getArgs
  tmp <- readFile arg0
  let t = treeFromList $ words tmp
  forM_ (inOrderList t) putStrLn

main = main1

也可以在BinTree的定义中使用严格注解：

data BinTree t = ExternalNode | InternalNode !(BinTree t) !t !(BinTree t)

代替seq 调用treeInsert - 这是Data.Set 所做的。

看来treeFromList 中的seq 调用效果不大。