#9025 closed bug (fixed)

Core Lint warning with -O (Demand type has 4 arguments ...)

Reported by: conal Owned by:
Priority: normal Milestone: 7.8.3
Component: Compiler Version: 7.8.2
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: None/Unknown Test Case:
Blocked By: Blocking:
Related Tickets: Differential Revisions:

Description

The attached small program triggers a Core Lint warning when compiled with -O:

bash-3.2$ ghc LintBomb.hs -fforce-recomp -dcore-lint
[1 of 1] Compiling LintBomb         ( LintBomb.hs, LintBomb.o )
bash-3.2$ ghc LintBomb.hs -fforce-recomp -dcore-lint -O
[1 of 1] Compiling LintBomb         ( LintBomb.hs, LintBomb.o )
*** Core Lint errors : in result of CorePrep ***
{-# LINE 13 "LintBomb.hs #-}: Warning:
    [RHS of LintBomb.$fEncodable(->)_$cencode :: forall a_arW b_arX.
                                                 (LintBomb.Encodable a_arW,
                                                  LintBomb.Encodable b_arX) =>
                                                 (a_arW -> b_arX) -> LintBomb.Enc (a_arW -> b_arX)]
    Demand type has 4 arguments, rhs has 3 arguments, LintBomb.$fEncodable(->)_$cencode
    Binder's strictness signature: DmdType <L,1*U(A,1*C1(U))><S(C(S)L),1*U(1*C1(U),A)><L,1*C1(U)><L,U>
*** Offending Program ***
LintBomb.encode [InlPrag=[NEVER]]
  :: forall a_arV.
     LintBomb.Encodable a_arV =>
     a_arV -> LintBomb.Enc a_arV
[GblId[ClassOp],
 Arity=1,
 Caf=NoCafRefs,
 Str=DmdType <S(SL),U(U,A)>,
 Unf=OtherCon [],
 RULES: Built in rule for LintBomb.encode: "Class op encode"]
LintBomb.encode =
  \ (@ a_arV) (tpl_sOv [Occ=Once!] :: LintBomb.Encodable a_arV) ->
    case tpl_sOv
    of _ [Occ=Dead]
    { LintBomb.D:Encodable tpl_sOx [Occ=Once] _ [Occ=Dead] ->
    tpl_sOx
    }

LintBomb.decode [InlPrag=[NEVER]]
  :: forall a_arV.
     LintBomb.Encodable a_arV =>
     LintBomb.Enc a_arV -> a_arV
[GblId[ClassOp],
 Arity=1,
 Caf=NoCafRefs,
 Str=DmdType <S(LS),U(A,U)>,
 Unf=OtherCon [],
 RULES: Built in rule for LintBomb.decode: "Class op decode"]
LintBomb.decode =
  \ (@ a_arV) (tpl_sOz [Occ=Once!] :: LintBomb.Encodable a_arV) ->
    case tpl_sOz
    of _ [Occ=Dead]
    { LintBomb.D:Encodable _ [Occ=Dead] tpl_sOC [Occ=Once] ->
    tpl_sOC
    }

LintBomb.$fEncodable(->)_$cdecode
  :: forall a_arW b_arX.
     (LintBomb.Encodable a_arW, LintBomb.Encodable b_arX) =>
     LintBomb.Enc (a_arW -> b_arX) -> a_arW -> b_arX
[GblId,
 Arity=4,
 Caf=NoCafRefs,
 Str=DmdType <L,1*U(1*C1(U),A)><S(LC(S)),1*U(A,1*C1(U))><L,1*C1(U)><L,U>,
 Unf=OtherCon []]
LintBomb.$fEncodable(->)_$cdecode =
  \ (@ a_arW)
    (@ b_arX)
    ($dEncodable_sOD [Occ=Once] :: LintBomb.Encodable a_arW)
    ($dEncodable1_sOE [Occ=Once] :: LintBomb.Encodable b_arX)
    (h_sOF [Occ=Once] :: LintBomb.Enc (a_arW -> b_arX))
    (eta_sOG [Occ=Once] :: a_arW) ->
    let {
      sat_sOI [Occ=Once] :: LintBomb.Enc b_arX
      [LclId, Str=DmdType]
      sat_sOI =
        let {
          sat_sOH [Occ=Once] :: LintBomb.Enc a_arW
          [LclId, Str=DmdType]
          sat_sOH = LintBomb.encode @ a_arW $dEncodable_sOD eta_sOG } in
        (h_sOF
         `cast` (Sub (LintBomb.TFCo:R:Enc(->)[0] <a_arW>_N <b_arX>_N)
                 :: LintBomb.Enc (a_arW -> b_arX)
                      ~#
                    (LintBomb.Enc a_arW -> LintBomb.Enc b_arX)))
          sat_sOH } in
    LintBomb.decode @ b_arX $dEncodable1_sOE sat_sOI

LintBomb.$fEncodable(->)1
  :: forall a_arW b_arX.
     (LintBomb.Encodable a_arW, LintBomb.Encodable b_arX) =>
     (a_arW -> b_arX) -> LintBomb.Enc a_arW -> LintBomb.Enc b_arX
[GblId,
 Arity=4,
 Caf=NoCafRefs,
 Str=DmdType <L,1*U(A,1*C1(U))><S(C(S)L),1*U(1*C1(U),A)><L,1*C1(U)><L,U>,
 Unf=OtherCon []]
LintBomb.$fEncodable(->)1 =
  \ (@ a_arW)
    (@ b_arX)
    ($dEncodable_sOJ [Occ=Once] :: LintBomb.Encodable a_arW)
    ($dEncodable1_sOK [Occ=Once] :: LintBomb.Encodable b_arX)
    (f_sOL [Occ=Once!] :: a_arW -> b_arX)
    (eta_sOM [Occ=Once] :: LintBomb.Enc a_arW) ->
    let {
      sat_sOO [Occ=Once] :: b_arX
      [LclId, Str=DmdType]
      sat_sOO =
        let {
          sat_sON [Occ=Once] :: a_arW
          [LclId, Str=DmdType]
          sat_sON = LintBomb.decode @ a_arW $dEncodable_sOJ eta_sOM } in
        f_sOL sat_sON } in
    LintBomb.encode @ b_arX $dEncodable1_sOK sat_sOO

LintBomb.$fEncodable(->)_$cencode
  :: forall a_arW b_arX.
     (LintBomb.Encodable a_arW, LintBomb.Encodable b_arX) =>
     (a_arW -> b_arX) -> LintBomb.Enc (a_arW -> b_arX)
[GblId,
 Arity=3,
 Caf=NoCafRefs,
 Str=DmdType <L,1*U(A,1*C1(U))><S(C(S)L),1*U(1*C1(U),A)><L,1*C1(U)><L,U>,
 Unf=OtherCon []]
LintBomb.$fEncodable(->)_$cencode =
  (\ (@ a_arW)
     (@ b_arX)
     (eta_B3 [Occ=Once] :: LintBomb.Encodable a_arW)
     (eta_B2 [Occ=Once] :: LintBomb.Encodable b_arX)
     (eta_B1 [Occ=Once] :: a_arW -> b_arX) ->
     LintBomb.$fEncodable(->)1 @ a_arW @ b_arX eta_B3 eta_B2 eta_B1)
  `cast` (forall a_arW b_arX.
          <LintBomb.Encodable a_arW>_R
          -> <LintBomb.Encodable b_arX>_R
          -> <a_arW -> b_arX>_R
          -> Sub (Sym (LintBomb.TFCo:R:Enc(->)[0] <a_arW>_N <b_arX>_N))
          :: (forall a_arW b_arX.
              (LintBomb.Encodable a_arW, LintBomb.Encodable b_arX) =>
              (a_arW -> b_arX) -> LintBomb.Enc a_arW -> LintBomb.Enc b_arX)
               ~#
             (forall a_arW b_arX.
              (LintBomb.Encodable a_arW, LintBomb.Encodable b_arX) =>
              (a_arW -> b_arX) -> LintBomb.Enc (a_arW -> b_arX)))

LintBomb.$fEncodable(->) [InlPrag=[ALWAYS] CONLIKE]
  :: forall a_arW b_arX.
     (LintBomb.Encodable a_arW, LintBomb.Encodable b_arX) =>
     LintBomb.Encodable (a_arW -> b_arX)
[GblId[DFunId],
 Arity=2,
 Caf=NoCafRefs,
 Str=DmdType <L,U(C(U),C(U))><L,U(C(U),C(U))>m,
 Unf=OtherCon []]
LintBomb.$fEncodable(->) =
  \ (@ a_Xs8)
    (@ b_Xsa)
    ($dEncodable_sOP :: LintBomb.Encodable a_Xs8)
    ($dEncodable1_sOQ :: LintBomb.Encodable b_Xsa) ->
    let {
      sat_sOS [Occ=Once]
        :: LintBomb.Enc (a_Xs8 -> b_Xsa) -> a_Xs8 -> b_Xsa
      [LclId, Str=DmdType]
      sat_sOS =
        \ (eta_B2 [Occ=Once] :: LintBomb.Enc (a_Xs8 -> b_Xsa))
          (eta_B1 [Occ=Once] :: a_Xs8) ->
          LintBomb.$fEncodable(->)_$cdecode
            @ a_Xs8 @ b_Xsa $dEncodable_sOP $dEncodable1_sOQ eta_B2 eta_B1 } in
    let {
      sat_sOR [Occ=Once]
        :: (a_Xs8 -> b_Xsa) -> LintBomb.Enc (a_Xs8 -> b_Xsa)
      [LclId, Str=DmdType]
      sat_sOR =
        (\ (eta_B1 [Occ=Once] :: a_Xs8 -> b_Xsa) ->
           LintBomb.$fEncodable(->)1
             @ a_Xs8 @ b_Xsa $dEncodable_sOP $dEncodable1_sOQ eta_B1)
        `cast` (<a_Xs8 -> b_Xsa>_R
                -> Sub (Sym (LintBomb.TFCo:R:Enc(->)[0] <a_Xs8>_N <b_Xsa>_N))
                :: ((a_Xs8 -> b_Xsa) -> LintBomb.Enc a_Xs8 -> LintBomb.Enc b_Xsa)
                     ~#
                   ((a_Xs8 -> b_Xsa) -> LintBomb.Enc (a_Xs8 -> b_Xsa))) } in
    LintBomb.D:Encodable @ (a_Xs8 -> b_Xsa) sat_sOR sat_sOS

LintBomb.D:Encodable
  :: forall a_arV.
     (a_arV -> LintBomb.Enc a_arV)
     -> (LintBomb.Enc a_arV -> a_arV) -> LintBomb.Encodable a_arV
[GblId[DataCon],
 Arity=2,
 Caf=NoCafRefs,
 Str=DmdType <L,U><L,U>m,
 Unf=OtherCon []]
LintBomb.D:Encodable =
  \ (@ a_arV)
    (eta_B2 [Occ=Once] :: a_arV -> LintBomb.Enc a_arV)
    (eta_B1 [Occ=Once] :: LintBomb.Enc a_arV -> a_arV) ->
    LintBomb.D:Encodable @ a_arV eta_B2 eta_B1

*** End of Offense ***


<no location info>: 
Compilation had errors

Attachments (1)

LintBomb.hs (875 bytes) - added by conal 15 months ago.
Haskell module

Download all attachments as: .zip

Change History (7)

Changed 15 months ago by conal

Haskell module

comment:1 follow-up: Changed 15 months ago by simonpj

Oddly this works for me. I'm not using precisely 7.8, but close. (In parallel I'm trying to check out a 7.8 branch.)

Simon

comment:2 Changed 15 months ago by goldfire

I can reproduce on 7.8.2.

comment:3 in reply to: ↑ 1 Changed 14 months ago by darchon

Replying to simonpj:

Oddly this works for me. I'm not using precisely 7.8, but close. (In parallel I'm trying to check out a 7.8 branch.)

Simon

Perhaps due to 848f595266268f578480ceb4ab1ce4938611c97e ?

comment:4 Changed 14 months ago by simonpj

  • Status changed from new to merge

I think drachon is right.

Please merge that commit to 7.8.

Simon

comment:5 Changed 14 months ago by thoughtpolice

  • Milestone set to 7.8.3

comment:6 Changed 14 months ago by thoughtpolice

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