Haskell三路归并排序代码运行出现栈溢出异常求助

问题分析 #

导致栈溢出的核心原因有两个：

1. Merge函数的无限递归分支 #

你的merge函数中存在多个无意义的递归分支，比如：

merge left middle [] = merge left middle []
merge left [] right = merge left [] right

这些分支直接以完全相同的参数递归调用自身，没有任何终止条件，一旦触发就会无限消耗栈空间，最终引发溢出。

2. 归并排序的拆分逻辑缺陷 #

当输入列表长度小于3时（比如测试用的[2,1]），n = length xs = 2，n div 3 = 0，因此：

• left = take 0 xs = []
• middle = take 0 (drop 0 xs) = []
• right = drop 0 xs = [2,1]
  这会导致threeWayMergeSort right再次调用自身，传入的还是[2,1]，陷入无限递归循环，进一步加剧栈溢出。

修复后的代码 #

-- three_way.hs

-- 辅助函数：合并两个有序列表
mergeTwo :: Ord a => [a] -> [a] -> [a]
mergeTwo [] ys = ys
mergeTwo xs [] = xs
mergeTwo (x:xs) (y:ys)
  | x <= y = x : mergeTwo xs (y:ys)
  | otherwise = y : mergeTwo (x:xs) ys

-- 合并三个有序列表
merge :: Ord a => [a] -> [a] -> [a] -> [a]
merge xs ys zs = mergeTwo (mergeTwo xs ys) zs

-- 3-way Merge Sort 函数
threeWayMergeSort :: Ord a => [a] -> [a]
threeWayMergeSort [] = []
threeWayMergeSort [x] = [x]
threeWayMergeSort [x,y] = if x <= y then [x,y] else [y,x]
threeWayMergeSort xs = merge sortedLeft sortedMiddle sortedRight
  where
    n = length xs
    third = n `div` 3
    left = take third xs
    middle = take third (drop third xs)
    right = drop (2 * third) xs
    sortedLeft = threeWayMergeSort left
    sortedMiddle = threeWayMergeSort middle
    sortedRight = threeWayMergeSort right

代码说明 #

1. 抽离两两合并逻辑：新增mergeTwo函数专门处理两个有序列表的合并，避免原merge函数的分支错误。三个列表的合并通过两次调用mergeTwo完成，逻辑简洁可靠。
2. 补充短列表基本情况：新增长度为2的列表直接排序逻辑，避免对短列表进行无效拆分导致的无限递归。
3. 保留三等份拆分：对于长度≥3的列表，依然按三等份拆分，保证归并排序的核心逻辑正确。

测试验证：

ghci> threeWayMergeSort [2,1]
[1,2]
ghci> threeWayMergeSort [3,1,4,1,5,9,2,6]
[1,1,2,3,4,5,6,9]

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