[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Add -Wmissing-poly-kind-signatures

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Jun 14 03:41:20 UTC 2023



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


Commits:
fd9858df by Oleg Grenrus at 2023-06-13T23:40:42-04:00
Add -Wmissing-poly-kind-signatures

Implements #22826

This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types.

- - - - -
06ac8c3f by doyougnu at 2023-06-13T23:40:56-04:00
ci: special case in req_host_target_ghc for JS

- - - - -
bf8fa982 by Gergo ERDI at 2023-06-13T23:41:01-04:00
When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions

Fixes #23486

- - - - -
ec0983c6 by Krzysztof Gogolewski at 2023-06-13T23:41:02-04:00
Add a testcase for #20076

Remove 'recursive' in the error message, since the error
can arise without recursion.

- - - - -
5830b128 by Krzysztof Gogolewski at 2023-06-13T23:41:02-04:00
Use tcInferFRR to prevent bad generalisation

Fixes #23176

- - - - -
cbab72d6 by Matthew Pickering at 2023-06-13T23:41:03-04:00
ci: Add dependenices on necessary aarch64 jobs for head.hackage ci

These need to be added since we started testing aarch64 on head.hackage
CI. The jobs will sometimes fail because they will start before the
relevant aarch64 job has finished.

Fixes #23511

- - - - -
c1a09b6a by Vladislav Zavialov at 2023-06-13T23:41:03-04:00
Add standalone kind signatures for Code and TExp

CodeQ and TExpQ already had standalone kind signatures
even before this change:

	type TExpQ :: TYPE r -> Kind.Type
	type CodeQ :: TYPE r -> Kind.Type

Now Code and TExp have signatures too:

	type TExp :: TYPE r -> Kind.Type
	type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type

This is a stylistic change.

- - - - -
8b5202ab by Tom Ellis at 2023-06-13T23:41:05-04:00
Warn that GHC.TypeLits.Internal should not be used

- - - - -
79870853 by Tom Ellis at 2023-06-13T23:41:05-04:00
Warn that GHC.TypeNats.Internal should not be used

- - - - -


28 changed files:

- .gitlab-ci.yml
- compiler/GHC/Core/Type.hs
- compiler/GHC/Data/BooleanFormula.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- docs/users_guide/using-warnings.rst
- libraries/base/GHC/TypeLits/Internal.hs
- libraries/base/GHC/TypeNats/Internal.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- testsuite/driver/testlib.py
- testsuite/tests/polykinds/T22743.stderr
- + testsuite/tests/rep-poly/T23176.hs
- + testsuite/tests/rep-poly/T23176.stderr
- testsuite/tests/rep-poly/all.T
- testsuite/tests/typecheck/should_fail/T23427.hs
- testsuite/tests/typecheck/should_fail/T23427.stderr
- + testsuite/tests/warnings/should_compile/T22826.hs
- + testsuite/tests/warnings/should_compile/T22826.stderr
- testsuite/tests/warnings/should_compile/all.T


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -718,6 +718,12 @@ hackage-lint:
     - job: nightly-x86_64-linux-deb10-numa-slow-validate
       optional: true
       artifacts: false
+    - job: nightly-aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
+    - job: aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
   extends: .hackage
   variables:
     SLOW_VALIDATE: 1
@@ -733,6 +739,9 @@ hackage-label-lint:
     - job: x86_64-linux-deb10-numa-slow-validate
       optional: true
       artifacts: false
+    - job: aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
   extends: .hackage
   variables:
     SLOW_VALIDATE: 1
@@ -747,6 +756,9 @@ nightly-hackage-lint:
     - job: nightly-x86_64-linux-deb10-numa-slow-validate
       optional: true
       artifacts: false
+    - job: nightly-aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
   rules:
     - if: $NIGHTLY
       variables:
@@ -761,6 +773,9 @@ nightly-hackage-perf:
     - job: nightly-x86_64-linux-fedora33-release
       optional: true
       artifacts: false
+    - job: nightly-aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
   rules:
     - if: $NIGHTLY
       variables:
@@ -777,6 +792,9 @@ release-hackage-lint:
     - job: release-x86_64-linux-fedora33-release
       optional: true
       artifacts: false
+    - job: release-aarch64-linux-deb10-release+no_split_sections
+      optional: true
+      artifacts: false
   rules:
     - if: '$RELEASE_JOB == "yes"'
   extends: .hackage


=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -111,6 +111,7 @@ module GHC.Core.Type (
         isTyVarTy, isFunTy, isCoercionTy,
         isCoercionTy_maybe, isForAllTy,
         isForAllTy_ty, isForAllTy_co,
+        isForAllTy_invis_ty,
         isPiTy, isTauTy, isFamFreeTy,
         isCoVarType, isAtomicTy,
 
@@ -1891,6 +1892,15 @@ isForAllTy_ty ty
 
   | otherwise = False
 
+-- | Like `isForAllTy`, but returns True only if it is an inferred tyvar binder
+isForAllTy_invis_ty :: Type -> Bool
+isForAllTy_invis_ty  ty
+  | ForAllTy (Bndr tv (Invisible InferredSpec)) _ <- coreFullView ty
+  , isTyVar tv
+  = True
+
+  | otherwise = False
+
 -- | Like `isForAllTy`, but returns True only if it is a covar binder
 isForAllTy_co :: Type -> Bool
 isForAllTy_co ty


=====================================
compiler/GHC/Data/BooleanFormula.hs
=====================================
@@ -24,8 +24,7 @@ import Data.Data
 
 import GHC.Utils.Monad
 import GHC.Utils.Outputable
-import GHC.Utils.Binary
-import GHC.Parser.Annotation ( LocatedL, noLocA )
+import GHC.Parser.Annotation ( LocatedL )
 import GHC.Types.SrcLoc
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
@@ -243,22 +242,3 @@ pprBooleanFormulaNormal = go
     go (Or [])    = keyword $ text "FALSE"
     go (Or xs)    = fsep $ intersperse vbar (map (go . unLoc) xs)
     go (Parens x) = parens (go $ unLoc x)
-
-
-----------------------------------------------------------------------
--- Binary
-----------------------------------------------------------------------
-
-instance Binary a => Binary (BooleanFormula a) where
-  put_ bh (Var x)    = putByte bh 0 >> put_ bh x
-  put_ bh (And xs)   = putByte bh 1 >> put_ bh (unLoc <$> xs)
-  put_ bh (Or  xs)   = putByte bh 2 >> put_ bh (unLoc <$> xs)
-  put_ bh (Parens x) = putByte bh 3 >> put_ bh (unLoc x)
-
-  get bh = do
-    h <- getByte bh
-    case h of
-      0 -> Var                  <$> get bh
-      1 -> And    . fmap noLocA <$> get bh
-      2 -> Or     . fmap noLocA <$> get bh
-      _ -> Parens . noLocA      <$> get bh


=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -631,6 +631,7 @@ data WarningFlag =
    | Opt_WarnAmbiguousFields                         -- Since 9.2
    | Opt_WarnImplicitLift                            -- Since 9.2
    | Opt_WarnMissingKindSignatures                   -- Since 9.2
+   | Opt_WarnMissingPolyKindSignatures               -- Since 9.8
    | Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2
    | Opt_WarnRedundantStrictnessFlags                -- Since 9.4
    | Opt_WarnForallIdentifier                        -- Since 9.4
@@ -685,6 +686,7 @@ warnFlagNames wflag = case wflag of
   Opt_WarnSemigroup                               -> "semigroup" :| []
   Opt_WarnMissingSignatures                       -> "missing-signatures" :| []
   Opt_WarnMissingKindSignatures                   -> "missing-kind-signatures" :| []
+  Opt_WarnMissingPolyKindSignatures               -> "missing-poly-kind-signatures" :| []
   Opt_WarnMissingExportedSignatures               -> "missing-exported-signatures" :| []
   Opt_WarnMonomorphism                            -> "monomorphism-restriction" :| []
   Opt_WarnNameShadowing                           -> "name-shadowing" :| []


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2192,6 +2192,7 @@ wWarningFlagsDeps = mconcat [
   warnSpec    Opt_WarnSemigroup,
   warnSpec    Opt_WarnMissingSignatures,
   warnSpec    Opt_WarnMissingKindSignatures,
+  warnSpec    Opt_WarnMissingPolyKindSignatures,
   subWarnSpec "missing-exported-sigs"
               Opt_WarnMissingExportedSignatures
               "it is replaced by -Wmissing-exported-signatures",


=====================================
compiler/GHC/Iface/Decl.hs
=====================================
@@ -1,5 +1,6 @@
 
 {-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-
 (c) The University of Glasgow 2006-2008
@@ -12,6 +13,7 @@
 module GHC.Iface.Decl
    ( coAxiomToIfaceDecl
    , tyThingToIfaceDecl -- Converting things to their Iface equivalents
+   , toIfaceBooleanFormula
    )
 where
 
@@ -38,12 +40,14 @@ import GHC.Types.Var
 import GHC.Types.Name
 import GHC.Types.Basic
 import GHC.Types.TyThing
+import GHC.Types.SrcLoc
 
 import GHC.Utils.Panic.Plain
 import GHC.Utils.Misc
 
 import GHC.Data.FastString
 import GHC.Data.Maybe
+import GHC.Data.BooleanFormula
 
 import Data.List ( findIndex, mapAccumL )
 
@@ -284,7 +288,7 @@ classToIfaceDecl env clas
                 ifClassCtxt   = tidyToIfaceContext env1 sc_theta,
                 ifATs    = map toIfaceAT clas_ats,
                 ifSigs   = map toIfaceClassOp op_stuff,
-                ifMinDef = fmap getOccFS (classMinimalDef clas)
+                ifMinDef = toIfaceBooleanFormula $ fmap getOccFS (classMinimalDef clas)
             }
 
     (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
@@ -332,3 +336,10 @@ tidyTyConBinders = mapAccumL tidyTyConBinder
 
 tidyTyVar :: TidyEnv -> TyVar -> FastString
 tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)
+
+toIfaceBooleanFormula :: BooleanFormula IfLclName -> IfaceBooleanFormula
+toIfaceBooleanFormula = \case
+    Var nm    -> IfVar    nm
+    And bfs   -> IfAnd    (map (toIfaceBooleanFormula . unLoc) bfs)
+    Or bfs    -> IfOr     (map (toIfaceBooleanFormula . unLoc) bfs)
+    Parens bf -> IfParens (toIfaceBooleanFormula . unLoc $ bf)


=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -17,7 +17,7 @@ module GHC.Iface.Syntax (
         IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..),
         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
         IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
-        IfaceClassBody(..),
+        IfaceClassBody(..), IfaceBooleanFormula(..),
         IfaceBang(..),
         IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),
         IfaceAxBranch(..),
@@ -32,6 +32,7 @@ module GHC.Iface.Syntax (
         -- Misc
         ifaceDeclImplicitBndrs, visibleIfConDecls,
         ifaceDeclFingerprints,
+        fromIfaceBooleanFormula,
 
         -- Free Names
         freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
@@ -66,12 +67,13 @@ import GHC.Types.Annotations( AnnPayload, AnnTarget )
 import GHC.Types.Basic
 import GHC.Unit.Module
 import GHC.Types.SrcLoc
-import GHC.Data.BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
+import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue )
 import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike )
 import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag )
 import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
 import GHC.Builtin.Types ( constraintKindTyConName )
 import GHC.Stg.InferTags.TagSig
