[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007)

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Mon Jul 10 15:08:34 UTC 2023



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


Commits:
fcca174a by jade at 2023-07-10T11:08:13-04:00
Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007)

As suggested in #20007 and implemented in !8895, trying to import type operators
will suggest a fix to use the 'type' keyword, without considering whether
ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces
is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled,
alongside the suggestion of adding the 'type' keyword.

- - - - -
2b665a65 by sheaf at 2023-07-10T11:08:20-04:00
tyThingLocalGREs: include all DataCons for RecFlds

The GREInfo for a record field should include the collection of all
the data constructors of the parent TyCon that have this record field.
This information was being incorrectly computed in the tyThingLocalGREs
function for a DataCon, as we were not taking into account other
DataCons with the same parent TyCon.

Fixes #23546

- - - - -
2255afad by Alan Zimmerman at 2023-07-10T11:08:21-04:00
EPA: Simplify GHC/Parser.y comb3

A follow up to !10743

- - - - -
3e588fd8 by Bodigrim at 2023-07-10T11:08:23-04:00
Document that compareByteArrays# is available since ghc-prim-0.5.2.0

- - - - -
e3593014 by Matthew Pickering at 2023-07-10T11:08:24-04:00
Revert "Bump text submodule"

This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a.

This commit requires that we bootstrap with ghc-9.4, which we do not
require until #23195 has been completed.

Subsequently this has broken nighty jobs such as the rocky8 job which in
turn has broken nightly releases.

- - - - -


11 changed files:

- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/TyThing.hs
- libraries/text
- + testsuite/tests/module/T20007.hs
- + testsuite/tests/module/T20007.stderr
- testsuite/tests/module/all.T


Changes:

=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1953,7 +1953,9 @@ primop  CompareByteArraysOp "compareByteArrays#" GenPrimOp
     specified ranges, but this is not checked.  Returns an 'Int#'
     less than, equal to, or greater than zero if the range is found,
     respectively, to be byte-wise lexicographically less than, to
-    match, or be greater than the second range.}
+    match, or be greater than the second range.
+
+    @since 0.5.2.0}
    with
    can_fail = True
 


=====================================
compiler/GHC/Parser.y
=====================================
@@ -1026,14 +1026,14 @@ exportlist1 :: { OrdList (LIE GhcPs) }
    -- No longer allow things like [] and (,,,) to be exported
    -- They are built in syntax, always available
 export  :: { OrdList (LIE GhcPs) }
-        : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) (reLoc $2) $> }
+        : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> }
                                                           ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3)
                                                           ; return $ unitOL $ reLocA $ sL span $ impExp } }
-        | maybeexportwarning 'module' modid            {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>)
+        | maybeexportwarning 'module' modid            {% do { let { span = (maybe comb2 comb3 $1) $2 $>
                                                                    ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 }
                                                           ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3))
                                                           ; return $ unitOL $ reLocA $ locImpExp } }
-        | maybeexportwarning 'pattern' qcon            { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>)
+        | maybeexportwarning 'pattern' qcon            { let span = (maybe comb2 comb3 $1) $2 $>
                                                        in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) }
 
 maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) }
@@ -1371,7 +1371,7 @@ inst_decl :: { LInstDecl GhcPs }
                                      , cid_tyfam_insts = ats
                                      , cid_overlap_mode = $2
                                      , cid_datafam_insts = adts }
-             ; acsA (\cs -> L (comb3 $1 (reLoc $3) $4)
+             ; acsA (\cs -> L (comb3 $1 $3 $4)
                              (ClsInstD { cid_d_ext = noExtField, cid_inst = cid cs }))
                    } }
 
@@ -1498,7 +1498,7 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs }
 at_decl_cls :: { LHsDecl GhcPs }
         :  -- data family declarations, with optional 'family' keyword
           'data' opt_family type opt_datafam_kind_sig
