Simon Peyton Jones pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: 50ba27b5 by Simon Peyton Jones at 2026-05-11T13:24:29+01:00 Fix krep stuff - - - - - 9 changed files: - compiler/GHC/Builtin.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types/LclEnv.hs - compiler/GHC/Tc/Utils/Env.hs Changes: ===================================== compiler/GHC/Builtin.hs ===================================== @@ -243,10 +243,10 @@ How known-occ entities work tcLookupKnownOccTyCon :: KnownOcc -> TcM TyCon dsLookupKnownOccTyCon :: KnownOcc -> DsM TyCon - The first thing we do is to get the `KnownNameSource`, via `getKnownKeySource`. + The first thing we do is to get the `KnownEntitySource`, via `getKnownKeySource`. There are then two cases, covered in the following sections. -* Known-occ lookup (normal case: KNS_FromModule) +* Known-occ lookup (normal case: KES_FromModule) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In normal client code, suppose the desugarer calls dsLookupKnownKeyTyCon rationalTyConKey @@ -267,7 +267,7 @@ How known-occ entities work Now it can simply look up `rationalTyConKey` in the `eps_known_keys`. Easy! See `GHC.Iface.Load.lookupKnownKeyThing` and `lookupKnownOccThing`. -* Known-occ lookup (base case: KNS_InScope) +* Known-occ lookup (base case: KES_InScope) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We can't follow the above plan when compiling modules in `base` or `ghc-internal` because GHC.Essentials has not yet been compiled! Instead, we use (roughly) whatever is in @@ -277,7 +277,7 @@ How known-occ entities work * We switch on -frebindable-known-names - * That ensures that we pass `KNS_InScope gbl_rdr_env` to `lookupKnownKeyThing` + * That ensures that we pass `KES_InScope gbl_rdr_env` to `lookupKnownKeyThing` * Suppose we are looking up the known-occ entity "wombat". The key function is `lookupKnownGRE`: @@ -366,6 +366,16 @@ Wrinkles Alternative: export all wired-in entities from GHC.Essentials. But that would simply bloat the interface for no good reason. +(KN4) In a KES_InScope record we keep, for the module being compiled + ke_rdr_env :: GlobalRdrEnv + ke_gbl_type_env :: TypeEnv + ke_lcl_type_env :: TcTypeEnv + We need the latter two to support `tcLookupKnownOccId` and friends. We need both + the global `TypeEnv` and the local `TcTypeEnv` because during typechecking we + keeps types and classes in the global type envt, but `Id`s in the local type envt. + (Ids move to the global type env during zonking; see `zonkTopDecls`.) + + Note [Recipe for adding a known-occ name] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To make `wombat` into a known-occ name, you do the following: ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -572,15 +572,16 @@ mkNamePprCtxDs = ds_name_ppr_ctx <$> getGblEnv * * ********************************************************************* -} -dsGetKnownKeySource :: DsM KnownNameSource +dsGetKnownKeySource :: DsM KnownEntitySource dsGetKnownKeySource = do { rebindable_path <- goptM Opt_RebindableKnownNames ; if rebindable_path then do { env <- getGblEnv - ; return (KNS_InScope (ds_mod env) - (ds_gbl_rdr_env env) - (ds_type_env env)) } - else return KNS_FromModule } + ; return (KES_InScope { ke_mod = ds_mod env + , ke_rdr_env = ds_gbl_rdr_env env + , ke_gbl_type_env = ds_type_env env + , ke_lcl_type_env = emptyNameEnv }) } + else return KES_FromModule } -------------------------------------- -- Lookups for known-occ things ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Iface.Load ( loadGlobalName, -- Known-occ things - KnownNameSource(..), + KnownEntitySource(..), lookupKnownKeyThing, lookupKnownKeyName, lookupKnownOccThing, lookupKnownOccName, loadKnownKeyOccMaps, lookupKnownGRE, @@ -155,24 +155,28 @@ import qualified GHC.Unit.Home.Graph as HUG * * ********************************************************************* -} -data KnownNameSource - = KNS_InScope Module GlobalRdrEnv TypeEnv - -- ^ Look up the known-occ name in this GlobalRdrEnv, which - -- is the top-level scope of the current module. +data KnownEntitySource -- See Note [Overview of known entities] + = KES_InScope { ke_mod :: Module + , ke_rdr_env :: GlobalRdrEnv + , ke_gbl_type_env :: TypeEnv + , ke_lcl_type_env :: TcTypeEnv } + -- ^ Look up the known-occ name in this GlobalRdrEnv/Type, which + -- reflect the top-level scope of the current module. -- This happens when -frebindable-known-name is set, usually when - -- we are compiling `ghc-internal` or `base` + -- we are compiling `ghc-internal` or `base` + -- Why both global and local type env? See (KN4) in Note [Overview of known entities] - | KNS_FromModule + | KES_FromModule -- ^ Look up the known-occ name in the export list of GHC.Essentials -- This is the "normal path", and happens when -frebindable-known-names -- is /not/ set -instance Outputable KnownNameSource where - ppr KNS_FromModule = text "FromModule" - ppr (KNS_InScope _ rdr_env _) = text "InScope" <> braces (ppr rdr_env) +instance Outputable KnownEntitySource where + ppr KES_FromModule = text "FromModule" + ppr (KES_InScope { ke_rdr_env = rdr_env }) = text "InScope" <> braces (ppr rdr_env) lookupKnownKeyThing :: HasDebugCallStack - => KnownKey -> KnownNameSource + => KnownKey -> KnownEntitySource -> IfM lcl (MaybeErr IfaceMessage TyThing) lookupKnownKeyThing key kk_ns = do { mb_name <- lookupKnownKeyName key kk_ns @@ -181,13 +185,13 @@ lookupKnownKeyThing key kk_ns Succeeded name -> lookupKnownName kk_ns name } lookupKnownKeyName :: HasDebugCallStack - => KnownKey -> KnownNameSource + => KnownKey -> KnownEntitySource -> IfM lcl (MaybeErr IfaceMessage Name) -lookupKnownKeyName key KNS_FromModule +lookupKnownKeyName key KES_FromModule = do { (kk_map, _) <- loadKnownKeyOccMaps ; return $ lookupKnownKeysMap kk_map key } -lookupKnownKeyName key (KNS_InScope _ gbl_rdr_env _) +lookupKnownKeyName key (KES_InScope { ke_rdr_env = gbl_rdr_env }) -- Just gbl_rdr_env: we have -frebindable-known-names on, and -- here is the top-level GlobalRdrEnv -- Look up the /un-qualified/ known-key OccName in the GlobalRdrEnv @@ -224,7 +228,7 @@ lookupKnownGRE rdr_env occ gres = lookupGRE rdr_env (LookupOccName occ SameNameSpace) lookupKnownOccThing :: HasDebugCallStack - => KnownOcc -> KnownNameSource + => KnownOcc -> KnownEntitySource -> IfM lcl (MaybeErr IfaceMessage TyThing) lookupKnownOccThing occ kk_ns = do { mb_name <- lookupKnownOccName occ kk_ns @@ -233,15 +237,15 @@ lookupKnownOccThing occ kk_ns Succeeded name -> lookupKnownName kk_ns name } lookupKnownOccName :: HasDebugCallStack - => KnownOcc -> KnownNameSource + => KnownOcc -> KnownEntitySource -> IfM lcl (MaybeErr IfaceMessage Name) -lookupKnownOccName occ KNS_FromModule +lookupKnownOccName occ KES_FromModule = do { (_, occ_map) <- loadKnownKeyOccMaps ; case lookupOccEnv occ_map occ of Just name -> return (Succeeded name) Nothing -> return (Failed (MissingKnownKey3 occ)) } -lookupKnownOccName occ (KNS_InScope _ gbl_rdr_env _) +lookupKnownOccName occ (KES_InScope { ke_rdr_env = gbl_rdr_env }) -- Just gbl_rdr_env: we have -frebindable-known-names on, and -- here is the top-level GlobalRdrEnv -- Look up the /un-qualified/ known-occ OccName in the GlobalRdrEnv @@ -254,20 +258,22 @@ lookupKnownOccName occ (KNS_InScope _ gbl_rdr_env _) Failed err -> return (Failed err) lookupKnownName :: HasDebugCallStack - => KnownNameSource -> Name + => KnownEntitySource -> Name -> IfM lcl (MaybeErr IfaceMessage TyThing) -- Go from a known Name to its TyThing --- If we are in KNS_InScope, look up in the current module's type environment +-- If we are in KES_InScope, look up in the current module's type environment -- in case it is defined right here in this module rather than imported lookupKnownName kk_ns name = case kk_ns of - KNS_InScope this_mod _ type_env + KES_InScope { ke_mod = this_mod, ke_gbl_type_env = type_env, ke_lcl_type_env = lcl_type_env } | name_mod == this_mod - -> case lookupTypeEnv type_env name of - Just thing -> return (Succeeded thing) - Nothing -> pprPanic "lookupKnownName" (ppr name $$ ppr type_env) - -- We found the name in the GlobalRdrEnv, but it's - -- not in the type env. That's a compiler error + -> case lookupNameEnv lcl_type_env name of + Just (ATcId { tct_id = id }) -> return (Succeeded (AnId id)) + _ -> case lookupTypeEnv type_env name of + Just thing -> return (Succeeded thing) + Nothing -> pprPanic "lookupKnownName" (ppr name $$ ppr type_env) + -- We found the name in the GlobalRdrEnv, but it's + -- not in the type env. That's a compiler error _ -> loadGlobalName name name_mod where ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -983,7 +983,7 @@ mk_top_id (IfGblTopBndr gbl_name) -- rather than the current module so we need this special case. -- See some similar logic in `GHC.Rename.Env`. | Just rOOT_MAIN == nameModule_maybe gbl_name - = lookupKnownOccThing ioTyConOcc KNS_FromModule >>= \case + = lookupKnownOccThing ioTyConOcc KES_FromModule >>= \case Failed err -> failIfM (pprDiagnostic err) Succeeded ioTyThing -> do ATyCon ioTyCon <- pure ioTyThing ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -1041,16 +1041,16 @@ rnLookupKnownOccName occ Succeeded name -> return name } lookup_known_occ :: HasDebugCallStack - => KnownNameSource -> KnownOcc + => KnownEntitySource -> KnownOcc -> RnM (MaybeErr IfaceMessage Name) -lookup_known_occ KNS_FromModule occ +lookup_known_occ KES_FromModule occ = do { (_, occ_map) <- initIfaceTcRn loadKnownKeyOccMaps ; case lookupOccEnv occ_map occ of Just name -> return (Succeeded name) Nothing -> return (Failed (MissingKnownKey3 occ)) } -lookup_known_occ (KNS_InScope _ gbl_rdr_env _) occ - = case lookupKnownGRE gbl_rdr_env occ of +lookup_known_occ (KES_InScope { ke_rdr_env = rdr_env }) occ + = case lookupKnownGRE rdr_env occ of Succeeded gre -> do { addUsedGRE NoDeprecationWarnings gre ; let name = greName gre ; traceIf $ hang (text "lookupKnownKeyOcc NoImplicitKnownKeyNames") ===================================== compiler/GHC/Tc/Instance/Typeable.hs ===================================== @@ -22,7 +22,6 @@ import GHC.Tc.Utils.TcType import GHC.Iface.Env( newGlobalBinder ) import GHC.Builtin.Modules( gHC_TYPES, gHC_PRIM ) -import GHC.Builtin.KnownKeys import GHC.Builtin.KnownOccs import GHC.Builtin.WiredIn.Prim ( primTyCons ) import GHC.Builtin.WiredIn.Types @@ -645,12 +644,12 @@ liftTc = KindRepM . lift -- | We generate `KindRep`s for a few common kinds, so that they -- can be reused across modules. -- These definitions are generated in `ghc-prim:GHC.Types`. -builtInKindReps :: [(Kind, Name)] +builtInKindReps :: [(Kind, KnownOcc)] builtInKindReps = - [ (star, starKindRepName) - , (constraintKind, constraintKindRepName) - , (mkVisFunTyMany star star, starArrStarKindRepName) - , (mkVisFunTysMany [star, star] star, starArrStarArrStarKindRepName) + [ (star, mkVarOcc "krepStar") + , (constraintKind, mkVarOcc "krepConstraint") + , (mkVisFunTyMany star star, mkVarOcc "krepStarArr") + , (mkVisFunTysMany [star, star] star, mkVarOcc "krepStarArrStarArr") ] where star = liftedTypeKind @@ -658,8 +657,8 @@ builtInKindReps = initialKindRepEnv :: TcRn KindRepEnv initialKindRepEnv = foldlM add_kind_rep emptyTypeMap builtInKindReps where - add_kind_rep acc (k,n) = do - id <- tcLookupId n + add_kind_rep acc (k,occ) = do + id <- tcLookupKnownOccId occ return $! extendTypeMap acc k (id, Nothing) -- The TypeMap looks through type synonyms ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -578,7 +578,7 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls ; return (tcg_env `addEvBinds` ev_binds) } -- Emit Typeable bindings - ; tcg_env <- setGblEnv tcg_env $ + ; tcg_env <- restoreEnvs (tcg_env, tcl_env) $ mkTypeableBinds ; traceTc "Tc9" empty ===================================== compiler/GHC/Tc/Types/LclEnv.hs ===================================== @@ -122,7 +122,8 @@ data TcLclCtxt tcl_arrow_ctxt :: ArrowCtxt, -- Arrow-notation context tcl_env :: TcTypeEnv -- The local type environment: - -- Ids and TyVars defined in this module + -- Ids and TyVars defined in this module + -- They move to the TcGbl env during zonkTopDecls } getLclEnvThLevel :: TcLclEnv -> ThLevel ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -517,19 +517,21 @@ tcMetaTy tc_name = do { t <- tcLookupTyCon tc_name ; return (mkTyConTy t) } -getKnownKeySource :: TcRn KnownNameSource +getKnownKeySource :: TcRn KnownEntitySource -- Used by both renamer and typechecker and renamer getKnownKeySource = do { rebindable_path <- goptM Opt_RebindableKnownNames ; if rebindable_path - then do { env <- getGblEnv - ; return (KNS_InScope (tcg_mod env) - (tcg_rdr_env env) - (tcg_type_env env)) } - else return KNS_FromModule } + then do { gbl_env <- getGblEnv + ; lcl_type_env <- getLclTypeEnv + ; return (KES_InScope { ke_mod = tcg_mod gbl_env + , ke_rdr_env = tcg_rdr_env gbl_env + , ke_gbl_type_env = tcg_type_env gbl_env + , ke_lcl_type_env = lcl_type_env }) } + else return KES_FromModule } tcrn_wrapper :: HasDebugCallStack - => (KnownNameSource -> IfG (MaybeErr IfaceMessage a)) -> TcRn a + => (KnownEntitySource -> IfG (MaybeErr IfaceMessage a)) -> TcRn a tcrn_wrapper do_the_lookup = do { kk_source <- getKnownKeySource ; mb_res <- initIfaceTcRn (do_the_lookup kk_source) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50ba27b54ab9efc70036655157d9cbba... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50ba27b54ab9efc70036655157d9cbba... You're receiving this email because of your account on gitlab.haskell.org.