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
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:
| ... | ... | @@ -246,7 +246,7 @@ How known-occ entities work |
| 246 | 246 | * Known-occ lookup (normal case: KES_FromModule)
|
| 247 | 247 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| 248 | 248 | In normal client code, suppose the desugarer calls
|
| 249 | - dsLookupKnownKeyTyCon rationalTyConKey
|
|
| 249 | + dsLookupKnownKeyTyCon ioTyConKey
|
|
| 250 | 250 | or
|
| 251 | 251 | dsLookupKnownOccTyCon rationalTyConOcc
|
| 252 | 252 | |
| ... | ... | @@ -304,8 +304,8 @@ Known-key entities are |
| 304 | 304 | * All the known-key names are gathered in one table:
|
| 305 | 305 | knownKeyTable :: [(KnownOcc, KnownKey)]
|
| 306 | 306 | knownKeyTable
|
| 307 | - = [ (mkTcOcc "Rational", rationalTyConKey)
|
|
| 308 | - , (mkTcOcc "Eq", eqClassKey)
|
|
| 307 | + = [ (mkTcOcc "IO", ioTyConKey)
|
|
| 308 | + , (mkTcOcc "Eq", eqClassKey)
|
|
| 309 | 309 | ... etc ... ]
|
| 310 | 310 | |
| 311 | 311 | * Because of (KnownOccNameInvariant) we can turn that table into two mappings:
|
| ... | ... | @@ -379,8 +379,6 @@ pureAClassOpOcc = mkVarOcc "pure" |
| 379 | 379 | returnMClassOpOcc = mkVarOcc "return"
|
| 380 | 380 | thenMClassOpOcc = mkVarOcc ">>"
|
| 381 | 381 | bindMClassOpOcc = mkVarOcc ">>="
|
| 382 | - -- ROMES:TODO: bindMClassOpOcc does not have a Known Names Table Entry. What
|
|
| 383 | - -- happens to all these occs needed for Quote? Should we make them just KnownOcc?
|
|
| 384 | 382 | thenAClassOpOcc = mkVarOcc "*>"
|
| 385 | 383 | mappendClassOpOcc = mkVarOcc "mappend"
|
| 386 | 384 | getFieldClassOpOcc = mkVarOcc "getField"
|
| ... | ... | @@ -483,7 +481,7 @@ addrPrimTyConKey, arrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey, |
| 483 | 481 | int32PrimTyConKey, int32TyConKey, int64PrimTyConKey, int64TyConKey,
|
| 484 | 482 | integerTyConKey, naturalTyConKey, listTyConKey, maybeTyConKey,
|
| 485 | 483 | weakPrimTyConKey, mutableArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
|
| 486 | - orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey,
|
|
| 484 | + orderingTyConKey, mVarPrimTyConKey, ratioTyConKey,
|
|
| 487 | 485 | realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey, eqTyConKey,
|
| 488 | 486 | heqTyConKey, smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey,
|
| 489 | 487 | stringTyConKey, ccArrowTyConKey, ctArrowTyConKey, tcArrowTyConKey :: KnownKey
|
| ... | ... | @@ -519,9 +517,7 @@ mutableArrayPrimTyConKey = mkPreludeTyConUnique 30 |
| 519 | 517 | mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 31
|
| 520 | 518 | orderingTyConKey = mkPreludeTyConUnique 32
|
| 521 | 519 | mVarPrimTyConKey = mkPreludeTyConUnique 33
|
| 522 | --- ioPortPrimTyConKey (34) was killed
|
|
| 523 | 520 | ratioTyConKey = mkPreludeTyConUnique 35
|
| 524 | -rationalTyConKey = mkPreludeTyConUnique 36
|
|
| 525 | 521 | realWorldTyConKey = mkPreludeTyConUnique 37
|
| 526 | 522 | stablePtrPrimTyConKey = mkPreludeTyConUnique 38
|
| 527 | 523 | stablePtrTyConKey = mkPreludeTyConUnique 39
|
| ... | ... | @@ -179,14 +179,8 @@ fromStaticPtrClassOpOcc, newStablePtrIdOcc :: KnownOcc |
| 179 | 179 | fromStaticPtrClassOpOcc = mkVarOcc "fromStaticPtr"
|
| 180 | 180 | newStablePtrIdOcc = mkVarOcc "newStablePtr"
|
| 181 | 181 | |
| 182 | -staticPtrTyConOcc, staticPtrInfoDataConOcc :: KnownOcc
|
|
| 183 | -staticPtrTyConOcc = mkTcOcc "StaticPtr"
|
|
| 184 | -staticPtrInfoDataConOcc = mkDataOcc "StaticPtrInfo"
|
|
| 185 | - |
|
| 186 | -knownNatClassOcc, knownSymbolClassOcc, knownCharClassOcc :: KnownOcc
|
|
| 187 | -knownNatClassOcc = mkTcOcc "KnownNat"
|
|
| 188 | -knownSymbolClassOcc = mkTcOcc "KnownSymbol"
|
|
| 189 | -knownCharClassOcc = mkTcOcc "KnownChar"
|
|
| 182 | +staticPtrTyConOcc :: KnownOcc
|
|
| 183 | +staticPtrTyConOcc = mkTcOcc "StaticPtr"
|
|
| 190 | 184 | |
| 191 | 185 | returnIOIdOcc, bindIOIdOcc, thenIOIdOcc,
|
| 192 | 186 | printIdOcc, ioTyConOcc, ioDataConOcc :: KnownOcc
|
| ... | ... | @@ -226,11 +220,10 @@ typeLitCharDataConOcc = mkDataOcc "TypeLitChar" |
| 226 | 220 | |
| 227 | 221 | |
| 228 | 222 | trModuleTyConOcc, trModuleDataConOcc, trNameSDataConOcc
|
| 229 | - , trTyConTyConOcc, trTyConDataConOcc :: KnownOcc
|
|
| 223 | + , trTyConDataConOcc :: KnownOcc
|
|
| 230 | 224 | trModuleTyConOcc = mkTcOcc "Module"
|
| 231 | 225 | trModuleDataConOcc = mkDataOcc "Module"
|
| 232 | 226 | trNameSDataConOcc = mkDataOcc "TrNameS"
|
| 233 | -trTyConTyConOcc = mkTcOcc "TyCon"
|
|
| 234 | 227 | trTyConDataConOcc = mkDataOcc "TyCon"
|
| 235 | 228 | |
| 236 | 229 | -- Typeable representation types
|
| ... | ... | @@ -137,7 +137,7 @@ import GHC.Iface.Errors.Types |
| 137 | 137 | import Language.Haskell.Syntax.BooleanFormula (BooleanFormula)
|
| 138 | 138 | import Language.Haskell.Syntax.BooleanFormula qualified as BF(BooleanFormula(..))
|
| 139 | 139 | import Language.Haskell.Syntax.Extension (NoExtField (NoExtField))
|
| 140 | -import GHC.Builtin.KnownOccs (ioTyConOcc)
|
|
| 140 | +import GHC.Builtin.KnownKeys (ioTyConKey)
|
|
| 141 | 141 | |
| 142 | 142 | {-
|
| 143 | 143 | This module takes
|
| ... | ... | @@ -983,7 +983,7 @@ mk_top_id (IfGblTopBndr gbl_name) |
| 983 | 983 | -- rather than the current module so we need this special case.
|
| 984 | 984 | -- See some similar logic in `GHC.Rename.Env`.
|
| 985 | 985 | | Just rOOT_MAIN == nameModule_maybe gbl_name
|
| 986 | - = lookupKnownOccThing ioTyConOcc KES_FromModule >>= \case
|
|
| 986 | + = lookupKnownKeyThing ioTyConKey KES_FromModule >>= \case
|
|
| 987 | 987 | Failed err -> failIfM (pprDiagnostic err)
|
| 988 | 988 | Succeeded ioTyThing -> do
|
| 989 | 989 | ATyCon ioTyCon <- pure ioTyThing
|
| ... | ... | @@ -27,13 +27,12 @@ import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) ) |
| 27 | 27 | import GHC.Builtin.WiredIn.Types
|
| 28 | 28 | import GHC.Builtin.WiredIn.Prim
|
| 29 | 29 | import GHC.Builtin.KnownKeys
|
| 30 | -import GHC.Builtin.KnownOccs
|
|
| 31 | 30 | import GHC.Builtin.PrimOps ( PrimOp(..) )
|
| 32 | 31 | import GHC.Builtin.PrimOps.Ids ( primOpId )
|
| 33 | 32 | |
| 34 | 33 | import GHC.Types.FieldLabel
|
| 35 | 34 | import GHC.Types.SafeHaskell
|
| 36 | -import GHC.Types.Name ( Name, KnownOcc )
|
|
| 35 | +import GHC.Types.Name ( Name, KnownKey )
|
|
| 37 | 36 | import GHC.Types.Name.Reader
|
| 38 | 37 | import GHC.Types.Var.Env ( VarEnv )
|
| 39 | 38 | import GHC.Types.Id
|
| ... | ... | @@ -961,9 +960,9 @@ matchTypeable clas [k,t] -- clas = Typeable |
| 961 | 960 | -- see Note [No Typeable for polytypes or qualified types]
|
| 962 | 961 | |
| 963 | 962 | -- Now cases that do work
|
| 964 | - | k `eqType` naturalTy = doTyLit knownNatClassOcc t
|
|
| 965 | - | k `eqType` typeSymbolKind = doTyLit knownSymbolClassOcc t
|
|
| 966 | - | k `eqType` charTy = doTyLit knownCharClassOcc t
|
|
| 963 | + | k `eqType` naturalTy = doTyLit knownNatClassKey t
|
|
| 964 | + | k `eqType` typeSymbolKind = doTyLit knownSymbolClassKey t
|
|
| 965 | + | k `eqType` charTy = doTyLit knownCharClassKey t
|
|
| 967 | 966 | | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)]
|
| 968 | 967 | , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks
|
| 969 | 968 | |
| ... | ... | @@ -1039,8 +1038,8 @@ mk_typeable_pred clas ty = mkClassPred clas [ typeKind ty, ty ] |
| 1039 | 1038 | -- Typeable is implied by KnownNat/KnownSymbol. In the case of a type literal
|
| 1040 | 1039 | -- we generate a sub-goal for the appropriate class.
|
| 1041 | 1040 | -- See Note [Typeable for Nat and Symbol]
|
| 1042 | -doTyLit :: KnownOcc -> Type -> TcM ClsInstResult
|
|
| 1043 | -doTyLit kc t = do { kc_clas <- tcLookupKnownOccClass kc
|
|
| 1041 | +doTyLit :: KnownKey -> Type -> TcM ClsInstResult
|
|
| 1042 | +doTyLit kc t = do { kc_clas <- tcLookupKnownKeyClass kc
|
|
| 1044 | 1043 | ; let kc_pred = mkClassPred kc_clas [ t ]
|
| 1045 | 1044 | mk_ev [ev] = evTypeable t $ EvTypeableTyLit (EvExpr ev)
|
| 1046 | 1045 | mk_ev _ = panic "doTyLit"
|
| ... | ... | @@ -23,6 +23,7 @@ import GHC.Iface.Env( newGlobalBinder ) |
| 23 | 23 | |
| 24 | 24 | import GHC.Builtin.Modules( gHC_TYPES, gHC_PRIM )
|
| 25 | 25 | import GHC.Builtin.KnownOccs
|
| 26 | +import GHC.Builtin.KnownKeys (trTyConTyConKey)
|
|
| 26 | 27 | import GHC.Builtin.WiredIn.Prim ( primTyCons )
|
| 27 | 28 | import GHC.Builtin.WiredIn.Types
|
| 28 | 29 | ( runtimeRepTyCon
|
| ... | ... | @@ -428,7 +429,7 @@ data TyConTodo |
| 428 | 429 | |
| 429 | 430 | todoForTyCons :: Module -> Id -> [TyCon] -> TcM TypeRepTodo
|
| 430 | 431 | todoForTyCons mod mod_id tycons = do
|
| 431 | - trTyConTy <- mkTyConTy <$> tcLookupKnownOccTyCon trTyConTyConOcc
|
|
| 432 | + trTyConTy <- mkTyConTy <$> tcLookupKnownKeyTyCon trTyConTyConKey
|
|
| 432 | 433 | let mk_rep_id :: TyConRepName -> Id
|
| 433 | 434 | mk_rep_id rep_name = mkExportedVanillaId rep_name trTyConTy
|
| 434 | 435 | `setInlinePragma` neverInlinePragma
|
| ... | ... | @@ -1975,7 +1975,7 @@ generateMainBinding tcg_env main_name = do |
| 1975 | 1975 | |
| 1976 | 1976 | getIOType :: TcM (TcType, TcType)
|
| 1977 | 1977 | -- Return (IO alpha, alpha) for fresh alpha
|
| 1978 | -getIOType = do { ioTyCon <- tcLookupKnownOccTyCon ioTyConOcc
|
|
| 1978 | +getIOType = do { ioTyCon <- tcLookupKnownKeyTyCon ioTyConKey
|
|
| 1979 | 1979 | ; res_ty <- newFlexiTyVarTy liftedTypeKind
|
| 1980 | 1980 | ; return (mkTyConApp ioTyCon [res_ty], res_ty) }
|
| 1981 | 1981 | |
| ... | ... | @@ -2589,7 +2589,7 @@ getGhciStepIO :: TcM (LHsExpr GhcRn) |
| 2589 | 2589 | getGhciStepIO = do
|
| 2590 | 2590 | ghciTy <- getGHCiMonad
|
| 2591 | 2591 | a_tv <- newName (mkTyVarOccFS (fsLit "a"))
|
| 2592 | - ioTyCon <- tcLookupKnownOccTyCon ioTyConOcc
|
|
| 2592 | + ioTyCon <- tcLookupKnownKeyTyCon ioTyConKey
|
|
| 2593 | 2593 | let ghciM = nlHsAppTy (nlHsTyVar NotPromoted ghciTy) (nlHsTyVar NotPromoted a_tv)
|
| 2594 | 2594 | ioM = nlHsAppTy (nlHsTyVar NotPromoted (tyConName ioTyCon)) (nlHsTyVar NotPromoted a_tv)
|
| 2595 | 2595 |