.gitlab-ci.yml

@@ -19,7 +19,7 @@ stages:
   - lint       # Source linting
   - build      # A quick smoke-test to weed out broken commits
   - full-build # Build all the things
-  - cleanup    # See Note [Cleanup on Windows]
+  - cleanup    # See Note [Cleanup after the shell executor]
   - packaging  # Source distribution, etc.
   - hackage    # head.hackage testing
   - deploy     # push documentation
@@ -673,35 +673,18 @@ nightly-i386-windows:
 #
 # As noted in [1], gitlab-runner's shell executor doesn't clean up its working
 # directory after builds. Unfortunately, we are forced to use the shell executor
-# on Windows. To avoid running out of disk space we add a stage at the end of
-# the build to remove the \GitLabRunner\builds directory. Since we only run a
-# single build at a time on Windows this should be safe.
+# on Darwin. To avoid running out of disk space we add a stage at the end of
+# the build to remove the /.../GitLabRunner/builds directory. Since we only run a
+# single build at a time on Darwin this should be safe.
+#
+# We used to have a similar cleanup job on Windows as well however it ended up
+# being quite fragile as we have multiple Windows builders yet there is no
+# guarantee that the cleanup job is run on the same machine as the build itself
+# was run. Consequently we were forced to instead handle cleanup with a separate
+# cleanup cron job on Windows.
 #
 # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856
 
-# See Note [Cleanup after shell executor]
-cleanup-windows:
-  <<: *only-default
-  stage: cleanup
-  tags:
-    - x86_64-windows
-  when: always
-  dependencies: []
-  before_script:
-    - echo "Time to clean up"
-  script:
-    - echo "Let's go"
-  after_script:
-    - set "BUILD_DIR=%CI_PROJECT_DIR%"
-    - set "BUILD_DIR=%BUILD_DIR:/=\%"
-    - echo "Cleaning %BUILD_DIR%"
-    - cd \GitLabRunner
-    # This is way more complicated than it should be:
-    # See https://stackoverflow.com/questions/1965787
-    - del %BUILD_DIR%\* /F /Q
-    - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p"
-    - exit /b 0
-
 # See Note [Cleanup after shell executor]
 cleanup-darwin:
   <<: *only-default

compiler/ghc.mk

@@ -63,8 +63,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo 'cBuildPlatformString = BuildPlatform_NAME'                   >> $@
 	@echo 'cHostPlatformString :: String'                               >> $@
 	@echo 'cHostPlatformString = HostPlatform_NAME'                     >> $@
-	@echo 'cTargetPlatformString :: String'                             >> $@
-	@echo 'cTargetPlatformString = TargetPlatform_NAME'                 >> $@
 	@echo                                                               >> $@
 	@echo 'cProjectName          :: String'                             >> $@
 	@echo 'cProjectName          = "$(ProjectName)"'                    >> $@
@@ -150,7 +148,6 @@ compiler/stage1/$(PLATFORM_H) : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo                                                    >> $@
 	@echo "#define BuildPlatform_NAME  \"$(BUILDPLATFORM)\""  >> $@
 	@echo "#define HostPlatform_NAME   \"$(HOSTPLATFORM)\""   >> $@
-	@echo "#define TargetPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@
 	@echo                                                     >> $@
 	@echo "#define $(BuildPlatform_CPP)_BUILD 1"              >> $@
 	@echo "#define $(HostPlatform_CPP)_HOST 1"                >> $@
@@ -192,7 +189,6 @@ compiler/stage2/$(PLATFORM_H) : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo                                                     >> $@
 	@echo "#define BuildPlatform_NAME  \"$(HOSTPLATFORM)\""   >> $@
 	@echo "#define HostPlatform_NAME   \"$(TARGETPLATFORM)\"" >> $@
-	@echo "#define TargetPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@
 	@echo                                                     >> $@
 	@echo "#define $(HostPlatform_CPP)_BUILD 1"               >> $@
 	@echo "#define $(TargetPlatform_CPP)_HOST 1"              >> $@

