Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC
Commits:
-
25497cb4
by Rodrigo Mesquita at 2026-05-06T17:51:42+01:00
5 changed files:
- compiler/GHC/Builtin/KnownKeys.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- libraries/base/src/GHC/Essentials.hs
Changes:
| ... | ... | @@ -271,6 +271,9 @@ knownKeyTable |
| 271 | 271 | , (mkDataOcc ":$$:", typeErrorVAppendDataConKey)
|
| 272 | 272 | , (mkDataOcc "ShowType", typeErrorShowTypeDataConKey)
|
| 273 | 273 | |
| 274 | + -- Unsafe coercion proofs
|
|
| 275 | + , (mkVarOcc "unsafeCoerce#", unsafeCoercePrimIdKey)
|
|
| 276 | + |
|
| 274 | 277 | -- Plugins
|
| 275 | 278 | , (mkTcOcc "Plugin", pluginTyConKey)
|
| 276 | 279 | , (mkTcOcc "FrontendPlugin", frontendPluginTyConKey)
|
| ... | ... | @@ -372,10 +375,7 @@ basicKnownKeyNames |
| 372 | 375 | starKindRepName,
|
| 373 | 376 | starArrStarKindRepName,
|
| 374 | 377 | starArrStarArrStarKindRepName,
|
| 375 | - constraintKindRepName,
|
|
| 376 | - |
|
| 377 | - -- Unsafe coercion proofs
|
|
| 378 | - unsafeCoercePrimName
|
|
| 378 | + constraintKindRepName
|
|
| 379 | 379 | ]
|
| 380 | 380 | |
| 381 | 381 | |
| ... | ... | @@ -437,10 +437,6 @@ constraintKindRepName = varQual gHC_TYPES (fsLit "krep$Constraint") con |
| 437 | 437 | withDictClassName :: Name
|
| 438 | 438 | withDictClassName = clsQual gHC_MAGIC_DICT (fsLit "WithDict") withDictClassKey
|
| 439 | 439 | |
| 440 | --- Unsafe coercion proofs
|
|
| 441 | -unsafeCoercePrimName:: Name
|
|
| 442 | -unsafeCoercePrimName = varQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "unsafeCoerce#") unsafeCoercePrimIdKey
|
|
| 443 | - |
|
| 444 | 440 | genericClassKeys :: [KnownKey]
|
| 445 | 441 | genericClassKeys = [genClassKey, gen1ClassKey]
|
| 446 | 442 |
| ... | ... | @@ -86,7 +86,6 @@ import GHC.Types.SourceFile |
| 86 | 86 | import GHC.Types.TypeEnv
|
| 87 | 87 | import GHC.Types.Name
|
| 88 | 88 | import GHC.Types.Name.Set
|
| 89 | -import GHC.Types.Name.Env
|
|
| 90 | 89 | import GHC.Types.Name.Ppr
|
| 91 | 90 | import GHC.Types.HpcInfo
|
| 92 | 91 | |
| ... | ... | @@ -99,6 +98,7 @@ import Data.List (partition) |
| 99 | 98 | import Data.IORef
|
| 100 | 99 | import GHC.Iface.Make (mkRecompUsageInfo)
|
| 101 | 100 | import GHC.Runtime.Interpreter (interpreterProfiled)
|
| 101 | +import GHC.Types.Unique.FM
|
|
| 102 | 102 | |
| 103 | 103 | {-
|
| 104 | 104 | ************************************************************************
|
| ... | ... | @@ -684,13 +684,14 @@ patchMagicDefns pairs |
| 684 | 684 | -- optimization: check whether we're in a magic module before looking
|
| 685 | 685 | -- at all the ids
|
| 686 | 686 | = do { this_mod <- getModule
|
| 687 | + ; magicDefnModules <- mkMagicDefnModules
|
|
| 687 | 688 | ; if this_mod `elemModuleSet` magicDefnModules
|
| 688 | 689 | then traverse patchMagicDefn pairs
|
| 689 | 690 | else return pairs }
|
| 690 | 691 | |
| 691 | 692 | patchMagicDefn :: (Id, CoreExpr) -> DsM (Id, CoreExpr)
|
| 692 | 693 | patchMagicDefn orig_pair@(orig_id, orig_rhs)
|
| 693 | - | Just mk_magic_pair <- lookupNameEnv magicDefnsEnv (getName orig_id)
|
|
| 694 | + | Just mk_magic_pair <- lookupUFM magicDefnsEnv (getUnique orig_id)
|
|
| 694 | 695 | = do { magic_pair@(magic_id, _) <- mk_magic_pair orig_id orig_rhs
|
| 695 | 696 | |
| 696 | 697 | -- Patching should not change the Name or the type of the Id
|
| ... | ... | @@ -701,22 +702,25 @@ patchMagicDefn orig_pair@(orig_id, orig_rhs) |
| 701 | 702 | | otherwise
|
| 702 | 703 | = return orig_pair
|
| 703 | 704 | |
| 704 | -magicDefns :: [(Name, Id -> CoreExpr -- old Id and RHS
|
|
| 705 | +magicDefns :: [(KnownKey, Id -> CoreExpr -- old Id and RHS
|
|
| 705 | 706 | -> DsM (Id, CoreExpr) -- new Id and RHS
|
| 706 | 707 | )]
|
| 707 | -magicDefns = [ (unsafeCoercePrimName, mkUnsafeCoercePrimPair) ]
|
|
| 708 | +magicDefns = [ (unsafeCoercePrimIdKey, mkUnsafeCoercePrimPair) ]
|
|
| 708 | 709 | |
| 709 | -magicDefnsEnv :: NameEnv (Id -> CoreExpr -> DsM (Id, CoreExpr))
|
|
| 710 | -magicDefnsEnv = mkNameEnv magicDefns
|
|
| 710 | +magicDefnsEnv :: UniqFM KnownKey (Id -> CoreExpr -> DsM (Id, CoreExpr))
|
|
| 711 | +magicDefnsEnv = listToUFM magicDefns
|
|
| 711 | 712 | |
| 712 | -magicDefnModules :: ModuleSet
|
|
| 713 | -magicDefnModules = mkModuleSet $ map (nameModule . getName . fst) magicDefns
|
|
| 713 | +mkMagicDefnModules :: DsM ModuleSet
|
|
| 714 | +mkMagicDefnModules = do
|
|
| 715 | + mods <- mapM (fmap nameModule . dsLookupKnownKeyName . fst) magicDefns
|
|
| 716 | + pure $ mkModuleSet mods
|
|
| 714 | 717 | |
| 715 | 718 | mkUnsafeCoercePrimPair :: Id -> CoreExpr -> DsM (Id, CoreExpr)
|
| 716 | 719 | -- See Note [Wiring in unsafeCoerce#] for the defn we are creating here
|
| 717 | 720 | mkUnsafeCoercePrimPair _old_id old_expr
|
| 718 | 721 | = do { unsafe_equality_proof_id <- dsLookupKnownKeyId unsafeEqualityProofIdKey
|
| 719 | 722 | ; unsafe_equality_tc <- dsLookupKnownKeyTyCon unsafeEqualityTyConKey
|
| 723 | + ; unsafeCoercePrimName <- dsLookupKnownKeyName unsafeCoercePrimIdKey
|
|
| 720 | 724 | |
| 721 | 725 | ; let [unsafe_refl_data_con] = tyConDataCons unsafe_equality_tc
|
| 722 | 726 |
| ... | ... | @@ -2566,7 +2566,7 @@ tcGhciStmts stmts |
| 2566 | 2566 | -- We use Any rather than a dummy type such as () because of
|
| 2567 | 2567 | -- the rules of unsafeCoerce#; see Unsafe/Coerce.hs for the details.
|
| 2568 | 2568 | |
| 2569 | - ; AnId unsafe_coerce_id <- tcLookupGlobal unsafeCoercePrimName
|
|
| 2569 | + ; AnId unsafe_coerce_id <- tcLookupKnownKeyGlobal unsafeCoercePrimIdKey
|
|
| 2570 | 2570 | -- We use unsafeCoerce# here because of (U11) in
|
| 2571 | 2571 | -- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce
|
| 2572 | 2572 |
| ... | ... | @@ -18,7 +18,7 @@ module GHC.Tc.Utils.Concrete |
| 18 | 18 | |
| 19 | 19 | import GHC.Prelude
|
| 20 | 20 | |
| 21 | -import GHC.Builtin.KnownKeys ( unsafeCoercePrimName )
|
|
| 21 | +import GHC.Builtin.KnownKeys ( unsafeCoercePrimIdKey )
|
|
| 22 | 22 | import GHC.Builtin.WiredIn.Types
|
| 23 | 23 | |
| 24 | 24 | import GHC.Core.Coercion
|
| ... | ... | @@ -45,6 +45,7 @@ import GHC.Utils.Outputable |
| 45 | 45 | import GHC.Data.FastString ( FastString, fsLit )
|
| 46 | 46 | |
| 47 | 47 | import Control.Monad ( void )
|
| 48 | +import GHC.Types.Name (hasKnownKey)
|
|
| 48 | 49 | |
| 49 | 50 | |
| 50 | 51 | {- Note [Concrete overview]
|
| ... | ... | @@ -857,7 +858,7 @@ idConcreteTvs id |
| 857 | 858 | -- in the correct information in the desugarer).
|
| 858 | 859 | -- So, for the time being, we manually inspect the type of the original,
|
| 859 | 860 | -- unpatched Id to retrieve which of its outer forall-d tyvars should be concrete.
|
| 860 | - | idName id == unsafeCoercePrimName
|
|
| 861 | + | id `hasKnownKey`unsafeCoercePrimIdKey
|
|
| 861 | 862 | , (a_rep:_b_rep:a:_b:_, _) <- tcSplitForAllTyVars $ idType id
|
| 862 | 863 | -- NB: only check the argument representation, not the result representation.
|
| 863 | 864 | -- This is because the following is OK:
|
| ... | ... | @@ -866,7 +867,7 @@ idConcreteTvs id |
| 866 | 867 | -- unsafeCoerceWordRep = unsafeCoerce#
|
| 867 | 868 | = mkNameEnv
|
| 868 | 869 | [(tyVarName a_rep, ConcreteFRR $ FixedRuntimeRepOrigin (mkTyVarTy a)
|
| 869 | - $ FRRRepPolyId unsafeCoercePrimName RepPolyFunction
|
|
| 870 | + $ FRRRepPolyId (idName id) RepPolyFunction
|
|
| 870 | 871 | $ mkArgPos 1 Top)]
|
| 871 | 872 | |
| 872 | 873 | | otherwise
|
| ... | ... | @@ -161,7 +161,7 @@ module GHC.Essentials |
| 161 | 161 | , CS.unpackAppendCStringUtf8#, CS.cstringLength#
|
| 162 | 162 | , eqString, inline
|
| 163 | 163 | |
| 164 | - , UnsafeEquality( UnsafeRefl ), unsafeEqualityProof
|
|
| 164 | + , UnsafeEquality( UnsafeRefl ), unsafeEqualityProof, unsafeCoerce#
|
|
| 165 | 165 | |
| 166 | 166 | -- Typeable and type representations
|
| 167 | 167 | , SomeTypeRep( SomeTypeRep ), TR.Module( Module )
|