[Haskell-beginners] Stack Overflow with foldl'
Cyril Pichard
cyril.pichard at gmail.com
Sat Jan 23 08:05:42 EST 2010
Hi,
I don't understand why the following code always result in a Stack space overflow error.
I'm using foldl' and think the main algorithm is tail recursive. Am I wrong ?
I've read the http://www.haskell.org/haskellwiki/Stack_overflow
Any help would be greatly appreciated.
Thanks
module Main where
import Data.List
-- Data structures
data Point = Point { x::Double, y::Double, z::Double } deriving(Eq, Show)
data Triangle = Triangle { p1::Point, p2::Point, p3::Point } deriving(Eq, Show)
data BBox = BBox { bbmax::Point, bbmin::Point } deriving(Eq,Show)
-- Construct a default triangle
newTriangle :: Triangle
newTriangle = Triangle (Point 1 0 0) (Point 0 1 0) (Point 0 0 1)
-- Construct a default BBox
newBBox = BBox (Point 0 0 0) (Point 0 0 0)
-- Defines min and max for Point
instance Ord Point where
max a b = Point ( max (x a ) (x b) ) ( max (y a) (y b) ) ( max (z a) (z b) )
min a b = Point ( min (x a ) (x b) ) ( min (y a) (y b) ) ( min (z a) (z b) )
-- Create a list of triangles
makeTriangles :: Double -> [Triangle]
makeTriangles 0 = []
makeTriangles n = [ Triangle (Point v 0 0) (Point 0 v 0) (Point 0 0 v) | v <- [1..n] ]
-- Compute the bounding box of a triangle
boundingBox :: Triangle -> BBox
boundingBox t = BBox pmax pmin
where pmax = max (p3 t) (max (p1 t) (p2 t))
pmin = min (p3 t) (min (p1 t) (p2 t))
-- Compute the bounding box of two bounding boxes
bboxAddb :: BBox -> BBox -> BBox
bboxAddb (BBox bb1max bb1min) (BBox bb2max bb2min) = BBox (max bb1max bb2max) (min bb1min bb2min)
-- Compute the bounding box of a triangle and a bounding box
bboxAddt :: BBox -> Triangle -> BBox
bboxAddt b t = bboxAddb b (boundingBox t)
main = do print $ foldl' bboxAddt newBBox triangles;
where triangles = makeTriangles 610000
error returned :
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize' to increase it.
ghc version 6.10.3 on MacOsX Snow Leopard
More information about the Beginners
mailing list