compiler/hsSyn/HsImpExp.hs

@@ -29,6 +29,7 @@ import SrcLoc
 import HsExtension
 
 import Data.Data
+import Data.Maybe
 
 {-
 ************************************************************************
@@ -48,6 +49,29 @@ type LImportDecl pass = Located (ImportDecl pass)
 
         -- For details on above see note [Api annotations] in ApiAnnotation
 
+-- | If/how an import is 'qualified'.
+data ImportDeclQualifiedStyle
+  = QualifiedPre  -- ^ 'qualified' appears in prepositive position.
+  | QualifiedPost -- ^ 'qualified' appears in postpositive position.
+  | NotQualified  -- ^ Not qualified.
+  deriving (Eq, Data)
+
+-- | Given two possible located 'qualified' tokens, compute a style
+-- (in a conforming Haskell program only one of the two can be not
+-- 'Nothing'). This is called from 'Parser.y'.
+importDeclQualifiedStyle :: Maybe (Located a)
+                         -> Maybe (Located a)
+                         -> ImportDeclQualifiedStyle
+importDeclQualifiedStyle mPre mPost =
+  if isJust mPre then QualifiedPre
+  else if isJust mPost then QualifiedPost else NotQualified
+
+-- | Convenience function to answer the question if an import decl. is
+-- qualified.
+isImportDeclQualified :: ImportDeclQualifiedStyle -> Bool
+isImportDeclQualified NotQualified = False
+isImportDeclQualified _ = True
+
 -- | Import Declaration
 --
 -- A single Haskell @import@ declaration.
@@ -60,7 +84,7 @@ data ImportDecl pass
       ideclPkgQual   :: Maybe StringLiteral,  -- ^ Package qualifier.
       ideclSource    :: Bool,          -- ^ True <=> {-\# SOURCE \#-} import
       ideclSafe      :: Bool,          -- ^ True => safe import
-      ideclQualified :: Bool,          -- ^ True => qualified
+      ideclQualified :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified.
       ideclImplicit  :: Bool,          -- ^ True => implicit import (of Prelude)
       ideclAs        :: Maybe (Located ModuleName),  -- ^ as Module
       ideclHiding    :: Maybe (Bool, Located [LIE pass])
@@ -96,7 +120,7 @@ simpleImportDecl mn = ImportDecl {
       ideclSource    = False,
       ideclSafe      = False,
       ideclImplicit  = False,
-      ideclQualified = False,
+      ideclQualified = NotQualified,
       ideclAs        = Nothing,
       ideclHiding    = Nothing
     }
@@ -109,7 +133,7 @@ instance (p ~ GhcPass pass,OutputableBndrId p)
                     , ideclQualified = qual, ideclImplicit = implicit
                     , ideclAs = as, ideclHiding = spec })
       = hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe,
-                    pp_qual qual, pp_pkg pkg, ppr mod', pp_as as])
+                    pp_qual qual False, pp_pkg pkg, ppr mod', pp_qual qual True, pp_as as])
              4 (pp_spec spec)
       where
         pp_implicit False = empty
@@ -119,8 +143,11 @@ instance (p ~ GhcPass pass,OutputableBndrId p)
         pp_pkg (Just (StringLiteral st p))
           = pprWithSourceText st (doubleQuotes (ftext p))
 
-        pp_qual False   = empty
-        pp_qual True    = text "qualified"
+        pp_qual QualifiedPre False = text "qualified" -- Prepositive qualifier/prepositive position.
+        pp_qual QualifiedPost True = text "qualified" -- Postpositive qualifier/postpositive position.
+        pp_qual QualifiedPre True = empty -- Prepositive qualifier/postpositive position.
+        pp_qual QualifiedPost False = empty -- Postpositive qualifier/prepositive position.
+        pp_qual NotQualified _ = empty
 
         pp_safe False   = empty
         pp_safe True    = text "safe"

compiler/main/DynFlags.hs

@@ -843,6 +843,7 @@ data WarningFlag =
    | Opt_WarnImplicitKindVars             -- Since 8.6
    | Opt_WarnSpaceAfterBang
    | Opt_WarnMissingDerivingStrategies    -- Since 8.8
