compiler/deSugar/Check.hs

@@ -2580,7 +2580,7 @@ warnPmIters dflags (DsMatchContext kind loc)
     msg is = fsep [ text "Pattern match checker exceeded"
                   , parens (ppr is), text "iterations in", ctxt <> dot
                   , text "(Use -fmax-pmcheck-iterations=n"
-                  , text "to set the maximun number of iterations to n)" ]
+                  , text "to set the maximum number of iterations to n)" ]
 
     flag_i = wopt Opt_WarnOverlappingPatterns dflags
     flag_u = exhaustive dflags kind

compiler/ghc.cabal.in

@@ -525,6 +525,7 @@ Library
         TcTyClsDecls
         TcTyDecls
         TcTypeable
+        TcTypeableValidity
         TcType
         TcEvidence
         TcEvTerm

compiler/rename/RnSplice.hs

@@ -378,22 +378,19 @@ mkQuasiQuoteExpr flavour quoter q_span quote
 rnSplice :: HsSplice GhcPs -> RnM (HsSplice GhcRn, FreeVars)
 -- Not exported...used for all
 rnSplice (HsTypedSplice x hasParen splice_name expr)
-  = do  { checkTH expr "Template Haskell typed splice"
-        ; loc  <- getSrcSpanM
+  = do  { loc  <- getSrcSpanM
         ; n' <- newLocalBndrRn (cL loc splice_name)
         ; (expr', fvs) <- rnLExpr expr
         ; return (HsTypedSplice x hasParen n' expr', fvs) }
 
 rnSplice (HsUntypedSplice x hasParen splice_name expr)
-  = do  { checkTH expr "Template Haskell untyped splice"
-        ; loc  <- getSrcSpanM
+  = do  { loc  <- getSrcSpanM
         ; n' <- newLocalBndrRn (cL loc splice_name)
         ; (expr', fvs) <- rnLExpr expr
         ; return (HsUntypedSplice x hasParen n' expr', fvs) }
 
 rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
-  = do  { checkTH quoter "Template Haskell quasi-quote"
-        ; loc  <- getSrcSpanM
+  = do  { loc  <- getSrcSpanM
         ; splice_name' <- newLocalBndrRn (cL loc splice_name)
 
           -- Rename the quoter; akin to the HsVar case of rnExpr

compiler/simplCore/CoreMonad.hs

@@ -36,7 +36,6 @@ module CoreMonad (
 
     -- ** Lifting into the monad
     liftIO, liftIOWithCount,
-    liftIO1, liftIO2, liftIO3, liftIO4,
 
     -- ** Dealing with annotations
     getAnnotations, getFirstAnnotations,

compiler/typecheck/ClsInst.hs

@@ -16,6 +16,7 @@ import TcRnMonad
 import TcType
 import TcMType
 import TcEvidence
+import TcTypeableValidity
 import RnEnv( addUsedGRE )
 import RdrName( lookupGRE_FieldLabel )
 import InstEnv
@@ -432,7 +433,7 @@ doFunTy clas ty arg_ty ret_ty
 -- of monomorphic kind (e.g. all kind variables have been instantiated).
 doTyConApp :: Class -> Type -> TyCon -> [Kind] -> TcM ClsInstResult
 doTyConApp clas ty tc kind_args
-  | Just _ <- tyConRepName_maybe tc
+  | tyConIsTypeable tc
   = return $ OneInst { cir_new_theta = (map (mk_typeable_pred clas) kind_args)
                      , cir_mk_ev     = mk_ev
                      , cir_what      = BuiltinInstance }

compiler/typecheck/TcEvidence.hs

@@ -8,7 +8,7 @@ module TcEvidence (
   HsWrapper(..),
   (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams,
   mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders,
-  mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper,
+  mkWpFun, idHsWrapper, isIdHsWrapper, isErasableHsWrapper,
   pprHsWrapper,
 
   -- Evidence bindings
@@ -300,21 +300,6 @@ mkWpFun (WpCast co1) WpHole       _  t2 _ = WpCast (mkTcFunCo Representational (
 mkWpFun (WpCast co1) (WpCast co2) _  _  _ = WpCast (mkTcFunCo Representational (mkTcSymCo co1) co2)
 mkWpFun co1          co2          t1 _  d = WpFun co1 co2 t1 d
 
--- | @mkWpFuns [(ty1, wrap1), (ty2, wrap2)] ty_res wrap_res@,
--- where @wrap1 :: ty1 "->" ty1'@ and @wrap2 :: ty2 "->" ty2'@,
--- @wrap3 :: ty3 "->" ty3'@ and @ty_res@ is /either/ @ty3@ or @ty3'@,
--- gives a wrapper @(ty1' -> ty2' -> ty3) "->" (ty1 -> ty2 -> ty3')@.
--- Notice that the result wrapper goes the other way round to all
--- the others. This is a result of sub-typing contravariance.
--- The SDoc is a description of what you were doing when you called mkWpFuns.
-mkWpFuns :: [(TcType, HsWrapper)] -> TcType -> HsWrapper -> SDoc -> HsWrapper
-mkWpFuns args res_ty res_wrap doc = snd $ go args res_ty res_wrap
-  where
-    go [] res_ty res_wrap = (res_ty, res_wrap)
-    go ((arg_ty, arg_wrap) : args) res_ty res_wrap
-      = let (tail_ty, tail_wrap) = go args res_ty res_wrap in
-        (arg_ty `mkVisFunTy` tail_ty, mkWpFun arg_wrap tail_wrap arg_ty tail_ty doc)
-
 mkWpCastR :: TcCoercionR -> HsWrapper
 mkWpCastR co
   | isTcReflCo co = WpHole

compiler/typecheck/TcRnMonad.hs

@@ -75,7 +75,6 @@ module TcRnMonad(
   askNoErrs, discardErrs, tryTcDiscardingErrs,
   checkNoErrs, whenNoErrs,
   ifErrsM, failIfErrsM,
-  checkTH, failTH,
 
   -- * Context management for the type checker
   getErrCtxt, setErrCtxt, addErrCtxt, addErrCtxtM, addLandmarkErrCtxt,
@@ -1021,17 +1020,6 @@ failIfErrsM :: TcRn ()
 -- Useful to avoid error cascades
 failIfErrsM = ifErrsM failM (return ())
 
-checkTH :: a -> String -> TcRn ()
-checkTH _ _ = return () -- OK
-
-failTH :: Outputable a => a -> String -> TcRn x
-failTH e what  -- Raise an error in a stage-1 compiler
-  = failWithTc (vcat [ hang (char 'A' <+> text what
-                             <+> text "requires GHC with interpreter support:")
-                          2 (ppr e)
-                     , text "Perhaps you are using a stage-1 compiler?" ])
-
-
 {- *********************************************************************
 *                                                                      *
         Context management for the type checker

compiler/typecheck/TcTypeable.hs

@@ -17,10 +17,11 @@ import GhcPrelude
 import BasicTypes ( Boxity(..), neverInlinePragma, SourceText(..) )
 import TcBinds( addTypecheckedBinds )
 import IfaceEnv( newGlobalBinder )
-import TyCoRep( Type(..), TyLit(..), isLiftedTypeKind )
+import TyCoRep( Type(..), TyLit(..) )
 import TcEnv
 import TcEvidence ( mkWpTyApps )
 import TcRnMonad
+import TcTypeableValidity
 import HscTypes ( lookupId )
 import PrelNames
 import TysPrim ( primTyCons )
@@ -45,7 +46,6 @@ import FastString ( FastString, mkFastString, fsLit )
 
 import Control.Monad.Trans.State
 import Control.Monad.Trans.Class (lift)
-import Data.Maybe ( isJust )
 import Data.Word( Word64 )
 
 {- Note [Grand plan for Typeable]
@@ -412,38 +412,6 @@ mkTyConRepBinds stuff todo (TypeableTyCon {..})
            tycon_rep_bind = mkVarBind tycon_rep_id tycon_rep_rhs
        return $ unitBag tycon_rep_bind
 
--- | Here is where we define the set of Typeable types. These exclude type
--- families and polytypes.
-tyConIsTypeable :: TyCon -> Bool
-tyConIsTypeable tc =
-       isJust (tyConRepName_maybe tc)
-    && typeIsTypeable (dropForAlls $ tyConKind tc)
-      -- Ensure that the kind of the TyCon, with its initial foralls removed,
-      -- is representable (e.g. has no higher-rank polymorphism or type
-      -- synonyms).
-
--- | Is a particular 'Type' representable by @Typeable@? Here we look for
--- polytypes and types containing casts (which may be, for instance, a type
--- family).
-typeIsTypeable :: Type -> Bool
--- We handle types of the form (TYPE LiftedRep) specifically to avoid
--- looping on (tyConIsTypeable RuntimeRep). We used to consider (TYPE rr)
--- to be typeable without inspecting rr, but this exhibits bad behavior
--- when rr is a type family.
-typeIsTypeable ty
-  | Just ty' <- coreView ty         = typeIsTypeable ty'
-typeIsTypeable ty
-  | isLiftedTypeKind ty             = True
-typeIsTypeable (TyVarTy _)          = True
-typeIsTypeable (AppTy a b)          = typeIsTypeable a && typeIsTypeable b
-typeIsTypeable (FunTy _ a b)        = typeIsTypeable a && typeIsTypeable b
-typeIsTypeable (TyConApp tc args)   = tyConIsTypeable tc
-                                   && all typeIsTypeable args
-typeIsTypeable (ForAllTy{})         = False
-typeIsTypeable (LitTy _)            = True
-typeIsTypeable (CastTy{})           = False
-typeIsTypeable (CoercionTy{})       = False
-
 -- | Maps kinds to 'KindRep' bindings. This binding may either be defined in
 -- some other module (in which case the @Maybe (LHsExpr Id@ will be 'Nothing')
 -- or a binding which we generated in the current module (in which case it will

compiler/typecheck/TcTypeableValidity.hs

+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1999
+-}
+
+-- | This module is separate from "TcTypeable" because the functions in this
+-- module are used in "ClsInst", and importing "TcTypeable" from "ClsInst"
+-- would lead to an import cycle.
+module TcTypeableValidity (tyConIsTypeable, typeIsTypeable) where
+
+import GhcPrelude
+
+import TyCoRep
+import TyCon
+import Type
+
+import Data.Maybe (isJust)
+
+-- | Is a particular 'TyCon' representable by @Typeable@?. These exclude type
+-- families and polytypes.
+tyConIsTypeable :: TyCon -> Bool
+tyConIsTypeable tc =
+       isJust (tyConRepName_maybe tc)
+    && typeIsTypeable (dropForAlls $ tyConKind tc)
+
+-- | Is a particular 'Type' representable by @Typeable@? Here we look for
+-- polytypes and types containing casts (which may be, for instance, a type
+-- family).
+typeIsTypeable :: Type -> Bool
+-- We handle types of the form (TYPE LiftedRep) specifically to avoid
+-- looping on (tyConIsTypeable RuntimeRep). We used to consider (TYPE rr)
+-- to be typeable without inspecting rr, but this exhibits bad behavior
+-- when rr is a type family.
+typeIsTypeable ty
+  | Just ty' <- coreView ty         = typeIsTypeable ty'
+typeIsTypeable ty
+  | isLiftedTypeKind ty             = True
+typeIsTypeable (TyVarTy _)          = True
+typeIsTypeable (AppTy a b)          = typeIsTypeable a && typeIsTypeable b
+typeIsTypeable (FunTy _ a b)        = typeIsTypeable a && typeIsTypeable b
+typeIsTypeable (TyConApp tc args)   = tyConIsTypeable tc
+                                   && all typeIsTypeable args
+typeIsTypeable (ForAllTy{})         = False
+typeIsTypeable (LitTy _)            = True
+typeIsTypeable (CastTy{})           = False
+typeIsTypeable (CoercionTy{})       = False

compiler/utils/MonadUtils.hs

@@ -8,8 +8,6 @@ module MonadUtils
         , MonadFix(..)
         , MonadIO(..)
 
-        , liftIO1, liftIO2, liftIO3, liftIO4
-
         , zipWith3M, zipWith3M_, zipWith4M, zipWithAndUnzipM
         , mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M, mapAndUnzip5M
         , mapAccumLM
@@ -37,27 +35,6 @@ import Control.Monad.IO.Class
 import Data.Foldable (sequenceA_)
 import Data.List (unzip4, unzip5, zipWith4)
 
--------------------------------------------------------------------------------
--- Lift combinators
---  These are used throughout the compiler
--------------------------------------------------------------------------------
-
--- | Lift an 'IO' operation with 1 argument into another monad
-liftIO1 :: MonadIO m => (a -> IO b) -> a -> m b
-liftIO1 = (.) liftIO
-
--- | Lift an 'IO' operation with 2 arguments into another monad
-liftIO2 :: MonadIO m => (a -> b -> IO c) -> a -> b -> m c
-liftIO2 = ((.).(.)) liftIO
-
--- | Lift an 'IO' operation with 3 arguments into another monad
-liftIO3 :: MonadIO m => (a -> b -> c -> IO d) -> a -> b -> c -> m d
-liftIO3 = ((.).((.).(.))) liftIO
-
--- | Lift an 'IO' operation with 4 arguments into another monad
-liftIO4 :: MonadIO m => (a -> b -> c -> d -> IO e) -> a -> b -> c -> d -> m e
-liftIO4 = (((.).(.)).((.).(.))) liftIO
-
 -------------------------------------------------------------------------------
 -- Common functions
 --  These are used throughout the compiler

ghc.mk

@@ -1306,6 +1306,7 @@ CLEAN_FILES += includes/DerivedConstants.h
 CLEAN_FILES += includes/ghcautoconf.h
 CLEAN_FILES += includes/ghcplatform.h
 CLEAN_FILES += includes/ghcversion.h
+CLEAN_FILES += $(includes_SETTINGS)
 CLEAN_FILES += utils/ghc-pkg/Version.hs
 CLEAN_FILES += compiler/prelude/primops.txt
 CLEAN_FILES += $(wildcard compiler/primop*incl)

hadrian/cabal.project

 packages: ./
           ../libraries/Cabal/Cabal/
+
+-- N.B. Compile with -O0 since this is not a performance-critical executable
+-- and the Cabal takes nearly twice as long to build with -O1. See #16817.
+package Cabal
+  optimization: False
+

hadrian/src/Settings/Flavours/Development.hs

@@ -2,6 +2,7 @@ module Settings.Flavours.Development (developmentFlavour) where
 
 import Expression
 import Flavour
+import Packages
 import {-# SOURCE #-} Settings.Default
 
 -- Please update doc/flavours.md when changing this file.
@@ -17,7 +18,10 @@ developmentArgs :: Stage -> Args
 developmentArgs ghcStage = do
     stage <- getStage
     sourceArgs SourceArgs
-        { hsDefault  = pure ["-O", "-H64m"]
+        { hsDefault  = mconcat [ pure ["-O", "-H64m"],
+                                 -- Disable optimization when building Cabal;
+                                 -- this saves many minutes of build time.
+                                 package cabal ? pure ["-O0"]]
         , hsLibrary  = notStage0 ? arg "-dcore-lint"
         , hsCompiler = mconcat [stage0 ? arg "-O2",
                                 succ stage == ghcStage ? pure ["-O0", "-DDEBUG"]]

libraries/base/tests/IO/all.T

@@ -84,7 +84,8 @@ test('hGetBuf001',
       expect_fail_if_windows],
      compile_and_run, ['-package unix'])
 
-test('hDuplicateTo001', [], compile_and_run, [''])
+# As discussed in #16819, this test is racy in a threaded environment.
+test('hDuplicateTo001', [omit_ways(concurrent_ways)], compile_and_run, [''])
 
 test('countReaders001', [], compile_and_run, [''])
 

libraries/base/tests/Numeric/all.T

@@ -13,7 +13,7 @@ test('num009', [ when(fast(), skip)
                , when(platform('powerpc64le-unknown-linux'), expect_broken(13634))],
              compile_and_run, [opts])
 test('num010',
-     when(platform('i386-apple-darwin'), expect_broken_for(7043, 'ghci')),
+     when(platform('i386-apple-darwin'), expect_broken_for(7043, ['ghci'])),
      compile_and_run,
      [''])
 test('sqrt', normal, compile_and_run, [''])

libraries/base/tests/all.T

@@ -249,5 +249,5 @@ test('T14425', normal, compile_and_run, [''])
 test('T10412', normal, compile_and_run, [''])
 test('T13896', normal, compile_and_run, [''])
 test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, [''])
-test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, [''])
+test('T15349', [exit_code(1), expect_broken_for(15349, ['ghci'])], compile_and_run, [''])
 test('T16111', exit_code(1), compile_and_run, [''])

unix @ bd2631b3

-Subproject commit 3985f63a35235ce5e10a4cb6f532c1041f466372
+Subproject commit bd2631b375f8c2e1d9f6c778065d0ef699cf853a

mk/flavours/devel1.mk

@@ -10,3 +10,7 @@ BUILD_SPHINX_PDF   = NO
 BUILD_MAN          = NO
 
 LAX_DEPENDENCIES   = YES
+
+# Reduce optimisation when building Cabal; this makes a significant difference
+# in overall build time. See #16817.
+libraries/Cabal_dist-install_HC_OPTS += -O0

mk/flavours/devel2.mk

@@ -10,3 +10,7 @@ BUILD_SPHINX_PDF   = NO
 BUILD_MAN          = NO
 
 LAX_DEPENDENCIES   = YES
+
+# Reduce optimisation when building Cabal; this makes a significant difference
+# in overall build time. See #16817.
+libraries/Cabal_dist-install_HC_OPTS += -O0

mk/flavours/validate.mk

@@ -27,6 +27,10 @@ endif
 
 WERROR             = -Werror
 
+# Reduce optimisation when building Cabal; this makes a significant difference
+# in overall build time. See #16817.
+libraries/Cabal_dist-install_HC_OPTS += -O0
+
 # DO NOT EDIT THIS FILE! Instead, create a file mk/validate.mk, whose settings
 # will override these. See also mk/custom-settings.mk.
 #
@@ -36,6 +40,7 @@ WERROR             = -Werror
 #
 #
 # Note [validate build settings]
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 #
 # Using GhcStage2HcOpts=-O (rather than -O0) here bringes my validate down from
 # 22mins to 16 mins. Compiling stage2 takes longer, but we gain a faster