compiler/basicTypes/MkId.hs

@@ -19,8 +19,7 @@ module MkId (
 
         mkPrimOpId, mkFCallId,
 
-        wrapNewTypeBody, unwrapNewTypeBody,
-        wrapFamInstBody,
+        unwrapNewTypeBody, wrapFamInstBody,
         DataConBoxer(..), mkDataConRep, mkDataConWorkId,
 
         -- And some particular Ids; see below for why they are wired in
@@ -247,6 +246,47 @@ Hence we translate to
         -- Coercion from family type to representation type
   Co7T a :: T [a] ~ :R7T a
 
+Newtype instances through an additional wrinkle into the mix. Consider the
+following example (adapted from #15318, comment:2):
+
+  data family T a
+  newtype instance T [a] = MkT [a]
+
+Within the newtype instance, there are three distinct types at play:
+
+1. The newtype's underlying type, [a].
+2. The instance's representation type, TList a (where TList is the
+   representation tycon).
+3. The family type, T [a].
+
+We need two coercions in order to cast from (1) to (3):
+
+(a) A newtype coercion axiom:
+
+      axiom coTList a :: TList a ~ [a]
+
+    (Where TList is the representation tycon of the newtype instance.)
+
+(b) A data family instance coercion axiom:
+
+      axiom coT a :: T [a] ~ TList a
+
+When we translate the newtype instance to Core, we obtain:
+
+    -- Wrapper
+  $WMkT :: forall a. [a] -> T [a]
+  $WMkT a x = MkT a x |> Sym (coT a)
+
+    -- Worker
+  MkT :: forall a. [a] -> TList [a]
+  MkT a x = x |> Sym (coTList a)
+
+Unlike for data instances, the worker for a newtype instance is actually an
+executable function which expands to a cast, but otherwise, the general
+strategy is essentially the same as for data instances. Also note that we have
+a wrapper, which is unusual for a newtype, but we make GHC produce one anyway
+for symmetry with the way data instances are handled.
+
 Note [Newtype datacons]
 ~~~~~~~~~~~~~~~~~~~~~~~
 The "data constructor" for a newtype should always be vanilla.  At one
@@ -614,8 +654,8 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
                      -- of some newtypes written with GADT syntax. See below.
          && (any isBanged (ev_ibangs ++ arg_ibangs)
                      -- Some forcing/unboxing (includes eq_spec)
-             || isFamInstTyCon tycon  -- Cast result
              || (not $ null eq_spec))) -- GADT
+      || isFamInstTyCon tycon -- Cast result
       || dataConUserTyVarsArePermuted data_con
                      -- If the data type was written with GADT syntax and
                      -- orders the type variables differently from what the
@@ -1009,15 +1049,9 @@ wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 --
 -- If a coercion constructor is provided in the newtype, then we use
 -- it, otherwise the wrap/unwrap are both no-ops
---
--- If the we are dealing with a newtype *instance*, we have a second coercion
--- identifying the family instance with the constructor of the newtype
--- instance.  This coercion is applied in any case (ie, composed with the
--- coercion constructor of the newtype or applied by itself).
 
 wrapNewTypeBody tycon args result_expr
   = ASSERT( isNewTyCon tycon )
-    wrapFamInstBody tycon args $
     mkCast result_expr (mkSymCo co)
   where
     co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args []

compiler/basicTypes/RdrName.hs

@@ -1311,14 +1311,10 @@ pprLoc (UnhelpfulSpan {}) = empty
 --      coming from GHC.TypeNats). In this case the user will get a kind
 --      mismatch error. This is a violation of assumption (c).
 --
--- Since NoStarIsType is implied by a fairly common extension TypeOperators,
--- the user might be working on a module with NoStarIsType unbeknownst to him.
--- Even if the user switched off StarIsType manually, he might have forgotten
--- about it and use '*' as 'Data.Kind.Type' out of habit.
---
--- Thus it is very important to give a hint whenever an assumption about '*' is
--- violated. Unfortunately, it is somewhat difficult to deal with (c), so we
--- limit ourselves to (a) and (b).
+-- The user might unknowingly be working on a module with NoStarIsType
+-- or use '*' as 'Data.Kind.Type' out of habit. So it is important to give a
+-- hint whenever an assumption about '*' is violated. Unfortunately, it is
+-- somewhat difficult to deal with (c), so we limit ourselves to (a) and (b).
 --
 -- 'starInfo' generates an appropriate hint to the user depending on the
 -- extensions enabled in the module and the name that triggered the error.