+   | Opt_WarnPrepositiveQualifiedModule   -- Since TBD
    deriving (Eq, Show, Enum)
 
 data Language = Haskell98 | Haskell2010
@@ -1356,6 +1357,7 @@ data Settings = Settings {
   sPlatformConstants     :: PlatformConstants,
 
   -- Formerly Config.hs, target specific
+  sTargetPlatformString :: String, -- TODO Recalculate string from richer info?
   sTablesNextToCode :: Bool
  }
 
@@ -4070,7 +4072,10 @@ wWarningFlagsDeps = [
   flagSpec "star-binder"                 Opt_WarnStarBinder,
   flagSpec "star-is-type"                Opt_WarnStarIsType,
   flagSpec "missing-space-after-bang"    Opt_WarnSpaceAfterBang,
-  flagSpec "partial-fields"              Opt_WarnPartialFields ]
+  flagSpec "partial-fields"              Opt_WarnPartialFields,
+  flagSpec "prepositive-qualified-module"
+                                         Opt_WarnPrepositiveQualifiedModule
+ ]
 
 -- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
 negatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
@@ -4396,6 +4401,7 @@ xFlagsDeps = [
                                               setGenDeriving,
   flagSpec "ImplicitParams"                   LangExt.ImplicitParams,
   flagSpec "ImplicitPrelude"                  LangExt.ImplicitPrelude,
+  flagSpec "ImportQualifiedPost"              LangExt.ImportQualifiedPost,
   flagSpec "ImpredicativeTypes"               LangExt.ImpredicativeTypes,
   flagSpec' "IncoherentInstances"             LangExt.IncoherentInstances
                                               setIncoherentInsts,
@@ -5616,7 +5622,7 @@ compilerInfo dflags
        ("Stage",                       cStage),
        ("Build platform",              cBuildPlatformString),
        ("Host platform",               cHostPlatformString),
-       ("Target platform",             cTargetPlatformString),
+       ("Target platform",             sTargetPlatformString $ settings dflags),
        ("Have interpreter",            cGhcWithInterpreter),
        ("Object splitting supported",  showBool False),
        ("Have native code generator",  cGhcWithNativeCodeGen),

compiler/main/HeaderInfo.hs

@@ -131,7 +131,7 @@ mkPrelImports this_mod loc implicit_prelude import_decls
                                 ideclPkgQual   = Nothing,
                                 ideclSource    = False,
                                 ideclSafe      = False,  -- Not a safe import
-                                ideclQualified = False,
+                                ideclQualified = NotQualified,
                                 ideclImplicit  = True,   -- Implicit!
                                 ideclAs        = Nothing,
                                 ideclHiding    = Nothing  }

compiler/main/HscStats.hs

@@ -126,9 +126,10 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
     import_info _ = panic " import_info: Impossible Match"
                              -- due to #15884
 
-    safe_info = qual_info
-    qual_info False  = 0
-    qual_info True   = 1
+    safe_info False = 0
+    safe_info True = 1
+    qual_info NotQualified = 0
+    qual_info _  = 1
     as_info Nothing  = 0
     as_info (Just _) = 1
     spec_info Nothing           = (0,0,0,0,1,0,0)

compiler/main/SysTools.hs

@@ -177,6 +177,7 @@ initSysTools top_dir
                                  Nothing -> pgmError ("Failed to read " ++ show key ++ " value " ++ show xs)
                              Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
        crossCompiling <- getBooleanSetting "cross compiling"
+       targetPlatformString <- getSetting "target platform string"
        targetArch <- readSetting "target arch"
        targetOS <- readSetting "target os"
        targetWordSize <- readSetting "target word size"
@@ -305,6 +306,7 @@ initSysTools top_dir
                     sOpt_lc      = [],
                     sOpt_i       = [],
                     sPlatformConstants = platformConstants,
+                    sTargetPlatformString = targetPlatformString,
                     sTablesNextToCode = tablesNextToCode
              }
 

