Here's the test case...
The space profile for tests 2 and 3 look interesting;
there are n triangular "spikes" (where 'n' is the breadth
of the tree) that drop off sharply.
My hypothesis is that 'deserialize' (the problematic function,
called 'buildTree' in my earlier message) is building up
a long chain of suspensions of the form
snd . snd . snd . ... build
that aren't getting reduced... not sure about this though.
It takes a really large tree before Hugs runs out of space
with this test case (breadth=11, depth=6 or so). In my
real program though there's much more data stored at each
node and it fails on modestly-sized inputs.
Thanks in advance for any advice...
--Joe English
[EMAIL PROTECTED]
--
module SpaceLeak where
data Tree a = Tree a [Tree a]
deriving (Show, Eq)
--
-- a few of the usual polytypic functions...
--
mapTree :: (a -> b) -> Tree a -> Tree b
mapTree f (Tree a c) = Tree (f a) (map (mapTree f) c)
type TreeF a b = (a, [b])
cataTree :: (TreeF a b -> b) -> Tree a -> b
anaTree :: (b -> TreeF a b) -> b -> Tree a
cataTree f (Tree a c) = f (a,map (cataTree f) c)
anaTree g b = let (a,bs) = g b in Tree a (map (anaTree g) bs)
--
-- and a few useful utilies...
--
preorderTree :: Tree a -> [a]
preorderTree t = traverse t [] where
traverse (Tree a c) k = a : travlist c k
travlist (c:cs) k = traverse c (travlist cs k)
travlist [] k = k
sizeTree :: Tree a -> Integer
sizeTree = cataTree (\(_,l)-> 1 + sum l)
treeChildren (Tree n c) = c
--
-- A datatype for tree serialization:
-- This is similar to the tokens returned by an XML parser.
--
data Event a =
StartTag a
| Data a
| EndTag
deriving (Show,Eq)
--
-- serialize turns a tree into a list of start/data/end events.
--
serialize :: Tree a -> [Event a]
serialize t = stree t [] where
stree (Tree x []) k = Data x : k
stree (Tree x l) k = StartTag x : slist l (EndTag : k)
slist [] k = k
slist (t:ts) k = stree t (slist ts k)
--
-- deserialize builds a tree from a list of events;
-- (deserialize . serialize) = id
--
-- This is the problematic function.
--
deserialize :: [Event a] -> Tree a
deserialize events = head (fst (build events)) where
build :: [Event a] -> ([Tree a], [Event a])
build [] = ([],[])
build (e:es) = case e of
Data a ->
let (siblings, rest) = build es
in (Tree a [] : siblings, rest)
StartTag a ->
let (children,es') = build es
(siblings,rest) = build es'
in (Tree a children : siblings, rest)
EndTag -> ([],es)
--
-- 'sampleTree breadth depth' generates a tree of the specified depth,
-- where each non-leaf node node has 'breadth' children.
--
testTree breadth depth = anaTree testCOAlg depth where
testCOAlg n = (n, if n > 1 then take breadth $ repeat (n-1) else [])
--
-- Quick sanity check to make sure 'deserialize' works as specified:
--
test0 n m = testTree n m == (deserialize . serialize) (testTree n m) -- True
--
-- The following all run in bounded space:
-- try with ':set -d1000' in Hugs, n=4, m=6 or so...
-- In particular, serialize $ testTree n m behaves nicely.
--
test1a n m = sizeTree $ testTree n m
test1b n m = length $ preorderTree $ testTree n m
test1c n m = length $ serialize $ testTree n m
--
-- These seem to leak space:
--
test2a n m = sizeTree $ deserialize $ serialize $ testTree n m
test2b n m = length $ preorderTree $ deserialize $ serialize $ testTree n m
test3a n m = deserialize $ serialize $ testTree n m
test3b n m = preorderTree $ deserialize $ serialize $ testTree n m
-- This does not:
test4a n m = length $ treeChildren $ deserialize $ serialize $ testTree n m
-- But this does:
test4b n m = map (length . treeChildren) $ treeChildren
$ deserialize $serialize $ testTree n m
-- *EOF* --
