[Haskell-cafe] How to implement nested loops with tail recursion?

[sdiyazg at sjtu.edu.cn]

A follow-up question.
I still haven't got the monadic version working, and the real use case involves IO actions.

I looked at http://www.haskell.org/haskellwiki/Recursion_in_a_monad and adapted the 'tail-recursive' snippet on the page into

main = do
	let 
		f 0 acc = return acc
		f n acc = do
		    v  <- return 1
		    f (n-1) (v+acc)
	f 1000000 100 >>= print

which still blows the memory. 

And so does this program

main = do
	s<-newIORef (0::Int)
	mapM_ (\i->modifyIORef s (+1)) [0..10000000]
	readIORef s>>=print

Why?

----- 原始邮件 -----
发件人: sdiyazg at sjtu.edu.cn
收件人: haskell-cafe at haskell.org
发送时间: 星期四, 2012年 9 月 20日 上午 12:08:19
主题: Re: How to implement nested loops with tail recursion?

Now I have discovered the right version...

main = print (f 1 0::Int) where
	f i s = (if i<=20000 then (f (i+1) (s + g 1 0)) else s) where
		g j s = (if j<=20000 then (g (j+1) (s + i*j)) else s)

----- 原始邮件 -----
发件人: sdiyazg at sjtu.edu.cn
收件人: haskell-cafe at haskell.org
发送时间: 星期三, 2012年 9 月 19日 下午 11:35:11
主题: How to implement nested loops with tail recursion?

I need to implement fast two-level loops, and I am learning using seq to make calls tail-recursive.

I write programs to compute
  main = print $ sum [i*j|i::Int<-[1..20000],j::Int<-[1..20000]]
This program (compiled with -O2) runs twenty times slower than the unoptimized (otherwise the loop gets optimized out) C version.
But it seems to run in constant memory, so I assume that it has been turned into loops.

#include <stdio.h>
int main(){
	int s=0;
	for(int i=1;i<=20000;++i){
		for(int j=1;j<=20000;++j){
			s+=i*j;
		}
	}
	printf("%d\n",s);
	return 0;
}

Then I write

main = print $ f 1 where
	f i = let x = g 1 in x `seq` (x + if i<20000 then f (i+1) else 0) :: Int where
		g j = let x = i*j in x `seq` (x + if j<20000 then g (j+1) else 0) :: Int

This version runs out of memory. When I scale the numbers down to 10000, the program does run correctly, and takes lots of memory.
Even if I change the seqs into deepseqs, or use BangPatterns (f !i =... ; g !j = ...), the situation doesn't change.

A monadic version

import Control.Monad.ST.Strict
import Control.Monad
import Data.STRef.Strict

main = print $ runST $ do
	s <- newSTRef (0::Int)
	let g !i !j = 
		if (j<=10000) then modifySTRef s (+1)>>(g i (j+1)) else return ()
	let f !i = 
		if (i<=10000) then g i 1>>(f $ i+1) else return ()
	f 1 
	readSTRef s

also runs out of memory.

So how can I write a program that executes nested loops efficiently?