@@ -1326,10 +1322,10 @@ pprLoc (UnhelpfulSpan {}) = empty
 -- Unicode variant, the resulting SDoc will contain a helpful suggestion.
 -- Otherwise it is empty.
 --
-starInfo :: (Bool, Bool) -> RdrName -> SDoc
-starInfo (type_operators, star_is_type) rdr_name =
+starInfo :: Bool -> RdrName -> SDoc
+starInfo star_is_type rdr_name =
   -- One might ask: if can use sdocWithDynFlags here, why bother to take
-  -- (type_operators, star_is_type) as input? Why not refactor?
+  -- star_is_type as input? Why not refactor?
   --
   -- The reason is that sdocWithDynFlags would provide DynFlags that are active
   -- in the module that tries to load the problematic definition, not
@@ -1340,10 +1336,7 @@ starInfo (type_operators, star_is_type) rdr_name =
   -- with StarIsType enabled!
   --
   if isUnqualStar && not star_is_type
-     then text "With NoStarIsType" <>
-          (if type_operators
-              then text " (implied by TypeOperators), "
-              else text ", ") <>
+     then text "With NoStarIsType, " <>
           quotes (ppr rdr_name) <>
           text " is treated as a regular type operator. "
         $$

compiler/deSugar/Coverage.hs

@@ -810,7 +810,7 @@ addTickIPBind (IPBind x nm e) =
         liftM2 (IPBind x)
                 (return nm)
                 (addTickLHsExpr e)
-addTickIPBind (XCIPBind x) = return (XCIPBind x)
+addTickIPBind (XIPBind x) = return (XIPBind x)
 
 -- There is no location here, so we might need to use a context location??
 addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)

compiler/deSugar/DsExpr.hs

