[GHC] #9025: Core Lint warning with -O (Demand type has 4 arguments ...)

23 Apr 2014


      #9025: Core Lint warning with -O (Demand type has 4 arguments ...)
------------------------------------+-------------------------------------
       Reporter:  conal             |             Owner:
           Type:  bug               |            Status:  new
       Priority:  normal            |         Milestone:
      Component:  Compiler          |           Version:  7.8.2
       Keywords:                    |  Operating System:  Unknown/Multiple
   Architecture:  Unknown/Multiple  |   Type of failure:  None/Unknown
     Difficulty:  Unknown           |         Test Case:
     Blocked By:                    |          Blocking:
Related Tickets:                    |
------------------------------------+-------------------------------------
 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
 
 *** 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 ,
  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 ,
  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 ,
  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] _N _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 ,
  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 ,
  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.
           _R
           -> _R
           ->  b_arX>_R
           -> Sub (Sym (LintBomb.TFCo:R:Enc(->)[0] _N _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 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` ( b_Xsa>_R
                 -> Sub (Sym (LintBomb.TFCo:R:Enc(->)[0] _N
 _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 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
 }}}

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

GHC

GHC

GHC

GHC

GHC

GHC

GHC

tags

participants (1)