[GHC] #13027: Core lint errors compiling containers HEAD with GHC HEAD
GHC
ghc-devs at haskell.org
Tue Jan 10 16:18:46 UTC 2017
#13027: Core lint errors compiling containers HEAD with GHC HEAD
-------------------------------------+-------------------------------------
Reporter: erikd | Owner:
Type: bug | Status: new
Priority: normal | Milestone: 8.2.1
Component: Compiler | Version: 8.1
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: Building GHC | Test Case:
failed | simplCore/should_compile/T13027
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by RyanGlScott):
Here's the offending part of `containers` this time:
{{{#!hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
module Containers (partition) where
import GHC.Exts (isTrue#, reallyUnsafePtrEquality#)
data Set a = Bin {-# UNPACK #-} !Size !a !(Set a) !(Set a)
| Tip
type Size = Int
data StrictPair a b = !a :*: !b
infixr 1 :*:
-- | Convert a strict pair to a standard pair.
toPair :: StrictPair a b -> (a, b)
toPair (x :*: y) = (x, y)
{-# INLINE toPair #-}
partition :: (a -> Bool) -> Set a -> (Set a,Set a)
partition p0 t0 = toPair $ go p0 t0
where
go _ Tip = (Tip :*: Tip)
go p t@(Bin _ x l r) = case (go p l, go p r) of
((l1 :*: l2), (r1 :*: r2))
| p x -> (if l1 `ptrEq` l && r1 `ptrEq` r
then t
else link x l1 r1) :*: merge l2 r2
| otherwise -> merge l1 r1 :*:
(if l2 `ptrEq` l && r2 `ptrEq` r
then t
else link x l2 r2)
merge :: Set a -> Set a -> Set a
merge = undefined
link :: a -> Set a -> Set a -> Set a
link = undefined
ptrEq :: a -> a -> Bool
ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y)
{-# INLINE ptrEq #-}
}}}
And here's the Core Lint error:
{{{
$ ghc/inplace/bin/ghc-stage2 Containers2.hs -fforce-recomp -dcore-lint -O2
[1 of 1] Compiling Containers ( Containers2.hs, Containers2.o )
*** Core Lint errors : in result of Simplifier ***
<no location info>: warning:
In the expression: tagToEnum#
@ Bool (reallyUnsafePtrEquality# @ (Set a)
ww_s4m3 l_a2PV)
This argument does not satisfy the let/app invariant:
reallyUnsafePtrEquality# @ (Set a) ww_s4m3 l_a2PV
*** Offending Program ***
merge :: forall a. Set a -> Set a -> Set a
[LclId,
Str=x,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=NEVER}]
merge =
\ (@ a_a3Sm) ->
raise#
@ SomeException
@ 'PtrRepLifted
@ (Set a -> Set a -> Set a)
(noinline
@ ([Char] -> CallStack -> SomeException)
errorCallWithCallStackException
undefined9
(PushCallStack
undefined8
undefined1
(PushCallStack
(unpackCString# "undefined"#)
(SrcLoc
(unpackCString# "main"#)
(unpackCString# "Containers"#)
(unpackCString# "Containers2.hs"#)
(I# 36#)
(I# 9#)
(I# 36#)
(I# 18#))
EmptyCallStack)))
link :: forall a. a -> Set a -> Set a -> Set a
[LclId,
Str=x,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=NEVER}]
link =
\ (@ a_a3S7) ->
raise#
@ SomeException
@ 'PtrRepLifted
@ (a -> Set a -> Set a -> Set a)
(noinline
@ ([Char] -> CallStack -> SomeException)
errorCallWithCallStackException
undefined9
(PushCallStack
undefined8
undefined1
(PushCallStack
(unpackCString# "undefined"#)
(SrcLoc
(unpackCString# "main"#)
(unpackCString# "Containers"#)
(unpackCString# "Containers2.hs"#)
(I# 39#)
(I# 9#)
(I# 39#)
(I# 18#))
EmptyCallStack)))
lvl_s4aT :: forall a. StrictPair (Set a) (Set a)
[LclId,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
lvl_s4aT =
\ (@ a_a3Sv) -> :*: @ (Set a) @ (Set a) (Tip @ a) (Tip @ a)
Rec {
poly_go_s4aS [InlPrag=INLINE[0]]
:: forall a. (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
[LclId,
Arity=2,
CallArity=2,
Str=<L,C(U)><S,U>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
Tmpl= \ (@ a_s4lW)
(w_s4lX [Occ=Once] :: a -> Bool)
(w_s4lY [Occ=Once] :: Set a) ->
case $wpoly_go_s4m1 @ a w_s4lX w_s4lY of
{ (# ww_s4m3 [Occ=Once], ww_s4m4 [Occ=Once] #) ->
:*: @ (Set a) @ (Set a) ww_s4m3 ww_s4m4
}}]
poly_go_s4aS =
\ (@ a_s4lW) (w_s4lX :: a -> Bool) (w_s4lY :: Set a) ->
case $wpoly_go_s4m1 @ a w_s4lX w_s4lY of
{ (# ww_s4m3, ww_s4m4 #) ->
:*: @ (Set a) @ (Set a) ww_s4m3 ww_s4m4
}
$wpoly_go_s4m1 [InlPrag=[0], Occ=LoopBreaker]
:: forall a. (a -> Bool) -> Set a -> (# Set a, Set a #)
[LclId,
Arity=2,
Str=<L,C(U)><S,1*U>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 30] 194 30}]
$wpoly_go_s4m1 =
\ (@ a_s4lW) (w_s4lX :: a -> Bool) (w_s4lY :: Set a) ->
case w_s4lY of wild_Xo {
Bin dt_d44n [Dmd=<B,U>] x_a2PU [Dmd=<B,U>] l_a2PV [Dmd=<B,U>]
r_a2PW [Dmd=<B,U>] ->
case $wpoly_go_s4m1 @ a w_s4lX l_a2PV of
{ (# ww_s4m3, ww_s4m4 #) ->
case $wpoly_go_s4m1 @ a w_s4lX r_a2PW of
{ (# ww_X4mP, ww_X4mR #) ->
case w_s4lX x_a2PU of {
False -> case merge of wild_00 { };
True ->
case case tagToEnum#
@ Bool (reallyUnsafePtrEquality# @ (Set a) ww_s4m3
l_a2PV)
of {
False -> case link of wild_00 { };
True ->
case tagToEnum#
@ Bool (reallyUnsafePtrEquality# @ (Set a)
ww_X4mP r_a2PW)
of {
False -> case link of wild_00 { };
True -> wild_Xo
}
}
of dt_X3KG [Dmd=<B,U>]
{ __DEFAULT ->
case merge of wild_00 { }
}
}
}
};
Tip -> (# Tip @ a, Tip @ a #)
}
end Rec }
partition :: forall a. (a -> Bool) -> Set a -> (Set a, Set a)
[LclIdX,
Arity=2,
Str=<L,C(U)><S,1*U>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
Tmpl= \ (@ a_a3Sv)
(p0_a2PP [Occ=Once] :: a -> Bool)
(t0_a2PQ [Occ=Once] :: Set a) ->
case poly_go_s4aS @ a p0_a2PP t0_a2PQ of
{ :*: x_a2PN [Occ=Once] y_a2PO [Occ=Once] ->
(x_a2PN, y_a2PO)
}}]
partition =
\ (@ a_a3Sv) (p0_a2PP :: a -> Bool) (t0_a2PQ :: Set a) ->
case $wpoly_go_s4m1 @ a p0_a2PP t0_a2PQ of
{ (# ww_s4m3, ww_s4m4 #) ->
(ww_s4m3, ww_s4m4)
}
$trModule_s4a3 :: TrName
[LclId,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}]
$trModule_s4a3 = TrNameS "main"#
$trModule_s4a4 :: TrName
[LclId,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 50 20}]
$trModule_s4a4 = TrNameS "Containers"#
$trModule :: Module
[LclIdX,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
$trModule = Module $trModule_s4a3 $trModule_s4a4
$tc'Tip_s4a5 :: TrName
[LclId,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}]
$tc'Tip_s4a5 = TrNameS "'Tip"#
$tc'Tip :: TyCon
[LclIdX,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}]
$tc'Tip =
TyCon
2793269457193232401## 14910929446856376197## $trModule $tc'Tip_s4a5
$tc'Bin_s4a6 :: TrName
[LclId,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}]
$tc'Bin_s4a6 = TrNameS "'Bin"#
$tc'Bin :: TyCon
[LclIdX,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}]
$tc'Bin =
TyCon
4548370254528349800## 3424913680517968384## $trModule $tc'Bin_s4a6
$tcSet_s4a7 :: TrName
[LclId,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}]
$tcSet_s4a7 = TrNameS "Set"#
$tcSet :: TyCon
[LclIdX,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}]
$tcSet =
TyCon
3037255313641890014## 1627524838438604808## $trModule $tcSet_s4a7
$tc':*:_s4a8 :: TrName
[LclId,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}]
$tc':*:_s4a8 = TrNameS "':*:"#
$tc':*: :: TyCon
[LclIdX,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}]
$tc':*: =
TyCon
9247104382896135333## 1281726570460431133## $trModule $tc':*:_s4a8
$tcStrictPair_s4a9 :: TrName
[LclId,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 50 20}]
$tcStrictPair_s4a9 = TrNameS "StrictPair"#
$tcStrictPair :: TyCon
[LclIdX,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}]
$tcStrictPair =
TyCon
18371072474651713953##
8175359178144728928##
$trModule
$tcStrictPair_s4a9
*** End of Offense ***
<no location info>: error:
Compilation had errors
}}}
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13027#comment:17>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list