Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC Commits: e65c697c by Simon Peyton Jones at 2026-03-19T00:05:50+00:00 Onward [skip ci] - - - - - 9 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Name.hs - libraries/ghc-internal/src/GHC/Internal/Base.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -129,7 +129,9 @@ import GHC.Unit.Types import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader import GHC.Types.Unique +import GHC.Types.Unique.FM import GHC.Builtin.Uniques +import GHC.Builtin.Names.TH( thKnownKeyTable ) import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Data.FastString @@ -156,7 +158,7 @@ allNameStringList = Inf.toList allNameStrings {- ************************************************************************ -* * +o* * \subsection{Local Names} * * ************************************************************************ @@ -187,6 +189,14 @@ names with uniques. These ones are the *non* wired-in ones. The wired in ones are defined in GHC.Builtin.Types etc. -} +-- | `knownKeyOccMap` maps the OccName of a known-key to its Unique +knownKeyOccMap :: OccEnv KnownKeyNameKey +knownKeyOccMap = mkOccEnv (basicKnownKeyTable ++ thKnownKeyTable) + +knownKeyUniqMap :: UniqFM KnownKeyNameKey OccName +knownKeyUniqMap = listToUFM [ (uniq, occ) + | (occ, uniq) <- basicKnownKeyTable ++ thKnownKeyTable ] + basicKnownKeyTable :: [(OccName, KnownKeyNameKey)] basicKnownKeyTable = [ (mkTcOcc "Rational", rationalTyConKey) @@ -1604,11 +1614,6 @@ tcQual modu str unique = mk_known_key_name tcName modu str unique clsQual modu str unique = mk_known_key_name clsName modu str unique dcQual modu str unique = mk_known_key_name dataName modu str unique -mk_known_key_name :: NameSpace -> Module -> FastString -> KnownKeyNameKey -> Name -{-# INLINE mk_known_key_name #-} -mk_known_key_name space modu str unique - = mkExternalName unique modu (mkOccNameFS space str) noSrcSpan - {- ************************************************************************ ===================================== compiler/GHC/Builtin/Names/TH.hs ===================================== @@ -8,9 +8,8 @@ module GHC.Builtin.Names.TH where import GHC.Prelude () -import GHC.Builtin.Names( mk_known_key_name ) import GHC.Unit.Types -import GHC.Types.Name( Name ) +import GHC.Types.Name( Name, mk_known_key_name ) import GHC.Types.Name.Occurrence( OccName, tcName, clsName, dataName, varName, fieldName ) import GHC.Types.Name.Reader( RdrName, nameRdrName ) import GHC.Types.Unique ( Unique ) ===================================== compiler/GHC/Builtin/Utils.hs ===================================== @@ -19,16 +19,15 @@ -- module GHC.Builtin.Utils ( -- * Known-key names - isKnownKeyName, - lookupKnownKeyName, - lookupKnownNameInfo, + oldIsKnownKeyName, + oldLookupKnownKeyName, + oldLookupKnownNameInfo, -- ** Internal use -- | 'knownKeyNames' is exported to seed the original name cache only; -- if you find yourself wanting to look at it you might consider using -- 'lookupKnownKeyName' or 'isKnownKeyName'. knownKeyNames, - knownKeyOccMap, knownKeyUniqMap, -- * Miscellaneous wiredInIds, ghcPrimIds, @@ -54,7 +53,7 @@ import GHC.Builtin.PrimOps.Ids import GHC.Builtin.Types import GHC.Builtin.Types.Literals ( typeNatTyCons ) import GHC.Builtin.Types.Prim -import GHC.Builtin.Names.TH ( templateHaskellNames, thKnownKeyTable ) +import GHC.Builtin.Names.TH ( templateHaskellNames ) import GHC.Builtin.Names import GHC.Core.ConLike ( ConLike(..) ) @@ -193,38 +192,34 @@ knownKeyNamesOkay all_names text ": " <> brackets (pprWithCommas (ppr . nameOccName) ns) +--------------- ToDo: get rid of these old-mechanism functions +--------------- when we complete the known-key tranitition +-------------- See #27013 + -- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a -- known-key thing. -lookupKnownKeyName :: Unique -> Maybe Name -lookupKnownKeyName u = - knownUniqueName u <|> lookupUFM_Directly knownKeysMap u +oldLookupKnownKeyName :: Unique -> Maybe Name +oldLookupKnownKeyName u = + knownUniqueName u <|> lookupUFM_Directly oldKnownKeysMap u -- TODO: remove this once all knownkey names come from providers -- | Is a 'Name' known-key? -isKnownKeyName :: Name -> Bool -isKnownKeyName n = - isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap - --- | `knownKeyOccMap` maps the OccName of a known-key to its Unique -knownKeyOccMap :: OccEnv Unique -knownKeyOccMap = mkOccEnv (basicKnownKeyTable ++ thKnownKeyTable) - -knownKeyUniqMap :: UniqFM Unique OccName -knownKeyUniqMap = listToUFM [ (uniq, occ) - | (occ, uniq) <- basicKnownKeyTable ++ thKnownKeyTable ] +oldIsKnownKeyName :: Name -> Bool +oldIsKnownKeyName n = + isJust (knownUniqueName $ nameUnique n) || elemUFM n oldKnownKeysMap -- | Maps 'Unique's to known-key names. -- -- The type is @UniqFM Name Name@ to denote that the 'Unique's used -- in the domain are 'Unique's associated with 'Name's (as opposed -- to some other namespace of 'Unique's). -knownKeysMap :: UniqFM Name Name -knownKeysMap = listToIdentityUFM knownKeyNames +oldKnownKeysMap :: UniqFM Name Name +oldKnownKeysMap = listToIdentityUFM knownKeyNames -- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by -- GHCi's ':info' command. -lookupKnownNameInfo :: Name -> SDoc -lookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of +oldLookupKnownNameInfo :: Name -> SDoc +oldLookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of -- If we do find a doc, we add comment delimiters to make the output -- of ':info' valid Haskell. Nothing -> empty ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -32,8 +32,8 @@ module GHC.Iface.Binary ( import GHC.Prelude -import GHC.Builtin.Utils ( knownKeyOccMap, isKnownKeyName, lookupKnownKeyName ) - +import GHC.Builtin.Utils ( oldIsKnownKeyName, oldLookupKnownKeyName ) +import GHC.Builtin.Names ( knownKeyOccMap ) import GHC.Utils.Panic import GHC.Utils.Binary as Binary import GHC.Utils.Outputable @@ -725,7 +725,7 @@ putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } bh name - | isKnownKeyName name + | oldIsKnownKeyName name , let (c, u) = unpkUniqueGrimly (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits = -- assert (u < 2^(22 :: Int)) put_ bh (0x80000000 @@ -758,7 +758,7 @@ getSymtabName symtab bh = do ix = fromIntegral i .&. 0x003FFFFF u = mkUniqueGrimilyWithTag tag ix in - return $! case lookupKnownKeyName u of + return $! case oldLookupKnownKeyName u of Nothing -> pprPanic "getSymtabName:unknown known-key unique" (ppr i $$ ppr u $$ char tag $$ ppr ix) Just n -> n ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -16,7 +16,8 @@ module GHC.Iface.Load ( -- Importing one thing importDecl, checkWiredInTyCon, ifCheckWiredInThing, - lookupKnownKeyThing, loadGlobalName, + lookupKnownKeyThing, lookupKnownKeyName, + loadGlobalName, -- RnM/TcM functions loadModuleInterface, loadModuleInterfaces, @@ -63,6 +64,9 @@ 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.Tc.Errors.Types import GHC.Tc.Utils.Monad @@ -134,9 +138,16 @@ import qualified GHC.Unit.Home.Graph as HUG ********************************************************************* -} lookupKnownKeyThing :: HasDebugCallStack - => Maybe GlobalRdrEnv -> Unique + => Maybe GlobalRdrEnv -> KnownKeyNameKey -> IfM lcl (MaybeErr IfaceMessage TyThing) -lookupKnownKeyThing Nothing uniq +lookupKnownKeyThing mb_gbl_rdr_env key + = do { name <- lookupKnownKeyName mb_gbl_rdr_env key + ; lookupGlobalName name } + +lookupKnownKeyName :: HasDebugCallStack + => Maybe GlobalRdrEnv -> KnownKeyNameKey + -> IfM lcl Name +lookupKnownKeyName Nothing uniq = do { known_key_name_map <- loadKnownKeyOccMap ; let name = lookupUFM known_key_name_map uniq `orElse` pprPanic "lookupKnownKeyThing 1" @@ -144,17 +155,23 @@ lookupKnownKeyThing Nothing uniq , text "occ-map" <+> ppr known_key_name_map ]) ; traceIf $ hang (text "lookupKnownKeyThing ImplicitKnownKeyNames") 2 (ppr name <+> ppr uniq) - ; lookupGlobalName name } + ; return name } -lookupKnownKeyThing (Just gbl_rdr_env) uniq - -- Look up the known-key OccName in the current top-level GlobalRdrEnv +lookupKnownKeyName (Just gbl_rdr_env) uniq + -- Just gbl_rdr_env: we have -frebindable-known-key-names on, and + -- 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. = 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 ; traceIf $ hang (text "lookupKnownKeyThing NoImplicitKnownKeyNames") 2 (ppr name <+> ppr uniq) - ; lookupGlobalName name } - gres -> pprPanic "lookupKnownKeyOcc" (ppr occ $$ ppr gres) + ; 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) where occ = lookupUFM knownKeyUniqMap uniq `orElse` pprPanic "lookupKnownKeyThing 2" ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2960,7 +2960,7 @@ tcRnGetInfo hsc_env name ; thing <- tcRnLookupName' name ; fixity <- lookupFixityRn name ; (cls_insts, fam_insts) <- lookupInsts thing - ; let info = lookupKnownNameInfo name + ; let info = oldLookupKnownNameInfo name ; return (thing, fixity, cls_insts, fam_insts, info) } ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -50,6 +50,8 @@ module GHC.Types.Name ( mkFCallName, mkExternalName, mkWiredInName, mkKnownKeyName, + mk_known_key_name, -- Temporary. ToDo: get rid of me #27013 + -- ** Manipulating and deconstructing 'Name's nameUnique, setNameUnique, nameOccName, nameNameSpace, nameModule, nameModule_maybe, extNamePieces, @@ -161,15 +163,28 @@ To implement all this, here are the moving parts: eqClassKey = mkPreludeClassUnique 3 * All the known-key names are gathered in one table: - basicKnownKeyTable :: [(OccName, KnownKeyNameKey)] - basicKnownKeyTable - = [ (mkTcOcc "Rational", rationalTyConKey) - , (mkTcOcc "Eq", eqClassKey) - ... etc ... + basicKnownKeyTable :: [(OccName, KnownKeyNameKey)] + basicKnownKeyTable + = [ (mkTcOcc "Rational", rationalTyConKey) + , (mkTcOcc "Eq", eqClassKey) + ... etc ... + + INVARIANT (KnownKeyInvariant): It is a requirement that all known-key names + have distinct OccNames. (We could have multiple name-spaces, but in practice + this is not an onerous restriction.) + +* Because of (KnownKeyInvariant) we can turn that table into two mappings: + + knownKeyOccMap :: OccEnv KnownKeyNameKey + knownKeyOccMap = mkOccEnv (basicKnownKeyTable ++ thKnownKeyTable) -* INVARIANT: It is a requirement that all known-key names have distinct - OccNames. (We could have multiple name-spaces, but in practice this is not an - onerous restriction.) + knownKeyUniqMap :: UniqFM KnownKeyNameKey OccName + +* There are two flags that control the treatment of known-key names: + -frebindable-known-key-names + -fdefines-known-key-names + +* When processing source code, /without/ -frebindable Note [About the NameSorts] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -360,6 +375,14 @@ hasKnownKey :: Uniquable a => a -> KnownKeyNameKey -> Bool -- See if a thing has a particular known key hasKnownKey = hasKey +-- ToDo: get rid of this function when we complete the known-key name transition +-- see #27013 +mk_known_key_name :: NameSpace -> Module -> FastString -> KnownKeyNameKey -> Name +{-# INLINE mk_known_key_name #-} +mk_known_key_name space modu str unique + = mkExternalName unique modu (mkOccNameFS space str) noSrcSpan + + {- ********************************************************************* * * ===================================== libraries/ghc-internal/src/GHC/Internal/Base.hs ===================================== @@ -82,6 +82,9 @@ Other Prelude modules are much easier with fewer complex dependencies. {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-} +{-# OPTIONS_GHC -fdefines-known-key-names #-} + -- Defines Monad + -- -Wno-orphans is needed for things like: -- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 {-# OPTIONS_GHC -Wno-orphans #-} ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs ===================================== @@ -31,7 +31,9 @@ module GHC.Internal.TH.Lift import GHC.Internal.TH.Syntax import GHC.Internal.TH.Monad -import qualified GHC.Internal.TH.Lib as Lib (litE) -- See wrinkle (W4) of Note [Tracking dependencies on primitives] +import qualified GHC.Internal.TH.Lib as Lib (litE) + -- See wrinkle (W4) of Note [Tracking dependencies on primitives] +import GHC.Internal.Base( Monad ) -- Needed for known-key lookup import GHC.Internal.Data.Either import GHC.Internal.Base (String, Void, map, mapM, ord, return, (.)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e65c697c3dc0d98e5a4df391e55dda3a... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e65c697c3dc0d98e5a4df391e55dda3a... You're receiving this email because of your account on gitlab.haskell.org.