GitLab

(Originally discovered in a head.hackage CI job here.)

The reroute-0.6.0.0 Hackage library fails to build on HEAD when built with -dcore-lint. Here is a minimal example:

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
module Web.Routing.SafeRouting where

import Control.DeepSeq (NFData (..))
import Data.Kind (Constraint)
import Data.Typeable (Typeable)

class FromHttpApiData a where

data PolyMap (c :: * -> Constraint) (f :: * -> *) (a :: *) where
  PMNil :: PolyMap c f a
  PMCons :: (Typeable p, c p) => f (p -> a) -> PolyMap c f a -> PolyMap c f a

rnfHelper :: (forall p. c p => f (p -> a) -> ()) -> PolyMap c f a -> ()
rnfHelper _ PMNil = ()
rnfHelper h (PMCons v pm) = h v `seq` rnfHelper h pm

data PathMap x =
  PathMap [x] (PolyMap FromHttpApiData PathMap x)

instance NFData x => NFData (PathMap x) where
  rnf (PathMap a b) = rnf a `seq` rnfHelper rnf b

It will produce this Core Lint error on HEAD:

$ ~/Software/ghc/inplace/bin/ghc-stage2 -dcore-lint Bug1.hs -O -dno-typeable-binds -fforce-recomp
[1 of 1] Compiling Web.Routing.SafeRouting ( Bug1.hs, Bug1.o )
*** Core Lint errors : in result of Specialise ***
Bug1.hs:24:10: warning:
    From-type of Cast differs from type of enclosed expression
    From-type: NFData x_aT3
    Type of enclosed expression: NFData (p_aTl -> x_aT3)
    Actual enclosed expression: $dNFData_sUv
    Coercion used in cast: N:NFData[0] <x_aT3>_N
    In the RHS of $s$crnf_sUw :: forall {p} {x}. PathMap x -> ()
    In the body of lambda with binder p_aTl :: *
    In the body of lambda with binder x_aT3 :: *
    In the body of lambda with binder eta_B0 :: PathMap x_aT3
    In the body of letrec with binders $dNFData_sUv :: NFData
                                                         (p_aTl -> x_aT3)
    In a case alternative: (PathMap a_aHg :: [x_aT3],
                                    b_aHh :: PolyMap FromHttpApiData PathMap x_aT3)
    Substitution: [TCvSubst
                     In scope: InScope {x_aT3 p_aTl}
                     Type env: [aT3 :-> x_aT3, aTl :-> p_aTl]
                     Co env: []]
*** Offending Program ***
Rec {
rnfHelper [Occ=LoopBreaker]
  :: forall (c :: * -> Constraint) (f :: * -> *) a.
     (forall p. c p => f (p -> a) -> ()) -> PolyMap c f a -> ()
[LclIdX,
 Arity=2,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 30] 90 10}]
rnfHelper
  = \ (@(c_aSx :: * -> Constraint))
      (@(f_aSy :: * -> *))
      (@a_aSz)
      (ds_dTD :: forall p. c_aSx p => f_aSy (p -> a_aSz) -> ())
      (ds_dTE :: PolyMap c_aSx f_aSy a_aSz) ->
      case ds_dTE of {
        PMNil -> ();
        PMCons @p_aSD $dTypeable_aSE irred_aSF v_aHn pm_aHo ->
          case ds_dTD @p_aSD irred_aSF v_aHn of { () ->
          rnfHelper @c_aSx @f_aSy @a_aSz ds_dTD pm_aHo
          }
      }
end Rec }