compiler/parser/Lexer.x

@@ -2329,6 +2329,7 @@ data ExtBits
   | DoAndIfThenElseBit
   | MultiWayIfBit
   | GadtSyntaxBit
+  | ImportQualifiedPostBit
 
   -- Flags that are updated once parsing starts
   | InRulePragBit
@@ -2415,6 +2416,7 @@ mkParserFlags' warningFlags extensionFlags thisPackage
       .|. DoAndIfThenElseBit          `xoptBit` LangExt.DoAndIfThenElse
       .|. MultiWayIfBit               `xoptBit` LangExt.MultiWayIf
       .|. GadtSyntaxBit               `xoptBit` LangExt.GADTSyntax
+      .|. ImportQualifiedPostBit      `xoptBit` LangExt.ImportQualifiedPost
     optBits =
           HaddockBit        `setBitIf` isHaddock
       .|. RawTokenStreamBit `setBitIf` rawTokStream

compiler/parser/Parser.y

@@ -39,6 +39,7 @@ module Parser (parseModule, parseSignature, parseImport, parseStatement, parseBa
 import Control.Monad    ( unless, liftM, when, (<=<) )
 import GHC.Exts
 import Data.Char
+import Data.Maybe       ( maybeToList )
 import Control.Monad    ( mplus )
 import Control.Applicative ((<$))
 
@@ -955,17 +956,22 @@ importdecls_semi
         | {- empty -}           { [] }
 
 importdecl :: { LImportDecl GhcPs }
-        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
-                {% ams (cL (comb4 $1 $6 (snd $7) $8) $
-                  ImportDecl { ideclExt = noExt
-                             , ideclSourceSrc = snd $ fst $2
-                             , ideclName = $6, ideclPkgQual = snd $5
-                             , ideclSource = snd $2, ideclSafe = snd $3
-                             , ideclQualified = snd $4, ideclImplicit = False
-                             , ideclAs = unLoc (snd $7)
-                             , ideclHiding = unLoc $8 })
-                   ((mj AnnImport $1 : (fst $ fst $2) ++ fst $3 ++ fst $4
-                                    ++ fst $5 ++ fst $7)) }
+        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec
+                {% do {
+                  ; checkImportDecl $4 $7
+                  ; ams (cL (comb4 $1 $6 (snd $8) $9) $
+                      ImportDecl { ideclExt = noExt
+                                  , ideclSourceSrc = snd $ fst $2
+                                  , ideclName = $6, ideclPkgQual = snd $5
+                                  , ideclSource = snd $2, ideclSafe = snd $3
+                                  , ideclQualified = importDeclQualifiedStyle $4 $7
+                                  , ideclImplicit = False
+                                  , ideclAs = unLoc (snd $8)
+                                  , ideclHiding = unLoc $9 })
+                         ((mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4)
+                                          ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8))
+                  }
+                }
 
 maybe_src :: { (([AddAnn],SourceText),IsBootInterface) }
         : '{-# SOURCE' '#-}'        { (([mo $1,mc $2],getSOURCE_PRAGs $1)
@@ -986,9 +992,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
                         ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } }
         | {- empty -}                           { ([],Nothing) }
 