@@ -96,7 +96,7 @@ dsIPBinds (IPBinds ev_binds ip_binds) body
     ds_ip_bind (L _ (IPBind _ ~(Right n) e)) body
       = do e' <- dsLExpr e
            return (Let (NonRec n e') body)
-    ds_ip_bind (L _ (XCIPBind _)) _ = panic "dsIPBinds"
+    ds_ip_bind (L _ (XIPBind _)) _ = panic "dsIPBinds"
 dsIPBinds (XHsIPBinds _) _ = panic "dsIPBinds"
 
 -------------------------

compiler/ghci/RtClosureInspect.hs

@@ -781,11 +781,14 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
           dflags <- getDynFlags
           let word_size = wORD_SIZE dflags
               size_b = primRepSizeB dflags rep
-              -- Fields are always aligned.
-              !aligned_idx = roundUpTo arr_i size_b
+              -- Align the start offset (eg, 2-byte value should be 2-byte
+              -- aligned). But not more than to a word. The offset calculation
+              -- should be the same with the offset calculation in
+              -- StgCmmLayout.mkVirtHeapOffsetsWithPadding.
+              !aligned_idx = roundUpTo arr_i (min word_size size_b)
               !new_arr_i = aligned_idx + size_b
               ws | size_b < word_size =
-                     [index size_b array aligned_idx word_size]
+                     [index size_b aligned_idx word_size]
                  | otherwise =
                      let (q, r) = size_b `quotRem` word_size
                      in ASSERT( r == 0 )
@@ -800,7 +803,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
                 (error "unboxedTupleTerm: no HValue for unboxed tuple") terms
 
     -- Extract a sub-word sized field from a word
-    index item_size_b array index_b word_size =
+    index item_size_b index_b word_size =
         (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes
       where
         mask :: Word

compiler/hsSyn/Convert.hs

@@ -818,7 +818,8 @@ cvtl e = wrapL (cvt e)
     cvt (AppTypeE e t) = do { e' <- cvtl e
                             ; t' <- cvtType t
                             ; tp <- wrap_apps t'
-                            ; return $ HsAppType (mkHsWildCardBndrs tp) e' }
+                            ; let tp' = parenthesizeHsType appPrec tp
+                            ; return $ HsAppType (mkHsWildCardBndrs tp') e' }
     cvt (LamE [] e)    = cvt e -- Degenerate case. We convert the body as its
                                -- own expression to avoid pretty-printing
                                -- oddities that can result from zero-argument
@@ -1283,7 +1284,9 @@ cvtTypeKind ty_str ty
                  x'' <- case x' of
                           L _ HsFunTy{}    -> returnL (HsParTy noExt x')
                           L _ HsForAllTy{} -> returnL (HsParTy noExt x')
-                                                                       -- #14646
+                                                               -- #14646
+                          L _ HsQualTy{}   -> returnL (HsParTy noExt x')
+                                                               -- #15324
                           _                -> return x'
                  returnL (HsFunTy noExt x'' y')
              | otherwise ->

compiler/hsSyn/HsBinds.hs

@@ -859,12 +859,12 @@ type LIPBind id = Located (IPBind id)
 -- For details on above see note [Api annotations] in ApiAnnotation
 data IPBind id
   = IPBind
-        (XIPBind id)
+        (XCIPBind id)
         (Either (Located HsIPName) (IdP id))
         (LHsExpr id)
-  | XCIPBind (XXIPBind id)
+  | XIPBind (XXIPBind id)
 
-type instance XIPBind     (GhcPass p) = NoExt
+type instance XCIPBind    (GhcPass p) = NoExt
 type instance XXIPBind    (GhcPass p) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
@@ -878,7 +878,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where
     where name = case lr of
                    Left (L _ ip) -> pprBndr LetBind ip
                    Right     id  -> pprBndr LetBind id
-  ppr (XCIPBind x) = ppr x
+  ppr (XIPBind x) = ppr x
 
 {-
 ************************************************************************

compiler/hsSyn/HsDecls.hs

@@ -516,17 +516,11 @@ data TyClDecl pass
     --              'ApiAnnotation.AnnWhere',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-    DataDecl { tcdDExt     :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs
-             , tcdLName    :: Located (IdP pass) -- ^ Type constructor
-             , tcdTyVars   :: LHsQTyVars pass  -- ^ Type variables; for an
-                                               -- associated type
-                                               --   these include outer binders
-                                               -- Eg  class T a where
-                                               --       type F a :: *
-                                               --       type F a = a -> a
-                                               -- Here the type decl for 'f'
-                                               -- includes 'a' in its tcdTyVars
-             , tcdFixity   :: LexicalFixity -- ^ Fixity used in the declaration
+    DataDecl { tcdDExt     :: XDataDecl pass       -- ^ Post renamer, CUSK flag, FVs
+             , tcdLName    :: Located (IdP pass)   -- ^ Type constructor
+             , tcdTyVars   :: LHsQTyVars pass      -- ^ Type variables
+                              -- See Note [TyVar binders for associated declarations]
+             , tcdFixity   :: LexicalFixity        -- ^ Fixity used in the declaration
              , tcdDataDefn :: HsDataDefn pass }
 
   | ClassDecl { tcdCExt    :: XClassDecl pass,         -- ^ Post renamer, FVs
@@ -539,8 +533,7 @@ data TyClDecl pass
                 tcdSigs    :: [LSig pass],              -- ^ Methods' signatures
                 tcdMeths   :: LHsBinds pass,            -- ^ Default methods
                 tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;
-                tcdATDefs  :: [LTyFamDefltEqn pass],
-                                                   -- ^ Associated type defaults
+                tcdATDefs  :: [LTyFamDefltEqn pass],    -- ^ Associated type defaults
                 tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
     }
         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
@@ -558,6 +551,27 @@ data DataDeclRn = DataDeclRn
              , tcdFVs      :: NameSet }
   deriving Data
 
+{- Note [TyVar binders for associated decls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For an /associated/ data, newtype, or type-family decl, the LHsQTyVars
+/includes/ outer binders.  For example
+    class T a where
+       data D a c
+       type F a b :: *
+       type F a b = a -> a
+Here the data decl for 'D', and type-family decl for 'F', both include 'a'
+in their LHsQTyVars (tcdTyVars and fdTyVars resp).
+
+Ditto any implicit binders in the hsq_implicit field of the LHSQTyVars.
+
+The idea is that the associated type is really a top-level decl in its
+own right.  However we are careful to use the same name 'a', so that
+we can match things up.
+
+c.f. Note [Associated type tyvar names] in Class.hs
+     Note [Family instance declaration binders]
+-}
+
 type instance XFamDecl      (GhcPass _) = NoExt
 
 type instance XSynDecl      GhcPs = NoExt
@@ -966,6 +980,7 @@ data FamilyDecl pass = FamilyDecl
   , fdInfo           :: FamilyInfo pass              -- type/data, closed/open
   , fdLName          :: Located (IdP pass)           -- type constructor
   , fdTyVars         :: LHsQTyVars pass              -- type variables
+                       -- See Note [TyVar binders for associated declarations]
   , fdFixity         :: LexicalFixity                -- Fixity used in the declaration
   , fdResultSig      :: LFamilyResultSig pass        -- result signature
   , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann
@@ -1490,6 +1505,8 @@ HsImplicitBndrs in FamInstEqn. Note in particular
 For associated type family default instances (TyFamDefltEqn), instead of using
 type patterns with binders in a surrounding HsImplicitBndrs, we use raw type
 variables (LHsQTyVars) in the feqn_pats field of FamEqn.
+
+c.f. Note [TyVar binders for associated declarations]
 -}
 
 -- | Type Family Instance Equation

compiler/hsSyn/HsExtension.hs

@@ -156,11 +156,11 @@ type ForallXHsIPBinds (c :: * -> Constraint) (x :: *) =
        )
 
 -- IPBind type families
-type family XIPBind  x
+type family XCIPBind x
 type family XXIPBind x
 
 type ForallXIPBind (c :: * -> Constraint) (x :: *) =
-       ( c (XIPBind  x)
+       ( c (XCIPBind x)
        , c (XXIPBind x)
        )
 

compiler/hsSyn/HsTypes.hs

@@ -1425,8 +1425,8 @@ ppr_tylit (HsStrTy _ s) = text (show s)
 hsTypeNeedsParens :: PprPrec -> HsType pass -> Bool
 hsTypeNeedsParens p = go
   where
-    go (HsForAllTy{})        = False
-    go (HsQualTy{})          = False
+    go (HsForAllTy{})        = p >= funPrec
+    go (HsQualTy{})          = p >= funPrec
     go (HsBangTy{})          = p > topPrec
     go (HsRecTy{})           = False
     go (HsTyVar{})           = False

compiler/hsSyn/HsUtils.hs

@@ -178,7 +178,10 @@ mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2)
 
 mkHsAppType :: (XAppTypeE (GhcPass id) ~ LHsWcType GhcRn)
             => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)
-mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType t e)
+mkHsAppType e t = addCLoc e t_body (HsAppType paren_wct e)
+  where
+    t_body    = hswc_body t
+    paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }
 
 mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
 mkHsAppTypes = foldl mkHsAppType
@@ -497,7 +500,13 @@ nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)
 
 nlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t))
 nlHsTyVar x   = noLoc (HsTyVar noExt NotPromoted (noLoc x))
-nlHsFunTy a b = noLoc (HsFunTy noExt a b)
+nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a)
+                                     (parenthesize_fun_tail b))
+  where
+    parenthesize_fun_tail (L loc (HsFunTy ext ty1 ty2))
+      = L loc (HsFunTy ext (parenthesizeHsType funPrec ty1)
+                           (parenthesize_fun_tail ty2))
+    parenthesize_fun_tail lty = lty
 nlHsParTy t   = noLoc (HsParTy noExt t)
 
 nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
