#4267: Missing unboxing in pre-order fold over binary tree
---------------------------------+------------------------------------------
Reporter: tibbe | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 6.13
Keywords: | Testcase:
Blockedby: | Difficulty:
Os: Unknown/Multiple | Blocking:
Architecture: Unknown/Multiple | Failure: None/Unknown
---------------------------------+------------------------------------------
Comment(by tibbe):
Here are the relevant parts of `-dverbose-core2core`. First, inlining
happens:
{{{
==================== Simplifier Phase 2 [main] max-iterations=4
====================
a_soD :: GHC.Types.Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 2}]
a_soD = GHC.Types.I# 0
FoldTest.sumTree :: Fold.Tree GHC.Types.Int -> GHC.Types.Int
[LclIdX,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0] 18 0}]
FoldTest.sumTree =
\ (eta1_B1 :: Fold.Tree GHC.Types.Int) ->
letrec {
go_aaE [Occ=LoopBreaker]
:: GHC.Types.Int -> Fold.Tree GHC.Types.Int -> GHC.Types.Int
[LclId,
Arity=2,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=2, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0 3] 12 0}]
go_aaE =
\ (z_aaF :: GHC.Types.Int) (ds_dbh :: Fold.Tree GHC.Types.Int) ->
case ds_dbh of _ {
Fold.Leaf -> z_aaF;
Fold.Node a_aaH l_aaI r_aaJ ->
case go_aaE z_aaF l_aaI of _ { GHC.Types.I# ipv_soJ ->
case a_aaH of _ { GHC.Types.I# y_aox ->
go_aaE (GHC.Types.I# (GHC.Prim.+# ipv_soJ y_aox)) r_aaJ
}
}
}; } in
go_aaE a_soD eta1_B1
}}}
And some time later demand analysis:
{{{
==================== Demand analysis ====================
a_soD :: GHC.Types.Int
[LclId,
Str=DmdType m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 2}]
a_soD = GHC.Types.I# 0
FoldTest.sumTree :: Fold.Tree GHC.Types.Int -> GHC.Types.Int
[LclIdX,
Arity=1,
Str=DmdType S,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0] 18 0}]
FoldTest.sumTree =
\ (eta1_B1 [Dmd=Just S] :: Fold.Tree GHC.Types.Int) ->
letrec {
go_aaE [Occ=LoopBreaker]
:: GHC.Types.Int -> Fold.Tree GHC.Types.Int -> GHC.Types.Int
[LclId,
Arity=2,
Str=DmdType SS,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=2, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0 3] 12 0}]
go_aaE =
\ (z_aaF [Dmd=Just S] :: GHC.Types.Int)
(ds_dbh [Dmd=Just S] :: Fold.Tree GHC.Types.Int) ->
case ds_dbh of _ {
Fold.Leaf -> z_aaF;
Fold.Node a_aaH [Dmd=Just U(L)]
l_aaI [Dmd=Just S]
r_aaJ [Dmd=Just S] ->
case go_aaE z_aaF l_aaI of _ { GHC.Types.I# ipv_soJ
[Dmd=Just L] ->
case a_aaH of _ { GHC.Types.I# y_aox [Dmd=Just L] ->
go_aaE (GHC.Types.I# (GHC.Prim.+# ipv_soJ y_aox)) r_aaJ
}
}
}; } in
go_aaE a_soD eta1_B1
}}}
and after that worker/wrapper
{{{
==================== Worker Wrapper binds ====================
a_soD :: GHC.Types.Int
[LclId,
Str=DmdType m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 2}]
a_soD = GHC.Types.I# 0
FoldTest.sumTree :: Fold.Tree GHC.Types.Int -> GHC.Types.Int
[LclIdX,
Arity=1,
Str=DmdType S,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0] 18 0}]
FoldTest.sumTree =
\ (eta1_B1 [Dmd=Just S] :: Fold.Tree GHC.Types.Int) ->
letrec {
go_aaE [Occ=LoopBreaker]
:: GHC.Types.Int -> Fold.Tree GHC.Types.Int -> GHC.Types.Int
[LclId,
Arity=2,
Str=DmdType SS,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=2, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0 3] 12 0}]
go_aaE =
\ (z_aaF [Dmd=Just S] :: GHC.Types.Int)
(ds_dbh [Dmd=Just S] :: Fold.Tree GHC.Types.Int) ->
case ds_dbh of _ {
Fold.Leaf -> z_aaF;
Fold.Node a_aaH [Dmd=Just U(L)]
l_aaI [Dmd=Just S]
r_aaJ [Dmd=Just S] ->
case go_aaE z_aaF l_aaI of _ { GHC.Types.I# ipv_soJ
[Dmd=Just L] ->
case a_aaH of _ { GHC.Types.I# y_aox [Dmd=Just L] ->
go_aaE (GHC.Types.I# (GHC.Prim.+# ipv_soJ y_aox)) r_aaJ
}
}
}; } in
go_aaE a_soD eta1_B1
}}}
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/4267#comment:4>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
