[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rnImports: var shouldn't import NoFldSelectors

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Mon Jul 17 09:52:12 UTC 2023



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


Commits:
c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00
rnImports: var shouldn't import NoFldSelectors

In an import declaration such as

  import M ( var )

the import of the variable "var" should **not** bring into scope record
fields named "var" which are defined with NoFieldSelectors.
Doing so can cause spurious "unused import" warnings, as reported in
ticket #23557.

Fixes #23557

- - - - -
1af2e773 by sheaf at 2023-07-17T02:48:19-04:00
Suggest similar names in imports

This commit adds similar name suggestions when importing. For example

  module A where { spelling = 'o' }
  module B where { import B ( speling ) }

will give rise to the error message:

  Module ‘A’ does not export ‘speling’.
  Suggested fix: Perhaps use ‘spelling’

This also provides hints when users try to import record fields defined
with NoFieldSelectors.

- - - - -
654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00
EPA: Store leading AnnSemi for decllist in al_rest

This simplifies the markAnnListA implementation in ExactPrint

- - - - -
f332470b by Rodrigo Mesquita at 2023-07-17T05:51:44-04:00
Split GHC.Platform.ArchOS from ghc-boot into ghc-platform

Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package
into this reinstallable standalone package which abides by the PVP, in
part motivated by the ongoing work on `ghc-toolchain` towards runtime
retargetability.

- - - - -
1bc23213 by Sylvain Henry at 2023-07-17T05:51:54-04:00
JS: better implementation for plusWord64 (#23597)

- - - - -


28 changed files:

- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Name/Reader.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Default.hs
- libraries/ghc-boot/ghc-boot.cabal.in
- + libraries/ghc-platform/CHANGELOG.md
- + libraries/ghc-platform/LICENSE
- + libraries/ghc-platform/ghc-platform.cabal
- libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs
- rts/js/arith.js
- testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr
- + testsuite/tests/overloadedrecflds/should_compile/T23557.hs
- + testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs
- testsuite/tests/overloadedrecflds/should_compile/all.T
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- + testsuite/tests/rename/should_fail/SimilarNamesImport.hs
- + testsuite/tests/rename/should_fail/SimilarNamesImport.stderr
- + testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs
- testsuite/tests/rename/should_fail/all.T
- utils/check-exact/ExactPrint.hs


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -1707,9 +1707,9 @@ cvars1 :: { [RecordPatSynField GhcPs] }
 
 where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) }
         : 'where' '{' decls '}'       {% amsrl (sLL $1 $> (snd $ unLoc $3))
-                                              (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) [mj AnnWhere $1] (fst $ unLoc $3)) }
+                                              (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) (mj AnnWhere $1: (fst $ unLoc $3)) []) }
         | 'where' vocurly decls close {% amsrl (sLL $1 $3 (snd $ unLoc $3))
-                                              (AnnList (Just $ glR $3) Nothing Nothing [mj AnnWhere $1] (fst $ unLoc $3))}
+                                              (AnnList (Just $ glR $3) Nothing Nothing (mj AnnWhere $1: (fst $ unLoc $3)) []) }
 
 pattern_synonym_sig :: { LSig GhcPs }
         : 'pattern' con_list '::' sigtype
@@ -1822,9 +1822,9 @@ where_inst :: { Located ([AddEpAnn]
 
 -- Declarations in binding groups other than classes and instances
 --
-decls   :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) }
+decls   :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) }
         : decls ';' decl    {% if isNilOL (snd $ unLoc $1)
-                                 then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemi $2)
+                                 then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemiA $2)
                                                         , unitOL $3))
                                  else case (snd $ unLoc $1) of
                                    SnocOL hs t -> do
@@ -1835,7 +1835,7 @@ decls   :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) }
                                       return (rest `seq` this `seq` these `seq`
                                                  (sLL $1 $> (fst $ unLoc $1, these))) }
         | decls ';'          {% if isNilOL (snd $ unLoc $1)
-                                  then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemi $2)
+                                  then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemiA $2)
                                                           ,snd $ unLoc $1)))
                                   else case (snd $ unLoc $1) of
                                     SnocOL hs t -> do
@@ -1846,9 +1846,9 @@ decls   :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) }
         | {- empty -}                   { noLoc ([],nilOL) }
 
 decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) }
-        : '{'            decls '}'     { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) [] (fst $ unLoc $2)
+        : '{'            decls '}'     { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3)  (fst $ unLoc $2) []
                                                    ,sL1 $2 $ snd $ unLoc $2) }
-        |     vocurly    decls close   { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing [] (fst $ unLoc $2)
+        |     vocurly    decls close   { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing (fst $ unLoc $2) []
                                                    ,sL1 $2 $ snd $ unLoc $2) }
 
 -- Binding groups other than those of class and instance declarations