+import GHC.Parser.Annotation (noLocA)
 
 import GHC.Utils.Lexeme (isLexSym)
 import GHC.Utils.Fingerprint
@@ -191,9 +193,22 @@ data IfaceClassBody
      ifClassCtxt :: IfaceContext,             -- Super classes
      ifATs       :: [IfaceAT],                -- Associated type families
      ifSigs      :: [IfaceClassOp],           -- Method signatures
-     ifMinDef    :: BooleanFormula IfLclName  -- Minimal complete definition
+     ifMinDef    :: IfaceBooleanFormula       -- Minimal complete definition
     }
 
+data IfaceBooleanFormula
+  = IfVar IfLclName
+  | IfAnd [IfaceBooleanFormula]
+  | IfOr [IfaceBooleanFormula]
+  | IfParens IfaceBooleanFormula
+
+fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula IfLclName
+fromIfaceBooleanFormula = \case
+    IfVar nm     -> Var    nm
+    IfAnd ibfs   -> And    (map (noLocA . fromIfaceBooleanFormula) ibfs)
+    IfOr ibfs    -> Or     (map (noLocA . fromIfaceBooleanFormula) ibfs)
+    IfParens ibf -> Parens (noLocA . fromIfaceBooleanFormula $ ibf)
+
 data IfaceTyConParent
   = IfNoParent
   | IfDataInstance