-optqualified :: { ([AddAnn],Bool) }
-        : 'qualified'                           { ([mj AnnQualified $1],True)  }
-        | {- empty -}                           { ([],False) }
+optqualified :: { Maybe (Located Token) }
+        : 'qualified'                           { Just $1 }
+        | {- empty -}                           { Nothing }
 
 maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) }
         : 'as' modid                           { ([mj AnnAs $1]

compiler/parser/RdrHsSyn.hs

@@ -49,6 +49,7 @@ module   RdrHsSyn (
 
         -- Bunch of functions in the parser monad for
         -- checking and constructing values
+        checkImportDecl,
         checkExpBlockArguments,
         checkPrecP,           -- Int -> P Int
         checkContext,         -- HsType -> P HsContext
@@ -81,7 +82,10 @@ module   RdrHsSyn (
 
         -- Warnings and errors
         warnStarIsType,
+        warnPrepositiveQualifiedModule,
         failOpFewArgs,
+        failOpNotEnabledImportQualifiedPost,
+        failOpImportQualifiedTwice,
 
         SumOrTuple (..),
 
@@ -1051,6 +1055,31 @@ checkNoDocs msg ty = go ty
                                   , text "on", msg, quotes (ppr t) ]
     go _ = pure ()
 
+checkImportDecl :: Maybe (Located Token)
+                -> Maybe (Located Token)
+                -> P ()
+checkImportDecl mPre mPost = do
+  let whenJust mg f = maybe (pure ()) f mg
+
+  importQualifiedPostEnabled <- getBit ImportQualifiedPostBit
+
+  -- Error if 'qualified' found in postpostive position and
+  -- 'ImportQualifiedPost' is not in effect.
+  whenJust mPost $ \post ->
+    when (not importQualifiedPostEnabled) $
+      failOpNotEnabledImportQualifiedPost (getLoc post)
+
+  -- Error if 'qualified' occurs in both pre and postpositive
+  -- positions.
+  whenJust mPost $ \post ->
+    when (isJust mPre) $
+      failOpImportQualifiedTwice (getLoc post)
+
+  -- Warn if 'qualified' found in prepositive position and
+  -- 'Opt_WarnPrepositiveQualifiedModule' is enabled.
+  whenJust mPre $ \pre ->
+    warnPrepositiveQualifiedModule (getLoc pre)
+
 -- -------------------------------------------------------------------------
 -- Checking Patterns.
 
@@ -2945,6 +2974,27 @@ isImpExpQcWildcard _                = False
 -----------------------------------------------------------------------------
 -- Warnings and failures
 
+warnPrepositiveQualifiedModule :: SrcSpan -> P ()
+warnPrepositiveQualifiedModule span =
+  addWarning Opt_WarnPrepositiveQualifiedModule span msg
+  where
+    msg = text "Found" <+> quotes (text "qualified")
+           <+> text "in prepositive position"
+       $$ text "Suggested fix: place " <+> quotes (text "qualified")
+           <+> text "after the module name instead."
+
+failOpNotEnabledImportQualifiedPost :: SrcSpan -> P ()
+failOpNotEnabledImportQualifiedPost loc = addError loc msg
+  where
+    msg = text "Found" <+> quotes (text "qualified")
+          <+> text "in postpositive position. "
+      $$ text "To allow this, enable language extension 'ImportQualifiedPost'"
+
+failOpImportQualifiedTwice :: SrcSpan -> P ()
+failOpImportQualifiedTwice loc = addError loc msg
+  where
+    msg = text "Multiple occurences of 'qualified'"
+
 warnStarIsType :: SrcSpan -> P ()
 warnStarIsType span = addWarning Opt_WarnStarIsType span msg
   where

compiler/rename/RnNames.hs

@@ -267,7 +267,7 @@ rnImportDecl this_mod
                                      , ideclName = loc_imp_mod_name
                                      , ideclPkgQual = mb_pkg
                                      , ideclSource = want_boot, ideclSafe = mod_safe
-                                     , ideclQualified = qual_only, ideclImplicit = implicit
+                                     , ideclQualified = qual_style, ideclImplicit = implicit
                                      , ideclAs = as_mod, ideclHiding = imp_details }))
   = setSrcSpan loc $ do
 
@@ -275,6 +275,8 @@ rnImportDecl this_mod
         pkg_imports <- xoptM LangExt.PackageImports
         when (not pkg_imports) $ addErr packageImportErr
 
+    let qual_only = isImportDeclQualified qual_style
+
     -- If there's an error in loadInterface, (e.g. interface
     -- file not found) we get lots of spurious errors from 'filterImports'
     let imp_mod_name = unLoc loc_imp_mod_name
@@ -1470,8 +1472,8 @@ warnUnusedImport flag fld_env (L loc decl, used, unused)
                , text "from module" <+> quotes pp_mod <+> is_redundant]
     pp_herald  = text "The" <+> pp_qual <+> text "import of"
     pp_qual