@@ -4282,6 +4282,9 @@ mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (srcSpan2e $ gl l)]
 msemi :: Located e -> [TrailingAnn]
 msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (srcSpan2e $ gl l)]
 
+msemiA :: Located e -> [AddEpAnn]
+msemiA l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn AnnSemi (srcSpan2e $ gl l)]
+
 msemim :: Located e -> Maybe EpaLocation
 msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (srcSpan2e $ gl l)
 


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -497,7 +497,7 @@ patch_anchor r1 (Anchor r0 op) = Anchor r op
 fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
 fixValbindsAnn EpAnnNotUsed = EpAnnNotUsed
 fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs)
-  = (EpAnn (widenAnchor anchor (map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs)
+  = (EpAnn (widenAnchor anchor (r ++ map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs)
 
 -- | The 'Anchor' for a stmtlist is based on either the location or
 -- the first semicolon annotion.


=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -38,6 +38,8 @@ import GHC.Driver.Ppr
 import GHC.Rename.Env
 import GHC.Rename.Fixity
 import GHC.Rename.Utils ( warnUnusedTopBinds )
+import GHC.Rename.Unbound
+import qualified GHC.Rename.Unbound as Unbound
 
 import GHC.Tc.Errors.Types
 import GHC.Tc.Utils.Env
@@ -67,6 +69,7 @@ import GHC.Types.Name.Set
 import GHC.Types.Name.Reader
 import GHC.Types.Avail
 import GHC.Types.FieldLabel
+import GHC.Types.Hint
 import GHC.Types.SourceFile
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Basic  ( TopLevelFlag(..) )
@@ -308,7 +311,7 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in
 --
 --  4. A boolean 'AnyHpcUsage' which is true if the imported module
 --     used HPC.
-rnImportDecl  :: Module -> (LImportDecl GhcPs, SDoc)
+rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc)
              -> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
 rnImportDecl this_mod
              (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name
@@ -1228,11 +1231,11 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
        = failLookupWith (QualImportError rdr)
        | otherwise
        = case lookups of
-           []         -> failLookupWith (BadImport ie BadImportIsParent)
+           []         -> failLookupWith (BadImport ie IsNotSubordinate)
            item:items -> return $ item :| items
       where
         lookups = concatMap nonDetNameEnvElts
-                $ lookupOccEnv_WithFields imp_occ_env (rdrNameOcc rdr)
+                $ lookupImpOccEnv (RelevantGREsFOS WantNormal) imp_occ_env (rdrNameOcc rdr)
 
     lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])]
     lookup_lie (L loc ieRdr)
@@ -1252,7 +1255,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
               -- 'BadImportW' is only constructed below in 'handle_bad_import', in
               -- the 'EverythingBut' case, so that's what we pass to
               -- 'badImportItemErr'.
-              reason <- badImportItemErr iface decl_spec ie BadImportIsParent all_avails
+              reason <- badImportItemErr iface decl_spec ie IsNotSubordinate all_avails
               pure (TcRnDodgyImports (DodgyImportsHiding reason))
             warning_msg (DeprecatedExport n w) =
               pure (TcRnPragmaWarning {
@@ -1338,7 +1341,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
                    dc_name = lookup_parent ie (setRdrNameSpace tc srcDataName)
                in
                case catIELookupM [ tc_name, dc_name ] of
-                 []    -> failLookupWith (BadImport ie BadImportIsParent)
+                 []    -> failLookupWith (BadImport ie IsNotSubordinate)
                  names -> return ( [mkIEThingAbs tc' l (imp_item name) | name <- names], [])
             | otherwise
             -> do ImpOccItem { imp_item = gre } <- lookup_parent ie (ieWrappedName tc')
@@ -1354,7 +1357,8 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
            -- See Note [Importing DuplicateRecordFields]
            case lookupChildren subnames rdr_ns of
 
-             Failed rdrs -> failLookupWith (BadImport (IEThingWith (deprecation, ann) ltc wc rdrs ) BadImportIsSubordinate)
+             Failed rdrs -> failLookupWith $
+                            BadImport (IEThingWith (deprecation, ann) ltc wc rdrs) IsSubordinate
                                 -- We are trying to import T( a,b,c,d ), and failed
                                 -- to find 'b' and 'd'.  So we make up an import item
                                 -- to report as failing, namely T( b, d ).
@@ -1382,7 +1386,9 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
           where n = greName gre
 
         handle_bad_import m = catchIELookup m $ \err -> case err of
-          BadImport ie _ | want_hiding == EverythingBut -> return ([], [BadImportW ie])
+          BadImport ie _
+            | want_hiding == EverythingBut
+            -> return ([], [BadImportW ie])
           _ -> failLookupWith err
 
         mk_depr_export_warning gre
@@ -1398,11 +1404,13 @@ data IELookupWarning
   | DodgyImport GlobalRdrElt
   | DeprecatedExport Name (WarningTxt GhcRn)
 
-data BadImportIsSubordinate = BadImportIsParent | BadImportIsSubordinate
+-- | Is this import/export item a subordinate or not?
+data IsSubordinate
+  = IsSubordinate | IsNotSubordinate
 
 data IELookupError
   = QualImportError RdrName
-  | BadImport (IE GhcPs) BadImportIsSubordinate
+  | BadImport (IE GhcPs) IsSubordinate
   | IllegalImport
 
 failLookupWith :: IELookupError -> IELookupM a
@@ -1486,6 +1494,23 @@ mkImportOccEnv hsc_env decl_spec all_avails =
         else item1
       -- Discard standalone pattern P in favour of T(P).
 
+-- | Essentially like @lookupGRE env (LookupOccName occ which_gres)@,
+-- but working with 'ImpOccItem's instead of 'GlobalRdrElt's.
+lookupImpOccEnv :: WhichGREs GREInfo
+                -> OccEnv (NameEnv ImpOccItem) -> OccName -> [NameEnv ImpOccItem]
+lookupImpOccEnv which_gres env occ =
+  mapMaybe relevant_items $ lookupOccEnv_AllNameSpaces env occ
+  where
+    is_relevant :: ImpOccItem -> Bool
+    is_relevant (ImpOccItem { imp_item = gre }) =
+      greIsRelevant which_gres (occNameSpace occ) gre
+    relevant_items :: NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem)
+    relevant_items nms
+      | let nms' = filterNameEnv is_relevant nms
+      = if isEmptyNameEnv nms'
+        then Nothing
+        else Just nms'
+
 {-
 ************************************************************************
 *                                                                      *
@@ -2134,21 +2159,42 @@ DRFPatSynExport for a test of this.
 -}
 
 badImportItemErr
-  :: ModIface -> ImpDeclSpec -> IE GhcPs -> BadImportIsSubordinate
+  :: ModIface -> ImpDeclSpec -> IE GhcPs -> IsSubordinate
   -> [AvailInfo]
   -> TcRn ImportLookupReason
 badImportItemErr iface decl_spec ie sub avails = do
   patsyns_enabled <- xoptM LangExt.PatternSynonyms
   expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces
-  pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled)
+  dflags <- getDynFlags
+  hsc_env <- getTopEnv
+  let rdr_env = mkGlobalRdrEnv
+              $ gresFromAvails hsc_env (Just imp_spec) all_avails
+  pure (ImportLookupBad (importErrorKind dflags rdr_env expl_ns_enabled) iface decl_spec ie patsyns_enabled)
   where
-    importErrorKind expl_ns_enabled
+    importErrorKind dflags rdr_env expl_ns_enabled
       | any checkIfTyCon avails = case sub of
-          BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled
-          BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren
+          IsNotSubordinate -> BadImportAvailTyCon expl_ns_enabled
+          IsSubordinate -> BadImportNotExportedSubordinates unavailableChildren
       | any checkIfVarName avails = BadImportAvailVar
       | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con)
-      | otherwise = BadImportNotExported
+      | otherwise = BadImportNotExported suggs
+        where
+          suggs = similar_suggs ++ fieldSelectorSuggestions rdr_env rdr
+          similar_names =
+            similarNameSuggestions (Unbound.LF WL_Anything WL_Global)
+              dflags rdr_env emptyLocalRdrEnv rdr
+          similar_suggs =
+            case NE.nonEmpty $ mapMaybe imported_item $ similar_names of
+              Just similar -> [ SuggestSimilarNames rdr similar ]
+              Nothing      -> [ ]
+
+          -- Only keep imported items, and set the "HowInScope" to
+          -- "Nothing" to avoid printing "imported from..." in the suggestion
+          -- error message.
+          imported_item (SimilarRdrName rdr_name (Just (ImportedBy {})))
+            = Just (SimilarRdrName rdr_name Nothing)
+          imported_item _ = Nothing
+
     checkIfDataCon = checkIfAvailMatches isDataConName
     checkIfTyCon = checkIfAvailMatches isTyConName
     checkIfVarName =
@@ -2164,9 +2210,12 @@ badImportItemErr iface decl_spec ie sub avails = do
             Nothing -> False
         Avail{} -> False
     availOccName = occName . availName
-    importedFS = occNameFS . rdrNameOcc $ ieName ie
-    unavailableChildren = map (rdrNameOcc) $ case ie of
-      IEThingWith _ _ _ ns -> map (ieWrappedName  . unLoc) ns
+    rdr = ieName ie
+    importedFS = occNameFS $ rdrNameOcc rdr
+    imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
+    all_avails = mi_exports iface
+    unavailableChildren = case ie of
+      IEThingWith _ _ _ ns -> map (rdrNameOcc . ieWrappedName  . unLoc) ns
       _ -> panic "importedChildren failed pattern match: no children"
 
 addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn ()


=====================================
compiler/GHC/Rename/Unbound.hs
=====================================
@@ -15,6 +15,8 @@ module GHC.Rename.Unbound
    , reportUnboundName
    , reportUnboundName'
    , unknownNameSuggestions
+   , similarNameSuggestions
+   , fieldSelectorSuggestions
    , WhatLooking(..)
    , WhereLooking(..)
    , LookingFor(..)
@@ -225,7 +227,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
     all_possibilities :: [(String, SimilarName)]
     all_possibilities = case what_look of
       WL_None -> []
-      _ -> [ (showPpr dflags r, SimilarRdrName r (LocallyBoundAt loc))
+      _ -> [ (showPpr dflags r, SimilarRdrName r (Just $ LocallyBoundAt loc))
            | (r,loc) <- local_possibilities local_env ]
         ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]
 
@@ -256,7 +258,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
 
     global_possibilities :: GlobalRdrEnv -> [(RdrName, SimilarName)]
     global_possibilities global_env
-      | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual how)
+      | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual (Just how))
                         | gre <- globalRdrEnvElts global_env
                         , isGreOk looking_for gre
                         , let occ = greOccName gre
@@ -271,7 +273,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
                           rdr_unqual = mkRdrUnqual occ
                     , correct_name_space occ
                     , sim <- case (unquals_in_scope gre, quals_only gre) of
-                                (how:_, _)    -> [ SimilarRdrName rdr_unqual how ]
+                                (how:_, _)    -> [ SimilarRdrName rdr_unqual (Just how) ]
                                 ([],    pr:_) -> [ pr ]  -- See Note [Only-quals]
                                 ([],    [])   -> [] ]
 
