Help: Stack-overflow and tail-recursive functions
Koji Nakahara
yu-@div.club.ne.jp
Thu, 19 Jun 2003 11:41:25 +0900
On Wed, 18 Jun 2003 17:36:28 -0700
"Hal Daume" <t-hald@microsoft.com> wrote:
> Note that there is essentially no difference between f1 and f2. When
> you $! in f2, all it does is ensure that the argument isn't undefined.
> It doesn't evaluate any of the list. Try $!! from the DeepSeq module or
> write your own list-forcing function.
Thank you very much. I understand.
However my original program still (or maybe from the beginning) stack-overflows
at another point, in the middle of the evaluation of "forpaintbdry".
Please give me some advice.
-----------
-- snippet of the program for painting a random matrix from its boundary.
module Main where
import System
import Random
import Array
import Ix
import List
main = putStrLn $ show $ forpaintbdry $ rmat 200
forpaintbdry m = [(pos, Live) | pos <- (uncurry bdryidxlist) $ bounds m , isUnknown $ m ! pos ]
bdryidxlist :: (Int, Int) -> (Int, Int) -> [(Int, Int)]
bdryidxlist (a1, a2) (b1, b2) = nub $ [(ab, j) | ab <- [a1, b1], j <- [a2..b2]] ++
[(i, ab) | ab <- [a2, b2], i <- [a1..b1]]
rmat n = listArray ((1,1),(n,n)) $ map ct (randoms (mkStdGen 1) ::[Bool])
where ct True = Unknown
ct False = Dead
data CellColor = Live | Unknown | Dead
isUnknown Unknown = True
isUnknown _ = False
instance Show CellColor where
show Live = "Live"
show Unknown = "Unknown"
show Dead = "Dead"