-                {% liftM mkTyClD (mkFamDecl (comb3 $1 (reLoc $3) $4) DataFamily NotTopLevel $3
+                {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3
                                                   (snd $ unLoc $4) Nothing
                         (mj AnnData $1:$2++(fst $ unLoc $4))) }
 
@@ -1506,13 +1506,13 @@ at_decl_cls :: { LHsDecl GhcPs }
            -- (can't use opt_instance because you get shift/reduce errors
         | 'type' type opt_at_kind_inj_sig
                {% liftM mkTyClD
-                        (mkFamDecl (comb3 $1 (reLoc $2) $3) OpenTypeFamily NotTopLevel $2
+                        (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily NotTopLevel $2
                                    (fst . snd $ unLoc $3)
                                    (snd . snd $ unLoc $3)
                          (mj AnnType $1:(fst $ unLoc $3)) )}
         | 'type' 'family' type opt_at_kind_inj_sig
                {% liftM mkTyClD
-                        (mkFamDecl (comb3 $1 (reLoc $3) $4) OpenTypeFamily NotTopLevel $3
+                        (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily NotTopLevel $3
                                    (fst . snd $ unLoc $4)
                                    (snd . snd $ unLoc $4)
                          (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)))}
@@ -1651,7 +1651,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs }
 
 role_annot :: { LRoleAnnotDecl GhcPs }
 role_annot : 'type' 'role' oqtycon maybe_roles
-          {% mkRoleAnnotDecl (comb3N $1 $4 $3) $3 (reverse (unLoc $4))
+          {% mkRoleAnnotDecl (comb3 $1 $4 $3) $3 (reverse (unLoc $4))
                    [mj AnnType $1,mj AnnRole $2] }
 
 -- Reversed!
@@ -2594,7 +2594,7 @@ decl    :: { LHsDecl GhcPs }
 rhs     :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) }
         : '=' exp wherebinds    {% runPV (unECP $2) >>= \ $2 ->
                                   do { let L l (bs, csw) = adaptWhereBinds $3
-                                     ; let loc = (comb3 $1 (reLoc $2) (L l bs))
+                                     ; let loc = (comb3 $1 $2 (L l bs))
                                      ; acs (\cs ->
                                        sL loc (GRHSs csw (unguardedRHS (EpAnn (anc $ rs loc) (GrhsAnn Nothing (mj AnnEqual $1)) cs) loc $2)
                                                       bs)) } }
@@ -2907,7 +2907,7 @@ aexp    :: { ECP }
         | 'case' exp 'of' altslist(pats1) {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) ->
                                              return $ ECP $
                                                $4 >>= \ $4 ->
-                                               mkHsCasePV (comb3 $1 $3 (reLoc $4)) $2 $4
+                                               mkHsCasePV (comb3 $1 $3 $4) $2 $4
                                                     (EpAnnHsCase (glAA $1) (glAA $3) []) }
         -- QualifiedDo.
         | DO  stmtlist               {% do
@@ -4090,17 +4090,9 @@ stringLiteralToHsDocWst  = lexStringLiteral parseIdentifier
 comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan
 comb2 a b = a `seq` b `seq` combineHasLocs a b
 
-comb3 :: Located a -> Located b -> Located c -> SrcSpan
+comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan
 comb3 a b c = a `seq` b `seq` c `seq`
-    combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
-
-comb3A :: Located a -> Located b -> LocatedAn t c -> SrcSpan
-comb3A a b c = a `seq` b `seq` c `seq`
-    combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c))
-
-comb3N :: Located a -> Located b -> LocatedN c -> SrcSpan
-comb3N a b c = a `seq` b `seq` c `seq`
-    combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c))
+    combineSrcSpans (getHasLoc a) (combineHasLocs b c)
 
 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
 comb4 a b c d = a `seq` b `seq` c `seq` d `seq`


=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -2139,11 +2139,12 @@ badImportItemErr
   -> TcRn ImportLookupReason
 badImportItemErr iface decl_spec ie sub avails = do
   patsyns_enabled <- xoptM LangExt.PatternSynonyms
-  pure (ImportLookupBad importErrorKind iface decl_spec ie patsyns_enabled)
+  expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces
+  pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled)
   where
-    importErrorKind
+    importErrorKind expl_ns_enabled
       | any checkIfTyCon avails = case sub of
-          BadImportIsParent -> BadImportAvailTyCon
+          BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled
           BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren
       | any checkIfVarName avails = BadImportAvailVar
       | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con)


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3108,7 +3108,9 @@ instance Diagnostic TcRnMessage where
       in case k of
         BadImportAvailVar         -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name]
         BadImportNotExported      -> noHints
-        BadImportAvailTyCon       -> [ImportSuggestion occ $ CouldAddTypeKeyword mod_name]
+        BadImportAvailTyCon ex_ns ->
+          [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns]
+          ++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name]
         BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par]
         BadImportNotExportedSubordinates{} -> noHints
     TcRnImportLookup{}


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -5263,7 +5263,9 @@ data BadImportKind
   -- | Module does not export...
   = BadImportNotExported
   -- | Missing @type@ keyword when importing a type.