@@ -299,7 +301,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
     quals_only :: GlobalRdrElt -> [SimilarName]
     -- Ones for which *only* the qualified version is in scope
     quals_only (gre at GRE { gre_imp = is })
-      = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (ImportedBy ispec))
+      = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (Just $ ImportedBy ispec))
         | i <- bagToList is, let ispec = is_decl i, is_qual ispec ]
 
 


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -62,9 +62,11 @@ import GHC.Driver.Backend
 import GHC.Hs
 
 import GHC.Tc.Errors.Types
+import GHC.Tc.Types.BasicTypes
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Origin
 import GHC.Tc.Types.Rank (Rank(..))
+import GHC.Tc.Types.TH
 import GHC.Tc.Utils.TcType
 
 import GHC.Types.Error
@@ -116,8 +118,6 @@ import Data.List ( groupBy, sortBy, tails
                  , partition, unfoldr )
 import Data.Ord ( comparing )
 import Data.Bifunctor
-import GHC.Tc.Types.TH
-import GHC.Tc.Types.BasicTypes
 
 
 defaultTcRnMessageOpts :: TcRnMessageOpts
@@ -3085,12 +3085,12 @@ instance Diagnostic TcRnMessage where
       let mod_name = moduleName $ is_mod is
           occ = rdrNameOcc $ ieName ie
       in case k of
