Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6f9d7c71 by Markus Läll at 2026-05-21T15:25:34-04:00 Use "grimily" instead of "grimly" Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/27221 - - - - - 10 changed files: - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/Supply.hs Changes: ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -318,7 +318,7 @@ instance DSM.MonadGetUnique LlvmM where tag <- getEnv envTag liftUDSMT $! do uq <- DSM.getUniqueM - return (newTagUniqueGrimly uq tag) + return (newTagUniqueGrimily uq tag) -- | Lifting of IO actions. Not exported, as we want to encapsulate IO. liftIO :: IO a -> LlvmM a ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -175,11 +175,11 @@ instance MonadPlus CoreM instance MonadUnique CoreM where getUniqueSupplyM = do tag <- read cr_uniq_tag - liftIO $! mkSplitUniqSupplyGrimly tag + liftIO $! mkSplitUniqSupplyGrimily tag getUniqueM = do tag <- read cr_uniq_tag - liftIO $! uniqFromTagGrimly tag + liftIO $! uniqFromTagGrimily tag runCoreM :: HscEnv -> RuleBase ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -144,7 +144,7 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv | otherwise = unpackHObj res_hty header_bits = maybe mempty idTag maybe_target - idTag i = let (tag, u) = unpkUniqueGrimly (getUnique i) + idTag i = let (tag, u) = unpkUniqueGrimily (getUnique i) in CHeader (char tag <> word64 u) normal_args = map (\(nm,_ty,_,_) -> nm) arg_info ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -707,7 +707,7 @@ putName BinSymbolTable{ bin_symtab_next = symtab_next } bh name | isKnownKeyName name - , let (c, u) = unpkUniqueGrimly (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits + , let (c, u) = unpkUniqueGrimily (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits = -- assert (u < 2^(22 :: Int)) put_ bh (0x80000000 .|. (fromIntegral (ord c) `shiftL` 22) ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -66,9 +66,9 @@ newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { tag <- ask - ; liftIO $! mkSplitUniqSupplyGrimly tag} + ; liftIO $! mkSplitUniqSupplyGrimily tag} getUniqueM = StgM $ do { tag <- ask - ; liftIO $! uniqFromTagGrimly tag} + ; liftIO $! uniqFromTagGrimily tag} runStgM :: UniqueTag -> StgM a -> IO a runStgM mask (StgM m) = runReaderT m (uniqueTag mask) ===================================== compiler/GHC/StgToJS/Ids.hs ===================================== @@ -130,7 +130,7 @@ makeIdentForId i num id_type current_module = name ident -- unique suffix for non-exported Ids , if exported then mempty - else let (c,u) = unpkUniqueGrimly (getUnique i) + else let (c,u) = unpkUniqueGrimily (getUnique i) in mconcat [BSC.pack ['_',c,'_'], word64BS u] ] @@ -235,4 +235,3 @@ declVarsForId i = case typeSize (idType i) of 0 -> return mempty 1 -> decl <$> identForId i s -> mconcat <$> mapM (\n -> decl <$> identForIdN i n) [1..s] - ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1008,13 +1008,13 @@ newUnique :: TcRnIf gbl lcl Unique newUnique = do { env <- getEnv ; let tag = env_ut env - ; liftIO $! uniqFromTagGrimly tag } + ; liftIO $! uniqFromTagGrimily tag } newUniqueSupply :: TcRnIf gbl lcl UniqSupply newUniqueSupply = do { env <- getEnv ; let tag = env_ut env - ; liftIO $! mkSplitUniqSupplyGrimly tag } + ; liftIO $! mkSplitUniqSupplyGrimily tag } cloneLocalName :: Name -> TcM Name -- Make a fresh Internal name with the same OccName and SrcSpan ===================================== compiler/GHC/Types/Name/Cache.hs ===================================== @@ -122,7 +122,7 @@ data NameCache = NameCache type OrigNameCache = ModuleEnv (OccEnv Name) takeUniqFromNameCache :: NameCache -> IO Unique -takeUniqFromNameCache (NameCache c _) = uniqFromTagGrimly c +takeUniqFromNameCache (NameCache c _) = uniqFromTagGrimily c lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name lookupOrigNameCache nc mod occ = lookup_infinite <|> lookup_normal ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -38,12 +38,12 @@ module GHC.Types.Unique ( mkUniqueIntGrimily, getKey, mkUnique, unpkUnique, - unpkUniqueGrimly, + unpkUniqueGrimily, mkUniqueInt, eqUnique, ltUnique, incrUnique, stepUnique, - newTagUnique, newTagUniqueGrimly, + newTagUnique, newTagUniqueGrimily, nonDetCmpUnique, isValidKnownKeyUnique, @@ -99,7 +99,7 @@ Note [Performance implications of UniqueTag] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The UniqueTag ADT is meant to be ephemeral and eliminated by the simplifier, so for long term storage (i.e. in monadic environments or data structures) we -want to store the raw 'Char's. Working with the raw tags is done via the *Grimly +want to store the raw 'Char's. Working with the raw tags is done via the *Grimily class of functions For instance, if we are generating a unique for a concrete tag, we should use @@ -116,7 +116,7 @@ newUnique ; liftIO $! uniqFromTag tag } Prefer `env_ut :: Char` and - ; liftIO $! uniqFromTagGrimly tag } + ; liftIO $! uniqFromTagGrimily tag } -} @@ -295,7 +295,7 @@ The stuff about unique *supplies* is handled further down this module. -} unpkUnique :: Unique -> (UniqueTag, Word64) -- The reverse -unpkUniqueGrimly :: Unique -> (Char, Word64) -- The reverse +unpkUniqueGrimily :: Unique -> (Char, Word64) -- The reverse mkUniqueGrimily :: Word64 -> Unique -- A trap-door for UniqSupply getKey :: Unique -> Word64 -- for Var @@ -303,7 +303,7 @@ getKey :: Unique -> Word64 -- for Var incrUnique :: Unique -> Unique stepUnique :: Unique -> Word64 -> Unique newTagUnique :: Unique -> UniqueTag -> Unique -newTagUniqueGrimly :: Unique -> Char -> Unique +newTagUniqueGrimily :: Unique -> Char -> Unique mkUniqueGrimily = MkUnique @@ -323,9 +323,9 @@ maxLocalUnique :: Unique maxLocalUnique = mkLocalUnique uniqueMask -- newTagUnique changes the "domain" of a unique to a different char -newTagUnique u c = newTagUniqueGrimly u (uniqueTag c) +newTagUnique u c = newTagUniqueGrimily u (uniqueTag c) -newTagUniqueGrimly u c = mkUniqueGrimilyWithTag c i where (_,i) = unpkUniqueGrimly u +newTagUniqueGrimily u c = mkUniqueGrimilyWithTag c i where (_,i) = unpkUniqueGrimily u -- | Bitmask that has zeros for the tag bits and ones for the rest. uniqueMask :: Word64 @@ -368,7 +368,7 @@ mkUniqueIntGrimily = MkUnique . intToWord64 {-# INLINE mkUniqueIntGrimily #-} -unpkUniqueGrimly (MkUnique u) +unpkUniqueGrimily (MkUnique u) = let -- The potentially truncating use of fromIntegral here is safe -- because the argument is just the tag bits after shifting. @@ -376,10 +376,10 @@ unpkUniqueGrimly (MkUnique u) i = u .&. uniqueMask in (tag, i) -{-# INLINE unpkUniqueGrimly #-} +{-# INLINE unpkUniqueGrimily #-} -unpkUnique u = case unpkUniqueGrimly u of +unpkUnique u = case unpkUniqueGrimily u of (c, i) -> ( charToUniqueTag c, i) {-# INLINE unpkUnique #-} @@ -389,7 +389,7 @@ unpkUnique u = case unpkUniqueGrimly u of -- See Note [Symbol table representation of names] in "GHC.Iface.Binary" for details. isValidKnownKeyUnique :: Unique -> Bool isValidKnownKeyUnique u = - case unpkUniqueGrimly u of + case unpkUniqueGrimily u of (c, x) -> ord c < 0xff && x <= (1 `shiftL` 22) {- @@ -512,7 +512,7 @@ showUnique :: Unique -> String showUnique uniq = tagStr ++ w64ToBase62 u where - (tag, u) = unpkUniqueGrimly uniq + (tag, u) = unpkUniqueGrimily uniq -- Avoid emitting non-printable characters in pretty uniques. -- See #25989. tagStr ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -16,10 +16,10 @@ module GHC.Types.Unique.Supply ( -- ** Operations on supplies uniqFromSupply, uniqsFromSupply, -- basic ops takeUniqFromSupply, - uniqFromTag, uniqFromTagGrimly, + uniqFromTag, uniqFromTagGrimily, UniqueTag(..), - mkSplitUniqSupply, mkSplitUniqSupplyGrimly, + mkSplitUniqSupply, mkSplitUniqSupplyGrimily, splitUniqSupply, listSplitUniqSupply, -- * Unique supply monad and its abstraction @@ -203,10 +203,10 @@ data UniqSupply -- when split => these two supplies mkSplitUniqSupply :: UniqueTag -> IO UniqSupply -mkSplitUniqSupply ut = mkSplitUniqSupplyGrimly (uniqueTag ut) +mkSplitUniqSupply ut = mkSplitUniqSupplyGrimily (uniqueTag ut) {-# INLINE mkSplitUniqSupply #-} -mkSplitUniqSupplyGrimly :: Char -> IO UniqSupply +mkSplitUniqSupplyGrimily :: Char -> IO UniqSupply -- ^ Create a unique supply out of thin air. -- The "tag" (Char) supplied is mostly cosmetic, making it easier -- to figure out where a Unique was born. See Note [Uniques and tags]. @@ -219,7 +219,7 @@ mkSplitUniqSupplyGrimly :: Char -> IO UniqSupply -- See Note [How the unique supply works] -- See Note [Optimising the unique supply] -mkSplitUniqSupplyGrimly ut +mkSplitUniqSupplyGrimily ut = unsafeDupableInterleaveIO (IO mk_supply) where @@ -286,15 +286,15 @@ initUniqSupply counter inc = do poke ghc_unique_inc inc uniqFromTag :: UniqueTag -> IO Unique -uniqFromTag !ut = uniqFromTagGrimly (uniqueTag ut) +uniqFromTag !ut = uniqFromTagGrimily (uniqueTag ut) {-# INLINE uniqFromTag #-} -uniqFromTagGrimly :: Char -> IO Unique -uniqFromTagGrimly !tag +uniqFromTagGrimily :: Char -> IO Unique +uniqFromTagGrimily !tag = do { uqNum <- genSym ; return $! mkUniqueGrimilyWithTag tag uqNum } -{-# NOINLINE uniqFromTagGrimly #-} -- We'll unbox everything, but we don't want to inline it +{-# NOINLINE uniqFromTagGrimily #-} -- We'll unbox everything, but we don't want to inline it splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply) -- ^ Build two 'UniqSupply' from a single one, each of which View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f9d7c71a762d3cc7e942cddb34680cd... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f9d7c71a762d3cc7e942cddb34680cd... You're receiving this email because of your account on gitlab.haskell.org.