@@ -694,7 +703,7 @@ The derived Eq instance for Glurp (without any kind signatures) would be:
   instance Eq a => Eq (Glurp a) where
     (==) = coerce @(Wat 'Proxy -> Wat 'Proxy -> Bool)
                   @(Glurp a    -> Glurp a    -> Bool)
-                  (==)
+                  (==) :: Glurp a -> Glurp a -> Bool
 
 (Where the visible type applications use types produced by typeToLHsType.)
 

compiler/iface/IfaceType.hs

@@ -513,8 +513,13 @@ stripInvisArgs dflags tys
     where
       suppress_invis c
         = case c of
+            ITC_Nil        -> ITC_Nil
             ITC_Invis _ ts -> suppress_invis ts
-            _ -> c
+            ITC_Vis   t ts -> ITC_Vis t $ suppress_invis ts
+              -- Keep recursing through the remainder of the arguments, as it's
+              -- possible that there are remaining invisible ones.
+              -- See the "In type declarations" section of Note [TyVarBndrs,
+              -- TyVarBinders, TyConBinders, and visibility] in TyCoRep.
 
 tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
 tcArgsIfaceTypes ITC_Nil = []
@@ -819,11 +824,15 @@ pprParendIfaceTcArgs = ppr_tc_args appPrec
 
 ppr_tc_args :: PprPrec -> IfaceTcArgs -> SDoc
 ppr_tc_args ctx_prec args
