[GHC] #16288: Core Lint error: Occurrence is GlobalId, but binding is LocalId

[GHC]

#16288: Core Lint error: Occurrence is GlobalId, but binding is LocalId
-------------------------------------+-------------------------------------
           Reporter:  monoidal       |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:
          Component:  Compiler       |           Version:  8.7
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  Compile-time
  Unknown/Multiple                   |  crash or panic
          Test Case:                 |        Blocked By:
           Blocking:  15840          |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 Compiling the following three modules causes a Core Lint error in HEAD.
 (This does not happen in 8.6 - the Lint check was introduced later.)

 To reproduce: save the three files in `Repro/` directory and use `ghc-
 stage2 -dcore-lint -O Repro/B.hs`. The reproduction code is minimized
 version of code from cabal and prettyprint libraries.

 A.hs

 {{{
 #!haskell
 module Repro.A where

 import Repro.C

 data License

 class Pretty a where
   pretty :: a -> Doc

 instance Pretty License where
   pretty _  = pretV

 bar :: (Pretty a) => a -> Doc
 bar w = foo (pretty (u w w w w))

 u :: a -> a -> a -> a -> a
 u = u
 }}}

 B.hs

 {{{
 #!haskell
 module Repro.B where

 import Repro.A
 import Repro.C

 bar2 :: License -> Doc
 bar2 = bar
 }}}

 C.hs

 {{{
 #!haskell
 module Repro.C where

 data Doc = Empty | Beside Doc

 hcat :: Doc -> Doc
 hcat Empty = Empty
 hcat xs = hcat xs

 pretV = hcat Empty

 foo :: Doc -> Doc
 foo Empty = hcat Empty
 foo val = Beside val
 }}}

 The error:

 {{{
 *** Core Lint errors : in result of Simplifier ***
 Repro/C.hs:9:1: warning:
     [in body of letrec with binders pretV_r3 :: Doc]
     Occurrence is GlobalId, but binding is LocalId
       pretV :: Doc
       [GblId,
        Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
                WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20
 0}]
 *** Offending Program ***
 lvl_s1kN :: Doc
 [LclId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
          WorkFree=True, Expandable=False, Guidance=IF_ARGS [] 30 20}]
 lvl_s1kN
   = case pretV of wild_Xd {
       Empty -> pretV;
       Beside ipv_s105 -> Beside wild_Xd
     }

 $sbar_s1kL [InlPrag=NOUSERINLINE[2]] :: License -> Doc
 [LclId,
  Arity=1,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)
          Tmpl= \ _ [Occ=Dead] ->
                  case pretV of wild_Xd [Occ=Once*] {
                    Empty ->
                      let {
                        pretV_r3 :: Doc
                        [LclId]
                        pretV_r3 = wild_Xd } in
                      pretV;
                    Beside _ [Occ=Dead] -> Beside wild_Xd
                  }}]
 $sbar_s1kL = \ _ [Occ=Dead] -> lvl_s1kN

 $trModule_s1kE :: Addr#
 [LclId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
 $trModule_s1kE = "main"#

 $trModule_s1kF :: TrName
 [LclId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
 $trModule_s1kF = TrNameS $trModule_s1kE

 $trModule_s1kG :: Addr#
 [LclId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
 $trModule_s1kG = "Repro.B"#

 $trModule_s1kH :: TrName
 [LclId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
 $trModule_s1kH = TrNameS $trModule_s1kG

 $trModule :: Module
 [LclIdX,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
 $trModule = Module $trModule_s1kF $trModule_s1kH

 bar2 :: License -> Doc
 [LclIdX,
  Arity=1,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 20}]
 bar2
   = \ _ [Occ=Dead] ->
       case pretV of wild_Xd {
         Empty -> pretV;
         Beside ipv_s105 -> Beside wild_Xd
       }

 *** End of Offense ***

 }}}

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/16288>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler