DynFlags: don't use sdocWithDynFlags in datacon ppr

We don't need to use `sdocWithDynFlags` to know whether we should
display linear types for datacon types, we already have
`sdocLinearTypes` field in `SDocContext`.  Moreover we want to remove
`sdocWithDynFlags` (#10143, #17957)).

6 files changed, 25 insertions, 24 deletions

diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs
index d8cf60ec98..3afa8180d8 100644
--- a/compiler/GHC/Core/DataCon.hs
+++ b/compiler/GHC/Core/DataCon.hs
@@ -87,9 +87,6 @@ import GHC.Utils.Binary
 import GHC.Types.Unique.Set
 import GHC.Types.Unique( mkAlphaTyVarUnique )
 
-import GHC.Driver.Session
-import GHC.LanguageExtensions as LangExt
-
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Builder as BSB
 import qualified Data.ByteString.Lazy    as LBS
@@ -1337,7 +1334,7 @@ The type of the constructor, with linear arrows replaced by unrestricted ones.
 Used when we don't want to introduce linear types to user (in holes
 and in types in hie used by haddock).
 
-3. dataConDisplayType (depends on DynFlags):
+3. dataConDisplayType (take a boolean indicating if -XLinearTypes is enabled):
 The type we'd like to show in error messages, :info and -ddump-types.
 Ideally, it should reflect the type written by the user;
 the function returns a type with arrows that would be required
