From b29a78ef6926101338f62e84f456dac8659dc9d2 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Thu, 16 Dec 2021 09:29:51 +0100 Subject: Bump ghc-head (#1445) * Update after NoExtCon -> DataConCantHappen rename * Update html-test for Data.List revert * Fix for new Plugins datatype Co-authored-by: Krzysztof Gogolewski Co-authored-by: Matthew Pickering --- haddock-api/src/Haddock/GhcUtils.hs | 2 +- haddock-api/src/Haddock/Interface.hs | 14 ++++++++------ haddock-api/src/Haddock/Types.hs | 24 ++++++++++++------------ html-test/ref/Identifiers.html | 10 +++++----- 4 files changed, 26 insertions(+), 24 deletions(-) diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 599404a0..85e6fcf4 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -114,7 +114,7 @@ pretty = showPpr -- instantiated at DocNameI instead of (GhcPass _). -- | Like 'hsTyVarName' from GHC API, but not instantiated at (GhcPass _) -hsTyVarBndrName :: forall flag n. (XXTyVarBndr n ~ NoExtCon, UnXRec n) +hsTyVarBndrName :: forall flag n. (XXTyVarBndr n ~ DataConCantHappen, UnXRec n) => HsTyVarBndr flag n -> IdP n hsTyVarBndrName (UserTyVar _ _ name) = unXRec @n name hsTyVarBndrName (KindedTyVar _ _ name _) = unXRec @n name diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index ba7d9d30..e4934711 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -56,11 +56,11 @@ import qualified Data.Set as Set import GHC hiding (verbosity) import GHC.Data.FastString (unpackFS) import GHC.Data.Graph.Directed -import GHC.Driver.Env (hscUpdateFlags, hsc_home_unit, hsc_logger, hsc_static_plugins, hsc_units) +import GHC.Driver.Env import GHC.Driver.Monad (modifySession, withTimingM) import GHC.Driver.Session hiding (verbosity) import GHC.HsToCore.Docs (getMainDeclBinder) -import GHC.Plugins (Outputable, Plugin (..), PluginWithArgs (..), StaticPlugin (..), defaultPlugin, keepRenamedSource) +import GHC.Plugins import GHC.Tc.Types (TcGblEnv (..), TcM) import GHC.Tc.Utils.Env (tcLookupGlobal) import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv) @@ -145,10 +145,12 @@ createIfaces verbosity modules flags instIfaceMap = do let installHaddockPlugin :: HscEnv -> HscEnv - installHaddockPlugin hsc_env = hscUpdateFlags (flip gopt_set Opt_PluginTrustworthy) $ hsc_env - { hsc_static_plugins = - haddockPlugin : hsc_static_plugins hsc_env - } + installHaddockPlugin hsc_env = + let + old_plugins = hsc_plugins hsc_env + new_plugins = old_plugins { staticPlugins = haddockPlugin : staticPlugins old_plugins } + hsc_env' = hsc_env { hsc_plugins = new_plugins } + in hscUpdateFlags (flip gopt_set Opt_PluginTrustworthy) hsc_env' -- Note that we would rather use withTempSession but as long as we -- have the separate attachInstances step we need to keep the session diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 05375185..30f583b0 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -319,7 +319,7 @@ type instance NoGhcTc DocNameI = DocNameI type instance IdP DocNameI = DocName instance CollectPass DocNameI where - collectXXPat _ _ ext = noExtCon ext + collectXXPat _ _ ext = dataConCantHappen ext instance NamedThing DocName where getName (Documented name _) = name @@ -760,11 +760,11 @@ type instance XXType DocNameI = HsCoreTy type instance XHsForAllVis DocNameI = NoExtField type instance XHsForAllInvis DocNameI = NoExtField -type instance XXHsForAllTelescope DocNameI = NoExtCon +type instance XXHsForAllTelescope DocNameI = DataConCantHappen type instance XUserTyVar DocNameI = NoExtField type instance XKindedTyVar DocNameI = NoExtField -type instance XXTyVarBndr DocNameI = NoExtCon +type instance XXTyVarBndr DocNameI = DataConCantHappen type instance XCFieldOcc DocNameI = DocName type instance XXFieldOcc DocNameI = NoExtField @@ -780,7 +780,7 @@ type instance XForeignExport DocNameI = NoExtField type instance XForeignImport DocNameI = NoExtField type instance XConDeclGADT DocNameI = NoExtField type instance XConDeclH98 DocNameI = NoExtField -type instance XXConDecl DocNameI = NoExtCon +type instance XXConDecl DocNameI = DataConCantHappen type instance XDerivD DocNameI = NoExtField type instance XInstD DocNameI = NoExtField @@ -791,10 +791,10 @@ type instance XTyClD DocNameI = NoExtField type instance XNoSig DocNameI = NoExtField type instance XCKindSig DocNameI = NoExtField type instance XTyVarSig DocNameI = NoExtField -type instance XXFamilyResultSig DocNameI = NoExtCon +type instance XXFamilyResultSig DocNameI = DataConCantHappen type instance XCFamEqn DocNameI _ = NoExtField -type instance XXFamEqn DocNameI _ = NoExtCon +type instance XXFamEqn DocNameI _ = DataConCantHappen type instance XCClsInstDecl DocNameI = NoExtField type instance XCDerivDecl DocNameI = NoExtField @@ -811,23 +811,23 @@ type instance XClassDecl DocNameI = NoExtField type instance XDataDecl DocNameI = NoExtField type instance XSynDecl DocNameI = NoExtField type instance XFamDecl DocNameI = NoExtField -type instance XXFamilyDecl DocNameI = NoExtCon -type instance XXTyClDecl DocNameI = NoExtCon +type instance XXFamilyDecl DocNameI = DataConCantHappen +type instance XXTyClDecl DocNameI = DataConCantHappen type instance XHsWC DocNameI _ = NoExtField type instance XHsOuterExplicit DocNameI _ = NoExtField type instance XHsOuterImplicit DocNameI = NoExtField -type instance XXHsOuterTyVarBndrs DocNameI = NoExtCon +type instance XXHsOuterTyVarBndrs DocNameI = DataConCantHappen type instance XHsSig DocNameI = NoExtField -type instance XXHsSigType DocNameI = NoExtCon +type instance XXHsSigType DocNameI = DataConCantHappen type instance XHsQTvs DocNameI = NoExtField type instance XConDeclField DocNameI = NoExtField -type instance XXConDeclField DocNameI = NoExtCon +type instance XXConDeclField DocNameI = DataConCantHappen -type instance XXPat DocNameI = NoExtCon +type instance XXPat DocNameI = DataConCantHappen type instance XCInjectivityAnn DocNameI = NoExtField diff --git a/html-test/ref/Identifiers.html b/html-test/ref/Identifiers.html index b177266d..76487140 100644 --- a/html-test/ref/Identifiers.html +++ b/html-test/ref/Identifiers.html @@ -147,7 +147,7 @@ >, Foldableelem
  • ++, Foldableelem, elemUnqualified: 1 `Foldable``elem` [-3..3]
  • Qualified: 1 `elem` [-3..3]
  • Namespaced: `Foldable``elem`, `elem` Date: Thu, 28 Apr 2022 16:19:04 -0400 Subject: Revert "Bump ghc-head (#1445)" This reverts commit b29a78ef6926101338f62e84f456dac8659dc9d2. This should not have been merged. --- haddock-api/src/Haddock/GhcUtils.hs | 2 +- haddock-api/src/Haddock/Interface.hs | 14 ++++++-------- haddock-api/src/Haddock/Types.hs | 24 ++++++++++++------------ html-test/ref/Identifiers.html | 10 +++++----- 4 files changed, 24 insertions(+), 26 deletions(-) diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 85e6fcf4..599404a0 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -114,7 +114,7 @@ pretty = showPpr -- instantiated at DocNameI instead of (GhcPass _). -- | Like 'hsTyVarName' from GHC API, but not instantiated at (GhcPass _) -hsTyVarBndrName :: forall flag n. (XXTyVarBndr n ~ DataConCantHappen, UnXRec n) +hsTyVarBndrName :: forall flag n. (XXTyVarBndr n ~ NoExtCon, UnXRec n) => HsTyVarBndr flag n -> IdP n hsTyVarBndrName (UserTyVar _ _ name) = unXRec @n name hsTyVarBndrName (KindedTyVar _ _ name _) = unXRec @n name diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index e4934711..ba7d9d30 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -56,11 +56,11 @@ import qualified Data.Set as Set import GHC hiding (verbosity) import GHC.Data.FastString (unpackFS) import GHC.Data.Graph.Directed -import GHC.Driver.Env +import GHC.Driver.Env (hscUpdateFlags, hsc_home_unit, hsc_logger, hsc_static_plugins, hsc_units) import GHC.Driver.Monad (modifySession, withTimingM) import GHC.Driver.Session hiding (verbosity) import GHC.HsToCore.Docs (getMainDeclBinder) -import GHC.Plugins +import GHC.Plugins (Outputable, Plugin (..), PluginWithArgs (..), StaticPlugin (..), defaultPlugin, keepRenamedSource) import GHC.Tc.Types (TcGblEnv (..), TcM) import GHC.Tc.Utils.Env (tcLookupGlobal) import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv) @@ -145,12 +145,10 @@ createIfaces verbosity modules flags instIfaceMap = do let installHaddockPlugin :: HscEnv -> HscEnv - installHaddockPlugin hsc_env = - let - old_plugins = hsc_plugins hsc_env - new_plugins = old_plugins { staticPlugins = haddockPlugin : staticPlugins old_plugins } - hsc_env' = hsc_env { hsc_plugins = new_plugins } - in hscUpdateFlags (flip gopt_set Opt_PluginTrustworthy) hsc_env' + installHaddockPlugin hsc_env = hscUpdateFlags (flip gopt_set Opt_PluginTrustworthy) $ hsc_env + { hsc_static_plugins = + haddockPlugin : hsc_static_plugins hsc_env + } -- Note that we would rather use withTempSession but as long as we -- have the separate attachInstances step we need to keep the session diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 30f583b0..05375185 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -319,7 +319,7 @@ type instance NoGhcTc DocNameI = DocNameI type instance IdP DocNameI = DocName instance CollectPass DocNameI where - collectXXPat _ _ ext = dataConCantHappen ext + collectXXPat _ _ ext = noExtCon ext instance NamedThing DocName where getName (Documented name _) = name @@ -760,11 +760,11 @@ type instance XXType DocNameI = HsCoreTy type instance XHsForAllVis DocNameI = NoExtField type instance XHsForAllInvis DocNameI = NoExtField -type instance XXHsForAllTelescope DocNameI = DataConCantHappen +type instance XXHsForAllTelescope DocNameI = NoExtCon type instance XUserTyVar DocNameI = NoExtField type instance XKindedTyVar DocNameI = NoExtField -type instance XXTyVarBndr DocNameI = DataConCantHappen +type instance XXTyVarBndr DocNameI = NoExtCon type instance XCFieldOcc DocNameI = DocName type instance XXFieldOcc DocNameI = NoExtField @@ -780,7 +780,7 @@ type instance XForeignExport DocNameI = NoExtField type instance XForeignImport DocNameI = NoExtField type instance XConDeclGADT DocNameI = NoExtField type instance XConDeclH98 DocNameI = NoExtField -type instance XXConDecl DocNameI = DataConCantHappen +type instance XXConDecl DocNameI = NoExtCon type instance XDerivD DocNameI = NoExtField type instance XInstD DocNameI = NoExtField @@ -791,10 +791,10 @@ type instance XTyClD DocNameI = NoExtField type instance XNoSig DocNameI = NoExtField type instance XCKindSig DocNameI = NoExtField type instance XTyVarSig DocNameI = NoExtField -type instance XXFamilyResultSig DocNameI = DataConCantHappen +type instance XXFamilyResultSig DocNameI = NoExtCon type instance XCFamEqn DocNameI _ = NoExtField -type instance XXFamEqn DocNameI _ = DataConCantHappen +type instance XXFamEqn DocNameI _ = NoExtCon type instance XCClsInstDecl DocNameI = NoExtField type instance XCDerivDecl DocNameI = NoExtField @@ -811,23 +811,23 @@ type instance XClassDecl DocNameI = NoExtField type instance XDataDecl DocNameI = NoExtField type instance XSynDecl DocNameI = NoExtField type instance XFamDecl DocNameI = NoExtField -type instance XXFamilyDecl DocNameI = DataConCantHappen -type instance XXTyClDecl DocNameI = DataConCantHappen +type instance XXFamilyDecl DocNameI = NoExtCon +type instance XXTyClDecl DocNameI = NoExtCon type instance XHsWC DocNameI _ = NoExtField type instance XHsOuterExplicit DocNameI _ = NoExtField type instance XHsOuterImplicit DocNameI = NoExtField -type instance XXHsOuterTyVarBndrs DocNameI = DataConCantHappen +type instance XXHsOuterTyVarBndrs DocNameI = NoExtCon type instance XHsSig DocNameI = NoExtField -type instance XXHsSigType DocNameI = DataConCantHappen +type instance XXHsSigType DocNameI = NoExtCon type instance XHsQTvs DocNameI = NoExtField type instance XConDeclField DocNameI = NoExtField -type instance XXConDeclField DocNameI = DataConCantHappen +type instance XXConDeclField DocNameI = NoExtCon -type instance XXPat DocNameI = DataConCantHappen +type instance XXPat DocNameI = NoExtCon type instance XCInjectivityAnn DocNameI = NoExtField diff --git a/html-test/ref/Identifiers.html b/html-test/ref/Identifiers.html index 76487140..b177266d 100644 --- a/html-test/ref/Identifiers.html +++ b/html-test/ref/Identifiers.html @@ -147,7 +147,7 @@ >, elemFoldable
  • ++, elemFoldable, elemUnqualified: 1 `elem``Foldable` [-3..3]
  • Qualified: 1 `elem` [-3..3]
  • Namespaced: `elem``Foldable`, `elem`