#5342: 2047 core lint error when profiling
---------------------------------+------------------------------------------
Reporter: igloo | Owner: simonpj
Type: bug | Status: new
Priority: highest | Milestone: 7.2.1
Component: Compiler | Version: 7.0.3
Keywords: | Testcase:
Blockedby: | Difficulty:
Os: Unknown/Multiple | Blocking:
Architecture: Unknown/Multiple | Failure: None/Unknown
---------------------------------+------------------------------------------
Cut-down copy of the 2047 test:
{{{
module Q (increaseAreas) where
import Control.Monad
import Data.List
nubSorted :: Eq a => [a] -> [a]
nubSorted = undefined
cellsAround :: (Num a, Num b, Ord a, Ord b) => [(a, b)] -> [(a, b)]
cellsAround = undefined
increaseAreas :: (Num a, Num b, Ord a, Ord b) => [[(a, b)]] -> [[(a, b)]]
increaseAreas areas = nubSorted $ sort $
do
area <- areas
cell2 <- cellsAround area
return $ sort $ cell2 : area
}}}
{{{
ghc -fforce-recomp -c -O -prof -auto-all -dcore-lint -dcmm-lint 2047.hs
-Wall
}}}
{{{
*** Core Lint errors : in result of Simplifier ***
<no location info>:
[RHS of go_sxn :: [[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]]
Demand type has 1 arguments, rhs has 0 arguments, go_sxn
Binder's strictness signature: DmdType S
*** Offending Program ***
$wincreaseAreas_sxi
:: forall a_adT b_adU.
(GHC.Classes.Ord a_adT, GHC.Classes.Ord b_adU) =>
[[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]
[LclId,
Arity=2,
Str=DmdType LL,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=2, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0 0] 442 60}]
$wincreaseAreas_sxi =
\ (@ a_adT)
(@ b_adU)
(w_sxf :: GHC.Classes.Ord a_adT)
(w_sxg :: GHC.Classes.Ord b_adU) ->
letrec {
go_sxn [Occ=LoopBreaker]
:: [[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]
[LclId,
Str=DmdType S,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
ConLike=True, Cheap=False, Expandable=False,
Guidance=IF_ARGS [] 301 60}]
go_sxn =
__scc {increaseAreas main:Q !}
let {
lvl_sxq
:: (a_adT, b_adU) -> (a_adT, b_adU) -> GHC.Ordering.Ordering
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 30 60}]
lvl_sxq =
GHC.Classes.$fOrd(,)_$ccompare @ a_adT @ b_adU w_sxf w_sxg }
in
\ (ds_avk :: [[(a_adT, b_adU)]]) ->
case ds_avk of _ {
[] -> GHC.Types.[] @ [(a_adT, b_adU)];
: y_avo [Dmd=Just X] ys_avp [Dmd=Just X] ->
letrec {
go_XvC [Occ=LoopBreaker] :: [(a_adT, b_adU)] -> [[(a_adT,
b_adU)]]
[LclId,
Arity=1,
Str=DmdType S,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [30] 90 130}]
go_XvC =
\ (ds_XvE :: [(a_adT, b_adU)]) ->
case ds_XvE of _ {
[] -> GHC.Types.[] @ [(a_adT, b_adU)];
: y_XvK [Dmd=Just L] ys_XvM [Dmd=Just L] ->
GHC.Types.:
@ [(a_adT, b_adU)]
(Data.List.sortBy
@ (a_adT, b_adU)
lvl_sxq
(GHC.Types.: @ (a_adT, b_adU) y_XvK y_avo))
(go_XvC ys_XvM)
}; } in
case go_XvC
((__scc {cellsAround main:Q}
GHC.Err.undefined @ ([(a_adT, b_adU)] -> [(a_adT,
b_adU)]))
y_avo)
of _ {
[] -> go_sxn ys_avp;
: x_avv [Dmd=Just L] xs_avw [Dmd=Just L] ->
GHC.Types.:
@ [(a_adT, b_adU)]
x_avv
(GHC.Base.++ @ [(a_adT, b_adU)] xs_avw (go_sxn
ys_avp))
}
}; } in
__scc {increaseAreas main:Q}
let {
$dOrd_svK [Dmd=Just L] :: GHC.Classes.Ord (a_adT, b_adU)
[LclId,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
ConLike=True, Cheap=False, Expandable=True,
Guidance=IF_ARGS [] 30 0}]
$dOrd_svK = GHC.Classes.$fOrd(,) @ a_adT @ b_adU w_sxf w_sxg } in
let {
lvl_sxr
:: [(a_adT, b_adU)] -> [(a_adT, b_adU)] -> GHC.Ordering.Ordering
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 20 60}]
lvl_sxr =
GHC.Classes.$fOrd[]_$ccompare1 @ (a_adT, b_adU) $dOrd_svK } in
\ (areas_adY :: [[(a_adT, b_adU)]]) ->
(__scc {nubSorted main:Q}
GHC.Err.undefined @ ([[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]))
(Data.List.sortBy @ [(a_adT, b_adU)] lvl_sxr (go_sxn areas_adY))
Q.increaseAreas [InlPrag=INLINE[0]]
:: forall a_adT b_adU.
(GHC.Num.Num a_adT,
GHC.Num.Num b_adU,
GHC.Classes.Ord a_adT,
GHC.Classes.Ord b_adU) =>
[[(a_adT, b_adU)]] -> [[(a_adT, b_adU)]]
[LclIdX,
Arity=4,
Str=DmdType AALL,
Unf=Unf{Src=Worker=$wincreaseAreas_sxi, TopLvl=True, Arity=4,
Value=True, ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)
Tmpl= \ (@ a_adT)
(@ b_adU)
_
_
(w_sxf [Occ=Once] :: GHC.Classes.Ord a_adT)
(w_sxg [Occ=Once] :: GHC.Classes.Ord b_adU) ->
$wincreaseAreas_sxi @ a_adT @ b_adU w_sxf w_sxg}]
Q.increaseAreas =
\ (@ a_adT)
(@ b_adU)
_
_
(w_sxf :: GHC.Classes.Ord a_adT)
(w_sxg :: GHC.Classes.Ord b_adU) ->
$wincreaseAreas_sxi @ a_adT @ b_adU w_sxf w_sxg
*** End of Offense ***
<no location info>:
Compilation had errors
}}}
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/5342>
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