@@ -1384,9 +1381,9 @@ dataConNonlinearType (MkData { dcUserTyVarBinders = user_tvbs,
        mkVisFunTys arg_tys' $
        res_ty
 
-dataConDisplayType :: DynFlags -> DataCon -> Type
-dataConDisplayType dflags dc
-  = if xopt LangExt.LinearTypes dflags
+dataConDisplayType :: Bool -> DataCon -> Type
+dataConDisplayType show_linear_types dc
+  = if show_linear_types
     then dataConWrapperType dc
     else dataConNonlinearType dc
 
diff --git a/compiler/GHC/Core/Ppr/TyThing.hs b/compiler/GHC/Core/Ppr/TyThing.hs
index 873c6ac199..a9231f8499 100644
--- a/compiler/GHC/Core/Ppr/TyThing.hs
+++ b/compiler/GHC/Core/Ppr/TyThing.hs
@@ -166,7 +166,8 @@ pprTyThing :: ShowSub -> TyThing -> SDoc
 -- We pretty-print 'TyThing' via 'IfaceDecl'
 -- See Note [Pretty-printing TyThings]
 pprTyThing ss ty_thing
-  = sdocWithDynFlags (\dflags -> pprIfaceDecl ss' (tyThingToIfaceDecl dflags ty_thing))
+  = sdocOption sdocLinearTypes $ \show_linear_types ->
+      pprIfaceDecl ss' (tyThingToIfaceDecl show_linear_types ty_thing)
   where
     ss' = case ss_how_much ss of
       ShowHeader (AltPpr Nothing)  -> ss { ss_how_much = ShowHeader ppr' }
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index bb383f6a57..59c93ef95c 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -28,6 +28,7 @@ import GHC.Iface.Recomp
 import GHC.Iface.Load
 import GHC.CoreToIface
 
+import qualified GHC.LanguageExtensions as LangExt
 import GHC.HsToCore.Usage ( mkUsageInfo, mkUsedNames, mkDependencies )
 import GHC.Types.Id
 import GHC.Types.Annotations
@@ -225,7 +226,8 @@ mkIface_ hsc_env
   = do
     let semantic_mod = canonicalizeHomeModule (hsc_dflags hsc_env) (moduleName this_mod)
         entities = typeEnvElts type_env
-        decls  = [ tyThingToIfaceDecl (hsc_dflags hsc_env) entity
+        show_linear_types = xopt LangExt.LinearTypes (hsc_dflags hsc_env)
+        decls  = [ tyThingToIfaceDecl show_linear_types entity
                  | entity <- entities,
                    let name = getName entity,
                    not (isImplicitTyThing entity),
@@ -376,12 +378,12 @@ so we may need to split up a single Avail into multiple ones.
 ************************************************************************
 -}
 
-tyThingToIfaceDecl :: DynFlags -> TyThing -> IfaceDecl
+tyThingToIfaceDecl :: Bool -> TyThing -> IfaceDecl
 tyThingToIfaceDecl _ (AnId id)      = idToIfaceDecl id
 tyThingToIfaceDecl _ (ATyCon tycon) = snd (tyConToIfaceDecl emptyTidyEnv tycon)
 tyThingToIfaceDecl _ (ACoAxiom ax)  = coAxiomToIfaceDecl ax
-tyThingToIfaceDecl dflags (AConLike cl)  = case cl of
-    RealDataCon dc -> dataConToIfaceDecl dflags dc -- for ppr purposes only
+tyThingToIfaceDecl show_linear_types (AConLike cl)  = case cl of
+    RealDataCon dc -> dataConToIfaceDecl show_linear_types dc -- for ppr purposes only
     PatSynCon ps   -> patSynToIfaceDecl ps
 
 --------------------------
@@ -397,10 +399,10 @@ idToIfaceDecl id
               ifIdInfo    = toIfaceIdInfo (idInfo id) }
 
 --------------------------
-dataConToIfaceDecl :: DynFlags -> DataCon -> IfaceDecl
-dataConToIfaceDecl dflags dataCon
+dataConToIfaceDecl :: Bool -> DataCon -> IfaceDecl
+dataConToIfaceDecl show_linear_types dataCon
   = IfaceId { ifName      = getName dataCon,
-              ifType      = toIfaceType (dataConDisplayType dflags dataCon),
+              ifType      = toIfaceType (dataConDisplayType show_linear_types dataCon),
               ifIdDetails = IfVanillaId,
               ifIdInfo    = [] }
 
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 512bf21f54..069fc1d3a6 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -2973,8 +2973,8 @@ ppr_datacons debug type_env
   = ppr_things "DATA CONSTRUCTORS" ppr_dc wanted_dcs
       -- The filter gets rid of class data constructors
   where
-    ppr_dc dc = sdocWithDynFlags (\dflags ->
-                ppr dc <+> dcolon <+> ppr (dataConDisplayType dflags dc))
+    ppr_dc dc = sdocOption sdocLinearTypes (\show_linear_types ->
+                ppr dc <+> dcolon <+> ppr (dataConDisplayType show_linear_types dc))
     all_dcs    = typeEnvDataCons type_env
     wanted_dcs | debug     = all_dcs
                | otherwise = filterOut is_cls_dc all_dcs
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 6d33be2e61..c928a529fd 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -4136,7 +4136,8 @@ checkValidDataCon dflags existential_ok tc con
       = hang herald 2 (text "on the" <+> speakNth n
                        <+> text "argument of" <+> quotes (ppr con))
 
-    data_con_display_type = dataConDisplayType dflags con
+    show_linear_types     = xopt LangExt.LinearTypes dflags
+    data_con_display_type = dataConDisplayType show_linear_types con
 
 -------------------------------
 checkNewDataCon :: DataCon -> TcM ()
@@ -4152,10 +4153,10 @@ checkNewDataCon con
           [ text "A newtype cannot have an unlifted argument type"
           , text "Perhaps you intended to use UnliftedNewtypes"
           ]
-        ; dflags <- getDynFlags
+        ; show_linear_types <- xopt LangExt.LinearTypes <$> getDynFlags
 
         ; let check_con what msg =
-               checkTc what (msg $$ ppr con <+> dcolon <+> ppr (dataConDisplayType dflags con))
+               checkTc what (msg $$ ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con))
 
         ; checkTc (ok_mult (scaledMult arg_ty1)) $
           text "A newtype constructor must be linear"
@@ -4843,10 +4844,10 @@ badGadtDecl tc_name
 
 badExistential :: DataCon -> SDoc
 badExistential con
-  = sdocWithDynFlags (\dflags ->
+  = sdocOption sdocLinearTypes (\show_linear_types ->
       hang (text "Data constructor" <+> quotes (ppr con) <+>
                   text "has existential type variables, a context, or a specialised result type")
-         2 (vcat [ ppr con <+> dcolon <+> ppr (dataConDisplayType dflags con)
+         2 (vcat [ ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)
                  , parens $ text "Enable ExistentialQuantification or GADTs to allow this" ]))
 
 badStupidTheta :: Name -> SDoc
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index f89841de92..cf43905ffb 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -286,10 +286,10 @@ pprSigSkolInfo ctxt ty
 
 pprPatSkolInfo :: ConLike -> SDoc
 pprPatSkolInfo (RealDataCon dc)
-  = sdocWithDynFlags (\dflags ->
+  = sdocOption sdocLinearTypes (\show_linear_types ->
       sep [ text "a pattern with constructor:"
           , nest 2 $ ppr dc <+> dcolon
-            <+> pprType (dataConDisplayType dflags dc) <> comma ])
+            <+> pprType (dataConDisplayType show_linear_types dc) <> comma ])
             -- pprType prints forall's regardless of -fprint-explicit-foralls
             -- which is what we want here, since we might be saying
             -- type variable 't' is bound by ...