Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC Commits: 13d7132f by Simon Peyton Jones at 2026-03-13T17:44:24+00:00 More WIP [skip ci] - - - - - 12 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Unit/External.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -37,7 +37,8 @@ the big-num package or (for plugins) the ghc package. It's not necessary to know the uniques for these guys, only their names -Note [Known-key names] +Note [Overview of +Note [Known-key names] <---- OLD VERSION ~~~~~~~~~~~~~~~~~~~~~~ It is *very* important that the compiler gives wired-in things and things with "known-key" names the correct Uniques wherever they @@ -189,7 +190,7 @@ wired in ones are defined in GHC.Builtin.Types etc. basicKnownKeyOccs :: [(OccName, Unique)] basicKnownKeyOccs - = [ ("Rational", rationalTyConKey) ] + = [ (mkTcOcc "Rational", rationalTyConKey) ] basicKnownKeyNames :: [Name] -- See Note [Known-key names] basicKnownKeyNames ===================================== compiler/GHC/Builtin/Names/TH.hs ===================================== @@ -8,10 +8,10 @@ module GHC.Builtin.Names.TH where import GHC.Prelude () -oimport GHC.Builtin.Names( mk_known_key_name ) +import GHC.Builtin.Names( mk_known_key_name ) import GHC.Unit.Types import GHC.Types.Name( Name ) -import GHC.Types.Name.Occurrence( tcName, clsName, dataName, varName, fieldName ) +import GHC.Types.Name.Occurrence( OccName, tcName, clsName, dataName, varName, fieldName ) import GHC.Types.Name.Reader( RdrName, nameRdrName ) import GHC.Types.Unique ( Unique ) import GHC.Builtin.Uniques ===================================== compiler/GHC/Builtin/Utils.hs ===================================== @@ -1,4 +1,4 @@ -oo{- +{- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} @@ -28,7 +28,7 @@ module GHC.Builtin.Utils ( -- if you find yourself wanting to look at it you might consider using -- 'lookupKnownKeyName' or 'isKnownKeyName'. knownKeyNames, - knownKeyOccMap, + KnownKeyOccMap, knownKeyOccMap, -- * Miscellaneous wiredInIds, ghcPrimIds, @@ -54,7 +54,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 ) +import GHC.Builtin.Names.TH ( templateHaskellNames, templateHaskellOccs ) import GHC.Builtin.Names import GHC.Core.ConLike ( ConLike(..) ) @@ -205,6 +205,9 @@ isKnownKeyName :: Name -> Bool isKnownKeyName n = isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap +type KnownKeyOccMap = OccEnv Name + -- See Note [Overview of known-key Names] + -- | `knownKeyOccMap` maps the OccName of a known-key to its Unique knownKeyOccMap :: OccEnv Unique knownKeyOccMap = mkOccEnv (basicKnownKeyOccs ++ templateHaskellOccs) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -117,7 +117,6 @@ import GHC.Core.Ppr ( pprOccWithTick) import GHC.Core.Type import GHC.Core.Multiplicity( pprArrowWithMultiplicity ) import GHC.Hs.Doc -import GHC.Hs.Lit (pprHsStringLit) import GHC.Generics (Generic, Generically(..)) import GHC.Types.Basic import GHC.Types.SrcLoc ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -427,8 +427,8 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var dsToIfL :: IfL a -> DsM a -- Run an Iface action in the Ds monad dsToIfl iface_action - = { env <- getGblEnv - ; setEnvs (ds_if_env env) iface_action } + = do { env <- getGblEnv + ; setEnvs (ds_if_env env) iface_action } {- @@ -561,7 +561,17 @@ dsLookupKnownKey occ then dsToIfL $ lookupImportedKnownKey occ else - do { + lookupKnownKeyOcc occ + } + +dsLookupKnownKeyOcc :: OccName -> DsM TyThing +-- Look up the known-key OccName in the current top-level GlobalRdrEnv +-- If we get a unique hit, use it; if not, panic. +dsLookupKnownKeyOcc occ + = do { gbl_rdr_env <- dsGetGlobalRdrEnv + ; case lookupGRE gbl_rdr_env (lookupOccName occ SameNameSpace) of + [name] -> dsLookupGlobal name + gres -> pprPanic "lookupKnownKeyOcc" (ppr occ $$ ppr gres) } dsLookupKnownKeyTyCon :: Name -> DsM TyCon dsLookupKnownKeyTyCon name ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -60,9 +60,11 @@ data DsGblEnv = DsGblEnv { ds_mod :: Module -- For SCC profiling , ds_fam_inst_env :: FamInstEnv -- Like tcg_fam_inst_env - , ds_gbl_rdr_env :: GlobalRdrEnv -- needed only for the following reasons: - -- - to know what newtype constructors are in scope - -- - to check whether all members of a COMPLETE pragma are in scope + , ds_gbl_rdr_env :: GlobalRdrEnv + -- The GlobalRdrEnv is needed for the following reasons: + -- - to know what newtype constructors are in scope + -- - to check whether all members of a COMPLETE pragma are in scope + -- - when looking up know-key names , ds_name_ppr_ctx :: NamePprCtx , ds_msgs :: IORef (Messages DsMessage) -- Diagnostic messages , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -32,23 +32,29 @@ module GHC.Iface.Binary ( import GHC.Prelude -import GHC.Builtin.Utils ( isKnownKeyName, lookupKnownKeyName ) -import GHC.Unit -import GHC.Unit.Module.ModIface -import GHC.Types.Name -import GHC.Platform.Profile -import GHC.Types.Unique.FM +import GHC.Builtin.Utils ( knownKeyOccMap, isKnownKeyName, lookupKnownKeyName ) + import GHC.Utils.Panic import GHC.Utils.Binary as Binary -import GHC.Data.FastMutInt -import GHC.Types.Unique import GHC.Utils.Outputable -import GHC.Types.Name.Cache + +import GHC.Types.Name +import GHC.Types.Unique.FM +import GHC.Types.Unique import GHC.Types.SrcLoc +import GHC.Types.Name.Cache + +import GHC.Unit +import GHC.Unit.Module.ModIface + +import GHC.Platform.Profile import GHC.Platform import GHC.Settings.Constants import GHC.Iface.Type (IfaceType(..), getIfaceType, putIfaceType, ifaceTypeSharedByte) +import GHC.Data.FastMutInt +import GHC.Data.Maybe( orElse ) + import Control.Monad import Data.Array import Data.Array.IO @@ -658,17 +664,18 @@ putSymbolTable bh name_count symtab = do getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) -- Create an array of Names for the symbols and add them to the NameCache -getSymbolTable bh name_cache = do +getSymbolTable bh name_cache = updateNameCache' name_cache $ \cache0 -> do { sz <- get bh :: IO Int ; mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int Name) - ; cache <- foldGet' (fromIntegral sz) bh cache0 deserialise_one + ; cache <- foldGet' (fromIntegral sz) bh cache0 (deserialise_one mut_arr) ; arr <- unsafeFreeze mut_arr - ; return (cache, arr) } + ; return (cache, arr) } where - deserialise_one :: Word -> (Unit, ModuleName, OccName, Bool) + deserialise_one :: (IOArray Int Name) + -> Word -> (Unit, ModuleName, OccName, Bool) -> OrigNameCache -> IO OrigNameCache - deserialise_one i (uid, mod_name, occ, is_known_key) cache + deserialise_one mut_arr i (uid, mod_name, occ, is_known_key) cache = case lookupOrigNameCache cache mod occ of Just name -> do { writeArray mut_arr (fromIntegral i) name @@ -692,15 +699,8 @@ getSymbolTable bh name_cache = do serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ - = assertPpr (isExternalName name) (ppr name) $ - put_ bh (moduleUnit mod, moduleName mod, nameOccName name, is_known_key) - where - (omod, is_known_key) - = case name of - WiredIn mod _ _ -> (mod,False) - External mod -> (mod,False) - KnownKey mod -> (mod,True) - _ -> pprPanic "serialiseName" (ppr name) + | (mod, occ, is_known_key) <- extNamePieces name + = put_ bh (moduleUnit mod, moduleName mod, occ, is_known_key) -- Note [Symbol table representation of names] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -184,17 +184,23 @@ loadKnownKeyOccMap -- We don't have a KnownKeyOccMap yet, so created it -- from the interface file for KnownKeyName - do { iface <- loadSrcInterface (text "lookupImportedKnownKey") - kNOWN_KEY_NAMES - NotBoot NoPkgQual + do { hsc_env <- getTopEnv + ; 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 + ; let occ_map :: KnownKeyOccMap occ_map = mkOccEnv [ (getOccName nm, nm) - | nm <- availNames (mi_exports iface) ] + | avail <- mi_exports iface + , nm <- availNames avail ] -- Record the KnownKeyOccMap in the EPS, so we will find it next time ; updateEps_ (\eps -> eps { eps_known_keys = Just occ_map }) ; return occ_map } } } + where + doc = text "Need interface for KnonwKeyNames" importDecl :: Name -> IfM lcl (MaybeErr IfaceMessage TyThing) -- Get the TyThing for this Name from an interface file ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -121,6 +121,21 @@ newtype IfLclName = IfLclName { getIfLclName :: LexicalFastString } deriving (Eq, Ord, Show) +data IfaceBndr -- Local (non-top-level) binders + = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr + | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr + deriving (Eq, Ord) + +type IfaceIdBndr = (IfaceType, IfLclName, IfaceType) -- (multiplicity, name, type) +type IfaceTvBndr = (IfLclName, IfaceKind) + +type IfaceLamBndr = (IfaceBndr, IfaceOneShot) + +data IfaceOneShot -- See Note [Preserve OneShotInfo] in "GHC.Core.Tidy" + = IfaceNoOneShot -- and Note [oneShot magic] in "GHC.Types.Id.Make" + | IfaceOneShot + + ifLclNameFS :: IfLclName -> FastString ifLclNameFS = getLexicalFastString . getIfLclName @@ -141,12 +156,6 @@ ifaceBndrType :: IfaceBndr -> IfaceType ifaceBndrType (IfaceIdBndr (_, _, t)) = t ifaceBndrType (IfaceTvBndr (_, t)) = t -type IfaceLamBndr = (IfaceBndr, IfaceOneShot) - -data IfaceOneShot -- See Note [Preserve OneShotInfo] in "GHC.Core.Tidy" - = IfaceNoOneShot -- and Note [oneShot magic] in "GHC.Types.Id.Make" - | IfaceOneShot - instance Outputable IfaceOneShot where ppr IfaceNoOneShot = text "NoOneShotInfo" ppr IfaceOneShot = text "OneShot" ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -23,7 +23,6 @@ module GHC.IfaceToCore ( tcIfaceAnnotations, tcIfaceCompleteMatches, tcIfaceExpr, -- Desired by HERMIT (#7683) tcIfaceGlobal, - tcifaceKnownKey, tcIfaceOneShot, tcTopIfaceBindings, tcIfaceImport, hydrateCgBreakInfo @@ -2037,9 +2036,6 @@ tcIfaceOneShot IfaceOneShot = OneShotLam ************************************************************************ -} -tcIfaceKnownKey :: OcName -> IfL TyThing -tcIfaceKownKey - tcIfaceGlobal :: Name -> IfL TyThing tcIfaceGlobal name | Just thing <- wiredInNameTyThing_maybe name ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -51,7 +51,7 @@ module GHC.Types.Name ( -- ** Manipulating and deconstructing 'Name's nameUnique, setNameUnique, - nameOccName, nameNameSpace, nameModule, nameModule_maybe, + nameOccName, nameNameSpace, nameModule, nameModule_maybe, extNamePieces, setNameLoc, tidyNameOcc, localiseName, @@ -317,10 +317,6 @@ isWiredIn = isWiredInName . getName isKnownKey :: NamedThing thing => thing -> Bool isKnownKey = isKnownKeyName' . getName -knownKeyTyThing_maybe :: Name -> Maybe TyThing -knownKeyTyThing_maybe (Name {n_sort = KnownKey m}) = Just m -knownKeyTyThing_maybe _ = Nothing - wiredInNameTyThing_maybe :: Name -> Maybe TyThing wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing wiredInNameTyThing_maybe _ = Nothing @@ -390,10 +386,17 @@ nameModule name = nameModule_maybe :: Name -> Maybe Module nameModule_maybe (Name { n_sort = External mod}) = Just mod -nameModule_maybe (Name { n_nort = KnownKey mod}) = Just mod +nameModule_maybe (Name { n_sort = KnownKey mod}) = Just mod nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod nameModule_maybe _ = Nothing +extNamePieces :: Name -> (Module, OccName, Bool) +-- Get the pieces of an external name, ready to serialise +extNamePieces (Name { n_occ = occ, n_sort = External mod}) = (mod, occ, False) +extNamePieces (Name { n_occ = occ, n_sort = WiredIn mod _ _}) = (mod, occ, False) +extNamePieces (Name { n_occ = occ, n_sort = KnownKey mod}) = (mod, occ, True) +extNamePieces name = pprPanic "extNamePieces" (ppr name) + is_interactive_or_from :: Module -> Module -> Bool is_interactive_or_from from mod = from == mod || isInteractiveModule mod @@ -558,17 +561,8 @@ mkExternalName uniq mod occ loc = Name { n_uniq = uniq, n_sort = External mod, n_occ = occ, n_loc = loc } -mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name -{-# INLINE mkExternalName #-} --- WATCH OUT! External Names should be in the Name Cache --- (see Note [The Name Cache] in GHC.Iface.Env), so don't just call mkExternalName --- with some fresh unique without populating the Name Cache -mkExternalName uniq mod occ loc - = Name { n_uniq = uniq, n_sort = External mod, - n_occ = occ, n_loc = loc } - mkKnownKeyName :: Unique -> Module -> OccName -> SrcSpan -> Name -{-# INLINE mkKnonwKeyName #-} +{-# INLINE mkKnownKeyName #-} mkKnownKeyName uniq mod occ loc = Name { n_uniq = uniq, n_sort = KnownKey mod, n_occ = occ, n_loc = loc } @@ -647,7 +641,7 @@ stableNameCmp (Name { n_sort = s1, n_occ = occ1 }) sort_cmp (External {}) _ = LT sort_cmp (KnownKey {}) (External {}) = GT - sort_cmp (KnownKey m1) (External m2) = m1 `stableModuleCmp` m2 + sort_cmp (KnownKey m1) (KnownKey m2) = m1 `stableModuleCmp` m2 sort_cmp (KnownKey {}) _ = LT sort_cmp (WiredIn {}) (External {}) = GT ===================================== compiler/GHC/Unit/External.hs ===================================== @@ -21,6 +21,8 @@ import GHC.Prelude import GHC.Unit import GHC.Unit.Module.ModIface +import GHC.Builtin.Utils( KnownKeyOccMap) + import GHC.Core.FamInstEnv import GHC.Core.InstEnv ( InstEnv, emptyInstEnv ) import GHC.Core.Opt.ConstantFold @@ -48,9 +50,6 @@ type PackageCompleteMatches = CompleteMatches type PackageIfaceTable = ModuleEnv ModIface -- Domain = modules in the imported packages -type KnownKeyOccMap = OccEnv Name - -- See Note [Overview of KnownKeyNames] - -- | Constructs an empty PackageIfaceTable emptyPackageIfaceTable :: PackageIfaceTable emptyPackageIfaceTable = emptyModuleEnv @@ -80,6 +79,7 @@ initExternalPackageState = EPS , eps_rule_base = mkRuleBase builtinRules , -- Initialise the EPS rule pool with the built-in rules eps_mod_fam_inst_env = emptyModuleEnv + , eps_known_keys = Nothing , eps_complete_matches = [] , eps_ann_env = emptyAnnEnv , eps_stats = EpsStats View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13d7132f7e424077af9bd90f8081cb16... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13d7132f7e424077af9bd90f8081cb16... You're receiving this email because of your account on gitlab.haskell.org.