#3403: linear stack usage where constant stack usage expected
-------------------------------+--------------------------------------------
Reporter: igloo | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 6.10.4
Severity: normal | Keywords:
Difficulty: Unknown | Testcase:
Os: Unknown/Multiple | Architecture: Unknown/Multiple
-------------------------------+--------------------------------------------
I would expect this program:
{{{
{-# LANGUAGE BangPatterns #-}
module Main (main) where
import qualified Data.Set as Set
import Data.Set (Set)
data Result = Result !S1 !S2
type S1 = Set ()
type S2 = Set ()
input :: [[(Int, ())]]
input = replicate 1000 (replicate 400 (100, ()))
main :: IO ()
main = do let Result s1 s2 = doAll Set.empty Set.empty () input
print $ Set.size s1
print $ Set.size s2
doAll :: S1 -> S2 -> () -> [[(Int, ())]] -> Result
doAll !s1 !s2 !_ [] = Result s1 s2
doAll !s1 !s2 !unit ([] : xs) = doAll s1 s2 unit xs
doAll !s1 !s2 !unit (((t, _) : x1) : x2 : xs)
| t >= 99999 = doAll s1 s2 unit (x1 : x2 : xs)
doAll !s1 !s2 !unit (((_, ()) : x) : xs)
= doAll s1 s2 unit (x : xs)
}}}
to run through the input list in constant stack space, and finish
successfully. However, with the HEAD (and 6.8.2 and 6.10.3):
{{{
$ ghc -O --make foo -ddump-simpl > out
$ ./foo
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize' to increase it.
}}}
The `doAll` function ends up like this:
{{{
Rec {
Main.main_$wdoAll :: Main.S1
-> Main.S2
-> [[(GHC.Types.Int, ())]]
-> (# Main.S1, Main.S2 #)
GblId
[Arity 3
NoCafRefs
Str: DmdType SSS]
Main.main_$wdoAll =
\ (w_sXJ :: Main.S1)
(w1_sXK :: Main.S2)
(w2_sXO :: [[(GHC.Types.Int, ())]]) ->
case w_sXJ of s1_Xgz { __DEFAULT ->
case w1_sXK of s2_XgE { __DEFAULT ->
case w2_sXO of _ {
[] -> (# s1_Xgz, s2_XgE #);
: ds_dqj xs_ags ->
case ds_dqj of _ {
[] -> Main.main_$wdoAll s1_Xgz s2_XgE xs_ags;
: ds1_dqk x1_agJ ->
case ds1_dqk of _ { (t_agH, ds2_dql) ->
let {
fail_sY1 :: Main.Result
LclId
[Str: DmdType m]
fail_sY1 =
case ds2_dql of _ { () ->
case Main.main_$wdoAll
s1_Xgz s2_XgE (GHC.Types.: @ [(GHC.Types.Int, ())]
x1_agJ xs_ags)
of _ { (# ww1_sXU, ww2_sXV #) ->
Main.Result ww1_sXU ww2_sXV
}
} } in
case xs_ags of wild3_XF {
[] ->
case fail_sY1 of _ { Main.Result ww1_sXU ww2_sXV ->
(# ww1_sXU, ww2_sXV #)
};
: x2_agL xs1_agN ->
case t_agH of _ { GHC.Types.I# x_axj ->
case GHC.Prim.>=# x_axj 99999 of _ {
GHC.Bool.False ->
case fail_sY1 of _ { Main.Result ww1_sXU ww2_sXV ->
(# ww1_sXU, ww2_sXV #)
};
GHC.Bool.True ->
Main.main_$wdoAll
s1_Xgz s2_XgE (GHC.Types.: @ [(GHC.Types.Int, ())]
x1_agJ wild3_XF)
}
}
}
}
}
}
}
}
end Rec }
}}}
It looks like the problem is that rather than just recursively tail-
calling itself, it calls itself in `fail_sY1`, builds a `Result`, and then
takes the result apart again to return an unboxed tuple.
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/3403>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
