[Git][ghc/ghc][wip/spj-reinstallable-base] Onward... [skip ci]

19 Mar 2026


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


Commits:
54a71f69 by Simon Peyton Jones at 2026-03-19T17:46:04+00:00
Onward...  [skip ci]

- - - - -


8 changed files:

- compiler/GHC/Builtin/Names.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Types.hs
- libraries/base/src/GHC/KnownKeyNames.hs


Changes:

=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -210,6 +210,7 @@ basicKnownKeyTable
     , (mkTcOcc "Bounded",      boundedClassKey)
     , (mkTcOcc "Enum",         enumClassKey)
     , (mkTcOcc "Monad",        monadClassKey)
+    , (mkTcOcc "Functor",      functorClassKey)
     ]
 
 basicKnownKeyNames :: [Name]  -- See Note [Known-key names]
@@ -218,7 +219,6 @@ basicKnownKeyNames
  ++ [   --  Classes.  *Must* include:
         --      classes that are grabbed by key (e.g., eqClassKey)
         --      classes in "Class.standardClassKeys" (quite a few)
-        functorClassName,
         realClassName,                  -- numeric
         integralClassName,              -- numeric
         fractionalClassName,            -- numeric


=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -563,7 +563,7 @@ mkNamePprCtxDs = ds_name_ppr_ctx <$> getGblEnv
 instance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where
     lookupThing = dsLookupGlobal
 
-dsLookupKnownKey :: Unique -> DsM TyThing
+dsLookupKnownKey :: KnownKeyNameKey -> DsM TyThing
 dsLookupKnownKey uniq
   = do { rebindable_path <- goptM Opt_RebindableKnownKeyNames
        ; mb_rdr_env <- if rebindable_path
@@ -575,7 +575,7 @@ dsLookupKnownKey uniq
                  Succeeded thing -> return thing
                  Failed msg -> failIfM (pprDiagnostic msg) } }
 
-dsLookupKnownKeyTyCon :: Unique -> DsM TyCon
+dsLookupKnownKeyTyCon :: KnownKeyNameKey -> DsM TyCon
 dsLookupKnownKeyTyCon uniq
   = tyThingTyCon <$> dsLookupKnownKey uniq
 


=====================================
compiler/GHC/Iface/Errors/Ppr.hs
=====================================
@@ -13,6 +13,7 @@ module GHC.Iface.Errors.Ppr
   , missingInterfaceErrorReason
   , missingInterfaceErrorDiagnostic
   , readInterfaceErrorDiagnostic
+  , defaultIfaceMessageOpts
 
   , lookingForHerald
   , cantFindErrorX


=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -4,6 +4,7 @@
 
 -}
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE NondecreasingIndentation #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -63,10 +64,7 @@ import GHC.Iface.Binary
 import GHC.Iface.Rename
 import GHC.Iface.Env
 import GHC.Iface.Errors as Iface_Errors
-
-import GHC.Rename.Env( addUsedGRE )
-import GHC.Rename.Utils( DeprecationWarnings(..) )
-
+import GHC.Iface.Errors.Ppr( defaultIfaceMessageOpts )
 import GHC.Tc.Errors.Types
 import GHC.Tc.Utils.Monad
 
@@ -101,7 +99,7 @@ import GHC.Types.SourceFile
 import GHC.Types.SafeHaskell
 import GHC.Types.TypeEnv
 import GHC.Types.Unique.DSet
-import GHC.Types.Unique.FM( listToUFM, lookupUFM )
+import GHC.Types.Unique.FM( UniqFM, listToUFM, lookupUFM )
 import GHC.Types.SrcLoc
 import GHC.Types.TyThing
 import GHC.Types.PkgQual
@@ -148,7 +146,7 @@ lookupKnownKeyName :: HasDebugCallStack
                    => Maybe GlobalRdrEnv -> KnownKeyNameKey
                    -> IfM lcl Name
 lookupKnownKeyName Nothing uniq