- = let pprTys t ts = ppr_ty ctx_prec t <+> ppr_tc_args ctx_prec ts
+ = let ppr_rest    = ppr_tc_args ctx_prec
+       pprTys t ts = ppr_ty ctx_prec t <+> ppr_rest ts
    in case args of
         ITC_Nil        -> empty
         ITC_Vis   t ts -> pprTys t ts
-        ITC_Invis t ts -> pprTys t ts
+        ITC_Invis t ts -> sdocWithDynFlags $ \dflags ->
+                          if gopt Opt_PrintExplicitKinds dflags
+                             then pprTys t ts
+                             else ppr_rest ts
 
 -------------------
 pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc

compiler/main/DynFlags.hs

@@ -814,6 +814,7 @@ data WarningFlag =
    | Opt_WarnMissingExportList
    | Opt_WarnInaccessibleCode
    | Opt_WarnStarIsType                   -- Since 8.6
+   | Opt_WarnStarBinder                   -- Since 8.6
    | Opt_WarnImplicitKindVars             -- Since 8.6
    deriving (Eq, Show, Enum)
 
@@ -3859,6 +3860,7 @@ wWarningFlagsDeps = [
   flagSpec "simplifiable-class-constraints" Opt_WarnSimplifiableClassConstraints,
   flagSpec "missing-home-modules"        Opt_WarnMissingHomeModules,
   flagSpec "unrecognised-warning-flags"  Opt_WarnUnrecognisedWarningFlags,
+  flagSpec "star-binder"                 Opt_WarnStarBinder,
   flagSpec "star-is-type"                Opt_WarnStarIsType,
   flagSpec "partial-fields"              Opt_WarnPartialFields ]
 
@@ -4362,7 +4364,6 @@ impliedXFlags
     , (LangExt.TypeInType,       turnOn, LangExt.DataKinds)
     , (LangExt.TypeInType,       turnOn, LangExt.PolyKinds)
     , (LangExt.TypeInType,       turnOn, LangExt.KindSignatures)
-    , (LangExt.TypeInType,       turnOff, LangExt.StarIsType)
 
     -- AutoDeriveTypeable is not very useful without DeriveDataTypeable
     , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)
@@ -4374,9 +4375,6 @@ impliedXFlags
 
     , (LangExt.ImpredicativeTypes,  turnOn, LangExt.RankNTypes)
 
-    -- See Note [When is StarIsType enabled]
-    , (LangExt.TypeOperators, turnOff, LangExt.StarIsType)
-
         -- Record wild-cards implies field disambiguation
         -- Otherwise if you write (C {..}) you may well get
         -- stuff like " 'a' not in scope ", which is a bit silly
@@ -4404,12 +4402,10 @@ impliedXFlags
 -- programs expect '*' to be synonymous with 'Type', so by default StarIsType is
 -- enabled.
 --
--- However, programs that use TypeOperators might expect to repurpose '*' for
--- multiplication or another binary operation, so we make TypeOperators imply
--- NoStarIsType.
+-- Programs that use TypeOperators might expect to repurpose '*' for
+-- multiplication or another binary operation, but making TypeOperators imply
+-- NoStarIsType caused too much breakage on Hackage.
 --
--- It is still possible to have TypeOperators and StarIsType enabled at the same
--- time, although it's not recommended.
 
 -- Note [Documenting optimisation flags]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -4559,6 +4555,7 @@ standardWarnings -- see Note [Documenting warning flags]
         Opt_WarnTabs,
         Opt_WarnUnrecognisedWarningFlags,
         Opt_WarnSimplifiableClassConstraints,
+        Opt_WarnStarBinder,
         Opt_WarnInaccessibleCode
       ]
 

compiler/main/HscMain.hs

@@ -85,7 +85,6 @@ module HscMain
 import GhcPrelude
 
 import Data.Data hiding (Fixity, TyCon)