-      | ideclQualified decl = text "qualified"
-      | otherwise           = Outputable.empty
+      | isImportDeclQualified (ideclQualified decl)= text "qualified"
+      | otherwise                                  = Outputable.empty
     pp_mod       = ppr (unLoc (ideclName decl))
     is_redundant = text "is redundant"
 

compiler/typecheck/TcRnDriver.hs

@@ -1567,7 +1567,7 @@ tcPreludeClashWarn warnFlag name = do
 
         -- Unqualified import?
         isUnqualified :: ImportDecl GhcRn -> Bool
-        isUnqualified = not . ideclQualified
+        isUnqualified = not . isImportDeclQualified . ideclQualified
 
         -- List of explicitly imported (or hidden) Names from a single import.
         --   Nothing -> No explicit imports

compiler/utils/Panic.hs

@@ -160,13 +160,13 @@ showGhcException exception
     sorryMsg :: ShowS -> ShowS
     sorryMsg s =
         showString "sorry! (unimplemented feature or known bug)\n"
-      . showString ("  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t")
+      . showString ("  (GHC version " ++ cProjectVersion ++ ":\n\t")
       . s . showString "\n"
 
     panicMsg :: ShowS -> ShowS
     panicMsg s =
         showString "panic! (the 'impossible' happened)\n"
-      . showString ("  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t")
+      . showString ("  (GHC version " ++ cProjectVersion ++ ":\n\t")
       . s . showString "\n\n"
       . showString "Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug\n"
 

docs/users_guide/glasgow_exts.rst

@@ -2109,6 +2109,38 @@ data constructor in an import or export list with the keyword
 ``pattern``, to allow the import or export of a data constructor without
 its parent type constructor (see :ref:`patsyn-impexp`).
