[Git][ghc/ghc][wip/spj-reinstallable-base] Two things

17 Mar 2026

Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC


Commits:
9308eece by Simon Peyton Jones at 2026-03-17T13:52:15+00:00
Two things

* Use -frebindable-known-key-names and -fdefines-known-key-names to control
  the known-key mechanism.

* Use the new mechanism for Eq, Ord, Show, Traversable, Foldable

- - - - -


15 changed files:

- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Utils/Env.hs
- libraries/base/base.cabal.in
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Classes.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs


Changes:

=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -193,7 +193,13 @@ wired in ones are defined in GHC.Builtin.Types etc.
 
 basicKnownKeyTable :: [(OccName, Unique)]
 basicKnownKeyTable
-  = [ (mkTcOcc "Rational", rationalTyConKey) ]
+  = [ (mkTcOcc "Rational", rationalTyConKey)
+    , (mkTcOcc "Eq", eqClassKey)
+    , (mkTcOcc "Ord", ordClassKey)
+    , (mkTcOcc "Show", showClassKey)
+    , (mkTcOcc "Foldable", foldableClassKey)
+    , (mkTcOcc "Traversable", traversableClassKey)
+    ]
 
 basicKnownKeyNames :: [Name]  -- See Note [Known-key names]
 basicKnownKeyNames
@@ -201,8 +207,6 @@ basicKnownKeyNames
  ++ [   --  Classes.  *Must* include:
         --      classes that are grabbed by key (e.g., eqClassKey)
         --      classes in "Class.standardClassKeys" (quite a few)
-        eqClassName,                    -- mentioned, derivable
-        ordClassName,                   -- derivable
         boundedClassName,               -- derivable
         numClassName,                   -- mentioned, numeric
         enumClassName,                  -- derivable
@@ -218,8 +222,6 @@ basicKnownKeyNames
         isStringClassName,
         applicativeClassName,
         alternativeClassName,
-        foldableClassName,
-        traversableClassName,
         semigroupClassName, sappendName,
         monoidClassName, memptyName, mappendName, mconcatName,
 
@@ -315,9 +317,6 @@ basicKnownKeyNames
         -- Ix stuff
         ixClassName,
 
-        -- Show stuff
-        showClassName,
-
         -- Read stuff
         readClassName,
 
@@ -1010,10 +1009,8 @@ inlineIdName :: Name
 inlineIdName            = varQual gHC_MAGIC (fsLit "inline") inlineIdKey
 
 -- Base classes (Eq, Ord, Functor)
-fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name
-eqClassName       = clsQual gHC_CLASSES (fsLit "Eq")      eqClassKey
+fmapName, eqName, geName, functorClassName :: Name
 eqName            = varQual gHC_CLASSES (fsLit "==")      eqClassOpKey
-ordClassName      = clsQual gHC_CLASSES (fsLit "Ord")     ordClassKey
 geName            = varQual gHC_CLASSES (fsLit ">=")      geClassOpKey
 functorClassName  = clsQual gHC_INTERNAL_BASE    (fsLit "Functor") functorClassKey
 fmapName          = varQual gHC_INTERNAL_BASE    (fsLit "fmap")    fmapClassOpKey
@@ -1038,8 +1035,7 @@ pureAName            = varQual gHC_INTERNAL_BASE (fsLit "pure")        pureAClas
 thenAName            = varQual gHC_INTERNAL_BASE (fsLit "*>")          thenAClassOpKey
 
 -- Classes (Foldable, Traversable)
-foldableClassName, traversableClassName :: Name
-foldableClassName     = clsQual  gHC_INTERNAL_DATA_FOLDABLE       (fsLit "Foldable")    foldableClassKey
+traversableClassName :: Name
 traversableClassName  = clsQual  gHC_INTERNAL_DATA_TRAVERSABLE    (fsLit "Traversable") traversableClassKey
 
 -- Classes (Semigroup, Monoid)
@@ -1427,10 +1423,6 @@ getFieldName, setFieldName :: Name
 getFieldName   = varQual gHC_INTERNAL_RECORDS (fsLit "getField") getFieldClassOpKey
 setFieldName   = varQual gHC_INTERNAL_RECORDS (fsLit "setField") setFieldClassOpKey

--- Class Show
-showClassName :: Name
-showClassName   = clsQual gHC_INTERNAL_SHOW (fsLit "Show")      showClassKey
-
 -- Class Read
 readClassName :: Name
 readClassName   = clsQual gHC_INTERNAL_READ (fsLit "Read")      readClassKey
@@ -2650,14 +2642,9 @@ derivableClassKeys
   = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey,
       boundedClassKey, showClassKey, readClassKey ]
 