-  = do { known_key_name_map <- loadKnownKeyOccMap
+  = do { known_key_name_map :: UniqFM KnownKeyNameKey Name <- loadKnownKeyOccMap
        ; let name = lookupUFM known_key_name_map uniq
                     `orElse` pprPanic "lookupKnownKeyThing 1"
                                  (vcat [ text "unique:" <+> ppr uniq
@@ -162,21 +160,22 @@ lookupKnownKeyName (Just gbl_rdr_env) uniq
   --                   here is the top-level GlobalRdrEnv
   -- Look up the known-key OccName in the GlobalRdrEnv
   -- If we get a unique hit, use it; if not, panic.
+  | let occ :: OccName
+        occ = lookupUFM knownKeyUniqMap uniq
+               `orElse` pprPanic "lookupKnownKeyThing: missing key"
+                      (vcat [ text "unique:" <+> ppr uniq
+                            , text "uniq-map:" <+> ppr knownKeyUniqMap ])
   = case lookupGRE gbl_rdr_env (LookupOccName occ SameNameSpace) of
        [gre] -> do { let name = greName gre
-                   ; addUsedGRE NoDeprecationWarnings gre
-                        -- addUseGRE: don't complain about unused imports
-                        -- of known-key names when -frebindable-known-key-names
+--                   ; addUsedGRE NoDeprecationWarnings gre
+--                        -- addUseGRE: don't complain about unused imports
+--                        -- of known-key names when -frebindable-known-key-names
                    ; traceIf $ hang (text "lookupKnownKeyThing NoImplicitKnownKeyNames")
                                   2 (ppr name <+> ppr uniq)
                    ; return name }
-       []    -> pprPanic "lookupKnownKeyOcc: known-key name is not in scope" (ppr occ)
-       gres  -> pprPanic "lookupKnownKeyOcc: known-key name is ambiguously in scope" (ppr gres)
+       []    -> pprPanic "lookupKnownKeyName: known-key name is not in scope" (ppr occ)
+       gres  -> pprPanic "lookupKnownKeyName: known-key name is ambiguously in scope" (ppr gres)
   where
-     occ = lookupUFM knownKeyUniqMap uniq
-           `orElse` pprPanic "lookupKnownKeyThing 2"
-                      (vcat [ text "unique:" <+> ppr uniq
-                            , text "uniq-map:" <+> ppr knownKeyUniqMap ])
 
 loadKnownKeyOccMap :: IfM lcl KnownKeyNameMap
 loadKnownKeyOccMap
@@ -191,7 +190,10 @@ loadKnownKeyOccMap
        ; mb_res <- liftIO $ findImportedModule hsc_env kNOWN_KEY_NAMES NoPkgQual
        ; iface <- case mb_res of
            Found _ mod -> loadInterfaceWithException doc mod ImportBySystem
-           _ -> panic "loadKnownKeyOccMap"   -- ToDo tidy up
+           fr -> do { hsc_env <- getHscEnv
+                    ; pprPanic "loadKnownKeyOccMap" $
+                      missingInterfaceErrorDiagnostic defaultIfaceMessageOpts $
+                      cannotFindModule hsc_env kNOWN_KEY_NAMES fr }
 
        ; let occ_map :: KnownKeyNameMap
              occ_map = listToUFM [ (getUnique nm, nm)
@@ -201,10 +203,26 @@ loadKnownKeyOccMap
        -- Record the KnownKeyOccMap in the EPS, so we will find it next time
        ; updateEps_ (\eps -> eps { eps_known_keys = Just occ_map })
 
+#ifdef DEBUG
+       ; case checkKnownKeyNamesIface occ_map of
+            Just msg -> pprPanic "Missing exports in KnownKeyNames" msg
+            Nothing  -> return ()
+#endif
        ; return occ_map } } }
   where
     doc = text "Need interface for KnonwKeyNames"
 
+checkKnownKeyNamesIface :: KnownKeyNameMap -> Maybe SDoc
+-- Check that KnownKeyNames exports all the things defined in `basicKnownKeyTable`
+-- and the the uniques and occ-names agree
+checkKnownKeyNamesIface known_key_names_occ_map
+  | null bad_ones = Nothing
+  | otherwise     = Just (ppr bad_ones)
+  where
+    bad_ones = filter is_bad basicKnownKeyTable
+    is_bad (occ, key) = case lookupUFM known_key_names_occ_map key of
+                           Nothing   -> True
+                           Just name -> getOccName name /= occ
 
 {- *********************************************************************
 *                                                                      *


=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -70,8 +70,7 @@ import GHC.Tc.Utils.Monad
 import GHC.Parser.PostProcess ( setRdrNameSpace )
 
 import GHC.Builtin.Types
-import GHC.Builtin.Utils( knownKeyOccMap )
-import GHC.Builtin.Names( rOOT_MAIN )
+import GHC.Builtin.Names
 
 import GHC.Types.Name
 import GHC.Types.Name.Set
@@ -87,7 +86,6 @@ import GHC.Types.Basic  ( TupleSort(..), tupleSortBoxity )
 import GHC.Types.TyThing ( tyThingGREInfo )
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Utils.Outputable as Outputable
-import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DSet
 import GHC.Types.Unique.Set


=====================================
compiler/GHC/Tc/Deriv/Infer.hs
=====================================
@@ -346,7 +346,7 @@ inferConstraintsStock dit@(DerivInstTys { dit_cls_tys     = cls_tys
            -> assert (tyConTyVars rep_tc `lengthExceeds` 0) $
               -- Generic1 has a single kind variable
               assert (cls_tys `lengthIs` 1) $
-              do { functorClass <- lift $ tcLookupClass functorClassName
+              do { functorClass <- lift $ tcLookupKnownKeyClass functorClassKey
                  ; pure $ con_arg_constraints
                         $ get_gen1_constraints functorClass }
 


=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -349,6 +349,7 @@ data IfGblEnv
         -- Some information about where this environment came from;
         -- useful for debugging.
         if_doc :: SDoc,
+
         -- The type environment for the module being compiled,
         -- in case the interface refers back to it via a reference that
         -- was originally a hi-boot file.


=====================================
libraries/base/src/GHC/KnownKeyNames.hs
=====================================
@@ -11,7 +11,12 @@
 --
 
 module GHC.KnownKeyNames
-    ( Rational -- TODO: add more than rational after smoke test
-     ) where
+    ( Rational
+    , Eq, Ord, Show, Num, Bounded
+    , Foldable, Traversable
+    , IsString
+    , Functor, Monad
+    ) where
 
-import GHC.Internal.Real
+import Prelude
+import Data.String( IsString )



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54a71f69902797e60c69b57debe0125c...

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

    

Simon Peyton Jones (＠simonpj)

tags

participants (1)