@@ -930,7 +945,7 @@ pprIfaceDecl ss (IfaceClass { ifName  = clas
          , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind)
          , text "class" <+> pprIfaceDeclHead suppress_bndr_sig context ss clas binders <+> pprFundeps fds <+> pp_where
          , nest 2 (vcat [ vcat asocs, vcat dsigs
-                        , ppShowAllSubs ss (pprMinDef minDef)])]
+                        , ppShowAllSubs ss (pprMinDef $ fromIfaceBooleanFormula minDef)])]
     where
       pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
 
@@ -2038,6 +2053,20 @@ instance Binary IfaceDecl where
                         ifBody = IfAbstractClass })
             _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
 
+instance Binary IfaceBooleanFormula where
+    put_ bh = \case
+        IfVar a1    -> putByte bh 0 >> put_ bh a1
+        IfAnd a1    -> putByte bh 1 >> put_ bh a1
+        IfOr a1     -> putByte bh 2 >> put_ bh a1
+        IfParens a1 -> putByte bh 3 >> put_ bh a1
+
+    get bh = do
+        getByte bh >>= \case
+            0 -> IfVar    <$> get bh
+            1 -> IfAnd    <$> get bh
+            2 -> IfOr     <$> get bh
+            _ -> IfParens <$> get bh
+
 {- Note [Lazy deserialization of IfaceId]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The use of lazyPut and lazyGet in the IfaceId Binary instance is
@@ -2650,7 +2679,14 @@ instance NFData IfaceAxBranch where
 instance NFData IfaceClassBody where
   rnf = \case
     IfAbstractClass -> ()
-    IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` ()
+    IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` ()
+
+instance NFData IfaceBooleanFormula where
+  rnf = \case
+      IfVar f1    -> rnf f1
+      IfAnd f1    -> rnf f1
+      IfOr f1     -> rnf f1
+      IfParens f1 -> rnf f1
 
 instance NFData IfaceAT where
   rnf (IfaceAT f1 f2) = rnf f1 `seq` rnf f2


=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -44,6 +44,7 @@ import GHC.Driver.Config.Core.Lint ( initLintConfig )
 import GHC.Builtin.Types.Literals(typeNatCoAxiomRules)
 import GHC.Builtin.Types
 
+import GHC.Iface.Decl (toIfaceBooleanFormula)
 import GHC.Iface.Syntax
 import GHC.Iface.Load
 import GHC.Iface.Env
@@ -290,7 +291,7 @@ mergeIfaceDecl d1 d2
                     (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
       in d1 { ifBody = (ifBody d1) {
                 ifSigs  = ops,
-                ifMinDef = BF.mkOr [noLocA bf1, noLocA bf2]
+                ifMinDef = toIfaceBooleanFormula . BF.mkOr . map (noLocA . fromIfaceBooleanFormula) $ [bf1, bf2]
                 }
             } `withRolesFrom` d2
     -- It doesn't matter; we'll check for consistency later when
@@ -773,7 +774,7 @@ tc_iface_decl _parent ignore_prags
                          ifBody = IfConcreteClass {
                              ifClassCtxt = rdr_ctxt,
                              ifATs = rdr_ats, ifSigs = rdr_sigs,
-                             ifMinDef = mindef_occ
+                             ifMinDef = if_mindef
                          }})
   = bindIfaceTyConBinders binders $ \ binders' -> do
     { traceIf (text "tc-iface-class1" <+> ppr tc_name)
@@ -782,6 +783,7 @@ tc_iface_decl _parent ignore_prags
     ; sigs <- mapM tc_sig rdr_sigs
     ; fds  <- mapM tc_fd rdr_fds
     ; traceIf (text "tc-iface-class3" <+> ppr tc_name)
+    ; let mindef_occ = fromIfaceBooleanFormula if_mindef
     ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ
     ; cls  <- fixM $ \ cls -> do
               { ats  <- mapM (tc_at cls) rdr_ats


=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -1689,12 +1689,13 @@ warnMissingKindSignatures gbl_env
     tcs = tcg_tcs gbl_env
     ksig_ns = tcg_ksigs gbl_env
     exports = availsToNameSet (tcg_exports gbl_env)
-    not_ghc_generated :: Name -> Bool
-    not_ghc_generated name = name `elemNameSet` ksig_ns
+
+    has_kind_signature :: Name -> Bool
+    has_kind_signature name = name `elemNameSet` ksig_ns
 
     add_ty_warn :: Bool -> TyCon -> RnM ()
     add_ty_warn cusks_enabled tyCon =
-      when (not_ghc_generated name) $
+      when (has_kind_signature name) $
         addDiagnosticAt (getSrcSpan name) diag
       where
         name = tyConName tyCon


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3321,8 +3321,8 @@ missingSignatureWarningFlags (MissingTopLevelBindingSig {}) exported
 missingSignatureWarningFlags (MissingPatSynSig {}) exported
   = Opt_WarnMissingPatternSynonymSignatures :|
     [ Opt_WarnMissingExportedPatternSynonymSignatures | IsExported  == exported ]
-missingSignatureWarningFlags (MissingTyConKindSig {}) _
-  = Opt_WarnMissingKindSignatures :| []
+missingSignatureWarningFlags (MissingTyConKindSig ty_con _) _
+  = Opt_WarnMissingKindSignatures :| [Opt_WarnMissingPolyKindSignatures | isForAllTy_invis_ty (tyConKind ty_con) ]
 
 useDerivingStrategies :: GhcHint
 useDerivingStrategies =


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -936,6 +936,7 @@ data TcRnMessage where
         -Wmissing-pattern-synonym-signatures
         -Wmissing-exported-pattern-synonym-signatures
         -Wmissing-kind-signatures
+        -Wmissing-poly-kind-signatures
 
       Test cases:
         T11077 (top-level bindings)


=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -1210,20 +1210,10 @@ This check, mkInferredPolyId, is really in the wrong place:
 `inferred_poly_ty` doesn't obey the PKTI and it would be better not to
 generalise it in the first place; see #20686.  But for now it works.
 
-How else could we avoid generalising over escaping type variables? I
-considered:
-
-* Adjust the generalisation in GHC.Tc.Solver to directly check for
-  escaping kind variables; instead, promote or default them. But that
-  gets into the defaulting swamp and is a non-trivial and unforced
-  change, so I have left it alone for now.
-
-* When inferring the type of a binding, in `tcMonoBinds`, we create
-  an ExpSigmaType with `tcInfer`.  If we simply gave it an ir_frr field
-  that said "must have fixed runtime rep", then the kind would be made
-  Concrete; and we never generalise over Concrete variables.  A bit
-  more indirect, but we need the "don't generalise over Concrete variables"
-  stuff anyway.
+I considered adjusting the generalisation in GHC.Tc.Solver to directly check for
+escaping kind variables; instead, promoting or defaulting them. But that
+gets into the defaulting swamp and is a non-trivial and unforced
+change, so I have left it alone for now.
 
 Note [Impedance matching]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1312,7 +1302,9 @@ tcMonoBinds is_rec sig_fn no_gen
   , Nothing <- sig_fn name   -- ...with no type signature
   = setSrcSpanA b_loc    $
     do  { ((co_fn, matches'), rhs_ty')
-            <- tcInfer $ \ exp_ty ->
+            <- tcInferFRR (FRRBinder name) $ \ exp_ty ->
+                          -- tcInferFRR: the type of a let-binder must have
+                          -- a fixed runtime rep. See #23176
                        tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $
                           -- We extend the error context even for a non-recursive
                           -- function so that in type error messages we show the
@@ -1334,7 +1326,9 @@ tcMonoBinds is_rec sig_fn no_gen
   | NonRecursive <- is_rec   -- ...binder isn't mentioned in RHS
   , all (isNothing . sig_fn) bndrs
   = addErrCtxt (patMonoBindsCtxt pat grhss) $
-    do { (grhss', pat_ty) <- tcInfer $ \ exp_ty ->
+    do { (grhss', pat_ty) <- tcInferFRR FRRPatBind $ \ exp_ty ->
+                          -- tcInferFRR: the type of each let-binder must have
+                          -- a fixed runtime rep. See #23176
                              tcGRHSsPat grhss exp_ty
 
        ; let exp_pat_ty :: Scaled ExpSigmaTypeFRR


=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -830,7 +830,7 @@ pprCtOrigin (InstProvidedOrigin mod cls_inst)
 
 pprCtOrigin (ImpedanceMatching x)
   = vcat [ text "arising when matching required constraints"
-         , text "in a recursive group involving" <+> quotes (ppr x)]
+         , text "in a group involving" <+> quotes (ppr x)]
 
 pprCtOrigin (CycleBreakerOrigin orig)
   = pprCtOrigin orig


=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1543,6 +1543,17 @@ tryTcDiscardingErrs recover thing_inside
     tidy up the message; we then use it to tidy the context messages
 -}
 
+{-
+
+Note [Reporting warning diagnostics]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We use functions below to report warnings.  For the most part,
+we do /not/ need to check any warning flags before doing so.
+See https://gitlab.haskell.org/ghc/ghc/-/wikis/Errors-as-(structured)-values
+for the design.
+
+-}
+
 addErrTc :: TcRnMessage -> TcM ()
 addErrTc err_msg = do { env0 <- liftZonkM tcInitTidyEnv
                       ; addErrTcM (env0, err_msg) }


=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -1324,6 +1324,31 @@ of ``-W(no-)*``.
     the parent class a standalone kind signature or CUSK is sufficient to fix
     the warning for the class's associated type families as well.
 
+.. ghc-flag:: -Wmissing-poly-kind-signatures
+    :shortdesc: warn when inferred polykinded type or class declaration don't have kind signatures nor CUSKs
+    :type: dynamic
+    :reverse: -Wno-missing-poly-kind-signatures
+    :category:
+
+    :since: 9.8
+    :default: off
+
+    .. index::
+         single: kind signatures, missing
+
+    This is a restricted version of :ghc-flag:`-Wmissing-kind-signatures`.
+
+    It warns when a declaration defines a type constructor that lacks a :ref:`standalone kind signature <standalone-kind-signatures>`
+    and whose inferred kind is polymorphic (which happens with `-PolyKinds`.  For example ::
+
+        data T a = MkT (a -> Int)    -- T :: Type -> Type
+                                     -- Not polymorphic, hence no warning
+        data W f a = MkW (f a)       -- W :: forall k. (k->Type) -> k -> Type
+                                     -- Polymorphic, hence warning!
+
+    It is useful to catch accidentally polykinded types, or to make that polymorphism explicit,
+    without requiring a kind signature for every type.
+
 .. ghc-flag:: -Wmissing-exported-pattern-synonym-signatures
     :shortdesc: warn about pattern synonyms without signatures, only if they
         are exported


=====================================
libraries/base/GHC/TypeLits/Internal.hs
=====================================
@@ -5,9 +5,14 @@
 {-# OPTIONS_HADDOCK not-home #-}
 
 {-|
-This module exports the Type Literal kinds as well as the comparison type
-families for those kinds.  It is needed to prevent module cycles while still
-allowing these identifiers to be imported in 'Data.Type.Ord'.
+DO NOT USE THIS MODULE.  Use "GHC.TypeLits" instead.
+
+This module is internal-only and was exposed by accident.  It may be
+removed without warning in a future version.
+
+(The technical reason for this module's existence is that it is needed
+to prevent module cycles while still allowing these identifiers to be
+imported in 'Data.Type.Ord'.)
 
 @since 4.16.0.0
 -}


=====================================
libraries/base/GHC/TypeNats/Internal.hs
=====================================
@@ -5,9 +5,14 @@
 {-# OPTIONS_HADDOCK not-home #-}
 
 {-|
-This module exports the Type Nat kind as well as the comparison type
-family for that kinds.  It is needed to prevent module cycles while still
-allowing these identifiers to be imported in 'Data.Type.Ord'.
+DO NOT USE THIS MODULE.  Use "GHC.TypeNats" instead.
+
+This module is internal-only and was exposed by accident.  It may be
+removed without warning in a future version.
+
+(The technical reason for this module's existence is that it is needed
+to prevent module cycles while still allowing these identifiers to be
+imported in 'Data.Type.Ord'.)
 
 @since 4.16.0.0
 -}


=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -8,6 +8,7 @@
 
 {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -57,6 +58,7 @@ import GHC.CString      ( unpackCString# )
 import GHC.Generics     ( Generic )
 import GHC.Types        ( Int(..), Word(..), Char(..), Double(..), Float(..),
                           TYPE, RuntimeRep(..), Multiplicity (..) )
+import qualified Data.Kind as Kind (Type)
 import GHC.Prim         ( Int#, Word#, Char#, Double#, Float#, Addr# )
 import GHC.Ptr          ( Ptr, plusPtr )
 import GHC.Lexeme       ( startsVarSym, startsVarId )
@@ -332,8 +334,9 @@ instance Quote Q where
 --
 -----------------------------------------------------
 
+type TExp :: TYPE r -> Kind.Type
 type role TExp nominal   -- See Note [Role of TExp]
-newtype TExp (a :: TYPE (r :: RuntimeRep)) = TExp
+newtype TExp a = TExp
   { unType :: Exp -- ^ Underlying untyped Template Haskell expression
   }
 -- ^ Typed wrapper around an 'Exp'.
@@ -376,8 +379,9 @@ The splice will evaluate to (MkAge 3) and you can't add that to
 
 -- Code constructor
 
+type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
 type role Code representational nominal   -- See Note [Role of TExp]
-newtype Code m (a :: TYPE (r :: RuntimeRep)) = Code
+newtype Code m a = Code
   { examineCode :: m (TExp a) -- ^ Underlying monadic value
   }
 -- ^ Represents an expression which has type @a@, built in monadic context @m at . Built on top of 'TExp', typed


=====================================
testsuite/driver/testlib.py
=====================================
@@ -327,12 +327,13 @@ def req_process( name, opts ):
 
 def req_host_target_ghc( name, opts ):
     """
-    When testing a cross GHC, some test cases require a host GHC as
-    well (e.g. for compiling custom Setup.hs). This is not supported
-    yet (#23236), so for the time being we skip them when testing
-    cross GHCs.
+    When testing a cross GHC, some test cases require a host GHC as well (e.g.
+    for compiling custom Setup.hs). This is not supported yet (#23236), so for
+    the time being we skip them when testing cross GHCs. However, this is not
+    the case for the JS backend. The JS backend is a cross-compiler that
+    produces code that the host can run.
     """
-    if isCross():
+    if isCross() and not js_arch():
         opts.skip = True
 
 def ignore_stdout(name, opts):


=====================================
testsuite/tests/polykinds/T22743.stderr
=====================================
@@ -1,7 +1,10 @@
 
-T22743.hs:10:1: error: [GHC-31147]
-    • Quantified type's kind mentions quantified type variable
-        type: ‘forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a’
-      where the body of the forall has this kind: ‘TYPE (f g)’
-    • When checking the inferred type
-        x :: forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a
+T22743.hs:10:1: error: [GHC-52083]
+    The binder ‘x’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T22743.hs:10:1: error: [GHC-52083]
+    The binder ‘x’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.


=====================================
testsuite/tests/rep-poly/T23176.hs
=====================================
@@ -0,0 +1,6 @@
+module T23176 where
+
+import GHC.Exts
+
+f = outOfScope :: (_ :: TYPE (r s))
+(g :: _) = outOfScope :: (_ :: TYPE (r s))


=====================================
testsuite/tests/rep-poly/T23176.stderr
=====================================
@@ -0,0 +1,30 @@
+
+T23176.hs:5:1: error: [GHC-52083]
+    The binder ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23176.hs:5:1: error: [GHC-52083]
+    The binder ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23176.hs:5:1: error: [GHC-52083]
+    The binder ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23176.hs:6:1: error: [GHC-52083]
+    The pattern binding
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23176.hs:6:1: error: [GHC-52083]
+    The pattern binding
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23176.hs:6:1: error: [GHC-52083]
+    The pattern binding
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.


=====================================
testsuite/tests/rep-poly/all.T
=====================================
@@ -118,3 +118,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags'])            ##
 test('T23051', normal, compile_fail, [''])
 test('T23153', normal, compile_fail, [''])
 test('T23154', normal, compile_fail, [''])
+test('T23176', normal, compile_fail, ['-XPartialTypeSignatures -fdefer-out-of-scope-variables'])


=====================================
testsuite/tests/typecheck/should_fail/T23427.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module T23427 where
 
 class C a where
@@ -8,3 +9,7 @@ indent n = doText n
     where
       doText x = const (f x) doTail
       doTail _ = const n doText
+
+-- Test case from #20076
+x :: Num a => a
+(x, y) = (1.2, 3.4)


=====================================
testsuite/tests/typecheck/should_fail/T23427.stderr
=====================================
@@ -1,12 +1,12 @@
 
-T23427.hs:9:7: error: [GHC-39999]
+T23427.hs:10:7: error: [GHC-39999]
     • Could not deduce ‘C a0’
         arising when matching required constraints
-        in a recursive group involving ‘doTail’
+        in a group involving ‘doTail’
       from the context: C a
         bound by the type signature for:
                    indent :: forall a. C a => a -> a
-        at T23427.hs:6:1-23
+        at T23427.hs:7:1-23
       The type variable ‘a0’ is ambiguous
     • In an equation for ‘indent’:
           indent n
@@ -14,3 +14,12 @@ T23427.hs:9:7: error: [GHC-39999]
             where
                 doText x = const (f x) doTail
                 doTail _ = const n doText
+
+T23427.hs:15:1: error: [GHC-39999]
+    Could not deduce ‘Fractional a’
+      arising when matching required constraints
+      in a group involving ‘x’
+    from the context: Num a
+      bound by the inferred type for ‘x’:
+                 forall a. Num a => a
+      at T23427.hs:15:1-19


=====================================
testsuite/tests/warnings/should_compile/T22826.hs
=====================================
@@ -0,0 +1,53 @@
+{-# OPTIONS_GHC -Wmissing-poly-kind-signatures #-}
+{-# LANGUAGE GADTs, PolyKinds, TypeFamilies #-}
+-- without standalone kind signatures or cusks: warnings
+module T22826 where
+
+import Data.Kind (Type)
+
+-- type family
+type family Id x where
+    Id Int = Int
+
+-- class definition
+class Functor f => Alt f where
+    (<!>) :: f a -> f a -> f a
+
+-- polykinded class
+class EqP f where
+    eqp :: f a -> f b -> Bool
+
+-- type alias
+type Arr a b = a -> b
+type B = Bool
+
+-- Haskell98 data
+data YesNo = Yes | No
+data V2 a = V2 a a
+
+-- GADT
+data Free f a where
+    Pure :: a -> Free f a
+    Ap   :: f b -> Free f (b -> a) -> Free f a
+
+-- data family
+data family D1 a
+
+-- polykinded data
+data Proxy a = Proxy
+
+-- associated type family
+class C a where
+    type AT a b
+
+-- polykinded type with partial kind spec
+-- not warned: PolyKinds don't add variables here
+data D (k :: Type) a (b :: k) where
+  D :: [a] -> D k a b
+
+-- polykinded type without kind signature, which is polymorphic,
+-- but PolyKinds won't change it.
+data E a k b = MkE a (VProxy k b)
+
+type VProxy :: forall k -> k -> Type
+data VProxy k a = MkVP


=====================================
testsuite/tests/warnings/should_compile/T22826.stderr
=====================================
@@ -0,0 +1,12 @@
+
+T22826.hs:17:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures]
+    Top-level type constructor with no standalone kind signature:
+      type EqP :: forall {k}. (k -> *) -> Constraint
+
+T22826.hs:37:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures]
+    Top-level type constructor with no standalone kind signature:
+      type Proxy :: forall {k}. k -> *
+
+T22826.hs:40:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures]
+    Top-level type constructor with no standalone kind signature:
+      type C :: forall {k}. k -> Constraint


=====================================
testsuite/tests/warnings/should_compile/all.T
=====================================
@@ -64,3 +64,4 @@ test('DodgyImports', normal, compile, ['-Wdodgy-imports'])
 test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports'])
 test('T22702a', normal, compile, [''])
 test('T22702b', normal, compile, [''])
+test('T22826', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/323038244f520507759dc5b7c52c8ec8aa8df8ff...79870853c232867acbfbd180fe33a93893e0384a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/323038244f520507759dc5b7c52c8ec8aa8df8ff...79870853c232867acbfbd180fe33a93893e0384a
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230613/5ebff511/attachment-0001.html>


More information about the ghc-commits mailing list