GitLab

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

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

module Repro.B where

import Repro.A
import Repro.C

bar2 :: License -> Doc
bar2 = bar

C.hs

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 ***

Trac metadata

Trac field	Value
Version	8.7
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC	aspiwack
Operating system
Architecture