为什么我在Haskell中收集堆栈溢出的消息？

Question

 import Data.Vector hiding((++))
 import System.Environment 
 d = generate 1000000 (\z->case z of
                      0 -> 2
                      1 -> 3
                      2 -> 5
                      otherwise -> if odd z then (d ! (z-1)) +2 else (d ! (z-1)) + 4)
 algorithmA _ _  1 pt  = pt
 algorithmA t k n pt = let dk = d ! k
                       q = div n dk
                       r = mod n dk
                      in if r /=0 then
                            if q>dk then
                              algorithmA t (k+1) n pt
                            else (n:pt)
                         else
                             algorithmA (t+1) k q (dk:pt)

main = do
        args<-getArgs
        let n = read (args !! 0)
        if (floor(sqrt(fromInteger n))) > Data.Vector.last d  then error ("The square  root of number is greater than " ++ show (Data.Vector.last d))
     else
         print (algorithmA 0 0 n [])

当我编译上面的程序并在命令行中给出时,test1 2222我会收到消息"Stake space overflow:current size ... use + RTS -Ksize -RTS to increase ...".但是当我在main函数中删除if时,程序运行没有问题.此外,如果我Data.Vector.last d 在ghci中给出命令,则计算值没有问题.那么为什么要打印这条消息呢？当我将堆栈大小增加到20M时,程序播放没有问题.test1是可执行文件的名称.

谢谢.

Answer 1

问题是你的代码在构建时太懒了d.请记住,它Data.Vector.Vector是一个盒装的矢量类型 - 也就是说,它在内部表示为一个指向堆对象的指针数组(它们是值或未评估的thunk).因此,当您填充d时generate,您实际上正在创建一个thunks向量.在你的榜样,当位置在thunk n被访问时,它触发的thunk的在位置评估n-1和n-2,这反过来又触发的thunk的评价n-3,n-4,n-5等等.因此,评估最后一个元素会导致前面的1000000 - 1元素被评估,从而导致堆栈增长.这就是您收到堆栈溢出错误的原因.

在不修改代码的情况下解决此问题的简单方法是在访问最后一个元素之前完全评估整个向量.在这种情况下,所有的thunk是为了评估并没有堆栈溢出(因为一旦一个thunk进行了评估,它与它所代表的表达式的值替换,所以当你评估元素n在已经评价要素后n-1和n-2,只必须访问这两个元素,并且不会触发所有先前thunks的级联评估):

import Control.DeepSeq (($!!))
...
let l = V.last $!! d
...

测试:

$ ghc -O2 Test.hs
[1 of 1] Compiling Main             ( Test.hs, Test.o )
Linking Test ...
$ ./Test 2222    
[101,11,2]

或者,您可以使用未装箱的向量(Ints的平面数组):

d :: U.Vector Int
d = U.create $ do
  v <- M.new dSize
  go 0 v
    where
      dSize = 1000000
      go i v | i >= dSize = return v
             | otherwise = do
               val <- case i of
                 0 -> return 2
                 1 -> return 3
                 2 -> return 5
                 _ -> if odd i
                      then (+2) <$> (M.read v (i-1))
                      else (+4) <$> (M.read v (i-1))
               M.write v i val
               go (i+1) v