Rec {
$s$crnf_sUw :: forall {p} {x}. PathMap x -> ()
[LclId, Arity=1]
$s$crnf_sUw
  = \ (@p_aTl) (@x_aT3) (eta_B0 :: PathMap x_aT3) ->
      let {
        $dNFData_sUv :: NFData (p_aTl -> x_aT3)
        [LclId,
         Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
                 WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
        $dNFData_sUv
          = (\ (v_aUr :: p_aTl -> x_aT3) ->
               case v_aUr of { __DEFAULT -> () })
            `cast` (Sym (N:NFData[0] <p_aTl -> x_aT3>_N)
                    :: ((p_aTl -> x_aT3) -> ()) ~R# NFData (p_aTl -> x_aT3)) } in
      case eta_B0 of { PathMap a_aHg b_aHh ->
      case $fNFData1List_$cliftRnf
             @x_aT3
             ($dNFData_sUv
              `cast` (N:NFData[0] <x_aT3>_N :: NFData x_aT3 ~R# (x_aT3 -> ())))
             a_aHg
      of
      { () ->
      rnfHelper
        @FromHttpApiData
        @PathMap
        @x_aT3
        (\ (@p_X3) _ [Occ=Dead] (eta_X4 :: PathMap (p_X3 -> x_aT3)) ->
           $crnf_aT6
             @(p_X3 -> x_aT3)
             ((\ (v_aUr :: p_X3 -> x_aT3) -> case v_aUr of { __DEFAULT -> () })
              `cast` (Sym (N:NFData[0] <p_X3 -> x_aT3>_N)
                      :: ((p_X3 -> x_aT3) -> ()) ~R# NFData (p_X3 -> x_aT3)))
             eta_X4)
        b_aHh
      }
      }

$crnf_aT6 [Occ=LoopBreaker]
  :: forall x. NFData x => PathMap x -> ()
[LclId,
 Arity=2,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 20] 150 0},
 RULES: "SPEC $crnf @(p -> x)"
            forall (@p_aTl) (@x_aT3) ($dNFData_sUv :: NFData (p_aTl -> x_aT3)).
              $crnf_aT6 @(p_aTl -> x_aT3) $dNFData_sUv
              = $s$crnf_sUw @p_aTl @x_aT3]
$crnf_aT6
  = \ (@x_aT3)
      ($dNFData_aT4 :: NFData x_aT3)
      (eta_B0 :: PathMap x_aT3) ->
      case eta_B0 of { PathMap a_aHg b_aHh ->
      case $fNFData1List_$cliftRnf
             @x_aT3
             ($dNFData_aT4
              `cast` (N:NFData[0] <x_aT3>_N :: NFData x_aT3 ~R# (x_aT3 -> ())))
             a_aHg
      of
      { () ->
      rnfHelper
        @FromHttpApiData
        @PathMap
        @x_aT3
        (\ (@p_aTl) _ [Occ=Dead] (eta_X3 :: PathMap (p_aTl -> x_aT3)) ->
           $crnf_aT6
             @(p_aTl -> x_aT3)
             ((\ (v_aUr :: p_aTl -> x_aT3) -> case v_aUr of { __DEFAULT -> () })
              `cast` (Sym (N:NFData[0] <p_aTl -> x_aT3>_N)
                      :: ((p_aTl -> x_aT3) -> ()) ~R# NFData (p_aTl -> x_aT3)))
             eta_X3)
        b_aHh
      }
      }
end Rec }

$fNFDataPathMap [InlPrag=INLINE (sat-args=0)]
  :: forall x. NFData x => NFData (PathMap x)
[LclIdX[DFunId(nt)],
 Arity=2,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=True)
         Tmpl= $crnf_aT6
               `cast` (forall (x :: <*>_N).
                       <NFData x>_R %<'Many>_N ->_R Sym (N:NFData[0] <PathMap x>_N)
                       :: (forall {x}. NFData x => PathMap x -> ())
                          ~R# (forall {x}. NFData x => NFData (PathMap x)))}]
$fNFDataPathMap
  = $crnf_aT6
    `cast` (forall (x :: <*>_N).
            <NFData x>_R %<'Many>_N ->_R Sym (N:NFData[0] <PathMap x>_N)
            :: (forall {x}. NFData x => PathMap x -> ())
               ~R# (forall {x}. NFData x => NFData (PathMap x)))

*** End of Offense ***


<no location info>: error: 
Compilation had errors



<no location info>: error: ExitFailure 1

This regression was introduced in commit 4d2ee313 (Specialising through specialised method calls). cc @sgraf812