Re: [GHC] #13027: Core lint errors compiling containers HEAD with GHC HEAD

10 Jan 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