Hi,
This is probably a simple question, but I sure don't know the answer. I'm
dabbling with haskell at the moment and have hit a problem. I remember something
from undergraduate school about how to write recursive functions so that
they don't eat up stack space, and instead behave more like while loops
(I think you had to convert them to tail-recursive forms?).
I've tried different variations, and it appears that they're all using the
stack and cause overflows when I expect that they wouldn't. All of these
are okay on standard Hugs for n = 13000, but all except testR5 cause Control
stack overflows for n = 14000. I thought that at least one of the forms
of testR2, testR3 and testR4 would be recognised as tail-recursive, and
executed as loops without using the stack. The stack overflow for n = 14000
appears to show me to be wrong.
(For example, testR2 13000 works, but testR2 14000 gives a Control stack
overflow).
Can anyone help with this? I'd like to be able to process lists with over
14000 elements, so need some help.
Thanks,
Eoin
module Test where
import Numeric
testR1 :: Integer -> Integer
testR1 0 = 0
testR1 n = n + (testR1 (n-1))
testR2 :: Integer -> Integer
testR2 n = testR2' 0 n
testR2' :: Integer -> Integer -> Integer
testR2' a 0 = a
testR2' a n = testR2' (a+n) (n-1)
testR3 :: Integer -> Integer
testR3 n = testR3' n 0
testR3' :: Integer -> Integer -> Integer
testR3' 0 a = a
testR3' n a = testR2' (a+n) (n-1)
testR4 :: Integer -> Integer
testR4 n = testR4' (0,n)
testR4' :: (Integer, Integer) -> Integer
testR4' (a,0) = a
testR4' (a,n) = testR4' (a+n,n-1)
testR5 :: Integer -> Integer
testR5 0 = 0
testR5 n = testR5 (n-1)
-- end of module Test
__________________________________________________________________
INTRODUCTORY OFFER! Tiscali Business Broadband for £15.99!
http://www.tiscali-business.co.uk/broadband/?code=ZZ-MS-12KC
Hi Scott,
Thanks for your insight on this one. My test routines now work, and I now
have a better understanding of this aspect of Haskell.
Best regards,
Eoin
-----Original Message-----
From: Scott Turner [mailto:p.turner@computer.org]
Sent: 18 November 2004 16:32
To: hugs-users(a)haskell.org
Cc: eoin.mcdonnell(a)lineone.net
Subject: Re: [Hugs-users] Avoiding use of the stack
On 2004 November 18 Thursday 06:15, eoin.mcdonnell(a)lineone.net wrote:
> how to write recursive functions
> so that they don't eat up stack space, and instead behave more like while
> loops (I think you had to convert them to tail-recursive forms?).
> testR2 :: Integer -> Integer
> testR2 n = testR2' 0 n
> testR2' :: Integer -> Integer -> Integer
> testR2' a 0 = a
> testR2' a n = testR2' (a+n) (n-1)
You're on the right track. This is properly tail recursive. The remaining
problem is that the argument (a+n) does not get evaluated during the
processing of testR2'. So each successive call to testR2' is passed a larger
expression such as
testR2' (((((0+10)+9)+8)+7)+6) (6-1)
Pattern matching causes the second argument to be evaluated.
To ensure that the first argument is processed, you can use the $! operator.
testR2' a n = (testR2' $! (a+n)) (n-1)
which evaluates (a+n) before passing it to testR2'.
Where you see stack overflow, it's actually a stack of + opeations rather
than
a stack of testR2' calls.
__________________________________________________________________
INTRODUCTORY OFFER! Tiscali Business Broadband for £15.99!
http://www.tiscali-business.co.uk/broadband/?code=ZZ-MS-12KC