-import Data.Maybe       ( isJust )
 import DynFlags         (addPluginModuleName)
 import Id
 import GHCi             ( addSptEntry )
@@ -455,14 +454,10 @@ tcRnModule' sum save_rn_syntax mod = do
     hsc_env <- getHscEnv
     dflags   <- getDynFlags
 
-    -- check if plugins need the renamed syntax
-    let plugin_needs_rn = any (isJust . renamedResultAction . lpPlugin)
-                              (plugins dflags)
-
     tcg_res <- {-# SCC "Typecheck-Rename" #-}
                ioMsgMaybe $
                    tcRnModule hsc_env sum
-                     (save_rn_syntax || plugin_needs_rn) mod
+                     save_rn_syntax mod
 
     -- See Note [Safe Haskell Overlapping Instances Implementation]
     -- although this is used for more than just that failure case.

compiler/main/Plugins.hs

@@ -3,7 +3,7 @@
 module Plugins (
       FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction
     , Plugin(..), CommandLineOption, LoadedPlugin(..), lpModuleName
-    , defaultPlugin, withPlugins, withPlugins_
+    , defaultPlugin, keepRenamedSource, withPlugins, withPlugins_
     , PluginRecompile(..)
     , purePlugin, impurePlugin, flagRecompile
     ) where
@@ -12,14 +12,13 @@ import GhcPrelude
 
 import {-# SOURCE #-} CoreMonad ( CoreToDo, CoreM )
 import qualified TcRnTypes
-import TcRnTypes ( TcGblEnv, IfM, TcM )
+import TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports )
 import HsSyn
 import DynFlags
 import HscTypes
 import GhcMonad
 import DriverPhases
 import Module ( ModuleName, Module(moduleName))
-import Avail
 import Fingerprint
 import Data.List
 import Outputable (Outputable(..), text, (<+>))
@@ -58,10 +57,10 @@ data Plugin = Plugin {
                             -> Hsc HsParsedModule
     -- ^ Modify the module when it is parsed. This is called by
     -- HscMain when the parsing is successful.
-  , renamedResultAction :: Maybe ([CommandLineOption] -> ModSummary
-                                    -> RenamedSource -> TcM ())
-    -- ^ Installs a read-only pass that receives the renamed syntax tree as an
-    -- argument when type checking is successful.
+  , renamedResultAction :: [CommandLineOption] -> TcGblEnv
+                                -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
+    -- ^ Modify each group after it is renamed. This is called after each
+    -- `HsGroup` has been renamed.
   , typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv
                                -> TcM TcGblEnv
     -- ^ Modify the module when it is type checked. This is called add the
@@ -82,8 +81,7 @@ data Plugin = Plugin {
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- The `Plugin` datatype have been extended by fields that allow access to the
 -- different inner representations that are generated during the compilation
--- process. These fields are `parsedResultAction`, `needsRenamedSyntax` (for
--- controlling when renamed representation is kept during typechecking),
+-- process. These fields are `parsedResultAction`, `renamedResultAction`,
 -- `typeCheckResultAction`, `spliceRunAction` and `interfaceLoadAction`.
 --
 -- The main purpose of these plugins is to help tool developers. They allow
@@ -149,19 +147,32 @@ defaultPlugin = Plugin {
         installCoreToDos      = const return
       , tcPlugin              = const Nothing
       , pluginRecompile  = impurePlugin
-      , renamedResultAction   = Nothing
+      , renamedResultAction   = \_ env grp -> return (env, grp)
       , parsedResultAction    = \_ _ -> return
       , typeCheckResultAction = \_ _ -> return
       , spliceRunAction       = \_ -> return
       , interfaceLoadAction   = \_ -> return
     }
 
+
+-- | A renamer plugin which mades the renamed source available in
+-- a typechecker plugin.
+keepRenamedSource :: [CommandLineOption] -> TcGblEnv
+                  -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
+keepRenamedSource _ gbl_env group =
+  return (gbl_env { tcg_rn_decls = update (tcg_rn_decls gbl_env)
+                  , tcg_rn_exports = update_exports (tcg_rn_exports gbl_env) }, group)
+  where
+    update_exports Nothing = Just []
+    update_exports m = m
+
+    update Nothing = Just emptyRnGroup
+    update m       = m
+
+
 type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a
 type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m ()
 
-type RenamedSource = ( HsGroup GhcRn, [LImportDecl GhcRn]
-                     , Maybe [(LIE GhcRn, Avails)], Maybe LHsDocString )
-
 -- | Perform an operation by using all of the plugins in turn.
 withPlugins :: Monad m => DynFlags -> PluginOperation m a -> a -> m a
 withPlugins df transformation input

compiler/parser/Lexer.x

@@ -68,7 +68,6 @@ module Lexer (
    explicitNamespacesEnabled,
    patternSynonymsEnabled,
    sccProfilingOn, hpcEnabled,
-   typeOperatorsEnabled,
    starIsTypeEnabled,
    addWarning,
    lexTokenStream,
@@ -2264,7 +2263,6 @@ data ExtBits
   | TypeApplicationsBit
   | StaticPointersBit
   | NumericUnderscoresBit
-  | TypeOperatorsBit
   | StarIsTypeBit
   deriving Enum
 
@@ -2334,8 +2332,6 @@ staticPointersEnabled :: ExtsBitmap -> Bool
 staticPointersEnabled = xtest StaticPointersBit
 numericUnderscoresEnabled :: ExtsBitmap -> Bool
 numericUnderscoresEnabled = xtest NumericUnderscoresBit
-typeOperatorsEnabled :: ExtsBitmap -> Bool
-typeOperatorsEnabled = xtest TypeOperatorsBit
 starIsTypeEnabled :: ExtsBitmap -> Bool
 starIsTypeEnabled = xtest StarIsTypeBit
 
@@ -2392,7 +2388,6 @@ mkParserFlags flags =
       .|. TypeApplicationsBit         `xoptBit` LangExt.TypeApplications
       .|. StaticPointersBit           `xoptBit` LangExt.StaticPointers
       .|. NumericUnderscoresBit       `xoptBit` LangExt.NumericUnderscores
-      .|. TypeOperatorsBit            `xoptBit` LangExt.TypeOperators
       .|. StarIsTypeBit               `xoptBit` LangExt.StarIsType
     optBits =
           HaddockBit        `goptBit` Opt_Haddock

compiler/parser/Parser.y

@@ -1882,7 +1882,8 @@ is connected to the first type too.
 
 type :: { LHsType GhcPs }
         : btype                        { $1 }
-        | btype '->' ctype             {% ams (sLL $1 $> $ HsFunTy noExt $1 $3)
+        | btype '->' ctype             {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
+                                       >> ams (sLL $1 $> $ HsFunTy noExt $1 $3)
                                               [mu AnnRarrow $2] }
 
 
@@ -1929,9 +1930,9 @@ tyapp :: { Located TyEl }
         | qtyconop                      { sL1 $1 $ TyElOpr (unLoc $1) }
         | tyvarop                       { sL1 $1 $ TyElOpr (unLoc $1) }
         | SIMPLEQUOTE qconop            {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
-                                               [mj AnnSimpleQuote $1] }
+                                               [mj AnnSimpleQuote $1,mj AnnVal $2] }
         | SIMPLEQUOTE varop             {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
-                                               [mj AnnSimpleQuote $1] }
+                                               [mj AnnSimpleQuote $1,mj AnnVal $2] }
 
 atype_docs :: { LHsType GhcPs }
         : atype docprev                 { sLL $1 $> $ HsDocTy noExt $1 $2 }

compiler/parser/RdrHsSyn.hs

@@ -643,13 +643,13 @@ mkGadtDecl :: [Located RdrName]
 mkGadtDecl names ty
   = (ConDeclGADT { con_g_ext  = noExt
                  , con_names  = names
-                 , con_forall = L l $ isLHsForAllTy ty
+                 , con_forall = L l $ isLHsForAllTy ty'
                  , con_qvars  = mkHsQTvs tvs
                  , con_mb_cxt = mcxt
                  , con_args   = args'
                  , con_res_ty = res_ty
                  , con_doc    = Nothing }
-    , anns1 ++ anns2 ++ anns3)
+    , anns1 ++ anns2)
   where
     (ty'@(L l _),anns1) = peel_parens ty []
     (tvs, rho) = splitLHsForAllTy ty'
@@ -660,14 +660,13 @@ mkGadtDecl names ty
     split_rho (L l (HsParTy _ ty)) ann = split_rho ty (ann++mkParensApiAnn l)
     split_rho tau                  ann = (Nothing, tau, ann)
 
-    (args, res_ty, anns3) = split_tau tau []
+    (args, res_ty) = split_tau tau
     args' = nudgeHsSrcBangs args
 
     -- See Note [GADT abstract syntax] in HsDecls
-    split_tau (L _ (HsFunTy _ (L loc (HsRecTy _ rf)) res_ty)) ann
-                                       = (RecCon (L loc rf), res_ty, ann)
-    split_tau (L l (HsParTy _ ty)) ann = split_tau ty (ann++mkParensApiAnn l)
-    split_tau tau                  ann = (PrefixCon [], tau, ann)
+    split_tau (L _ (HsFunTy _ (L loc (HsRecTy _ rf)) res_ty))
+                                   = (RecCon (L loc rf), res_ty)
+    split_tau tau                  = (PrefixCon [], tau)
 
     peel_parens (L l (HsParTy _ ty)) ann = peel_parens ty
                                                        (ann++mkParensApiAnn l)
@@ -871,6 +870,12 @@ checkTyClHdr is_cls ty
   where
     goL (L l ty) acc ann fix = go l ty acc ann fix
 
+    -- workaround to define '*' despite StarIsType
+    go _ (HsParTy _ (L l (HsStarTy _ isUni))) acc ann fix
+      = do { warnStarBndr l
+           ; let name = mkOccName tcClsName (if isUni then "★" else "*")
+           ; return (L l (Unqual name), acc, fix, ann) }
+
     go l (HsTyVar _ _ (L _ tc)) acc ann fix
       | isRdrTc tc               = return (L l tc, acc, fix, ann)
     go _ (HsOpTy _ t1 ltc@(L _ tc) t2) acc ann _fix
@@ -1748,11 +1753,19 @@ warnStarIsType span = addWarning Opt_WarnStarIsType span msg
         $$ text "Suggested fix: use" <+> quotes (text "Type")
            <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead."
 
+warnStarBndr :: SrcSpan -> P ()
+warnStarBndr span = addWarning Opt_WarnStarBinder span msg
+  where
+    msg =  text "Desugaring" <+> quotes (text "*") <+> text "in a binder"
+           <+> text "position as a type operator despite StarIsType."
+        $$ text "NB. To use (or export) this operator in"
+           <+> text "modules with StarIsType,"
+        $$ text "    including the definition module, you must qualify it."
+
 failOpFewArgs :: Located RdrName -> P a
 failOpFewArgs (L loc op) =
-  do { type_operators <- extension typeOperatorsEnabled
-     ; star_is_type <- extension starIsTypeEnabled
-     ; let msg = too_few $$ starInfo (type_operators, star_is_type) op
+  do { star_is_type <- extension starIsTypeEnabled
+     ; let msg = too_few $$ starInfo star_is_type op
      ; parseErrorSDoc loc msg }
   where
     too_few = text "Operator applied to too few arguments:" <+> ppr op

compiler/rename/RnBinds.hs

@@ -226,7 +226,7 @@ rnIPBind :: IPBind GhcPs -> RnM (IPBind GhcRn, FreeVars)
 rnIPBind (IPBind _ ~(Left n) expr) = do
     (expr',fvExpr) <- rnLExpr expr
     return (IPBind noExt (Left n) expr', fvExpr)
-rnIPBind (XCIPBind _) = panic "rnIPBind"
+rnIPBind (XIPBind _) = panic "rnIPBind"
 
 {-
 ************************************************************************

compiler/rename/RnEnv.hs

@@ -930,9 +930,8 @@ lookup_demoted rdr_name
   | Just demoted_rdr <- demoteRdrName rdr_name
     -- Maybe it's the name of a *data* constructor
   = do { data_kinds <- xoptM LangExt.DataKinds
-       ; type_operators <- xoptM LangExt.TypeOperators
        ; star_is_type <- xoptM LangExt.StarIsType
-       ; let star_info = starInfo (type_operators, star_is_type) rdr_name
+       ; let star_info = starInfo star_is_type rdr_name
        ; if data_kinds
             then do { mb_demoted_name <- lookupOccRn_maybe demoted_rdr
                     ; case mb_demoted_name of