[Git][ghc/ghc][master] DynFlags: don't use sdocWithDynFlags in datacon ppr
Marge Bot
gitlab at gitlab.haskell.org
Fri Jul 31 02:55:31 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00
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 changed files:
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/Ppr/TyThing.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/Types/Origin.hs
Changes:
=====================================
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
=====================================
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' }
=====================================
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 = [] }
=====================================
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
=====================================
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
=====================================
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 ...
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/175cb5b4044e6f4ad2224f54115f42e7a8b08f9b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/175cb5b4044e6f4ad2224f54115f42e7a8b08f9b
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/20200730/16337226/attachment-0001.html>
More information about the ghc-commits
mailing list