-        BadImportAvailVar         -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name]
-        BadImportNotExported      -> noHints
-        BadImportAvailTyCon ex_ns ->
+        BadImportAvailVar          -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name]
+        BadImportNotExported suggs -> suggs
+        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]
+        BadImportAvailDataCon par  -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par]
         BadImportNotExportedSubordinates{} -> noHints
     TcRnImportLookup{}
       -> noHints
@@ -5343,7 +5343,7 @@ pprImportLookup = \case
         hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon)
           2 (vcat msgs)
     in case k of
-      BadImportNotExported ->
+      BadImportNotExported _ ->
         vcat
           [ text "Module" <+> pprImpDeclSpec iface decl_spec <+>
             text "does not export" <+> quotes (ppr ie) <> dot


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -5250,7 +5250,7 @@ data WhenMatching
 
 data BadImportKind
   -- | Module does not export...
-  = BadImportNotExported
+  = BadImportNotExported [GhcHint] -- ^ suggestions for what might have been meant
   -- | Missing @type@ keyword when importing a type.
   -- e.g.  `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+)
   -- Then we want to suggest using `import TypeLits( type (+) )`


=====================================
compiler/GHC/Types/Hint.hs
=====================================
@@ -515,7 +515,7 @@ data HowInScope
 
 data SimilarName
   = SimilarName Name
-  | SimilarRdrName RdrName HowInScope
+  | SimilarRdrName RdrName (Maybe HowInScope)
 
 -- | Something is promoted to the type-level without a promotion tick.
 data UntickedPromotedThing


=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -353,18 +353,17 @@ pprSimilarName :: NameSpace -> SimilarName -> SDoc
 pprSimilarName _ (SimilarName name)
   = quotes (ppr name) <+> parens (pprDefinedAt name)
 pprSimilarName tried_ns (SimilarRdrName rdr_name how_in_scope)
-  = case how_in_scope of
-      LocallyBoundAt loc ->
-        pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc'
-          where
-            loc' = case loc of
-              UnhelpfulSpan l -> parens (ppr l)
-              RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
-      ImportedBy is ->
-        pp_ns rdr_name <+> quotes (ppr rdr_name) <+>
-        parens (text "imported from" <+> ppr (moduleName $ is_mod is))
-
+  = pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc
   where
+    loc = case how_in_scope of
+      Nothing -> empty
+      Just scope -> case scope of
+        LocallyBoundAt loc ->
+          case loc of
+            UnhelpfulSpan l -> parens (ppr l)
+            RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
+        ImportedBy is ->
+          parens (text "imported from" <+> ppr (moduleName $ is_mod is))
     pp_ns :: RdrName -> SDoc
     pp_ns rdr | ns /= tried_ns = pprNameSpace ns
               | otherwise      = empty


=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -1313,19 +1313,19 @@ lookupGRE env = \case
 --
 -- This allows us to first look in e.g. the data 'NameSpace', and then fall back
 -- to the type/class 'NameSpace'.
-highestPriorityGREs :: forall info prio
+highestPriorityGREs :: forall gre prio
                     .  Ord prio
-                    => (GlobalRdrEltX info -> Maybe prio)
+                    => (gre -> Maybe prio)
                       -- ^ priority function
                       -- lower value <=> higher priority
-                    -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
+                    -> [gre] -> [gre]
 highestPriorityGREs priority gres =
   take_highest_prio $ NE.group $ sort
     [ S.Arg prio gre
     | gre <- gres
     , prio <- maybeToList $ priority gre ]
   where
-    take_highest_prio :: [NE.NonEmpty (S.Arg prio (GlobalRdrEltX info))] -> [GlobalRdrEltX info]
+    take_highest_prio :: [NE.NonEmpty (S.Arg prio gre)] -> [gre]
     take_highest_prio [] = []
     take_highest_prio (fs:_) = map (\ (S.Arg _ gre) -> gre) $ NE.toList fs
 {-# INLINEABLE highestPriorityGREs #-}


=====================================
hadrian/src/Packages.hs
=====================================
@@ -4,7 +4,7 @@ module Packages (
     array, base, binary, bytestring, cabal, cabalSyntax, checkPpr,
     checkExact, countDeps,
     compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls,
-    exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh,
+    exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform,
     ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline,
     hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
     libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts,
@@ -36,7 +36,7 @@ ghcPackages :: [Package]
 ghcPackages =
     [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps
     , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls
-    , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh
+    , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform
     , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs
     , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl
     , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell
@@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages)
 -- | Package definitions, see 'Package'.
 array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps,
   compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls,
-  exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh,
+  exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform,
   ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs,
   hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl,
   parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell,
@@ -84,6 +84,7 @@ ghc                 = prg  "ghc-bin"         `setPath` "ghc"
 ghcBignum           = lib  "ghc-bignum"
 ghcBoot             = lib  "ghc-boot"
 ghcBootTh           = lib  "ghc-boot-th"
+ghcPlatform         = lib  "ghc-platform"
 ghcCompact          = lib  "ghc-compact"
 ghcConfig           = prg  "ghc-config"      `setPath` "testsuite/ghc-config"
 ghcHeap             = lib  "ghc-heap"


=====================================
hadrian/src/Rules/ToolArgs.hs
=====================================
@@ -158,6 +158,7 @@ toolTargets = [ binary
               -- , runGhc  -- # depends on ghc library
               , ghcBoot
               , ghcBootTh
+              , ghcPlatform
               , ghcHeap
               , ghci
               , ghcPkg  -- # executable


=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -85,6 +85,7 @@ stage0Packages = do
              , runGhc
              , ghcBoot
              , ghcBootTh
+             , ghcPlatform
              , ghcHeap
              , ghci
              , ghcPkg


=====================================
libraries/ghc-boot/ghc-boot.cabal.in
=====================================
@@ -51,7 +51,6 @@ Library
             GHC.Serialized
             GHC.ForeignSrcLang
             GHC.HandleEncoding
-            GHC.Platform.ArchOS
             GHC.Platform.Host
             GHC.Settings.Utils
             GHC.UniqueSubdir
@@ -65,6 +64,10 @@ Library
             , GHC.ForeignSrcLang.Type
             , GHC.Lexeme
 
+    -- reexport platform modules from ghc-platform
+    reexported-modules:
+              GHC.Platform.ArchOS
+
     -- but done by Hadrian
     autogen-modules:
             GHC.Version
@@ -77,6 +80,7 @@ Library
                    directory  >= 1.2 && < 1.4,
                    filepath   >= 1.3 && < 1.5,
                    deepseq    >= 1.4 && < 1.5,
+                   ghc-platform >= 0.1,
                    ghc-boot-th == @ProjectVersionMunged@
     if !os(windows)
         build-depends:


=====================================
libraries/ghc-platform/CHANGELOG.md
=====================================
@@ -0,0 +1,7 @@
+# Revision history for ghc-platform
+
+## 0.1.0.0 -- 2023-06-20
+
+* First version. Split off the `GHC.Platform.ArchOS` module from the `ghc-boot`
+    package into this reinstallable standalone package which abides by the PVP,
+    in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability.


=====================================
libraries/ghc-platform/LICENSE
=====================================
@@ -0,0 +1,30 @@
+Copyright (c) 2023, Rodrigo Mesquita
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Rodrigo Mesquita nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


=====================================
libraries/ghc-platform/ghc-platform.cabal
=====================================
@@ -0,0 +1,20 @@
+cabal-version:      3.0
+name:               ghc-platform
+version:            0.1.0.0
+synopsis:           Platform information used by GHC and friends
+license:            BSD-3-Clause
+license-file:       LICENSE
+author:             Rodrigo Mesquita
+maintainer:         ghc-devs at haskell.org
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+
+common warnings
+    ghc-options: -Wall
+
+library
+    import:           warnings
+    exposed-modules:  GHC.Platform.ArchOS
+    build-depends:    base >=4.15.0.0
+    hs-source-dirs:   src
+    default-language: Haskell2010


=====================================
libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs
=====================================
@@ -1,17 +1,19 @@
 {-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
 
 -- | Platform architecture and OS
---
--- We need it in ghc-boot because ghc-pkg needs it.
 module GHC.Platform.ArchOS
    ( ArchOS(..)
+
+     -- * Architectures
    , Arch(..)
-   , OS(..)
    , ArmISA(..)
    , ArmISAExt(..)
    , ArmABI(..)
    , PPC_64ABI(..)
    , stringEncodeArch
+
+     -- * Operating systems
+   , OS(..)
    , stringEncodeOS
    )
 where
@@ -27,10 +29,6 @@ data ArchOS
    deriving (Read, Show, Eq, Ord)
 
 -- | Architectures
---
--- TODO: It might be nice to extend these constructors with information about
--- what instruction set extensions an architecture might support.
---
 data Arch
    = ArchUnknown
    | ArchX86


=====================================
rts/js/arith.js
=====================================
@@ -60,11 +60,11 @@ function h$hs_minusWord64(h1,l1,h2,l2) {
 }
 
 function h$hs_plusWord64(h1,l1,h2,l2) {
-  var a = W64(h1,l1);
-  var b = W64(h2,l2);
-  var r = BigInt.asUintN(64, a + b);
-  TRACE_ARITH("Word64: " + a + " + " + b + " ==> " + r)
-  RETURN_W64(r);
+  var l  = l1+l2;
+  var rl = l>>>0;
+  var rh = (h1+h2+(l!=rl?1:0))>>>0;
+  TRACE_ARITH("Word64: " + (h1,l1) + " + " + (h2,l2) + " ==> " + (rh,rl))
+  RETURN_UBX_TUP2(rh,rl);
 }
 
 function h$hs_timesInt64(h1,l1,h2,l2) {


=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr
=====================================
@@ -1,6 +1,6 @@
 
-T22106_C.hs:5:9: error: [GHC-88464]
-    Variable not in scope: bar
+T22106_C.hs:3:21: error: [GHC-61689]
+    Module ‘T22106_aux’ does not export ‘bar’.
     Suggested fix:
       Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’
       that has been suppressed by NoFieldSelectors.


=====================================
testsuite/tests/overloadedrecflds/should_compile/T23557.hs
=====================================
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -Werror=unused-imports #-}
+
+module T23557 (main) where
+
+import T23557_aux (foo)
+
+main :: IO ()
+main = print foo
+
+-- We should not get an unused import for the import of the field selector "foo",
+-- because the module we are importing from uses NoFieldSelectors.


=====================================
testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE NoFieldSelectors #-}
+
+module T23557_aux where
+
+foo :: Int
+foo = 23
+
+data Foo = Foo {
+  foo :: Int
+}


=====================================
testsuite/tests/overloadedrecflds/should_compile/all.T
=====================================
@@ -50,9 +50,9 @@ test('BootFldReexport'
 test('T23220'
     , [req_th, extra_files(['T23220_aux.hs'])]
     , multimod_compile, ['T23220_aux.hs T23220.hs', '-v0'])
-
 test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0'])
 test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0'])
 test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0'])
 test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0'])
 test('T23279', [extra_files(['T23279_aux.hs'])], multimod_compile, ['T23279', '-v0'])
+test('T23557', [extra_files(['T23557_aux.hs'])], multimod_compile, ['T23557', '-v0'])


=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -1517,17 +1517,12 @@
                      (AddEpAnn AnnOpenC (EpaSpan { DumpSemis.hs:34:13 })))
                     (Just
                      (AddEpAnn AnnCloseC (EpaSpan { DumpSemis.hs:34:31 })))
-                    []
-                    [(AddSemiAnn
-                      (EpaSpan { DumpSemis.hs:34:14 }))
-                    ,(AddSemiAnn
-                      (EpaSpan { DumpSemis.hs:34:15 }))
-                    ,(AddSemiAnn
-                      (EpaSpan { DumpSemis.hs:34:16 }))
-                    ,(AddSemiAnn
-                      (EpaSpan { DumpSemis.hs:34:17 }))
-                    ,(AddSemiAnn
-                      (EpaSpan { DumpSemis.hs:34:18 }))])
+                    [(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:14 }))
+                    ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:15 }))
+                    ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:16 }))
+                    ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:17 }))
+                    ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:18 }))]
+                    [])
                    (EpaComments
                     []))
                   (ValBinds


=====================================
testsuite/tests/rename/should_fail/SimilarNamesImport.hs
=====================================
@@ -0,0 +1,3 @@
+module SimilarNamesImport where
+
+import SimilarNamesImport_aux ( dyzzy, Wabble, wabble, Trizzle(bizzy) )


=====================================
testsuite/tests/rename/should_fail/SimilarNamesImport.stderr
=====================================
@@ -0,0 +1,16 @@
+
+SimilarNamesImport.hs:3:33: error: [GHC-61689]
+    Module ‘SimilarNamesImport_aux’ does not export ‘dyzzy’.
+    Suggested fix:
+      Perhaps use one of these: record field of MkD ‘dizzy’, ‘xyzzy’
+
+SimilarNamesImport.hs:3:40: error: [GHC-61689]
+    Module ‘SimilarNamesImport_aux’ does not export ‘Wabble’.
+    Suggested fix: Perhaps use ‘Wibble’
+
+SimilarNamesImport.hs:3:48: error: [GHC-61689]
+    Module ‘SimilarNamesImport_aux’ does not export ‘wabble’.
+
+SimilarNamesImport.hs:3:56: error: [GHC-61689]
+    Module ‘SimilarNamesImport_aux’ does not export ‘Trizzle’.
+    Suggested fix: Perhaps use one of these: ‘Drizzle’, ‘Frizzle’


=====================================
testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs
=====================================
@@ -0,0 +1,11 @@
+module SimilarNamesImport_aux where
+
+xyzzy :: Double
+xyzzy = exp $ pi * sqrt 163
+
+
+data Drizzle = MkD { dizzy :: Int }
+data Frizzle = MkE { fizzy :: Bool }
+
+data Wibble
+


=====================================
testsuite/tests/rename/should_fail/all.T
=====================================
@@ -199,6 +199,7 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, [''])
 test('RnStupidThetaInGadt', normal, compile_fail, [''])
 test('PackageImportsDisabled', normal, compile_fail, [''])
 test('ImportLookupIllegal', normal, compile_fail, [''])
+test('SimilarNamesImport', [extra_files(['SimilarNamesImport_aux.hs'])], multimod_compile_fail, ['SimilarNamesImport', '-v0'])
 test('T23510a', normal, compile_fail, [''])
 test('T16635a', normal, compile_fail, [''])
 test('T16635b', normal, compile_fail, [''])


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1176,32 +1176,27 @@ markKwT (AddVbarAnn ss)    = AddVbarAnn    <$> markKwA AnnVbar ss
 -- ---------------------------------------------------------------------
 
 markAnnList :: (Monad m, Monoid w)
-  => Bool -> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
-markAnnList reallyTrail ann action = do
-  markAnnListA reallyTrail ann $ \a -> do
+  => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
+markAnnList ann action = do
+  markAnnListA ann $ \a -> do
     r <- action
     return (a,r)
 
 markAnnListA :: (Monad m, Monoid w)
-  => Bool -> EpAnn AnnList
+  => EpAnn AnnList
   -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
   -> EP w m (EpAnn AnnList, a)
-markAnnListA _ EpAnnNotUsed action = do
+markAnnListA EpAnnNotUsed action = do
   action EpAnnNotUsed
-markAnnListA reallyTrail an action = do
+markAnnListA an action = do
   debugM $ "markAnnListA: an=" ++ showAst an
   an0 <- markLensMAA an lal_open
-  an1 <- if (not reallyTrail)
-           then markTrailingL an0 lal_trailing
-           else return an0
-  an2 <- markEpAnnAllL an1 lal_rest AnnSemi
-  (an3, r) <- action an2
-  an4 <- markLensMAA an3 lal_close
-  an5 <- if reallyTrail
-           then markTrailingL an4 lal_trailing
-           else return an4
-  debugM $ "markAnnListA: an5=" ++ showAst an
-  return (an5, r)
+  an1 <- markEpAnnAllL an0 lal_rest AnnSemi
+  (an2, r) <- action an1
+  an3 <- markLensMAA an2 lal_close
+  an4 <- markTrailingL an3 lal_trailing
+  debugM $ "markAnnListA: an4=" ++ showAst an
+  return (an4, r)
 
 -- ---------------------------------------------------------------------
 
@@ -2297,12 +2292,12 @@ instance ExactPrint (HsLocalBinds GhcPs) where
         when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc)
       _ -> return ()
 
-    (an1, valbinds') <- markAnnList False an0 $ markAnnotatedWithLayout valbinds
+    (an1, valbinds') <- markAnnList an0 $ markAnnotatedWithLayout valbinds
     debugM $ "exact HsValBinds: an1=" ++ showAst an1
     return (HsValBinds an1 valbinds')
 
   exact (HsIPBinds an bs) = do
-    (as, ipb) <- markAnnList True an (markEpAnnL an lal_rest AnnWhere
+    (as, ipb) <- markAnnList an (markEpAnnL an lal_rest AnnWhere
                            >> markAnnotated bs
                            >>= \bs' -> return (HsIPBinds an bs'::HsLocalBinds GhcPs))
     case ipb of
@@ -2845,7 +2840,7 @@ instance ExactPrint (HsExpr GhcPs) where
 
   exact (HsDo an do_or_list_comp stmts) = do
     debugM $ "HsDo"
-    (an',stmts') <- markAnnListA True an $ \a -> exactDo a do_or_list_comp stmts
+    (an',stmts') <- markAnnListA an $ \a -> exactDo a do_or_list_comp stmts
     return (HsDo an' do_or_list_comp stmts')
 
   exact (ExplicitList an es) = do
@@ -3379,7 +3374,7 @@ instance (
   exact (RecStmt an stmts a b c d e) = do
     debugM $ "RecStmt"
     an0 <- markEpAnnL an lal_rest AnnRec
-    (an1, stmts') <- markAnnList True an0 (markAnnotated stmts)
+    (an1, stmts') <- markAnnList an0 (markAnnotated stmts)
     return (RecStmt an1 stmts' a b c d e)
 
 -- ---------------------------------------------------------------------
@@ -4400,7 +4395,7 @@ instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where
     an0 <- markEpAnnL an lal_rest AnnHiding
     p <- getPosP
     debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p
-    (an1, ies') <- markAnnList True an0 (markAnnotated ies)
+    (an1, ies') <- markAnnList an0 (markAnnotated ies)
     return (L (SrcSpanAnn an1 l) ies')
 
 instance (ExactPrint (Match GhcPs (LocatedA body)))
@@ -4423,7 +4418,7 @@ instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr Gh
   setAnnotationAnchor = setAnchorAn
   exact (L (SrcSpanAnn an l) stmts) = do
     debugM $ "LocatedL [ExprLStmt"
-    (an'', stmts') <- markAnnList True an $ do
+    (an'', stmts') <- markAnnList an $ do
       case snocView stmts of
         Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do
           debugM $ "LocatedL [ExprLStmt: snocView"
@@ -4450,7 +4445,7 @@ instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where
   setAnnotationAnchor = setAnchorAn
   exact (L (SrcSpanAnn an l) fs) = do
     debugM $ "LocatedL [LConDeclField"
-    (an', fs') <- markAnnList True an (markAnnotated fs)
+    (an', fs') <- markAnnList an (markAnnotated fs)
     return (L (SrcSpanAnn an' l) fs')
 
 instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where
@@ -4458,7 +4453,7 @@ instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where
   setAnnotationAnchor = setAnchorAn
   exact (L (SrcSpanAnn an l) bf) = do
     debugM $ "LocatedL [LBooleanFormula"
-    (an', bf') <- markAnnList True an (markAnnotated bf)
+    (an', bf') <- markAnnList an (markAnnotated bf)
     return (L (SrcSpanAnn an' l) bf')
 
 -- ---------------------------------------------------------------------
@@ -4616,7 +4611,7 @@ instance ExactPrint (Pat GhcPs) where
     return (BangPat an0 pat')
 
   exact (ListPat an pats) = do
-    (an', pats') <- markAnnList True an (markAnnotated pats)
+    (an', pats') <- markAnnList an (markAnnotated pats)
     return (ListPat an' pats')
 
   exact (TuplePat an pats boxity) = do



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95c01b41970b100966a091138ea2276721139a30...1bc23213d2a981fe2b1655c30b47c9817502a8c4

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95c01b41970b100966a091138ea2276721139a30...1bc23213d2a981fe2b1655c30b47c9817502a8c4
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/20230717/2fc10bc8/attachment-0001.html>


More information about the ghc-commits mailing list