+.. _importqualifiedpost:
+
+Writing qualified in postpositive position
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+.. extension:: ImportQualifiedPost
+    :shortdesc: ``ImportQualifiedPost`` allows the syntax ``import M qualified``
+
+    :since: 8.10.1
+
+    ``ImportQualifiedPost`` allows the syntax ``import M qualified``, that is, to annotate a module as qualified by writing ``qualified`` after the module name.
+
+To import a qualified module usually you must specify ``qualified`` in prepositive position : ``import qualified M``. This often leads to a "hanging indent" (which is automatically inserted by some autoformatters and common in many code bases. For example:
+
+.. code-block::  none
+
+ import qualified A
+ import           B
+ import           C
+
+The ``ImportQualifiedPost`` extension allows ``qualified`` to appear in postpositive position : ``import M qualified``. With this extension enabled, one can write:
+
+.. code-block:: none
+
+   import A qualified
+   import B
+   import C
+
+It is an error if ``qualified`` appears in both pre and postpositive positions.
+
+The warning ``-Wprepositive-qualified-syntax`` (off by default) reports on any occurrences of imports annotated ``qualified`` using prepositive syntax.
+
 .. _block-arguments:
 More liberal syntax for function arguments

ghc/GHCi/UI.hs

@@ -2649,7 +2649,7 @@ iiSubsumes (IIModule m1) (IIModule m2) = m1==m2
 iiSubsumes (IIDecl d1) (IIDecl d2)      -- A bit crude
   =  unLoc (ideclName d1) == unLoc (ideclName d2)
      && ideclAs d1 == ideclAs d2
-     && (not (ideclQualified d1) || ideclQualified d2)
+     && (not (isImportDeclQualified (ideclQualified d1)) || isImportDeclQualified (ideclQualified d2))
      && (ideclHiding d1 `hidingSubsumes` ideclHiding d2)
   where
      _                    `hidingSubsumes` Just (False,L _ []) = True

hadrian/src/Rules/Generate.hs

@@ -292,6 +292,7 @@ generateSettings = do
         , ("libtool command", settingsFileSetting SettingsFileSetting_LibtoolCommand)
         , ("unlit command", ("$topdir/bin/" <>) . takeFileName <$> builderPath Unlit)
         , ("cross compiling", flag' CrossCompiling)
+        , ("target platform string", setting TargetPlatform)
         , ("target os", lookupValueOrError configFile "haskell-target-os")
         , ("target arch", lookupValueOrError configFile "haskell-target-arch")
         , ("target word size", lookupValueOrError configFile "target-word-size")
@@ -357,8 +358,6 @@ generateConfigHs = do
         , "cBuildPlatformString = BuildPlatform_NAME"
         , "cHostPlatformString :: String"
         , "cHostPlatformString = HostPlatform_NAME"
-        , "cTargetPlatformString :: String"
-        , "cTargetPlatformString = TargetPlatform_NAME"
         , ""
         , "cProjectName          :: String"
         , "cProjectName          = " ++ show cProjectName
@@ -452,7 +451,6 @@ generateGhcBootPlatformH = do
         , ""
         , "#define BuildPlatform_NAME  " ++ show buildPlatform
         , "#define HostPlatform_NAME   " ++ show hostPlatform
-        , "#define TargetPlatform_NAME " ++ show targetPlatform
         , ""
         , "#define " ++ cppify buildPlatform  ++ "_BUILD 1"
         , "#define " ++ cppify hostPlatform   ++ "_HOST 1"

includes/Cmm.h

@@ -159,14 +159,19 @@
 #define BYTES_TO_WDS(n) ((n) / SIZEOF_W)
 #define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)
 
-/* TO_W_(n) converts n to W_ type from a smaller type */
+/*
+ * TO_W_(n) and TO_ZXW_(n) convert n to W_ type from a smaller type,
+ * with and without sign extension respectively
+ */
 #if SIZEOF_W == 4
 #define TO_I64(x) %sx64(x)
 #define TO_W_(x) %sx32(x)
+#define TO_ZXW_(x) %zx32(x)
 #define HALF_W_(x) %lobits16(x)
 #elif SIZEOF_W == 8
 #define TO_I64(x) (x)
 #define TO_W_(x) %sx64(x)
+#define TO_ZXW_(x) %zx64(x)
 #define HALF_W_(x) %lobits32(x)
 #endif
 

includes/ghc.mk

@@ -199,6 +199,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/.
 	@echo ',("libtool command", "$(SettingsLibtoolCommand)")' >> $@
 	@echo ',("unlit command", "$$topdir/bin/$(utils/unlit_dist_PROG)")' >> $@
 	@echo ',("cross compiling", "$(CrossCompiling)")' >> $@
+	@echo ',("target platform string", "$(TARGETPLATFORM)")' >> $@
 	@echo ',("target os", "$(HaskellTargetOs)")' >> $@
 	@echo ',("target arch", "$(HaskellTargetArch)")' >> $@
 	@echo ',("target word size", "$(TargetWordSize)")' >> $@

libraries/base/GHC/Generics.hs

@@ -1434,6 +1434,30 @@ deriving instance Generic ((,,,,,) a b c d e f)
 -- | @since 4.6.0.0
 deriving instance Generic ((,,,,,,) a b c d e f g)
 
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,) a b c d e f g h)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,) a b c d e f g h i)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o)
+
 -- | @since 4.12.0.0
 deriving instance Generic (Down a)
 
@@ -1471,6 +1495,30 @@ deriving instance Generic1 ((,,,,,) a b c d e)
 -- | @since 4.6.0.0
 deriving instance Generic1 ((,,,,,,) a b c d e f)
 
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,) a b c d e f g)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,) a b c d e f g h)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n)
+
 -- | @since 4.12.0.0
 deriving instance Generic1 Down
 

libraries/base/cbits/CastFloatWord.cmm

@@ -61,7 +61,8 @@ stg_floatToWord32zh(F_ f)
 
     reserve 1 = ptr {
         F_[ptr] = f;
-        w = TO_W_(I32[ptr]);
+        // Fix #16617: use zero-extending (TO_ZXW_) here
+        w = TO_ZXW_(I32[ptr]);
     }
 
     return (w);