Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: 395134b6 by Rodrigo Mesquita at 2026-05-19T14:16:19+01:00 prefer KnownKeys to KnownOcc, bit of polish - - - - - 7 changed files: - compiler/GHC/Builtin.hs - compiler/GHC/Builtin/KnownKeys.hs - compiler/GHC/Builtin/KnownOccs.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Module.hs Changes: ===================================== compiler/GHC/Builtin.hs ===================================== @@ -246,7 +246,7 @@ How known-occ entities work * Known-occ lookup (normal case: KES_FromModule) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In normal client code, suppose the desugarer calls - dsLookupKnownKeyTyCon rationalTyConKey + dsLookupKnownKeyTyCon ioTyConKey or dsLookupKnownOccTyCon rationalTyConOcc @@ -304,8 +304,8 @@ Known-key entities are * All the known-key names are gathered in one table: knownKeyTable :: [(KnownOcc, KnownKey)] knownKeyTable - = [ (mkTcOcc "Rational", rationalTyConKey) - , (mkTcOcc "Eq", eqClassKey) + = [ (mkTcOcc "IO", ioTyConKey) + , (mkTcOcc "Eq", eqClassKey) ... etc ... ] * Because of (KnownOccNameInvariant) we can turn that table into two mappings: ===================================== compiler/GHC/Builtin/KnownKeys.hs ===================================== @@ -379,8 +379,6 @@ pureAClassOpOcc = mkVarOcc "pure" returnMClassOpOcc = mkVarOcc "return" thenMClassOpOcc = mkVarOcc ">>" bindMClassOpOcc = mkVarOcc ">>=" - -- ROMES:TODO: bindMClassOpOcc does not have a Known Names Table Entry. What - -- happens to all these occs needed for Quote? Should we make them just KnownOcc? thenAClassOpOcc = mkVarOcc "*>" mappendClassOpOcc = mkVarOcc "mappend" getFieldClassOpOcc = mkVarOcc "getField" @@ -483,7 +481,7 @@ addrPrimTyConKey, arrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey, int32PrimTyConKey, int32TyConKey, int64PrimTyConKey, int64TyConKey, integerTyConKey, naturalTyConKey, listTyConKey, maybeTyConKey, weakPrimTyConKey, mutableArrayPrimTyConKey, mutableByteArrayPrimTyConKey, - orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey, + orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey, eqTyConKey, heqTyConKey, smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey, stringTyConKey, ccArrowTyConKey, ctArrowTyConKey, tcArrowTyConKey :: KnownKey @@ -519,9 +517,7 @@ mutableArrayPrimTyConKey = mkPreludeTyConUnique 30 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 31 orderingTyConKey = mkPreludeTyConUnique 32 mVarPrimTyConKey = mkPreludeTyConUnique 33 --- ioPortPrimTyConKey (34) was killed ratioTyConKey = mkPreludeTyConUnique 35 -rationalTyConKey = mkPreludeTyConUnique 36 realWorldTyConKey = mkPreludeTyConUnique 37 stablePtrPrimTyConKey = mkPreludeTyConUnique 38 stablePtrTyConKey = mkPreludeTyConUnique 39 ===================================== compiler/GHC/Builtin/KnownOccs.hs ===================================== @@ -179,14 +179,8 @@ fromStaticPtrClassOpOcc, newStablePtrIdOcc :: KnownOcc fromStaticPtrClassOpOcc = mkVarOcc "fromStaticPtr" newStablePtrIdOcc = mkVarOcc "newStablePtr" -staticPtrTyConOcc, staticPtrInfoDataConOcc :: KnownOcc -staticPtrTyConOcc = mkTcOcc "StaticPtr" -staticPtrInfoDataConOcc = mkDataOcc "StaticPtrInfo" - -knownNatClassOcc, knownSymbolClassOcc, knownCharClassOcc :: KnownOcc -knownNatClassOcc = mkTcOcc "KnownNat" -knownSymbolClassOcc = mkTcOcc "KnownSymbol" -knownCharClassOcc = mkTcOcc "KnownChar" +staticPtrTyConOcc :: KnownOcc +staticPtrTyConOcc = mkTcOcc "StaticPtr" returnIOIdOcc, bindIOIdOcc, thenIOIdOcc, printIdOcc, ioTyConOcc, ioDataConOcc :: KnownOcc @@ -226,11 +220,10 @@ typeLitCharDataConOcc = mkDataOcc "TypeLitChar" trModuleTyConOcc, trModuleDataConOcc, trNameSDataConOcc - , trTyConTyConOcc, trTyConDataConOcc :: KnownOcc + , trTyConDataConOcc :: KnownOcc trModuleTyConOcc = mkTcOcc "Module" trModuleDataConOcc = mkDataOcc "Module" trNameSDataConOcc = mkDataOcc "TrNameS" -trTyConTyConOcc = mkTcOcc "TyCon" trTyConDataConOcc = mkDataOcc "TyCon" -- Typeable representation types ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -137,7 +137,7 @@ import GHC.Iface.Errors.Types import Language.Haskell.Syntax.BooleanFormula (BooleanFormula) import Language.Haskell.Syntax.BooleanFormula qualified as BF(BooleanFormula(..)) import Language.Haskell.Syntax.Extension (NoExtField (NoExtField)) -import GHC.Builtin.KnownOccs (ioTyConOcc) +import GHC.Builtin.KnownKeys (ioTyConKey) {- This module takes @@ -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 KES_FromModule >>= \case + = lookupKnownKeyThing ioTyConKey KES_FromModule >>= \case Failed err -> failIfM (pprDiagnostic err) Succeeded ioTyThing -> do ATyCon ioTyCon <- pure ioTyThing ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -27,13 +27,12 @@ import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) ) import GHC.Builtin.WiredIn.Types import GHC.Builtin.WiredIn.Prim import GHC.Builtin.KnownKeys -import GHC.Builtin.KnownOccs import GHC.Builtin.PrimOps ( PrimOp(..) ) import GHC.Builtin.PrimOps.Ids ( primOpId ) import GHC.Types.FieldLabel import GHC.Types.SafeHaskell -import GHC.Types.Name ( Name, KnownOcc ) +import GHC.Types.Name ( Name, KnownKey ) import GHC.Types.Name.Reader import GHC.Types.Var.Env ( VarEnv ) import GHC.Types.Id @@ -961,9 +960,9 @@ matchTypeable clas [k,t] -- clas = Typeable -- see Note [No Typeable for polytypes or qualified types] -- Now cases that do work - | k `eqType` naturalTy = doTyLit knownNatClassOcc t - | k `eqType` typeSymbolKind = doTyLit knownSymbolClassOcc t - | k `eqType` charTy = doTyLit knownCharClassOcc t + | k `eqType` naturalTy = doTyLit knownNatClassKey t + | k `eqType` typeSymbolKind = doTyLit knownSymbolClassKey t + | k `eqType` charTy = doTyLit knownCharClassKey t | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks @@ -1039,8 +1038,8 @@ mk_typeable_pred clas ty = mkClassPred clas [ typeKind ty, ty ] -- Typeable is implied by KnownNat/KnownSymbol. In the case of a type literal -- we generate a sub-goal for the appropriate class. -- See Note [Typeable for Nat and Symbol] -doTyLit :: KnownOcc -> Type -> TcM ClsInstResult -doTyLit kc t = do { kc_clas <- tcLookupKnownOccClass kc +doTyLit :: KnownKey -> Type -> TcM ClsInstResult +doTyLit kc t = do { kc_clas <- tcLookupKnownKeyClass kc ; let kc_pred = mkClassPred kc_clas [ t ] mk_ev [ev] = evTypeable t $ EvTypeableTyLit (EvExpr ev) mk_ev _ = panic "doTyLit" ===================================== compiler/GHC/Tc/Instance/Typeable.hs ===================================== @@ -23,6 +23,7 @@ import GHC.Iface.Env( newGlobalBinder ) import GHC.Builtin.Modules( gHC_TYPES, gHC_PRIM ) import GHC.Builtin.KnownOccs +import GHC.Builtin.KnownKeys (trTyConTyConKey) import GHC.Builtin.WiredIn.Prim ( primTyCons ) import GHC.Builtin.WiredIn.Types ( runtimeRepTyCon @@ -428,7 +429,7 @@ data TyConTodo todoForTyCons :: Module -> Id -> [TyCon] -> TcM TypeRepTodo todoForTyCons mod mod_id tycons = do - trTyConTy <- mkTyConTy <$> tcLookupKnownOccTyCon trTyConTyConOcc + trTyConTy <- mkTyConTy <$> tcLookupKnownKeyTyCon trTyConTyConKey let mk_rep_id :: TyConRepName -> Id mk_rep_id rep_name = mkExportedVanillaId rep_name trTyConTy `setInlinePragma` neverInlinePragma ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -1975,7 +1975,7 @@ generateMainBinding tcg_env main_name = do getIOType :: TcM (TcType, TcType) -- Return (IO alpha, alpha) for fresh alpha -getIOType = do { ioTyCon <- tcLookupKnownOccTyCon ioTyConOcc +getIOType = do { ioTyCon <- tcLookupKnownKeyTyCon ioTyConKey ; res_ty <- newFlexiTyVarTy liftedTypeKind ; return (mkTyConApp ioTyCon [res_ty], res_ty) } @@ -2589,7 +2589,7 @@ getGhciStepIO :: TcM (LHsExpr GhcRn) getGhciStepIO = do ghciTy <- getGHCiMonad a_tv <- newName (mkTyVarOccFS (fsLit "a")) - ioTyCon <- tcLookupKnownOccTyCon ioTyConOcc + ioTyCon <- tcLookupKnownKeyTyCon ioTyConKey let ghciM = nlHsAppTy (nlHsTyVar NotPromoted ghciTy) (nlHsTyVar NotPromoted a_tv) ioM = nlHsAppTy (nlHsTyVar NotPromoted (tyConName ioTyCon)) (nlHsTyVar NotPromoted a_tv) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/395134b66b8aa71bcd602777bce6031c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/395134b66b8aa71bcd602777bce6031c... You're receiving this email because of your account on gitlab.haskell.org.