linear stack usage where constant stack usage expected
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.
Trac metadata
Trac field | Value |
---|---|
Version | 6.10.4 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |