GitLab

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

fd24a551

by Cheng Shao at 2025-08-26T04:39:02-04:00

compiler: use zero cost coerce in hoopl setElems/mapToList

This patch is a follow-up of !14680 and changes setElems/mapToList in
GHC/Cmm/Dataflow/Label to use coerce instead of mapping mkHooplLabel
over the keys.

32f8482d

by Ryan Scott at 2025-08-26T04:39:02-04:00

Reject infix promoted data constructors without DataKinds

In the rename, make sure to apply the same `DataKinds` checks for both
`HsTyVar` (for prefix promoted data constructors) and `HsOpTy` (for infix
promoted data constructors) alike.

Fixes #26318.

6 changed files:

compiler/GHC/Cmm/Dataflow/Label.hs
compiler/GHC/Rename/HsType.hs
docs/users_guide/9.16.1-notes.rst
+ testsuite/tests/typecheck/should_fail/T26318.hs
+ testsuite/tests/typecheck/should_fail/T26318.stderr
testsuite/tests/typecheck/should_fail/all.T

Changes:

compiler/GHC/Cmm/Dataflow/Label.hs

@@ -83,6 +83,7 @@ import GHC.Data.Word64Map.Strict (Word64Map)
  import qualified GHC.Data.Word64Map.Strict as M
  import GHC.Data.TrieMap
 +import Data.Coerce
  import Data.Word (Word64)
@@ -164,7 +165,7 @@ setFoldr k z (LS s) = S.foldr (\v a -> k (mkHooplLabel v) a) z s
  {-# INLINE setElems #-}
  setElems :: LabelSet -> [Label]
 -setElems (LS s) = map mkHooplLabel (S.elems s)
 +setElems (LS s) = coerce $ S.elems s
  {-# INLINE setFromList #-}
  setFromList :: [Label] -> LabelSet
@@ -272,7 +273,7 @@ mapKeys (LM m) = map (mkHooplLabel . fst) (M.toList m)
  {-# INLINE mapToList #-}
  mapToList :: LabelMap b -> [(Label, b)]
 -mapToList (LM m) = [(mkHooplLabel k, v) | (k, v) <- M.toList m]
 +mapToList (LM m) = coerce $ M.toList m
  {-# INLINE mapFromList #-}
  mapFromList :: [(Label, v)] -> LabelMap v

compiler/GHC/Rename/HsType.hs

@@ -547,15 +547,7 @@ rnHsTyKi env tv@(HsTyVar _ ip (L loc rdr_name))
         ; this_mod <- getModule
         ; when (nameIsLocalOrFrom this_mod name) $
           checkThLocalTyName name
 -       ; when (isDataConName name && not (isKindName name)) $
 -           -- Any use of a promoted data constructor name (that is not
 -           -- specifically exempted by isKindName) is illegal without the use
 -           -- of DataKinds. See Note [Checking for DataKinds] in
 -           -- GHC.Tc.Validity.
 -           checkDataKinds env tv
 -       ; when (isDataConName name && not (isPromoted ip)) $
 -         -- NB: a prefix symbolic operator such as (:) is represented as HsTyVar.
 -            addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor Prefix name)
 +       ; checkPromotedDataConName env tv Prefix ip name
         ; return (HsTyVar noAnn ip (L loc $ WithUserRdr rdr_name name), unitFV name) }
  rnHsTyKi env ty@(HsOpTy _ prom ty1 l_op ty2)
@@ -567,8 +559,7 @@ rnHsTyKi env ty@(HsOpTy _ prom ty1 l_op ty2)
          ; (ty1', fvs2) <- rnLHsTyKi env ty1
          ; (ty2', fvs3) <- rnLHsTyKi env ty2
          ; res_ty <- mkHsOpTyRn prom (fmap (WithUserRdr op_rdr) l_op') fix ty1' ty2'
 -        ; when (isDataConName op_name && not (isPromoted prom)) $
 -            addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor Infix op_name)
 +        ; checkPromotedDataConName env ty Infix prom op_name
          ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) }
  rnHsTyKi env (HsParTy _ ty)
@@ -1670,6 +1661,30 @@ checkDataKinds env thing
      type_or_kind | isRnKindLevel env = KindLevel
                   | otherwise         = TypeLevel
 +-- | If a 'Name' is that of a promoted data constructor, perform various
 +-- validity checks on it.
 +checkPromotedDataConName ::
 +  RnTyKiEnv ->
 +  -- | The type that the 'Name' belongs to. This will always be an 'HsTyVar'
 +  -- (for 'Prefix' names) or an 'HsOpTy' (for 'Infix' names).
 +  HsType GhcPs ->
 +  -- | Whether the type is written 'Prefix' or 'Infix'.
 +  LexicalFixity ->
 +  -- | Whether the name was written with an explicit promotion tick or not.
 +  PromotionFlag ->
 +  -- | The name to check.
 +  Name ->
 +  TcM ()
 +checkPromotedDataConName env ty fixity ip name
 +  = do when (isDataConName name && not (isKindName name)) $
 +         -- Any use of a promoted data constructor name (that is not
 +         -- specifically exempted by isKindName) is illegal without the use
 +         -- of DataKinds. See Note [Checking for DataKinds] in
 +         -- GHC.Tc.Validity.
 +         checkDataKinds env ty
 +       when (isDataConName name && not (isPromoted ip)) $
 +         addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor fixity name)
++
  warnUnusedForAll :: OutputableBndrFlag flag 'Renamed
                   => HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcM ()
  warnUnusedForAll doc (L loc tvb) used_names =

docs/users_guide/9.16.1-notes.rst

@@ -11,6 +11,11 @@ for specific guidance on migrating programs to this release.
  Language
  ~~~~~~~~
 +- Fix a bug introduced in GHC 9.10 where GHC would erroneously accept infix uses
 +  of promoted data constructors without enabling :extension:`DataKinds`. As a
 +  result, you may need to enable :extension:`DataKinds` in code that did not
 +  previously require it.
++
  Compiler
  ~~~~~~~~

testsuite/tests/typecheck/should_fail/T26318.hs

 +{-# LANGUAGE GHC2021 #-}
 +{-# LANGUAGE NoDataKinds #-}
 +module T26318 where
++
 +class C1 l
 +instance C1 (x : xs)
++
 +class C2 l
 +instance C2 (x ': xs)
++
 +class C3 l
 +instance C3 ((:) x xs)
++
 +class C4 l
 +instance C4 ('(:) x xs)

testsuite/tests/typecheck/should_fail/T26318.stderr

 +T26318.hs:6:16: error: [GHC-68567]
 +    Illegal type: ‘x : xs’
 +    Suggested fix:
 +      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
++
 +T26318.hs:9:16: error: [GHC-68567]
 +    Illegal type: ‘x ': xs’
 +    Suggested fix:
 +      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
++
 +T26318.hs:12:14: error: [GHC-68567]
 +    Illegal type: ‘(:)’
 +    Suggested fix:
 +      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
++
 +T26318.hs:15:14: error: [GHC-68567]
 +    Illegal type: ‘'(:)’
 +    Suggested fix:
 +      Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
++

testsuite/tests/typecheck/should_fail/all.T

@@ -741,3 +741,4 @@ test('T25325', normal, compile_fail, [''])
  test('T25004', normal, compile_fail, [''])
  test('T25004k', normal, compile_fail, [''])
  test('T26004', normal, compile_fail, [''])
 +test('T26318', normal, compile_fail, [''])