-
+interactiveClassKeys :: [Unique]
 -- These are the "interactive classes" that are consulted when doing
 -- defaulting. Does not include Num or IsString, which have special
 -- handling.
-interactiveClassNames :: [Name]
-interactiveClassNames
-  = [ showClassName, eqClassName, ordClassName, foldableClassName
-    , traversableClassName ]
-
-interactiveClassKeys :: [Unique]
-interactiveClassKeys = map getUnique interactiveClassNames
+interactiveClassKeys = [ showClassKey, eqClassKey, ordClassKey
+                       , foldableClassKey, traversableClassKey ]


=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -1382,9 +1382,7 @@ languageExtensions :: Maybe Language -> [LangExt.Extension]
 languageExtensions Nothing = languageExtensions (Just defaultLanguage)
 
 languageExtensions (Just Haskell98)
-    = [LangExt.ImplicitPrelude,
-       LangExt.ImplicitKnownKeyNames,
-       -- See Note [When is StarIsType enabled]
+    = [-- See Note [When is StarIsType enabled]
        LangExt.StarIsType,
        LangExt.CUSKs,
        LangExt.MonomorphismRestriction,
@@ -1405,9 +1403,7 @@ languageExtensions (Just Haskell98)
       ]
 
 languageExtensions (Just Haskell2010)
-    = [LangExt.ImplicitPrelude,
-       LangExt.ImplicitKnownKeyNames,
-       -- See Note [When is StarIsType enabled]
+    = [-- See Note [When is StarIsType enabled]
        LangExt.StarIsType,
        LangExt.CUSKs,
        LangExt.MonomorphismRestriction,
@@ -1425,9 +1421,7 @@ languageExtensions (Just Haskell2010)
        ]
 
 languageExtensions (Just GHC2021)
-    = [LangExt.ImplicitPrelude,
-       LangExt.ImplicitKnownKeyNames,
-       -- See Note [When is StarIsType enabled]
+    = [-- See Note [When is StarIsType enabled]
        LangExt.StarIsType,
        LangExt.MonomorphismRestriction,
        LangExt.TraditionalRecordSyntax,


=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -149,8 +149,6 @@ extensionName = \case
   LangExt.QuasiQuotes -> "QuasiQuotes"
   LangExt.ImplicitParams -> "ImplicitParams"
   LangExt.ImplicitPrelude -> "ImplicitPrelude"
-  LangExt.ImplicitKnownKeyNames -> "ImplicitKnownKeyNames"
-  LangExt.DefinesKnownKeyNames -> "DefinesKnownKeyNames"
   LangExt.ScopedTypeVariables -> "ScopedTypeVariables"
   LangExt.AllowAmbiguousTypes -> "AllowAmbiguousTypes"
   LangExt.UnboxedTuples -> "UnboxedTuples"
@@ -889,6 +887,10 @@ data GeneralFlag
 
    | Opt_G_NoStateHack
    | Opt_G_NoOptCoercion
+
+   -- Known-key names
+   | Opt_DefinesKnownKeyNames
+   | Opt_RebindableKnownKeyNames
    deriving (Eq, Show, Enum)
 
 -- | The set of flags which affect optimisation for the purposes of
@@ -1001,7 +1003,6 @@ data WarningFlag =
    | Opt_WarnRedundantConstraints
    | Opt_WarnHiShadows
    | Opt_WarnImplicitPrelude
-   -- TODO: Opt_WarnImplicitKnownKeyNames
    | Opt_WarnIncompletePatterns
    | Opt_WarnIncompleteUniPatterns
    | Opt_WarnIncompletePatternsRecUpd


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2665,7 +2665,11 @@ fFlagsDeps = [
   flagSpec "break-points"                     Opt_InsertBreakpoints,
   flagSpec "info-table-map"                   Opt_InfoTableMap,
   flagSpec "info-table-map-with-stack"        Opt_InfoTableMapWithStack,
-  flagSpec "info-table-map-with-fallback"     Opt_InfoTableMapWithFallback
+  flagSpec "info-table-map-with-fallback"     Opt_InfoTableMapWithFallback,
+
+  -- Known-key names
+  flagSpec "defines-known-key-names"          Opt_DefinesKnownKeyNames,
+  flagSpec "rebindable-known-key-names"       Opt_RebindableKnownKeyNames
   ]
   ++ fHoleFlags
 


=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -567,10 +567,10 @@ instance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where
 
 dsLookupKnownKey :: Unique -> DsM TyThing
 dsLookupKnownKey uniq
-  = do { normal_path <- xoptM LangExt.ImplicitKnownKeyNames
-       ; mb_rdr_env <- if normal_path
-                       then return Nothing
-                       else Just <$> dsGetGlobalRdrEnv
+  = do { rebindable_path <- goptM Opt_RebindableKnownKeyNames
+       ; mb_rdr_env <- if rebindable_path
+                       then Just <$> dsGetGlobalRdrEnv
+                       else return Nothing
        ; dsToIfL $
          do { mb_res <- lookupKnownKeyThing mb_rdr_env uniq
             ; case mb_res of


=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -252,7 +252,7 @@ newTopVanillaSrcBinder occ loc
   = do { this_mod <- getModule
 
        -- See if this bindings is for a known-key name, and if so get its Unique
-       ; defines_known_keys <- xoptM LangExt.DefinesKnownKeyNames
+       ; defines_known_keys <- goptM Opt_DefinesKnownKeyNames
        ; let mb_uniq :: Maybe Unique
              mb_uniq | defines_known_keys = lookupOccEnv knownKeyOccMap occ
                      | otherwise          = Nothing


=====================================
compiler/GHC/Tc/Gen/Default.hs
=====================================
@@ -157,7 +157,8 @@ tcDefaultDecls decls =
       -- typeclass when typechecking such a default declaration. To do this, we wrap
       -- calls of 'tcLookupClass' in 'tryTc'.
       (True, [L _ (DefaultDecl _ Nothing [])]) -> do
-        h2010_dflt_clss <- foldMapM (fmap maybeToList . fmap fst . tryTc . tcLookupClass) =<< getH2010DefaultNames
+        h2010_dflt_clss <- foldMapM (fmap maybeToList . fmap fst . tryTc . tcLookupKnownKeyClass)
+                           =<< getH2010DefaultKeys
         case NE.nonEmpty h2010_dflt_clss of
           Nothing -> return []
           Just h2010_dflt_clss' -> toClassDefaults h2010_dflt_clss' decls
@@ -176,18 +177,21 @@ tcDefaultDecls decls =
     --    No extensions:       Num
     --    OverloadedStrings:   add IsString
     --    ExtendedDefaults:    add Show, Eq, Ord, Foldable, Traversable
-    getH2010DefaultClasses = mapM tcLookupClass =<< getH2010DefaultNames
-    getH2010DefaultNames
+    getH2010DefaultClasses = do { keys <- getH2010DefaultKeys
+                                ; mapM tcLookupKnownKeyClass keys }
+
+    getH2010DefaultKeys :: TcM (NonEmpty Unique)
+    getH2010DefaultKeys
       = do { ovl_str   <- xoptM LangExt.OverloadedStrings
            ; ext_deflt <- xoptM LangExt.ExtendedDefaultRules
            ; let deflt_str = if ovl_str
-                              then [isStringClassName]
+                              then [isStringClassKey]
                               else []
            ; let deflt_interactive = if ext_deflt
-                                  then interactiveClassNames
+                                  then interactiveClassKeys
                                   else []
            ; let extra_clss_names = deflt_str ++ deflt_interactive
-           ; return $ numClassName :| extra_clss_names
+           ; return $ numClassKey :| extra_clss_names
            }
     declarationParts :: NonEmpty Class -> LDefaultDecl GhcRn -> TcM (Maybe (Maybe Class, LDefaultDecl GhcRn, [Type]))
     declarationParts h2010_dflt_clss decl@(L locn (DefaultDecl _ mb_cls_name dflt_hs_tys))


=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -29,6 +29,8 @@ module GHC.Tc.Utils.Env(
         addTypecheckedBinds, addEvBinds, addTopEvBinds,
         failIllegalTyCon, failIllegalTyVar,
 
+        tcLookupKnownKeyGlobal, tcLookupKnownKeyTyCon, tcLookupKnownKeyClass,
+
         -- Local environment
         tcExtendKindEnv, tcExtendKindEnvList,
         tcExtendTyVarEnv, tcExtendNameTyVarEnv,
@@ -497,6 +499,39 @@ to bring the data constructor A into scope. We thus emit the following message:
       Add ‘A’ to the import list in the import of M1
 
 ************************************************************************
+*                                                                      *
+                Looking up known-key things
+*                                                                      *
+************************************************************************
+-}
+
+tcLookupKnownKeyGlobal :: Unique -> TcM TyThing
+tcLookupKnownKeyGlobal uniq
+  = do { rebindable_path <- goptM Opt_RebindableKnownKeyNames
+       ; mb_rdr_env <- if rebindable_path
+                       then Just <$> getGlobalRdrEnv
+                       else return Nothing
+       ; mb_thing <- initIfaceTcRn (lookupKnownKeyThing mb_rdr_env uniq)
+       ; case mb_thing of
+           Succeeded thing -> return thing
+           Failed msg      -> failWithTc (TcRnInterfaceError msg) }
+
+tcLookupKnownKeyClass :: Unique -> TcM Class
+tcLookupKnownKeyClass uniq
+  = do { thing <- tcLookupKnownKeyGlobal uniq
+       ; case thing of
+           ATyCon tc | Just cls <- tyConClass_maybe tc
+                     -> return cls
+           _  -> wrongThingErr WrongThingClass (AGlobal thing) (getName thing) }
+
+tcLookupKnownKeyTyCon :: Unique -> TcM TyCon
+tcLookupKnownKeyTyCon uniq
+  = do { thing <- tcLookupKnownKeyGlobal uniq
+       ; case thing of
+           ATyCon tc -> return tc
+           _  -> wrongThingErr WrongThingClass (AGlobal thing) (getName thing) }
+
+{- *********************************************************************
 *                                                                      *
                 Extending the global environment
 *                                                                      *
@@ -955,15 +990,8 @@ tcExtendRules lcl_rules thing_inside
 
 tcMetaKnownKeyTy :: HasDebugCallStack => Unique -> TcM Type
 tcMetaKnownKeyTy uniq
-  = do { normal_path <- xoptM LangExt.ImplicitKnownKeyNames
-       ; mb_rdr_env <- if normal_path
-                       then return Nothing
-                       else Just <$> getGlobalRdrEnv
-       ; mb_thing <- initIfaceTcRn (lookupKnownKeyThing mb_rdr_env uniq)
-       ; case mb_thing of
-           Succeeded (ATyCon tc) -> return (mkTyConTy tc)
-           Succeeded thing -> wrongThingErr WrongThingTyCon (AGlobal thing) (getName thing)
-           Failed msg      -> failWithTc (TcRnInterfaceError msg) }
+  = do { tc <- tcLookupKnownKeyTyCon uniq
+       ; return (mkTyConTy tc) }
 
 tcMetaTy :: Name -> TcM Type
 -- Given the name of a Template Haskell data type,
@@ -1035,9 +1063,9 @@ tcGetDefaultTys
               { extDef <- if extended_defaults
                           then do { list_ty <- tcMetaTy listTyConName
                                   ; integer_ty <- tcMetaTy integerTyConName
-                                  ; foldableClass <- tcLookupClass foldableClassName
-                                  ; showClass <- tcLookupClass showClassName
-                                  ; eqClass <- tcLookupClass eqClassName
+                                  ; foldableClass <- tcLookupKnownKeyClass foldableClassKey
+                                  ; showClass <- tcLookupKnownKeyClass showClassKey
+                                  ; eqClass <- tcLookupKnownKeyClass eqClassKey
                                   ; pure $ defaultEnv
                                     [ builtinDefaults foldableClass [list_ty]
                                     , builtinDefaults showClass [unitTy, integer_ty, doubleTy]


=====================================
libraries/base/base.cabal.in
=====================================
@@ -28,11 +28,15 @@ extra-doc-files:
 
 Library
     default-language: Haskell2010
-    default-extensions: NoImplicitPrelude, NoImplicitKnownKeyNames
+    default-extensions: NoImplicitPrelude
     build-depends:
         ghc-internal == @ProjectVersionForLib@.*,
         ghc-prim,
 
+    -- Set -frebindable-known-key-names,
+    -- since GHC.KnownKeyNames isn't available yet
+    ghc-options: -frebindable-known-key-names
+
     exposed-modules:
           Control.Applicative
         , Control.Concurrent


=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -571,5 +571,9 @@ Library
     -- as it's magic.
     ghc-options: -this-unit-id ghc-internal
 
+    -- Set -frebindable-known-key-names,
+    -- since GHC.KnownKeyNames isn't available yet
+    ghc-options: -frebindable-known-key-names
+
     -- Make sure we don't accidentally regress into anti-patterns
     ghc-options: -Wcompat -Wnoncanonical-monad-instances


=====================================
libraries/ghc-internal/src/GHC/Internal/Classes.hs
=====================================
@@ -7,6 +7,9 @@
 {-# LANGUAGE UndecidableSuperClasses #-}
   -- Because of the type-variable superclasses for tuples
 
+{-# LANGUAGE_GHC -fdefines-known-key-names #-}
+    -- Defines Eq, Ord
+
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 -- -Wno-unused-imports needed for the GHC.Internal.Tuple import below. Sigh.
 


=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
=====================================
@@ -6,6 +6,9 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE TypeOperators #-}
 
+{-# LANGUAGE_GHC -fdefines-known-key-names #-}
+    -- Defines Foldable
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Internal.Data.Foldable


=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
=====================================
@@ -7,6 +7,9 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
+{-# LANGUAGE_GHC -fdefines-known-key-names #-}
+    -- Defines Traversable
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Internal.Data.Traversable


=====================================
libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
=====================================
@@ -55,8 +55,6 @@ data Extension
    | QuasiQuotes
    | ImplicitParams
    | ImplicitPrelude
-   | ImplicitKnownKeyNames   -- See Note [Overview of known-key names]
-   | DefinesKnownKeyNames    -- See Note [Overview of known-key names]
    | ScopedTypeVariables
    | AllowAmbiguousTypes
    | UnboxedTuples


=====================================
libraries/ghc-internal/src/GHC/Internal/Real.hs
=====================================
@@ -1,7 +1,9 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE DefinesKnownKeyNames #-}
 {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples, BangPatterns #-}
+
+{-# OPTIONS_GHC -fdefines-known-key-names #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
+
 {-# OPTIONS_HADDOCK not-home #-}
 
 -----------------------------------------------------------------------------



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9308eeceea20f751e7f2609addce5439...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9308eeceea20f751e7f2609addce5439...
You're receiving this email because of your account on gitlab.haskell.org.

    

Simon Peyton Jones (＠simonpj)

tags

participants (1)