-  | BadImportAvailTyCon
+  -- e.g.  `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+)
+  -- Then we want to suggest using `import TypeLits( type (+) )`
+  | BadImportAvailTyCon Bool -- ^ is ExplicitNamespaces enabled?
   -- | Trying to import a data constructor directly, e.g.
   -- @import Data.Maybe (Just)@ instead of @import Data.Maybe (Maybe(Just))@
   | BadImportAvailDataCon OccName


=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -310,12 +310,12 @@ pprImportSuggestion occ_name (CouldUnhideFrom mods)
         | (mod,imv) <- NE.toList mods
         ])
 pprImportSuggestion occ_name (CouldAddTypeKeyword mod)
- = vcat [ text "Add the" <+> quotes (text "type")
+  = vcat [ text "Add the" <+> quotes (text "type")
           <+> text "keyword to the import statement:"
-        , nest 2 $ text "import"
+         , nest 2 $ text "import"
             <+> ppr mod
             <+> parens_sp (text "type" <+> pprPrefixOcc occ_name)
-        ]
+         ]
   where
     parens_sp d = parens (space <> d <> space)
 pprImportSuggestion occ_name (CouldRemoveTypeKeyword mod)


=====================================
compiler/GHC/Types/TyThing.hs
=====================================
@@ -28,6 +28,7 @@ where
 
 import GHC.Prelude
 
+import GHC.Types.GREInfo
 import GHC.Types.Name
 import GHC.Types.Name.Reader
 import GHC.Types.Var
@@ -52,6 +53,11 @@ import Control.Monad ( liftM )
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Class
 
+import Data.List.NonEmpty ( NonEmpty(..) )
+import qualified Data.List.NonEmpty as NE
+import Data.List ( intersect )
+
+
 {-
 Note [ATyCon for classes]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -301,15 +307,24 @@ tyThingLocalGREs ty_thing =
                | dc <- dcs
                , let con_info = conLikeConInfo (RealDataCon dc) ]
     AConLike con ->
-      let par = case con of
-                  PatSynCon {} -> NoParent
-                  -- NoParent for local pattern synonyms as per
-                  -- Note [Parents] in GHC.Types.Name.Reader.
-                  RealDataCon dc -> ParentIs $ tyConName $ dataConTyCon dc
-      in
-        myself par :
-          mkLocalFieldGREs par
-            [(conLikeConLikeName con, conLikeConInfo con)]
+      let (par, cons_flds) = case con of
+            PatSynCon {} ->
+              (NoParent, [(conLikeConLikeName con, conLikeConInfo con)])
+              -- NB: NoParent for local pattern synonyms, as per
+              -- Note [Parents] in GHC.Types.Name.Reader.
+            RealDataCon dc1 ->
+              (ParentIs $ tyConName $ dataConTyCon dc1
+              , [ (DataConName $ dataConName $ dc, ConHasRecordFields (fld :| flds))
+                | dc <- tyConDataCons $ dataConTyCon dc1
+                -- Go through all the data constructors of the parent TyCon,
+                -- to ensure that all the record fields have the correct set
+                -- of parent data constructors. See #23546.
+                , let con_info = conLikeConInfo (RealDataCon dc)
+                , ConHasRecordFields flds0 <- [con_info]
+                , let flds1 = NE.toList flds0 `intersect` dataConFieldLabels dc
+                , fld:flds <- [flds1]
+                ])
+      in myself par : mkLocalFieldGREs par cons_flds
     AnId id
       | RecSelId { sel_tycon = RecSelData tc } <- idDetails id
       -> [ myself (ParentIs $ tyConName tc) ]


=====================================
libraries/text
=====================================
@@ -1 +1 @@
-Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f
+Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e


=====================================
testsuite/tests/module/T20007.hs
=====================================
@@ -0,0 +1 @@
+import Data.Type.Equality ( (~) )


=====================================
testsuite/tests/module/T20007.stderr
=====================================
@@ -0,0 +1,8 @@
+
+T20007.hs:1:29: [GHC-56449]
+    In the import of ‘Data.Type.Equality’:
+      an item called ‘(~)’ is exported, but it is a type.
+    Suggested fixes:
+       Use ExplicitNamespaces
+       Add the ‘type’ keyword to the import statement:
+          import Data.Type.Equality ( type (~) )


=====================================
testsuite/tests/module/all.T
=====================================
@@ -298,3 +298,4 @@ test('T21752', [extra_files(['T21752A.hs', 'T21752.hs'])], multimod_compile, ['T
 
 test('TupleTyConUserSyntax', [extra_files(['TupleTyConUserSyntaxA.hs', 'TupleTyConUserSyntax.hs'])], multimod_compile, ['TupleTyConUserSyntax', '-v0'])
 test('T21826', normal, compile_fail, [''])
+test('T20007', normal, compile_fail, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfc584c64ab593a3a52af97badb25ebb6c5ab1f0...e3593014222e996d67390d56cb9118772de5eef0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfc584c64ab593a3a52af97badb25ebb6c5ab1f0...e3593014222e996d67390d56cb9118772de5eef0
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/20230710/4eb89b56/attachment-0001.html>


More information about the ghc-commits mailing list