Opened 3 years ago

Closed 3 years ago

#5359 closed bug (fixed)

GHC 7.2.1-rc1 panics on `cgLookupPanic`

Reported by: hvr Owned by: simonpj
Priority: highest Milestone: 7.2.1
Component: Compiler Version: 7.1
Keywords: Cc:
Operating System: Linux Architecture: x86_64 (amd64)
Type of failure: Compile-time crash Difficulty:
Test Case: simplCore/should_compile/T5359a,b Blocked By:
Blocking: Related Tickets:

Description

Grabbed the ghc-7.2.0.20110728-x86_64-unknown-linux.tar.bz2 release, and as a first thing after install I tried to cabal install text, which paniced with the following output

...
Registering deepseq-1.1.0.2...
Configuring text-0.11.1.5...
Preprocessing library text-0.11.1.5...
Building text-0.11.1.5...
[ 1 of 38] Compiling Data.Text.Encoding.Utf32 ( Data/Text/Encoding/Utf32.hs, dist/build/Data/Text/Encoding/Utf32.o )
...
[23 of 38] Compiling Data.Text.Foreign ( Data/Text/Foreign.hs, dist/build/Data/Text/Foreign.o )

Data/Text/Foreign.hs:36:26:
    Warning: In the use of `unsafeIOToST'
             (imported from Control.Monad.ST):
             Deprecated: "Please import from Control.Monad.ST.Unsafe instead; This will be removed in the next release"
[24 of 38] Compiling Data.Text        ( Data/Text.hs, dist/build/Data/Text.o )
ghc: panic! (the 'impossible' happened)
  (GHC version 7.2.0.20110728 for x86_64-unknown-linux):
	cgLookupPanic (probably invalid Core; try -dcore-lint)
    $w$j{v s1HTU} [lid]
    static binds for:
    local binds for:

Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug

cabal: Error: some packages failed to install:
text-0.11.1.5 failed during the building phase. The exception was:
ExitFailure 1

Change History (7)

comment:1 Changed 3 years ago by igloo

  • Milestone set to 7.2.1
  • Owner set to simonpj
  • Priority changed from normal to highest

Thanks for the report. Here's a single-module testcase:

{-# LANGUAGE BangPatterns, Rank2Types, MagicHash, UnboxedTuples #-}

module Foo (linesT) where

import GHC.Base
import GHC.Word
import GHC.ST (ST(..), runST)

nullT :: Text -> Bool
nullT (Text _ _ len) = len <= 0
{-# INLINE [1] nullT #-}

spanT :: (Char -> Bool) -> Text -> (Text, Text)
spanT p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))
  where k = loop 0
        loop !i | i >= len || not (p c) = i
                | otherwise             = loop (i+d)
            where Iter c d              = iter t i
{-# INLINE spanT #-}

linesT :: Text -> [Text]
linesT ps | nullT ps  = []
          | otherwise = h : if nullT t
                            then []
                            else linesT (unsafeTail t)
    where (h,t) = spanT (/= '\n') ps
{-# INLINE linesT #-}

unsafeTail :: Text -> Text
unsafeTail t@(Text arr off len) = Text arr (off+d) (len-d)
  where d = iter_ t 0
{-# INLINE unsafeTail #-}

data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int

iter :: Text -> Int -> Iter
iter (Text arr _ _) i = Iter (unsafeChrT m) 1
  where m = unsafeIndex arr i
{-# INLINE iter #-}

iter_ :: Text -> Int -> Int
iter_ (Text arr off _) i | m < 0xD800 || m > 0xDBFF = 1
                         | otherwise                = 2
  where m = unsafeIndex arr (off+i)
{-# INLINE iter_ #-}

data Text = Text {-# UNPACK #-}!Array {-# UNPACK #-}!Int {-# UNPACK #-}!Int

text :: Array -> Int -> Int -> Text
text arr off len = Text arr off len
{-# INLINE text #-}

emptyT :: Text
emptyT = Text empty 0 0
{-# INLINE [1] emptyT #-}

textP :: Array -> Int -> Int -> Text
textP arr off len | len == 0  = emptyT
                  | otherwise = text arr off len
{-# INLINE textP #-}

unsafeChrT :: Word16 -> Char
unsafeChrT (W16# w#) = C# (chr# (word2Int# w#))
{-# INLINE unsafeChrT #-}

data Array = Array ByteArray#

data MArray s = MArray (MutableByteArray# s)

new :: forall s. Int -> ST s (MArray s)
new n@(I# len#)
  | n < 0 || n /= 0 = error $ "Data.Text.Array.new: size overflow"
  | otherwise = ST $ \s1# ->
       case newByteArray# len# s1# of
         (# s2#, marr# #) -> (# s2#, MArray marr# #)
{-# INLINE new #-}

unsafeFreeze :: MArray s -> ST s Array
unsafeFreeze (MArray maBA) = ST $ \s# -> (# s#, Array (unsafeCoerce# maBA) #)
{-# INLINE unsafeFreeze #-}

unsafeIndex :: Array -> Int -> Word16
unsafeIndex (Array aBA) (I# i#) =
    case indexWord16Array# aBA i# of r# -> (W16# r#)
{-# INLINE unsafeIndex #-}

empty :: Array
empty = runST (new 0 >>= unsafeFreeze)
ghc -dcore-lint -c Foo.hs -O2
*** Core Lint warnings : in result of Specialise ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Float out(FOS {Lam = Just 0,
                                                     Consts = True,
                                                     PAPs = False}) ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Float inwards ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Demand analysis ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Worker Wrapper binds ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Simplifier ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Float out(FOS {Lam = Just 0,
                                                     Consts = True,
                                                     PAPs = True}) ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Common sub-expression ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Float inwards ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint warnings : in result of Liberate case ***
{-# LINE 22 "Foo.hs #-}:
    [RHS of linesT_rki :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: linesT_rki
{-# LINE 22 "Foo.hs #-}:
    [RHS of Foo.linesT :: Foo.Text -> [Foo.Text]]
    INLINE binder is (non-rule) loop breaker: Foo.linesT

*** Core Lint errors : in result of Simplifier ***
<no location info>:
    In a case alternative: (GHC.Types.I# y_aEB :: GHC.Prim.Int#)
    $w$j_sHK is out of scope
*** Offending Program ***
lvl_sHL
  :: forall s_aA6.
     GHC.Prim.State# s_aA6 -> (# GHC.Prim.State# s_aA6, Foo.Array #)
[LclId,
 Arity=1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=IF_ARGS [0] 23 30}]
lvl_sHL =
  \ (@ s_aA6)
    (s_aDy [Dmd=Just L, Lbv=OneShot] :: GHC.Prim.State# s_aA6) ->
    case GHC.Prim.newByteArray# @ s_aA6 0 s_aDy
    of _ { (# s2#_atc [Dmd=Just A], marr#_atd [Dmd=Just L] #) ->
    (# s2#_atc,
       Foo.Array
         (marr#_atd
          `cast` (UnsafeCo
                    (GHC.Prim.MutableByteArray# s_aA6) GHC.Prim.ByteArray#
                  :: GHC.Prim.MutableByteArray# s_aA6 ~ GHC.Prim.ByteArray#)) #)
    }

Foo.empty :: Foo.Array
[LclId,
 Str=DmdType,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=False, Expandable=False,
         Guidance=IF_ARGS [] 20 0}]
Foo.empty = GHC.ST.runSTRep @ Foo.Array lvl_sHL

Foo.emptyT [InlPrag=INLINE[1] (sat-args=0)] :: Foo.Text
[LclId,
 Str=DmdType,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False)
         Tmpl= case Foo.empty of _ { Foo.Array tpl_B5 [Occ=Once] ->
               Foo.Text tpl_B5 0 0
               }}]
Foo.emptyT =
  case Foo.empty of _ { Foo.Array tpl_B5 [Dmd=Just L] ->
  Foo.Text tpl_B5 0 0
  }

Foo.nullT [InlPrag=INLINE[1] (sat-args=1)]
  :: Foo.Text -> GHC.Types.Bool
[LclId,
 Arity=1,
 Str=DmdType U(AAL),
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False)
         Tmpl= \ (ds_dBb [Occ=Once!] :: Foo.Text) ->
                 case ds_dBb of _ { Foo.Text _ _ rb_dBp [Occ=Once] ->
                 GHC.Prim.<=# rb_dBp 0
                 }}]
Foo.nullT =
  \ (ds_dBb :: Foo.Text) ->
    case ds_dBb
    of _
    { Foo.Text rb_dBn [Dmd=Just A]
               rb_dBo [Dmd=Just A]
               rb_dBp [Dmd=Just L] ->
    GHC.Prim.<=# rb_dBp 0
    }

Foo.unsafeTail [InlPrag=INLINE (sat-args=1)]
  :: Foo.Text -> Foo.Text
[LclId,
 Arity=1,
 Str=DmdType U(LLL)m,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False)
         Tmpl= \ (t_asQ [Occ=Once!] :: Foo.Text) ->
                 case t_asQ of _ { Foo.Text rb_dBB rb_dBC rb_dBD [Occ=Once*] ->
                 let {
                   a_sEG :: GHC.Prim.Word#
                   [LclId,
                    Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                            ConLike=False, Cheap=True, Expandable=True,
                            Guidance=IF_ARGS [] 1 0}]
                   a_sEG = GHC.Prim.indexWord16Array# rb_dBB rb_dBC } in
                 let {
                   m_at1 :: GHC.Word.Word16
                   [LclId,
                    Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
                            ConLike=True, Cheap=True, Expandable=True,
                            Guidance=IF_ARGS [] 10 110}]
                   m_at1 = GHC.Word.W16# a_sEG } in
                 case GHC.Classes.||
                        (GHC.Word.$fOrdWord16_$c<
                           m_at1
                           (GHC.Word.$fBitsWord16_$cfromInteger
                              (GHC.Integer.smallInteger 55296)))
                        (GHC.Word.$fOrdWord16_$c>
                           m_at1
                           (GHC.Word.$fBitsWord16_$cfromInteger
                              (GHC.Integer.smallInteger 56319)))
                 of _ {
                   GHC.Types.False ->
                     Foo.Text rb_dBB (GHC.Prim.+# rb_dBC 2) (GHC.Prim.-# rb_dBD 2);
                   GHC.Types.True ->
                     Foo.Text rb_dBB (GHC.Prim.+# rb_dBC 1) (GHC.Prim.-# rb_dBD 1)
                 }
                 }}]
Foo.unsafeTail =
  \ (t_asQ :: Foo.Text) ->
    case t_asQ
    of _
    { Foo.Text rb_dBB [Dmd=Just L]
               rb_dBC [Dmd=Just L]
               rb_dBD [Dmd=Just L] ->
    let {
      a_sGQ [Dmd=Just L] :: GHC.Prim.Word#
      [LclId,
       Str=DmdType,
       Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
               ConLike=False, Cheap=True, Expandable=True,
               Guidance=IF_ARGS [] 1 0}]
      a_sGQ = GHC.Prim.indexWord16Array# rb_dBB rb_dBC } in
    case GHC.Prim.ltWord# a_sGQ __word 55296 of _ {
      GHC.Types.False ->
        case GHC.Prim.gtWord# a_sGQ __word 56319 of _ {
          GHC.Types.False ->
            Foo.Text rb_dBB (GHC.Prim.+# rb_dBC 2) (GHC.Prim.-# rb_dBD 2);
          GHC.Types.True ->
            Foo.Text rb_dBB (GHC.Prim.+# rb_dBC 1) (GHC.Prim.-# rb_dBD 1)
        };
      GHC.Types.True ->
        Foo.Text rb_dBB (GHC.Prim.+# rb_dBC 1) (GHC.Prim.-# rb_dBD 1)
    }
    }

Rec {
Foo.linesT [InlPrag=INLINE (sat-args=1), Occ=LoopBreaker]
  :: Foo.Text -> [Foo.Text]
[LclIdX,
 Arity=1,
 Str=DmdType U(LLL),
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False)
         Tmpl= \ (ps_aqA :: Foo.Text) ->
                 let {
                   ds_dBj :: (Foo.Text, Foo.Text)
                   [LclId,
                    Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                            ConLike=False, Cheap=False, Expandable=False,
                            Guidance=IF_ARGS [] 335 120}]
                   ds_dBj =
                     let {
                       ds_dBi [Occ=OnceL] :: GHC.Types.Char
                       [LclId,
                        Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
                                ConLike=True, Cheap=True, Expandable=True,
                                Guidance=IF_ARGS [] 10 110}]
                       ds_dBi = GHC.Types.C# '\n' } in
                     case ps_aqA of _ { Foo.Text rb_dBr rb_dBs rb_dBt ->
                     let {
                       k_aqv :: GHC.Types.Int
                       [LclId,
                        Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                                ConLike=False, Cheap=False, Expandable=False,
                                Guidance=IF_ARGS [] 203 0}]
                       k_aqv =
                         letrec {
                           loop_aAr [Occ=LoopBreaker] :: GHC.Types.Int -> GHC.Types.Int
                           [LclId,
                            Arity=1,
                            Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=1, Value=True,
                                    ConLike=True, Cheap=True, Expandable=True,
                                    Guidance=IF_ARGS [20] 153 0}]
                           loop_aAr =
                             \ (i_aqx [Occ=Once!] :: GHC.Types.Int) ->
                               case i_aqx of i_XqJ { GHC.Types.I# ipv_sFe ->
                               case GHC.Classes.||
                                      (GHC.Prim.>=# ipv_sFe rb_dBt)
                                      (GHC.Classes.not
                                         (GHC.Classes.$fEqChar_$c/=
                                            (GHC.Types.C#
                                               (GHC.Prim.chr#
                                                  (GHC.Prim.word2Int#
                                                     (GHC.Prim.indexWord16Array# rb_dBr ipv_sFe))))
                                            ds_dBi))
                               of _ {
                                 GHC.Types.False -> loop_aAr (GHC.Types.I# (GHC.Prim.+# ipv_sFe 1));
                                 GHC.Types.True -> i_XqJ
                               }
                               }; } in
                         loop_aAr (GHC.Types.I# 0) } in
                     (case k_aqv of _ { GHC.Types.I# x_aEN [Occ=Once!] ->
                      case x_aEN of wild_Xy {
                        __DEFAULT -> Foo.Text rb_dBr rb_dBs wild_Xy;
                        0 -> Foo.emptyT
                      }
                      },
                      case k_aqv of _ { GHC.Types.I# y_aEB ->
                      case GHC.Prim.-# rb_dBt y_aEB of wild_Xy {
                        __DEFAULT -> Foo.Text rb_dBr (GHC.Prim.+# rb_dBs y_aEB) wild_Xy;
                        0 -> Foo.emptyT
                      }
                      })
                     } } in
                 let {
                   t_aqC :: Foo.Text
                   [LclId,
                    Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                            ConLike=False, Cheap=True, Expandable=True,
                            Guidance=IF_ARGS [] 10 0}]
                   t_aqC = case ds_dBj of _ { (_, t_Xra [Occ=Once]) -> t_Xra } } in
                 case Foo.nullT ps_aqA of _ {
                   GHC.Types.False ->
                     GHC.Types.:
                       @ Foo.Text
                       (case ds_dBj of _ { (h_aqB [Occ=Once], _) -> h_aqB })
                       (case Foo.nullT t_aqC of _ {
                          GHC.Types.False -> Foo.linesT (Foo.unsafeTail t_aqC);
                          GHC.Types.True -> GHC.Types.[] @ Foo.Text
                        });
                   GHC.Types.True -> GHC.Types.[] @ Foo.Text
                 }}]
Foo.linesT =
  \ (ps_aqA :: Foo.Text) ->
    case ps_aqA
    of _
    { Foo.Text rb_dBn [Dmd=Just L]
               rb_dBo [Dmd=Just L]
               rb_dBp [Dmd=Just L] ->
    case GHC.Prim.<=# rb_dBp 0 of _ {
      GHC.Types.False ->
        let {
          k_aqv [Dmd=Just D(L)] :: GHC.Types.Int
          [LclId,
           Str=DmdType,
           Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                   ConLike=False, Cheap=False, Expandable=False,
                   Guidance=IF_ARGS [] 123 110}]
          k_aqv =
            letrec {
              $wloop_sHE [Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int#
              [LclId,
               Arity=1,
               Str=DmdType L,
               Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=1, Value=True,
                       ConLike=True, Cheap=True, Expandable=True,
                       Guidance=IF_ARGS [0] 63 0}]
              $wloop_sHE =
                \ (ww_sHp :: GHC.Prim.Int#) ->
                  case GHC.Prim.>=# ww_sHp rb_dBp of _ {
                    GHC.Types.False ->
                      case GHC.Prim.chr#
                             (GHC.Prim.word2Int# (GHC.Prim.indexWord16Array# rb_dBn ww_sHp))
                      of _ {
                        __DEFAULT -> $wloop_sHE (GHC.Prim.+# ww_sHp 1);
                        '\n' -> ww_sHp
                      };
                    GHC.Types.True -> ww_sHp
                  }; } in
            case $wloop_sHE 0 of ww_sHt { __DEFAULT ->
            GHC.Types.I# ww_sHt
            } } in
        GHC.Types.:
          @ Foo.Text
          (case k_aqv of _ { GHC.Types.I# x_aEN [Dmd=Just L] ->
           case x_aEN of wild_Xy [Dmd=Just L] {
             __DEFAULT -> Foo.Text rb_dBn rb_dBo wild_Xy;
             0 -> Foo.emptyT
           }
           })
          (case k_aqv of _ { GHC.Types.I# y_aEB [Dmd=Just L] ->
           case GHC.Prim.-# rb_dBp y_aEB of wild_Xy [Dmd=Just L] {
             __DEFAULT -> $w$j_sHK rb_dBn (GHC.Prim.+# rb_dBo y_aEB) wild_Xy;
             0 ->
               case Foo.emptyT
               of wild_XR [Dmd=Just A]
               { Foo.Text rb_XBR [Dmd=Just L]
                          rb_XBT [Dmd=Just L]
                          rb_XBV [Dmd=Just L] ->
               letrec {
                 linesT_XkT [InlPrag=INLINE (sat-args=1), Occ=LoopBreaker]
                   :: Foo.Text -> [Foo.Text]
                 [LclId,
                  Arity=1,
                  Str=DmdType U(LLL),
                  Unf=Unf{Src=InlineStable, TopLvl=False, Arity=1, Value=True,
                          ConLike=True, Cheap=True, Expandable=True,
                          Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False)
                          Tmpl= \ (ps_Xrd :: Foo.Text) ->
                                  let {
                                    ds_dBj :: (Foo.Text, Foo.Text)
                                    [LclId,
                                     Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                                             ConLike=False, Cheap=False, Expandable=False,
                                             Guidance=IF_ARGS [] 335 120}]
                                    ds_dBj =
                                      let {
                                        ds_dBi [Occ=OnceL] :: GHC.Types.Char
                                        [LclId,
                                         Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
                                                 ConLike=True, Cheap=True, Expandable=True,
                                                 Guidance=IF_ARGS [] 10 110}]
                                        ds_dBi = GHC.Types.C# '\n' } in
                                      case ps_Xrd of _ { Foo.Text rb_dBr rb_dBs rb_dBt ->
                                      let {
                                        k_Xri :: GHC.Types.Int
                                        [LclId,
                                         Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                                                 ConLike=False, Cheap=False, Expandable=False,
                                                 Guidance=IF_ARGS [] 203 0}]
                                        k_Xri =
                                          letrec {
                                            loop_aAr [Occ=LoopBreaker]
                                              :: GHC.Types.Int -> GHC.Types.Int
                                            [LclId,
                                             Arity=1,
                                             Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=1,
                                                     Value=True, ConLike=True, Cheap=True,
                                                     Expandable=True, Guidance=IF_ARGS [20] 153 0}]
                                            loop_aAr =
                                              \ (i_aqx [Occ=Once!] :: GHC.Types.Int) ->
                                                case i_aqx of i_XqJ { GHC.Types.I# ipv_sFe ->
                                                case GHC.Classes.||
                                                       (GHC.Prim.>=# ipv_sFe rb_dBt)
                                                       (GHC.Classes.not
                                                          (GHC.Classes.$fEqChar_$c/=
                                                             (GHC.Types.C#
                                                                (GHC.Prim.chr#
                                                                   (GHC.Prim.word2Int#
                                                                      (GHC.Prim.indexWord16Array#
                                                                         rb_dBr ipv_sFe))))
                                                             ds_dBi))
                                                of _ {
                                                  GHC.Types.False ->
                                                    loop_aAr (GHC.Types.I# (GHC.Prim.+# ipv_sFe 1));
                                                  GHC.Types.True -> i_XqJ
                                                }
                                                }; } in
                                          loop_aAr (GHC.Types.I# 0) } in
                                      (case k_Xri of _ { GHC.Types.I# x_aEN [Occ=Once!] ->
                                       case x_aEN of wild_X1r {
                                         __DEFAULT -> Foo.Text rb_dBr rb_dBs wild_X1r;
                                         0 -> wild_XR
                                       }
                                       },
                                       case k_Xri of _ { GHC.Types.I# y_XFr ->
                                       case GHC.Prim.-# rb_dBt y_XFr of wild_X1r {
                                         __DEFAULT ->
                                           Foo.Text rb_dBr (GHC.Prim.+# rb_dBs y_XFr) wild_X1r;
                                         0 -> wild_XR
                                       }
                                       })
                                      } } in
                                  let {
                                    t_aqC :: Foo.Text
                                    [LclId,
                                     Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                                             ConLike=False, Cheap=True, Expandable=True,
                                             Guidance=IF_ARGS [] 10 0}]
                                    t_aqC = case ds_dBj of _ { (_, t_Xra [Occ=Once]) -> t_Xra } } in
                                  case Foo.nullT ps_Xrd of _ {
                                    GHC.Types.False ->
                                      GHC.Types.:
                                        @ Foo.Text
                                        (case ds_dBj of _ { (h_aqB [Occ=Once], _) -> h_aqB })
                                        (case Foo.nullT t_aqC of _ {
                                           GHC.Types.False -> linesT_XkT (Foo.unsafeTail t_aqC);
                                           GHC.Types.True -> GHC.Types.[] @ Foo.Text
                                         });
                                    GHC.Types.True -> GHC.Types.[] @ Foo.Text
                                  }}]
                 linesT_XkT =
                   \ (ps_Xrd :: Foo.Text) ->
                     case ps_Xrd
                     of _
                     { Foo.Text rb_XC2 [Dmd=Just L]
                                rb_XC4 [Dmd=Just L]
                                rb_XC6 [Dmd=Just L] ->
                     case GHC.Prim.<=# rb_XC6 0 of _ {
                       GHC.Types.False ->
                         let {
                           k_Xrh [Dmd=Just D(L)] :: GHC.Types.Int
                           [LclId,
                            Str=DmdType,
                            Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                                    ConLike=False, Cheap=False, Expandable=False,
                                    Guidance=IF_ARGS [] 123 110}]
                           k_Xrh =
                             letrec {
                               $wloop_sHE [Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int#
                               [LclId,
                                Arity=1,
                                Str=DmdType L,
                                Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=1, Value=True,
                                        ConLike=True, Cheap=True, Expandable=True,
                                        Guidance=IF_ARGS [0] 63 0}]
                               $wloop_sHE =
                                 \ (ww_sHp :: GHC.Prim.Int#) ->
                                   case GHC.Prim.>=# ww_sHp rb_XC6 of _ {
                                     GHC.Types.False ->
                                       case GHC.Prim.chr#
                                              (GHC.Prim.word2Int#
                                                 (GHC.Prim.indexWord16Array# rb_XC2 ww_sHp))
                                       of _ {
                                         __DEFAULT -> $wloop_sHE (GHC.Prim.+# ww_sHp 1);
                                         '\n' -> ww_sHp
                                       };
                                     GHC.Types.True -> ww_sHp
                                   }; } in
                             case $wloop_sHE 0 of ww_sHt { __DEFAULT ->
                             GHC.Types.I# ww_sHt
                             } } in
                         GHC.Types.:
                           @ Foo.Text
                           (case k_Xrh of _ { GHC.Types.I# x_aEN [Dmd=Just L] ->
                            case x_aEN of wild_X1q [Dmd=Just L] {
                              __DEFAULT -> Foo.Text rb_XC2 rb_XC4 wild_X1q;
                              0 -> wild_XR
                            }
                            })
                           (case k_Xrh of _ { GHC.Types.I# y_XFq [Dmd=Just L] ->
                            case GHC.Prim.-# rb_XC6 y_XFq of wild_X1q [Dmd=Just L] {
                              __DEFAULT -> $w$j_XIm rb_XC2 (GHC.Prim.+# rb_XC4 y_XFq) wild_X1q;
                              0 -> $w$j_XIm rb_XBR rb_XBT rb_XBV
                            }
                            });
                       GHC.Types.True -> GHC.Types.[] @ Foo.Text
                     }
                     };
                 $w$j_XIm
                   :: GHC.Prim.ByteArray#
                      -> GHC.Prim.Int# -> GHC.Prim.Int# -> [Foo.Text]
                 [LclId,
                  Arity=3,
                  Str=DmdType LLL,
                  Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=3, Value=True,
                          ConLike=True, Cheap=True, Expandable=True,
                          Guidance=IF_ARGS [0 0 0] 160 10}]
                 $w$j_XIm =
                   \ (w_sHz [Dmd=Just L, Lbv=OneShot] :: GHC.Prim.ByteArray#)
                     (w_sHA [Dmd=Just L, Lbv=OneShot] :: GHC.Prim.Int#)
                     (w_sHB [Dmd=Just L, Lbv=OneShot] :: GHC.Prim.Int#) ->
                     case GHC.Prim.<=# w_sHB 0 of _ {
                       GHC.Types.False ->
                         let {
                           a_sEG [Dmd=Just L] :: GHC.Prim.Word#
                           [LclId,
                            Str=DmdType,
                            Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=False,
                                    ConLike=False, Cheap=True, Expandable=True,
                                    Guidance=IF_ARGS [] 1 0}]
                           a_sEG = GHC.Prim.indexWord16Array# w_sHz w_sHA } in
                         case GHC.Prim.ltWord# a_sEG __word 55296 of _ {
                           GHC.Types.False ->
                             case GHC.Prim.gtWord# a_sEG __word 56319 of _ {
                               GHC.Types.False ->
                                 linesT_XkT
                                   (Foo.Text w_sHz (GHC.Prim.+# w_sHA 2) (GHC.Prim.-# w_sHB 2));
                               GHC.Types.True ->
                                 linesT_XkT
                                   (Foo.Text w_sHz (GHC.Prim.+# w_sHA 1) (GHC.Prim.-# w_sHB 1))
                             };
                           GHC.Types.True ->
                             linesT_XkT
                               (Foo.Text w_sHz (GHC.Prim.+# w_sHA 1) (GHC.Prim.-# w_sHB 1))
                         };
                       GHC.Types.True -> GHC.Types.[] @ Foo.Text
                     }; } in
               $w$j_XIm rb_XBR rb_XBT rb_XBV
               }
           }
           });
      GHC.Types.True -> GHC.Types.[] @ Foo.Text
    }
    }
end Rec }

*** End of Offense ***

comment:2 Changed 3 years ago by dreixel

I have a similar problem, but also involving SPECIALISE pragmas. At first I thought this could be somehow related to #4903, but maybe it isn't...

Here is my file:

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}

module Main where

-----------------------------------------------------------------------------
-- Base
-----------------------------------------------------------------------------
infixr 5 :+:
infixr 6 :*:

data U       = U              
data a :+: b = L a | R b      
data a :*: b = a :*: b        
newtype Rec a   = Rec a       

class Representable a where
  type Rep a
  to   :: Rep a -> a
  from :: a -> Rep a


data Tree = Leaf | Bin Int Tree Tree

instance Representable Tree where
  type Rep Tree =     U
                      :+: (Rec Int :*: Rec Tree :*: Rec Tree)

  from (Bin x l r) = R ((Rec x :*: Rec l :*: Rec r))
  from Leaf        = L (U)

  to (R ((Rec x :*: (Rec l) :*: (Rec r)))) = Bin x l r
  to (L (U))                               = Leaf

--------------------------------------------------------------------------------
-- Generic enum
--------------------------------------------------------------------------------

class Enum' a where
  enum' :: [a]

instance Enum' U where enum' = undefined
instance (Enum' a) => Enum' (Rec a) where enum' = undefined
instance (Enum' f, Enum' g) => Enum' (f :+: g) where enum' = undefined
instance (Enum' f, Enum' g) => Enum' (f :*: g) where enum' = undefined


-- This INLINE pragma is essential for the bug
{-# INLINE genum #-}
genum :: (Representable a, Enum' (Rep a)) => [a]
-- The definition of genum is essential for the bug
genum = map to enum'


instance Enum' Tree where enum' = genum
instance Enum' Int  where enum' = []

-- This SPECIALISE pragma is essential for the bug
{-# SPECIALISE genum :: [Tree] #-}

main = undefined

The error:

ghc.exe: panic! (the 'impossible' happened)
  (GHC version 7.2.0.20110728 for i386-unknown-mingw32):
        cgLookupPanic (probably invalid Core; try -dcore-lint)
    lvl_sk5{v} [lid]
    static binds for:
    local binds for:
    main:Main.to{v rk} [gid[ClassOp]]
    main:Main.enum'{v rcS} [gid[ClassOp]]
    main:Main.from{v rcT} [gid[ClassOp]]

And the -dcore-lint output:

[1 of 1] Compiling Main             ( Main.hs, Main.o )
*** Core Lint errors : in result of Simplifier ***
<no location info>:
    In the expression: GHC.Base.build @ Main.Tree lvl_siR
    lvl_siR is out of scope
*** Offending Program ***
Main.main :: forall a_aeU. a_aeU
[LclIdX,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
Main.main = GHC.Err.undefined

lvl_siP
  :: Main.U
     Main.:+: (Main.Rec GHC.Types.Int
               Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree))
[LclId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=IF_ARGS [] 10 110}]
lvl_siP =
  Main.L
    @ Main.U
    @ (Main.Rec GHC.Types.Int
       Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree))
    Main.U

$cfrom_afD :: Main.Tree -> Main.Rep Main.Tree
[LclId,
 Arity=1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=IF_ARGS [30] 50 110}]
$cfrom_afD =
  \ (ds_dhr :: Main.Tree) ->
    case ds_dhr of _ {
      Main.Leaf ->
        lvl_siP
        `cast` (Sym (Main.TFCo:R:RepTree)
                :: Main.R:RepTree ~ Main.Rep Main.Tree);
      Main.Bin x_abV l_abW r_abX ->
        (Main.R
           @ Main.U
           @ (Main.Rec GHC.Types.Int
              Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree))
           (Main.:*:
              @ (Main.Rec GHC.Types.Int)
              @ (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree)
              (x_abV
               `cast` (Sym (Main.NTCo:Rec <GHC.Types.Int>)
                       :: GHC.Types.Int ~ Main.Rec GHC.Types.Int))
              (Main.:*:
                 @ (Main.Rec Main.Tree)
                 @ (Main.Rec Main.Tree)
                 (l_abW
                  `cast` (Sym (Main.NTCo:Rec <Main.Tree>)
                          :: Main.Tree ~ Main.Rec Main.Tree))
                 (r_abX
                  `cast` (Sym (Main.NTCo:Rec <Main.Tree>)
                          :: Main.Tree ~ Main.Rec Main.Tree)))))
        `cast` (Sym (Main.TFCo:R:RepTree)
                :: Main.R:RepTree ~ Main.Rep Main.Tree)
    }

$cto_afz :: Main.Rep Main.Tree -> Main.Tree
[LclId,
 Arity=1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=IF_ARGS [0] 60 140}]
$cto_afz =
  \ (ds_dhe :: Main.Rep Main.Tree) ->
    case ds_dhe
         `cast` (Main.TFCo:R:RepTree :: Main.Rep Main.Tree ~ Main.R:RepTree)
    of _ {
      Main.L ds_dhl -> case ds_dhl of _ { Main.U -> Main.Leaf };
      Main.R ds_dhg ->
        case ds_dhg of _ { Main.:*: ds_dhh ds_dhi ->
        case ds_dhi of _ { Main.:*: ds_dhj ds_dhk ->
        Main.Bin
          (ds_dhh
           `cast` (Main.NTCo:Rec <GHC.Types.Int>
                   :: Main.Rec GHC.Types.Int ~ GHC.Types.Int))
          (ds_dhj
           `cast` (Main.NTCo:Rec <Main.Tree>
                   :: Main.Rec Main.Tree ~ Main.Tree))
          (ds_dhk
           `cast` (Main.NTCo:Rec <Main.Tree>
                   :: Main.Rec Main.Tree ~ Main.Tree))
        }
        }
    }

Main.$fRepresentableTree [InlPrag=[ALWAYS] CONLIKE]
  :: Main.Representable Main.Tree
[LclIdX[DFunId],
 Unf=DFun(arity=0) Main.D:Representable [$cto_afz, $cfrom_afD]]
Main.$fRepresentableTree =
  Main.D:Representable @ Main.Tree $cto_afz $cfrom_afD

Main.$fEnum'U [InlPrag=INLINE (sat-args=0)] :: Main.Enum' Main.U
[LclIdX[DFunId(nt)],
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True)
         Tmpl= (GHC.Err.undefined @ [Main.U])
               `cast` (Sym (Main.NTCo:T:Enum') <Main.U>
                       :: [Main.U] ~ Main.T:Enum' Main.U)}]
Main.$fEnum'U =
  (GHC.Err.undefined @ [Main.U])
  `cast` (Sym (Main.NTCo:T:Enum') <Main.U>
          :: [Main.U] ~ Main.T:Enum' Main.U)

$cenum'_aft :: forall a_abU. Main.Enum' a_abU => [Main.Rec a_abU]
[LclId,
 Arity=1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
$cenum'_aft = \ (@ a_abU) _ -> GHC.Err.undefined @ [Main.Rec a_abU]

Main.$fEnum'Int [InlPrag=INLINE (sat-args=0)]
  :: Main.Enum' GHC.Types.Int
[LclIdX[DFunId(nt)],
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True)
         Tmpl= (GHC.Types.[] @ GHC.Types.Int)
               `cast` (Sym (Main.NTCo:T:Enum') <GHC.Types.Int>
                       :: [GHC.Types.Int] ~ Main.T:Enum' GHC.Types.Int)}]
Main.$fEnum'Int =
  (GHC.Types.[] @ GHC.Types.Int)
  `cast` (Sym (Main.NTCo:T:Enum') <GHC.Types.Int>
          :: [GHC.Types.Int] ~ Main.T:Enum' GHC.Types.Int)

Main.$fEnum'Rec [InlPrag=INLINE (sat-args=0)]
  :: forall a_abU. Main.Enum' a_abU => Main.Enum' (Main.Rec a_abU)
[LclIdX[DFunId(nt)],
 Arity=1,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True)
         Tmpl= $cenum'_aft
               `cast` (forall a_abU.
                       <Main.Enum' a_abU> -> Sym (Main.NTCo:T:Enum') <Main.Rec a_abU>
                       :: (forall a_abU. Main.Enum' a_abU => [Main.Rec a_abU])
                            ~
                          (forall a_abU.
                           Main.Enum' a_abU =>
                           Main.T:Enum' (Main.Rec a_abU)))}]
Main.$fEnum'Rec =
  $cenum'_aft
  `cast` (forall a_abU.
          <Main.Enum' a_abU> -> Sym (Main.NTCo:T:Enum') <Main.Rec a_abU>
          :: (forall a_abU. Main.Enum' a_abU => [Main.Rec a_abU])
               ~
             (forall a_abU. Main.Enum' a_abU => Main.T:Enum' (Main.Rec a_abU)))

$dEnum'_ah0 :: Main.Enum' (Main.Rec GHC.Types.Int)
[LclId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
$dEnum'_ah0 =
  (GHC.Err.undefined @ [Main.Rec GHC.Types.Int])
  `cast` (Nth: 1
            ((forall a_abU.
              <Main.Enum' a_abU>
              -> Sym (Main.NTCo:T:Enum') <Main.Rec a_abU>)@GHC.Types.Int)
          :: [Main.Rec GHC.Types.Int]
               ~
             Main.T:Enum' (Main.Rec GHC.Types.Int))

$cenum'_afp
  :: forall f_abS g_abT.
     (Main.Enum' f_abS, Main.Enum' g_abT) =>
     [f_abS Main.:+: g_abT]
[LclId,
 Arity=2,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=2, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
$cenum'_afp =
  \ (@ f_abS) (@ g_abT) _ _ ->
    GHC.Err.undefined @ [f_abS Main.:+: g_abT]

Main.$fEnum':+: [InlPrag=INLINE (sat-args=0)]
  :: forall f_abS g_abT.
     (Main.Enum' f_abS, Main.Enum' g_abT) =>
     Main.Enum' (f_abS Main.:+: g_abT)
[LclIdX[DFunId(nt)],
 Arity=2,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=2, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True)
         Tmpl= $cenum'_afp
               `cast` (forall f_abS g_abT.
                       <Main.Enum' f_abS>
                       -> <Main.Enum' g_abT>
                       -> Sym (Main.NTCo:T:Enum') <f_abS Main.:+: g_abT>
                       :: (forall f_abS g_abT.
                           (Main.Enum' f_abS, Main.Enum' g_abT) =>
                           [f_abS Main.:+: g_abT])
                            ~
                          (forall f_abS g_abT.
                           (Main.Enum' f_abS, Main.Enum' g_abT) =>
                           Main.T:Enum' (f_abS Main.:+: g_abT)))}]
Main.$fEnum':+: =
  $cenum'_afp
  `cast` (forall f_abS g_abT.
          <Main.Enum' f_abS>
          -> <Main.Enum' g_abT>
          -> Sym (Main.NTCo:T:Enum') <f_abS Main.:+: g_abT>
          :: (forall f_abS g_abT.
              (Main.Enum' f_abS, Main.Enum' g_abT) =>
              [f_abS Main.:+: g_abT])
               ~
             (forall f_abS g_abT.
              (Main.Enum' f_abS, Main.Enum' g_abT) =>
              Main.T:Enum' (f_abS Main.:+: g_abT)))

$cenum'_afk
  :: forall f_abQ g_abR.
     (Main.Enum' f_abQ, Main.Enum' g_abR) =>
     [f_abQ Main.:*: g_abR]
[LclId,
 Arity=2,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=2, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
$cenum'_afk =
  \ (@ f_abQ) (@ g_abR) _ _ ->
    GHC.Err.undefined @ [f_abQ Main.:*: g_abR]

Main.$fEnum':*: [InlPrag=INLINE (sat-args=0)]
  :: forall f_abQ g_abR.
     (Main.Enum' f_abQ, Main.Enum' g_abR) =>
     Main.Enum' (f_abQ Main.:*: g_abR)
[LclIdX[DFunId(nt)],
 Arity=2,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=2, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True)
         Tmpl= $cenum'_afk
               `cast` (forall f_abQ g_abR.
                       <Main.Enum' f_abQ>
                       -> <Main.Enum' g_abR>
                       -> Sym (Main.NTCo:T:Enum') <f_abQ Main.:*: g_abR>
                       :: (forall f_abQ g_abR.
                           (Main.Enum' f_abQ, Main.Enum' g_abR) =>
                           [f_abQ Main.:*: g_abR])
                            ~
                          (forall f_abQ g_abR.
                           (Main.Enum' f_abQ, Main.Enum' g_abR) =>
                           Main.T:Enum' (f_abQ Main.:*: g_abR)))}]
Main.$fEnum':*: =
  $cenum'_afk
  `cast` (forall f_abQ g_abR.
          <Main.Enum' f_abQ>
          -> <Main.Enum' g_abR>
          -> Sym (Main.NTCo:T:Enum') <f_abQ Main.:*: g_abR>
          :: (forall f_abQ g_abR.
              (Main.Enum' f_abQ, Main.Enum' g_abR) =>
              [f_abQ Main.:*: g_abR])
               ~
             (forall f_abQ g_abR.
              (Main.Enum' f_abQ, Main.Enum' g_abR) =>
              Main.T:Enum' (f_abQ Main.:*: g_abR)))

Rec {
genum_dhd [InlPrag=INLINE (sat-args=0)] :: [Main.Tree]
[LclId,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=False, Expandable=False,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False)
         Tmpl= GHC.Base.build
                 @ Main.Tree
                 (\ (@ b1_ahA)
                    (c_ahB [Occ=Once, Lbv=OneShot] :: Main.Tree -> b1_ahA -> b1_ahA)
                    (n_ahC [Occ=Once, Lbv=OneShot] :: b1_ahA) ->
                    GHC.Base.foldr
                      @ (Main.Rep Main.Tree)
                      @ b1_ahA
                      (GHC.Base.mapFB
                         @ Main.Tree @ b1_ahA @ (Main.Rep Main.Tree) c_ahB $cto_afz)
                      n_ahC
                      ($dEnum'_agX
                       `cast` (Main.T:Enum'
                                 (Sym (Main.TFCo:R:RepTree)) ; Main.NTCo:T:Enum' <Main.Rep
                                                                                    Main.Tree>
                               :: Main.T:Enum' Main.R:RepTree ~ [Main.Rep Main.Tree])))}]
genum_dhd = GHC.Base.build @ Main.Tree lvl_siR

$cenum'_afd :: [Main.Tree]
[LclId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
$cenum'_afd = genum_dhd

Main.$fEnum'Tree [InlPrag=INLINE (sat-args=0)]
  :: Main.Enum' Main.Tree
[LclIdX[DFunId(nt)],
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=True)
         Tmpl= $cenum'_afd
               `cast` (Sym (Main.NTCo:T:Enum') <Main.Tree>
                       :: [Main.Tree] ~ Main.T:Enum' Main.Tree)}]
Main.$fEnum'Tree =
  genum_dhd
  `cast` (Sym (Main.NTCo:T:Enum') <Main.Tree>
          :: [Main.Tree] ~ Main.T:Enum' Main.Tree)

$dEnum'_ah3 :: Main.Enum' (Main.Rec Main.Tree)
[LclId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
$dEnum'_ah3 =
  (GHC.Err.undefined @ [Main.Rec Main.Tree])
  `cast` (Nth: 1
            ((forall a_abU.
              <Main.Enum' a_abU>
              -> Sym (Main.NTCo:T:Enum') <Main.Rec a_abU>)@Main.Tree)
          :: [Main.Rec Main.Tree] ~ Main.T:Enum' (Main.Rec Main.Tree))

$dEnum'_ah1
  :: Main.Enum' (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree)
[LclId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
$dEnum'_ah1 =
  (GHC.Err.undefined
     @ [Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree])
  `cast` (Nth: 1
            (Nth: 1
               (((forall f_abQ g_abR.
                  <Main.Enum' f_abQ>
                  -> <Main.Enum' g_abR>
                  -> Sym (Main.NTCo:T:Enum') <f_abQ Main.:*: g_abR>)@Main.Rec
                                                                       Main.Tree)@Main.Rec
                                                                                    Main.Tree))
          :: [Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree]
               ~
             Main.T:Enum' (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree))

$dEnum'_agZ
  :: Main.Enum'
       (Main.Rec GHC.Types.Int
        Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree))
[LclId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
$dEnum'_agZ =
  (GHC.Err.undefined
     @ [Main.Rec GHC.Types.Int
        Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree)])
  `cast` (Nth: 1
            (Nth: 1
               (((forall f_abQ g_abR.
                  <Main.Enum' f_abQ>
                  -> <Main.Enum' g_abR>
                  -> Sym (Main.NTCo:T:Enum') <f_abQ Main.:*: g_abR>)@Main.Rec
                                                                       GHC.Types.Int)@Main.Rec
                                                                                        Main.Tree
                                                                                      Main.:*: Main.Rec
                                                                                                 Main.Tree))
          :: [Main.Rec GHC.Types.Int
              Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree)]
               ~
             Main.T:Enum'
               (Main.Rec GHC.Types.Int
                Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree)))

$dEnum'_agX [Occ=LoopBreaker]
  :: Main.Enum'
       (Main.U
        Main.:+: (Main.Rec GHC.Types.Int
                  Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree)))
[LclId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
$dEnum'_agX =
  (GHC.Err.undefined
     @ [Main.U
        Main.:+: (Main.Rec GHC.Types.Int
                  Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree))])
  `cast` (Nth: 1
            (Nth: 1
               (((forall f_abS g_abT.
                  <Main.Enum' f_abS>
                  -> <Main.Enum' g_abT>
                  -> Sym (Main.NTCo:T:Enum') <f_abS Main.:+: g_abT>)@Main.U)@Main.Rec
                                                                               GHC.Types.Int
                                                                             Main.:*: (Main.Rec
                                                                                         Main.Tree
                                                                                       Main.:*: Main.Rec
                                                                                                  Main.Tree)))
          :: [Main.U
              Main.:+: (Main.Rec GHC.Types.Int
                        Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree))]
               ~
             Main.T:Enum'
               (Main.U
                Main.:+: (Main.Rec GHC.Types.Int
                          Main.:*: (Main.Rec Main.Tree Main.:*: Main.Rec Main.Tree))))
end Rec }

Main.genum [InlPrag=INLINE (sat-args=0)]
  :: forall a_abP.
     (Main.Representable a_abP, Main.Enum' (Main.Rep a_abP)) =>
     [a_abP]
[LclIdX,
 Arity=2,
 Unf=Unf{Src=InlineStable, TopLvl=True, Arity=2, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False)
         Tmpl= \ (@ a_aeV)
                 ($dRepresentable_aeW [Occ=Once] :: Main.Representable a_aeV)
                 ($dEnum'_aeX [Occ=Once] :: Main.Enum' (Main.Rep a_aeV)) ->
                 GHC.Base.build
                   @ a_aeV
                   (\ (@ b1_ahA)
                      (c_ahB [Occ=Once, Lbv=OneShot] :: a_aeV -> b1_ahA -> b1_ahA)
                      (n_ahC [Occ=Once, Lbv=OneShot] :: b1_ahA) ->
                      GHC.Base.foldr
                        @ (Main.Rep a_aeV)
                        @ b1_ahA
                        (GHC.Base.mapFB
                           @ a_aeV
                           @ b1_ahA
                           @ (Main.Rep a_aeV)
                           c_ahB
                           (Main.to @ a_aeV $dRepresentable_aeW))
                        n_ahC
                        ($dEnum'_aeX
                         `cast` (Main.NTCo:T:Enum' <Main.Rep a_aeV>
                                 :: Main.T:Enum' (Main.Rep a_aeV) ~ [Main.Rep a_aeV])))},
 RULES: "SPEC Main.genum" [ALWAYS]
            forall ($dRepresentable_af6 :: Main.Representable Main.Tree)
                   ($dEnum'_XfB :: Main.Enum' (Main.Rep Main.Tree)).
              Main.genum @ Main.Tree $dRepresentable_af6 $dEnum'_XfB
              = genum_dhd]
Main.genum =
  \ (@ a_aeV)
    ($dRepresentable_aeW :: Main.Representable a_aeV)
    ($dEnum'_aeX :: Main.Enum' (Main.Rep a_aeV)) ->
    GHC.Base.build
      @ a_aeV
      (\ (@ b1_ahA)
         (c_ahB [Lbv=OneShot] :: a_aeV -> b1_ahA -> b1_ahA)
         (n_ahC [Lbv=OneShot] :: b1_ahA) ->
         GHC.Base.foldr
           @ (Main.Rep a_aeV)
           @ b1_ahA
           (GHC.Base.mapFB
              @ a_aeV
              @ b1_ahA
              @ (Main.Rep a_aeV)
              c_ahB
              (Main.to @ a_aeV $dRepresentable_aeW))
           n_ahC
           ($dEnum'_aeX
            `cast` (Main.NTCo:T:Enum' <Main.Rep a_aeV>
                    :: Main.T:Enum' (Main.Rep a_aeV) ~ [Main.Rep a_aeV])))

a_siJ
  :: GHC.Prim.State# GHC.Prim.RealWorld
     -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Any #)
[LclId,
 Arity=1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=IF_ARGS [0] 30 0}]
a_siJ =
  \ (eta_B1 :: GHC.Prim.State# GHC.Prim.RealWorld) ->
    GHC.TopHandler.runMainIO1
      @ GHC.Prim.Any
      (GHC.Err.undefined @ (GHC.Types.IO GHC.Prim.Any))
      eta_B1

:Main.main :: GHC.Types.IO GHC.Prim.Any
[LclIdX,
 Arity=1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
:Main.main =
  a_siJ
  `cast` (Sym (GHC.Types.NTCo:IO <GHC.Prim.Any>)
          :: (GHC.Prim.State# GHC.Prim.RealWorld
              -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Any #))
               ~
             GHC.Types.IO GHC.Prim.Any)

*** End of Offense ***

comment:3 Changed 3 years ago by simonpj

I'm on this.

comment:4 Changed 3 years ago by simonpj@…

commit 428f8c3dbe74645e0560fc6003bf2891229d28a7

Author: Simon Peyton Jones <simonpj@microsoft.com>
Date:   Mon Aug 1 15:27:39 2011 +0100

    Further simplification to OccurAnal, concerning "weak loop breakers"
    
    Fixes Trac #5359.

 compiler/simplCore/OccurAnal.lhs |   84 ++++++++++++++++++++++---------------
 1 files changed, 50 insertions(+), 34 deletions(-)

comment:5 Changed 3 years ago by simonpj

Plus this commit:

commit 034b5e95c4c3194e4a6343867b0a45f8037f1c1d
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date:   Tue Aug 2 18:03:46 2011 +0100

    Fix reversed test in OccurAnal (introduced in recent commit 428f8c3d)

comment:6 Changed 3 years ago by simonpj

  • Status changed from new to merge
  • Test Case set to simplCore/should_compile/T5359a,b

comment:7 Changed 3 years ago by igloo

  • Resolution set to fixed
  • Status changed from merge to closed
Note: See TracTickets for help on using tickets.