Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: 64903c23 by Rodrigo Mesquita at 2026-05-14T00:33:45+01:00 finish going through them - - - - - d2787047 by Rodrigo Mesquita at 2026-05-14T11:45:54+01:00 kill more things - - - - - d1742062 by Rodrigo Mesquita at 2026-05-14T13:42:42+01:00 fixes [skip ci] - - - - - 6 changed files: - compiler/GHC/Builtin.hs - compiler/GHC/Builtin/KnownKeys.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Module.hs Changes: ===================================== compiler/GHC/Builtin.hs ===================================== @@ -26,15 +26,11 @@ module GHC.Builtin ( knownKeyTable, knownKeyOccMap, knownKeyUniqMap, knownKeyOccName, knownKeyOccName_maybe, - -- * Known-occ names - oldIsKnownKeyName, - oldLookupKnownKeyName, - oldLookupKnownNameInfo, - -- * Random other things maybeCharLikeCon, maybeIntLikeCon, allNameStrings, allNameStringList, itName, mkUnboundName, isUnboundName, + lookupKnownNameInfo, -- * Class categories isNumericClass, isStandardClass, @@ -46,7 +42,6 @@ module GHC.Builtin ( import GHC.Prelude -import GHC.Builtin.Uniques import GHC.Builtin.PrimOps import GHC.Builtin.PrimOps.Ids import GHC.Builtin.WiredIn.Types @@ -77,10 +72,6 @@ import GHC.Data.List.SetOps import GHC.Data.FastString import qualified GHC.Data.List.Infinite as Inf -import Control.Applicative ((<|>)) -import Data.Maybe - - {- ********************************************************************* * * @@ -579,17 +570,11 @@ wiredInNames Nothing -> [] -- | Check the known-key names list of consistency. --- (a) Unique is in-range (ToDo: get rid of this) --- (b) Distinct uniques +-- (a) Distinct uniques knownKeyNamesOkay :: [Name] -> Maybe SDoc knownKeyNamesOkay all_names - | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names - = Just $ text " Out-of-range known-key uniques: " <> - brackets (pprWithCommas (ppr . nameOccName) ns) - | null badNamesPairs - = Nothing - | otherwise - = Just badNamesDoc + | null badNamesPairs = Nothing + | otherwise = Just badNamesDoc where namesEnv = foldl' (\m n -> extendNameEnv_Acc (:) Utils.singleton m n n) emptyUFM all_names @@ -606,42 +591,18 @@ knownKeyNamesOkay all_names text ": " <> brackets (pprWithCommas (ppr . nameOccName) ns) ---------------- ToDo: get rid of these old-mechanism functions ---------------- when we complete the known-key tranitition --------------- See #27013 - --- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a --- known-key thing. -oldLookupKnownKeyName :: Unique -> Maybe Name -oldLookupKnownKeyName u = - knownUniqueName u <|> lookupUFM_Directly oldKnownKeysMap u - --- TODO: remove this once all knownkey names come from providers --- | Is a 'Name' known-key? -oldIsKnownKeyName :: Name -> Bool -oldIsKnownKeyName n = - isJust (knownUniqueName $ nameUnique n) || elemUFM n oldKnownKeysMap - --- | Maps 'Unique's to known-key names. --- --- The type is @UniqFM Name Name@ to denote that the 'Unique's used --- in the domain are 'Unique's associated with 'Name's (as opposed --- to some other namespace of 'Unique's). -oldKnownKeysMap :: UniqFM Name Name -oldKnownKeysMap = listToIdentityUFM wiredInNames - -- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by -- GHCi's ':info' command. -oldLookupKnownNameInfo :: Name -> SDoc -oldLookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of +lookupKnownNameInfo :: Name -> SDoc +lookupKnownNameInfo name = case lookupUFM knownNamesInfo (getUnique name) of -- If we do find a doc, we add comment delimiters to make the output -- of ':info' valid Haskell. Nothing -> empty Just doc -> vcat [text "{-", doc, text "-}"] -- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390) -knownNamesInfo :: NameEnv SDoc -knownNamesInfo = unitNameEnv coercibleTyConName $ +knownNamesInfo :: UniqFM KnownKey SDoc +knownNamesInfo = unitUFM coercibleTyConKey $ vcat [ text "Coercible is a special constraint with custom solving rules." , text "It is not a class." , text "Please see section `The Coercible constraint`" ===================================== compiler/GHC/Builtin/KnownKeys.hs ===================================== @@ -63,8 +63,6 @@ import GHC.Prelude import GHC.Builtin.Uniques -import GHC.Unit.Types - import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader import GHC.Types.Unique @@ -73,8 +71,6 @@ import GHC.Types.Name import GHC.Utils.Misc( HasDebugCallStack ) import GHC.Utils.Panic - -import GHC.Data.FastString import GHC.Data.Maybe @@ -150,6 +146,7 @@ knownKeyTable , (mkTcOcc "Num", numClassKey) , (mkTcOcc "Integral", integralClassKey) , (mkTcOcc "Real", realClassKey) + , (mkTcOcc "Floating", floatingClassKey) , (mkTcOcc "Fractional", fractionalClassKey) , (mkTcOcc "RealFloat", realFloatClassKey) , (mkTcOcc "RealFrac", realFracClassKey) @@ -356,50 +353,18 @@ knownKeyTable * * ************************************************************************ -Many of these Names are not really "built in", but some parts of the -compiler (notably the deriving mechanism) need to mention their names, -and it's convenient to write them all down in one place. +See Note [Overview of known entities] -} -wildCardName :: Name -wildCardName = mkSystemVarName wildCardKey (fsLit "wild") - -- AMP additions pureAClassOpKey, thenAClassOpKey, alternativeClassKey :: KnownKey pureAClassOpKey = mkPreludeMiscIdUnique 752 thenAClassOpKey = mkPreludeMiscIdUnique 753 alternativeClassKey = mkPreludeMiscIdUnique 754 ---------------------------------- --- End of ghc-bignum ---------------------------------- - --- WithDict - genericClassKeys :: [KnownKey] genericClassKeys = [genClassKey, gen1ClassKey] -{- -************************************************************************ -* * -\subsection{Local helpers} -* * -************************************************************************ - -All these are original names; hence mkOrig --} - -{-# INLINE varQual #-} -{-# INLINE tcQual #-} -{-# INLINE clsQual #-} -{-# INLINE dcQual #-} -varQual, tcQual, clsQual, dcQual :: Module -> FastString -> Unique -> Name -varQual modu str unique = mk_known_key_name varName modu str unique -tcQual modu str unique = mk_known_key_name tcName modu str unique -clsQual modu str unique = mk_known_key_name clsName modu str unique -dcQual modu str unique = mk_known_key_name dataName modu str unique - - {- ********************************************************************* * * Statically-known occurrence names @@ -413,6 +378,8 @@ 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" ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -190,6 +190,9 @@ mkWildValBinder w ty = mkLocalIdOrCoVar wildCardName w ty -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors -- (e.g. see test T15695). Ticket #17291 covers fixing this problem. +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + -- | Make a case expression whose case binder is unused -- The alts and res_ty should not have any occurrences of WildId mkWildCase :: CoreExpr -- ^ scrutinee ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -32,14 +32,13 @@ module GHC.Iface.Binary ( import GHC.Prelude -import GHC.Builtin ( knownKeyOccMap, oldIsKnownKeyName, oldLookupKnownKeyName ) +import GHC.Builtin ( knownKeyOccMap ) import GHC.Utils.Panic import GHC.Utils.Binary as Binary import GHC.Utils.Outputable import GHC.Types.Name import GHC.Types.Unique.FM -import GHC.Types.Unique import GHC.Types.SrcLoc import GHC.Types.Name.Cache @@ -58,7 +57,6 @@ import Control.Monad import Data.Array import Data.Array.IO import Data.Array.Unsafe -import Data.Char import Data.IORef import Data.Map.Strict (Map) import Data.Word @@ -703,42 +701,11 @@ getSymbolTable bh name_cache ; writeArray mut_arr (fromIntegral i) name ; return new_cache } --- ROMES:TODO: KILL THIS from here to the end. --- We no longer put uniques for known-occ names anymore, they'll be looked up --- in the table. --- No uniques in interface files! - - --- Note [Symbol table representation of names] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- An occurrence of a name in an interface file is serialized as a single 32-bit --- word. The format of this word is: --- 00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx --- A normal name. x is an index into the symbol table --- 10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy --- A known-key name. x is the Unique's Char, y is the int part. We assume that --- all known-key uniques fit in this space. This is asserted by --- GHC.Builtin.knownKeyNamesOkay. --- --- During serialization we check for known-key things using oldIsKnownKeyName. --- During deserialization we use lookupKnownKeyName to get from the unique back --- to its corresponding Name. - - --- See Note [Symbol table representation of names] putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } bh name - | oldIsKnownKeyName name - , let (c, u) = unpkUniqueGrimly (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits - = -- assert (u < 2^(22 :: Int)) - put_ bh (0x80000000 - .|. (fromIntegral (ord c) `shiftL` 22) - .|. (fromIntegral u :: Word32)) - - | otherwise = do symtab_map <- readIORef symtab_map_ref case lookupUFM symtab_map name of Just (off,_) -> put_ bh (fromIntegral off :: Word32) @@ -750,23 +717,8 @@ putName BinSymbolTable{ $! addToUFM symtab_map name (off,name) put_ bh (fromIntegral off :: Word32) --- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh - case i .&. 0xC0000000 of - 0x00000000 -> return $! symtab ! fromIntegral i - - 0x80000000 -> - let - tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22)) - ix = fromIntegral i .&. 0x003FFFFF - u = mkUniqueGrimilyWithTag tag ix - in - return $! case oldLookupKnownKeyName u of - Nothing -> pprPanic "getSymtabName:unknown known-key unique" - (ppr i $$ ppr u $$ char tag $$ ppr ix) - Just n -> n - - _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) + return $! symtab ! fromIntegral i ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -105,7 +105,7 @@ import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Ppr import GHC.Builtin( allNameStrings ) -import GHC.Builtin.KnownKeys hiding ( wildCardName ) +import GHC.Builtin.KnownKeys import GHC.Builtin.WiredIn.Types import GHC.Builtin.WiredIn.Prim ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2989,7 +2989,7 @@ tcRnGetInfo hsc_env name ; thing <- tcRnLookupName' name ; fixity <- lookupFixityRn name ; (cls_insts, fam_insts) <- lookupInsts thing - ; let info = oldLookupKnownNameInfo name + ; let info = lookupKnownNameInfo name ; return (thing, fixity, cls_insts, fam_insts, info) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a4236f2eef310de910c4684457df13... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a4236f2eef310de910c4684457df13... You're receiving this email because of your account on gitlab.haskell.org.