Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC
Commits:
-
510ae59d
by Simon Peyton Jones at 2026-04-08T11:55:00+01:00
5 changed files:
- compiler/GHC/Builtin.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Tc/Utils/Env.hs
- libraries/base/src/GHC/KnownKeyNames.hs
Changes:
| ... | ... | @@ -291,6 +291,15 @@ Wrinkles |
| 291 | 291 | So we compile GHC.Internal.Data.Foldable with
|
| 292 | 292 | -fexclude-known-key-define=toList
|
| 293 | 293 | |
| 294 | +(KKN3) You don't need need to export the wired-in entities from GHC.KnownKeyNames
|
|
| 295 | + because we (should) never look up a wired-in name via its key. That is,
|
|
| 296 | + `GHC.Iface.Load.lookupKnownKeyName` should never be called on the key of
|
|
| 297 | + a wired-in name.
|
|
| 298 | + |
|
| 299 | + Alternative: export all wired-in entities from GHC.KnownKeyNames. But that
|
|
| 300 | + would simply bloat the interface for no good reason.
|
|
| 301 | + |
|
| 302 | + |
|
| 294 | 303 | Note [Recipe for adding a known-occ name]
|
| 295 | 304 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| 296 | 305 | To make `wombat` into a known-occ name, you must ensure that:
|
| ... | ... | @@ -452,6 +461,8 @@ wiredInNames |
| 452 | 461 | Nothing -> []
|
| 453 | 462 | |
| 454 | 463 | -- | Check the known-key names list of consistency.
|
| 464 | +-- (a) Unique is in-range (ToDo: get rid of this)
|
|
| 465 | +-- (b) Distinct uniques
|
|
| 455 | 466 | knownKeyNamesOkay :: [Name] -> Maybe SDoc
|
| 456 | 467 | knownKeyNamesOkay all_names
|
| 457 | 468 | | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names
|
| ... | ... | @@ -652,7 +652,10 @@ initNameWriterTable = do |
| 652 | 652 | )
|
| 653 | 653 | |
| 654 | 654 | |
| 655 | -putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO ()
|
|
| 655 | +putSymbolTable :: WriteBinHandle
|
|
| 656 | + -> Int -- Size of the table
|
|
| 657 | + -> UniqFM Name (Int,Name) -- For each Name, its index in the table
|
|
| 658 | + -> IO ()
|
|
| 656 | 659 | putSymbolTable bh name_count symtab
|
| 657 | 660 | = do { put_ bh name_count
|
| 658 | 661 | ; let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab))
|
| ... | ... | @@ -702,7 +705,6 @@ getSymbolTable bh name_cache |
| 702 | 705 | |
| 703 | 706 | -- Note [Symbol table representation of names]
|
| 704 | 707 | -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| 705 | ---
|
|
| 706 | 708 | -- An occurrence of a name in an interface file is serialized as a single 32-bit
|
| 707 | 709 | -- word. The format of this word is:
|
| 708 | 710 | -- 00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
|
| ... | ... | @@ -168,28 +168,39 @@ lookupKnownKeyThing key mb_gbl_rdr_env |
| 168 | 168 | lookupKnownKeyName :: HasDebugCallStack
|
| 169 | 169 | => KnownKey -> KnownKeyNameSource
|
| 170 | 170 | -> IfM lcl (MaybeErr IfaceMessage Name)
|
| 171 | -lookupKnownKeyName uniq KKNS_FromModule
|
|
| 171 | +lookupKnownKeyName key KKNS_FromModule
|
|
| 172 | 172 | = do { (kk_map, _) <- loadKnownKeyOccMaps
|
| 173 | - ; case lookupUFM kk_map uniq of
|
|
| 173 | + ; case lookupUFM kk_map key of
|
|
| 174 | 174 | Just name -> return (Succeeded name)
|
| 175 | - Nothing -> return (Failed (MissingKnownKey1 uniq)) }
|
|
| 176 | - |
|
| 177 | -lookupKnownKeyName uniq (KKNS_InScope gbl_rdr_env)
|
|
| 175 | + Nothing
|
|
| 176 | + | wired_in_nm : _ <- filter (`hasKey` key) wiredInNames
|
|
| 177 | + -> -- We should never call lookupKnownKeyName on the key of a wired-in
|
|
| 178 | + -- entity; see (KKN3) in Note [Overview of known-key entities]
|
|
| 179 | + -- We hackily panic here rather than use a civilised error
|
|
| 180 | + -- message so that we get a helpful stack backtrace
|
|
| 181 | + pprPanic "lookupKownKeyName" $
|
|
| 182 | + hang (text "You tried to look up wired-in"
|
|
| 183 | + <+> quotes (ppr wired_in_nm) <+> text "in the known-key table")
|
|
| 184 | + 2 (text "Better to use the wired-in name directly")
|
|
| 185 | + | otherwise
|
|
| 186 | + -> return (Failed (MissingKnownKey1 key)) }
|
|
| 187 | + |
|
| 188 | +lookupKnownKeyName key (KKNS_InScope gbl_rdr_env)
|
|
| 178 | 189 | -- Just gbl_rdr_env: we have -frebindable-known-key-names on, and
|
| 179 | 190 | -- here is the top-level GlobalRdrEnv
|
| 180 | 191 | -- Look up the /un-qualified/ known-key OccName in the GlobalRdrEnv
|
| 181 | 192 | -- If we get a unique hit, use it; if not, panic.
|
| 182 | - | Just (occ :: OccName) <- lookupUFM knownKeyUniqMap uniq
|
|
| 193 | + | Just (occ :: OccName) <- lookupUFM knownKeyUniqMap key
|
|
| 183 | 194 | = case lookupGRE gbl_rdr_env (LookupRdrName (mkRdrUnqual occ) SameNameSpace) of
|
| 184 | 195 | [gre] -> do { let name = greName gre
|
| 185 | 196 | ; traceIf $ hang (text "lookupKnownKeyName1 NoImplicitKnownKeyNames")
|
| 186 | - 2 (ppr name <+> ppr uniq)
|
|
| 197 | + 2 (ppr name <+> ppr key)
|
|
| 187 | 198 | ; return (Succeeded name) }
|
| 188 | 199 | gres -> return (Failed (KnownKeyScopeError occ gres))
|
| 189 | 200 | |
| 190 | 201 | | otherwise
|
| 191 | - = pprTrace "lookup failed" (pprKnownKey uniq $$ callStackDoc) $
|
|
| 192 | - return (Failed (MissingKnownKey2 uniq))
|
|
| 202 | + = pprTrace "lookup failed" (pprKnownKey key $$ callStackDoc) $
|
|
| 203 | + return (Failed (MissingKnownKey2 key))
|
|
| 193 | 204 | |
| 194 | 205 | lookupKnownOccThing :: HasDebugCallStack
|
| 195 | 206 | => KnownOcc -> KnownKeyNameSource
|
| ... | ... | @@ -1118,12 +1118,11 @@ tcGetDefaultTys |
| 1118 | 1118 | -- Not one of the built-in units
|
| 1119 | 1119 | -- @default Num (Integer, Double)@, plus extensions
|
| 1120 | 1120 | { extDef <- if extended_defaults
|
| 1121 | - then do { list_tc <- tcLookupKnownKeyTyCon listTyConKey
|
|
| 1122 | - ; foldableClass <- tcLookupKnownKeyClass foldableClassKey
|
|
| 1121 | + then do { foldableClass <- tcLookupKnownKeyClass foldableClassKey
|
|
| 1123 | 1122 | ; showClass <- tcLookupKnownKeyClass showClassKey
|
| 1124 | 1123 | ; eqClass <- tcLookupKnownKeyClass eqClassKey
|
| 1125 | 1124 | ; pure $ defaultEnv
|
| 1126 | - [ builtinDefaults foldableClass [mkTyConTy list_tc]
|
|
| 1125 | + [ builtinDefaults foldableClass [mkTyConTy listTyCon]
|
|
| 1127 | 1126 | , builtinDefaults showClass [unitTy, integerTy, doubleTy]
|
| 1128 | 1127 | , builtinDefaults eqClass [unitTy, integerTy, doubleTy]
|
| 1129 | 1128 | ]
|
| ... | ... | @@ -59,9 +59,8 @@ module GHC.KnownKeyNames |
| 59 | 59 | , dataToTag#
|
| 60 | 60 | |
| 61 | 61 | -- Numbers
|
| 62 | - , Num
|
|
| 62 | + , Num, Integral, Real, Fractional
|
|
| 63 | 63 | , (+), (-), (*), negate, fromInteger
|
| 64 | - , Integral, Real
|
|
| 65 | 64 | , fromRational
|
| 66 | 65 | , mkRationalBase2, mkRationalBase10
|
| 67 | 66 | , divInt#, modInt#
|
| ... | ... | @@ -70,7 +69,7 @@ module GHC.KnownKeyNames |
| 70 | 69 | , IsString
|
| 71 | 70 | , fromString
|
| 72 | 71 | |
| 73 | - -- Records and lists
|
|
| 72 | + -- Records
|
|
| 74 | 73 | , HasField
|
| 75 | 74 | , fromLabel, getField
|
| 76 | 75 | |
| ... | ... | @@ -129,8 +128,8 @@ module GHC.KnownKeyNames |
| 129 | 128 | , pragSpecED, pragSpecInlED
|
| 130 | 129 | , pragSpecInstD, pragRuleD, pragCompleteD, pragAnnD, pragSCCFunD
|
| 131 | 130 | , pragSCCFunNamedD, dataInstD, newtypeInstD, tySynInstD, openTypeFamilyD
|
| 132 | - , closedTypeFamilyD, dataFamilyD, infixLWithSpecD, infixRWithSpecD, roleAnnotD
|
|
| 133 | - , patSynD, patSynSigD, implicitParamBindD
|
|
| 131 | + , closedTypeFamilyD, dataFamilyD, infixLWithSpecD, infixRWithSpecD, infixNWithSpecD
|
|
| 132 | + , roleAnnotD, patSynD, patSynSigD, implicitParamBindD
|
|
| 134 | 133 | , Lit, charL, stringL, integerL, intPrimL, wordPrimL, floatPrimL
|
| 135 | 134 | , doublePrimL, rationalL, stringPrimL, charPrimL
|
| 136 | 135 | , Pat, litP, varP, tupP, unboxedTupP, unboxedSumP, conP, infixP, tildeP
|