[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: CorePrep: Name `sat` binders more descriptively
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Feb 5 20:46:57 UTC 2025
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
7cc08550 by Ben Gamari at 2025-02-04T18:34:49-05:00
CorePrep: Name `sat` binders more descriptively
- - - - -
fb40981d by Ben Gamari at 2025-02-04T18:35:26-05:00
ghc-toolchain: Parse i686 triples
This is a moniker used for later 32-bit x86 implementations
(Pentium Pro and later).
Fixes #25691.
- - - - -
02794411 by Cheng Shao at 2025-02-04T18:36:03-05:00
compiler: remove unused assembleOneBCO function
This patch removes the unused assembleOneBCO function from the
bytecode assembler.
- - - - -
4f6eb892 by Matthew Pickering at 2025-02-05T15:46:39-05:00
perf: Replace uses of genericLength with strictGenericLength
genericLength is a recursive function and marked NOINLINE. It is not
going to specialise. In profiles, it can be seen that 3% of total compilation
time when computing bytecode is spend calling this non-specialised
function.
In addition, we can simplify `addListToSS` to avoid traversing the input
list twice and also allocating an intermediate list (after the call to
reverse).
Overall these changes reduce the time spend in 'assembleBCOs' from 5.61s
to 3.88s. Allocations drop from 8GB to 5.3G.
Fixes #25706
- - - - -
b666e6c8 by Matthew Pickering at 2025-02-05T15:46:39-05:00
perf: nameToCLabel: Directly manipulate ByteString rather than going via strings
`nameToCLabel` is called from `lookupHsSymbol` many times during
bytecode linking. We can save a lot of allocations and time by directly
manipulating the bytestrings rather than going via intermediate lists.
Before: 2GB allocation, 1.11s
After: 260MB allocation, 375ms
Fixes #25719
-------------------------
Metric Decrease:
MultiLayerModulesTH_OneShot
-------------------------
- - - - -
14 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Prelude/Basic.hs
- compiler/GHC/StgToByteCode.hs
- libraries/ghc-boot/GHC/Data/SizedSeq.hs
- testsuite/tests/core-to-stg/T14895.stderr
- testsuite/tests/core-to-stg/T24124.stderr
- testsuite/tests/ghci/should_run/T21052.stdout
- testsuite/tests/simplCore/should_compile/T20040.stderr
- testsuite/tests/simplCore/should_compile/T23083.stderr
- testsuite/tests/simplStg/should_compile/T15226b.stderr
- testsuite/tests/simplStg/should_compile/T19717.stderr
- utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -8,7 +8,7 @@
-- | Bytecode assembler and linker
module GHC.ByteCode.Asm (
- assembleBCOs, assembleOneBCO,
+ assembleBCOs,
bcoFreeNames,
SizedSeq, sizeSS, ssElts,
iNTERP_STACK_CHECK_THRESH,
@@ -34,7 +34,6 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Core.TyCon
-import GHC.Data.FlatBag
import GHC.Data.SizedSeq
import GHC.StgToCmm.Layout ( ArgRep(..) )
@@ -53,7 +52,6 @@ import Data.Array.Base ( UArray(..) )
import Foreign hiding (shiftL, shiftR)
import Data.Char ( ord )
-import Data.List ( genericLength )
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import qualified Data.Map.Strict as Map
@@ -168,15 +166,6 @@ mallocStrings interp ulbcos = do
collectPtr (BCOPtrBCO bco) = collect bco
collectPtr _ = return ()
-
-assembleOneBCO :: Interp -> Profile -> ProtoBCO Name -> IO UnlinkedBCO
-assembleOneBCO interp profile pbco = do
- -- TODO: the profile should be bundled with the interpreter: the rts ways are
- -- fixed for an interpreter
- ubco <- assembleBCO (profilePlatform profile) pbco
- UnitFlatBag ubco' <- mallocStrings interp (UnitFlatBag ubco)
- return ubco'
-
assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO
assembleBCO platform
(ProtoBCO { protoBCOName = nm
@@ -343,6 +332,7 @@ data InspectState = InspectState
, lblEnv :: LabelEnvMap
}
+
inspectAsm :: Platform -> Bool -> Word -> Assembler a -> (Word, LabelEnvMap)
inspectAsm platform long_jumps initial_offset
= go (InspectState initial_offset 0 0 Map.empty)
@@ -350,7 +340,7 @@ inspectAsm platform long_jumps initial_offset
go s (NullAsm _) = (instrCount s, lblEnv s)
go s (AllocPtr _ k) = go (s { ptrCount = n + 1 }) (k n)
where n = ptrCount s
- go s (AllocLit ls k) = go (s { litCount = n + genericLength ls }) (k n)
+ go s (AllocLit ls k) = go (s { litCount = n + strictGenericLength ls }) (k n)
where n = litCount s
go s (AllocLabel lbl k) = go s' k
where s' = s { lblEnv = Map.insert lbl (instrCount s) (lblEnv s) }
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
--
-- (c) The University of Glasgow 2002-2006
@@ -210,9 +211,9 @@ linkFail who what
nameToCLabel :: Name -> String -> FastString
-nameToCLabel n suffix = mkFastString label
+nameToCLabel n suffix = mkFastStringByteString label
where
- encodeZ = zString . zEncodeFS
+ encodeZ = fastZStringToByteString . zEncodeFS
(Module pkgKey modName) = assert (isExternalName n) $ case nameModule n of
-- Primops are exported from GHC.Prim, their HValues live in GHC.PrimopWrappers
-- See Note [Primop wrappers] in GHC.Builtin.PrimOps.
@@ -222,11 +223,14 @@ nameToCLabel n suffix = mkFastString label
modulePart = encodeZ (moduleNameFS modName)
occPart = encodeZ $ occNameMangledFS (nameOccName n)
- label = concat
- [ if pkgKey == mainUnit then "" else packagePart ++ "_"
- , modulePart
- , '_':occPart
- , '_':suffix
+ label = mconcat $
+ [ packagePart `mappend` "_" | pkgKey /= mainUnit ]
+ ++
+ [modulePart
+ , "_"
+ , occPart
+ , "_"
+ , fromString suffix
]
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -59,7 +59,8 @@ import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Id.Make ( realWorldPrimId )
import GHC.Types.Basic
-import GHC.Types.Name ( NamedThing(..), nameSrcSpan, isInternalName )
+import GHC.Types.Name ( NamedThing(..), nameSrcSpan, isInternalName, OccName )
+import GHC.Types.Name.Occurrence (occNameString)
import GHC.Types.SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc )
import GHC.Types.Literal
import GHC.Types.Tickish
@@ -70,6 +71,7 @@ import qualified Data.ByteString.Builder as BB
import Data.ByteString.Builder.Prim
import Control.Monad
+import Data.List (intercalate)
{-
Note [CorePrep Overview]
@@ -247,11 +249,11 @@ corePrepPgm logger cp_cfg pgm_cfg
withTiming logger
(text "CorePrep"<+>brackets (ppr this_mod))
(\a -> a `seqList` ()) $ do
- us <- mkSplitUniqSupply 's'
let initialCorePrepEnv = mkInitialCorePrepEnv cp_cfg
- let
- implicit_binds = mkDataConWorkers
+ us <- mkSplitUniqSupply 's'
+
+ let implicit_binds = mkDataConWorkers
(cpPgm_generateDebugInfo pgm_cfg)
mod_loc data_tycons
-- NB: we must feed mkImplicitBinds through corePrep too
@@ -711,13 +713,13 @@ cpePair :: TopLevelFlag -> RecFlag -> Demand -> Levity
-> UniqSM (Floats, CpeRhs)
-- Used for all bindings
-- The binder is already cloned, hence an OutId
-cpePair top_lvl is_rec dmd lev env bndr rhs
+cpePair top_lvl is_rec dmd lev env0 bndr rhs
= assert (not (isJoinId bndr)) $ -- those should use cpeJoinPair
do { (floats1, rhs1) <- cpeRhsE env rhs
-- See if we are allowed to float this stuff out of the RHS
; let dec = want_float_from_rhs floats1 rhs1
- ; (floats2, rhs2) <- executeFloatDecision dec floats1 rhs1
+ ; (floats2, rhs2) <- executeFloatDecision env dec floats1 rhs1
-- Make the arity match up
; (floats3, rhs3)
@@ -725,7 +727,7 @@ cpePair top_lvl is_rec dmd lev env bndr rhs
then return (floats2, cpeEtaExpand arity rhs2)
else warnPprTrace True "CorePrep: silly extra arguments:" (ppr bndr) $
-- Note [Silly extra arguments]
- (do { v <- newVar (idType bndr)
+ (do { v <- newVar env (idType bndr)
; let (float, v') = mkNonRecFloat env Lifted v rhs2
; return ( snocFloat floats2 float
, cpeEtaExpand arity (Var v')) })
@@ -735,6 +737,8 @@ cpePair top_lvl is_rec dmd lev env bndr rhs
; return (floats4, rhs4) }
where
+ env = pushBinderContext bndr env0
+
arity = idArity bndr -- We must match this arity
want_float_from_rhs floats rhs
@@ -967,36 +971,36 @@ cpeBodyNF env expr
cpeBody :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeBody)
cpeBody env expr
= do { (floats1, rhs) <- cpeRhsE env expr
- ; (floats2, body) <- rhsToBody rhs
+ ; (floats2, body) <- rhsToBody env rhs
; return (floats1 `appFloats` floats2, body) }
--------
-rhsToBody :: CpeRhs -> UniqSM (Floats, CpeBody)
+rhsToBody :: CorePrepEnv -> CpeRhs -> UniqSM (Floats, CpeBody)
-- Remove top level lambdas by let-binding
-rhsToBody (Tick t expr)
+rhsToBody env (Tick t expr)
| tickishScoped t == NoScope -- only float out of non-scoped annotations
- = do { (floats, expr') <- rhsToBody expr
+ = do { (floats, expr') <- rhsToBody env expr
; return (floats, mkTick t expr') }
-rhsToBody (Cast e co)
+rhsToBody env (Cast e co)
-- You can get things like
-- case e of { p -> coerce t (\s -> ...) }
- = do { (floats, e') <- rhsToBody e
+ = do { (floats, e') <- rhsToBody env e
; return (floats, Cast e' co) }
-rhsToBody expr@(Lam {}) -- See Note [No eta reduction needed in rhsToBody]
+rhsToBody env expr@(Lam {}) -- See Note [No eta reduction needed in rhsToBody]
| all isTyVar bndrs -- Type lambdas are ok
= return (emptyFloats, expr)
| otherwise -- Some value lambdas
= do { let rhs = cpeEtaExpand (exprArity expr) expr
- ; fn <- newVar (exprType rhs)
+ ; fn <- newVar env (exprType rhs)
; let float = Float (NonRec fn rhs) LetBound TopLvlFloatable
; return (unitFloat float, Var fn) }
where
(bndrs,_) = collectBinders expr
-rhsToBody expr = return (emptyFloats, expr)
+rhsToBody _env expr = return (emptyFloats, expr)
{- Note [No eta reduction needed in rhsToBody]
@@ -1168,7 +1172,7 @@ cpeApp top_env expr
-- allocating CaseBound Floats for token and thing as needed
= do { (floats1, token) <- cpeArg env topDmd token
; (floats2, thing) <- cpeBody env thing
- ; case_bndr <- (`setIdUnfolding` evaldUnfolding) <$> newVar ty
+ ; case_bndr <- (`setIdUnfolding` evaldUnfolding) <$> newVar env ty
; let tup = mkCoreUnboxedTuple [token, Var case_bndr]
; let float = mkCaseFloat case_bndr thing
; return (floats1 `appFloats` floats2 `snocFloat` float, tup) }
@@ -1577,7 +1581,7 @@ cpeArg env dmd arg
; let arg_ty = exprType arg1
lev = typeLevity arg_ty
dec = wantFloatLocal NonRecursive dmd lev floats1 arg1
- ; (floats2, arg2) <- executeFloatDecision dec floats1 arg1
+ ; (floats2, arg2) <- executeFloatDecision env dec floats1 arg1
-- Else case: arg1 might have lambdas, and we can't
-- put them inside a wrapBinds
@@ -1586,7 +1590,7 @@ cpeArg env dmd arg
-- see Note [ANF-ising literal string arguments]
; if exprIsTrivial arg2
then return (floats2, arg2)
- else do { v <- (`setIdDemandInfo` dmd) <$> newVar arg_ty
+ else do { v <- (`setIdDemandInfo` dmd) <$> newVar env arg_ty
-- See Note [Pin demand info on floats]
; let arity = cpeArgArity env dec floats1 arg2
arg3 = cpeEtaExpand arity arg2
@@ -2424,13 +2428,13 @@ instance Outputable FloatDecision where
ppr FloatNone = text "none"
ppr FloatAll = text "all"
-executeFloatDecision :: FloatDecision -> Floats -> CpeRhs -> UniqSM (Floats, CpeRhs)
-executeFloatDecision dec floats rhs
+executeFloatDecision :: CorePrepEnv -> FloatDecision -> Floats -> CpeRhs -> UniqSM (Floats, CpeRhs)
+executeFloatDecision env dec floats rhs
= case dec of
FloatAll -> return (floats, rhs)
FloatNone
| isEmptyFloats floats -> return (emptyFloats, rhs)
- | otherwise -> do { (floats', body) <- rhsToBody rhs
+ | otherwise -> do { (floats', body) <- rhsToBody env rhs
; return (emptyFloats, wrapBinds floats $
wrapBinds floats' body) }
-- FloatNone case: `rhs` might have lambdas, and we can't
@@ -2569,6 +2573,8 @@ data CorePrepEnv
, cpe_subst :: Subst -- ^ See Note [CorePrepEnv: cpe_subst]
, cpe_rec_ids :: UnVarSet -- Faster OutIdSet; See Note [Speculative evaluation]
+
+ , cpe_context :: [OccName] -- ^ See Note [Binder context]
}
mkInitialCorePrepEnv :: CorePrepConfig -> CorePrepEnv
@@ -2576,6 +2582,7 @@ mkInitialCorePrepEnv cfg = CPE
{ cpe_config = cfg
, cpe_subst = emptySubst
, cpe_rec_ids = emptyUnVarSet
+ , cpe_context = []
}
extendCorePrepEnv :: CorePrepEnv -> Id -> Id -> CorePrepEnv
@@ -2616,6 +2623,14 @@ cpSubstCo :: CorePrepEnv -> Coercion -> Coercion
cpSubstCo (CPE { cpe_subst = subst }) co = substCo subst co
-- substCo has a short-cut if the TCvSubst is empty
+-- | See Note [Binder context]
+pushBinderContext :: Id -> CorePrepEnv -> CorePrepEnv
+pushBinderContext ident env
+ | lengthAtLeast (cpe_context env) 2
+ = env
+ | otherwise
+ = env { cpe_context = getOccName ident : cpe_context env}
+
------------------------------------------------------------------------------
-- Cloning binders
-- ---------------------------------------------------------------------------
@@ -2704,10 +2719,20 @@ fiddleCCall id
-- Generating new binders
-- ---------------------------------------------------------------------------
-newVar :: Type -> UniqSM Id
-newVar ty
- = seqType ty `seq` mkSysLocalOrCoVarM (fsLit "sat") ManyTy ty
-
+newVar :: CorePrepEnv -> Type -> UniqSM Id
+newVar env ty
+ -- See Note [Binder context]
+ = seqType ty `seq` mkSysLocalOrCoVarM (fsLit occ) ManyTy ty
+ where occ = intercalate "_" (map occNameString $ cpe_context env) ++ "_sat"
+
+{- Note [Binder context]
+ ~~~~~~~~~~~~~~~~~~~~~
+ To ensure that the compiled program (specifically symbol names)
+ remains understandable to the user we maintain a context
+ of binders that we are currently under. This allows us to give
+ identifiers conjured during CorePrep more contextually-meaningful
+ names. This is done in `newVar`.
+ -}
------------------------------------------------------------------------------
-- Floating ticks
=====================================
compiler/GHC/Prelude/Basic.hs
=====================================
@@ -25,6 +25,8 @@ module GHC.Prelude.Basic
, shiftL, shiftR
, setBit, clearBit
, head, tail
+
+ , strictGenericLength
) where
@@ -130,3 +132,15 @@ head = Prelude.head
tail :: HasCallStack => [a] -> [a]
tail = Prelude.tail
{-# INLINE tail #-}
+
+{- |
+The 'genericLength' function defined in base can't be specialised due to the
+NOINLINE pragma.
+
+It is also not strict in the accumulator, and strictGenericLength is not exported.
+
+See #25706 for why it is important to use a strict, specialised version.
+
+-}
+strictGenericLength :: Num a => [x] -> a
+strictGenericLength = fromIntegral . length
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -70,7 +70,7 @@ import GHC.Types.Name.Env (mkNameEnv)
import GHC.Types.Tickish
import GHC.Types.SptEntry
-import Data.List ( genericReplicate, genericLength, intersperse
+import Data.List ( genericReplicate, intersperse
, partition, scanl', sortBy, zip4, zip6 )
import Foreign hiding (shiftL, shiftR)
import Control.Monad
@@ -394,7 +394,7 @@ schemeR_wrk fvs nm original_body (args, body)
-- make the arg bitmap
bits = argBits platform (reverse (map (idArgRep platform) all_args))
- bitmap_size = genericLength bits
+ bitmap_size = strictGenericLength bits
bitmap = mkBitmap platform bits
body_code <- schemeER_wrk sum_szsb_args p_init body
@@ -608,7 +608,7 @@ schemeE d s p (StgLet _ext binds body) = do
platform <- targetPlatform <$> getDynFlags
let (xs,rhss) = case binds of StgNonRec x rhs -> ([x],[rhs])
StgRec xs_n_rhss -> unzip xs_n_rhss
- n_binds = genericLength xs
+ n_binds = strictGenericLength xs
fvss = map (fvsToEnv p') rhss
@@ -617,7 +617,7 @@ schemeE d s p (StgLet _ext binds body) = do
sizes = map (\rhs_fvs -> sum (map size_w rhs_fvs)) fvss
-- the arity of each rhs
- arities = map (genericLength . fst . collect) rhss
+ arities = map (strictGenericLength . fst . collect) rhss
-- This p', d' defn is safe because all the items being pushed
-- are ptrs, so all have size 1 word. d' and p' reflect the stack
@@ -1858,7 +1858,7 @@ implement_tagToId
implement_tagToId d s p arg names
= assert (notNull names) $
do (push_arg, arg_bytes) <- pushAtom d p (StgVarArg arg)
- labels <- getLabelsBc (genericLength names)
+ labels <- getLabelsBc (strictGenericLength names)
label_fail <- getLabelBc
label_exit <- getLabelBc
dflags <- getDynFlags
=====================================
libraries/ghc-boot/GHC/Data/SizedSeq.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving, DeriveGeneric, CPP #-}
module GHC.Data.SizedSeq
( SizedSeq(..)
, emptySS
@@ -11,9 +11,12 @@ module GHC.Data.SizedSeq
import Prelude -- See note [Why do we import Prelude here?]
import Control.DeepSeq
import Data.Binary
-import Data.List (genericLength)
import GHC.Generics
+#if ! MIN_VERSION_base(4,20,0)
+import Data.List (foldl')
+#endif
+
data SizedSeq a = SizedSeq {-# UNPACK #-} !Word [a]
deriving (Generic, Show)
@@ -37,9 +40,9 @@ emptySS = SizedSeq 0 []
addToSS :: SizedSeq a -> a -> SizedSeq a
addToSS (SizedSeq n r_xs) x = SizedSeq (n+1) (x:r_xs)
+-- NB, important this is eta-expand so that foldl' is inlined.
addListToSS :: SizedSeq a -> [a] -> SizedSeq a
-addListToSS (SizedSeq n r_xs) xs
- = SizedSeq (n + genericLength xs) (reverse xs ++ r_xs)
+addListToSS s xs = foldl' addToSS s xs
ssElts :: SizedSeq a -> [a]
ssElts (SizedSeq _ r_xs) = reverse r_xs
=====================================
testsuite/tests/core-to-stg/T14895.stderr
=====================================
@@ -11,10 +11,10 @@ T14895.go
GHC.Internal.Data.Either.Left e [Occ=Once1] -> wild<TagProper>;
GHC.Internal.Data.Either.Right a1 [Occ=Once1] ->
let {
- sat [Occ=Once1] :: b
+ go_sat [Occ=Once1] :: b
[LclId] =
{a1, f} \u [] f a1;
- } in GHC.Internal.Data.Either.Right [sat];
+ } in GHC.Internal.Data.Either.Right [go_sat];
};
=====================================
testsuite/tests/core-to-stg/T24124.stderr
=====================================
@@ -9,16 +9,16 @@ T24124.testFun1
T24124.StrictPair a b #)
[GblId, Arity=3, Str=<L><L><L>, Cpr=1, Unf=OtherCon []] =
{} \r [x y void]
- case x of sat {
+ case x of testFun1_sat {
__DEFAULT ->
case
case y of y [OS=OneShot] {
- __DEFAULT -> T24124.MkStrictPair [sat y];
+ __DEFAULT -> T24124.MkStrictPair [testFun1_sat y];
}
of
- sat
+ testFun1_sat
{
- __DEFAULT -> GHC.Internal.Types.MkSolo# [sat];
+ __DEFAULT -> GHC.Internal.Types.MkSolo# [testFun1_sat];
};
};
=====================================
testsuite/tests/ghci/should_run/T21052.stdout
=====================================
@@ -4,9 +4,9 @@ BCO_toplevel :: GHC.Internal.Types.IO [GHC.Internal.Types.Any]
[LclIdX] =
{} \u []
let {
- sat :: [GHC.Internal.Types.Any]
+ _sat :: [GHC.Internal.Types.Any]
[LclId, Unf=OtherCon []] =
:! [GHC.Internal.Tuple.() GHC.Internal.Types.[]];
- } in GHC.Internal.Base.returnIO sat;
+ } in GHC.Internal.Base.returnIO _sat;
=====================================
testsuite/tests/simplCore/should_compile/T20040.stderr
=====================================
@@ -16,7 +16,9 @@ ifoldl' =
Cons ipv2 ipv3 ->
case z of z1 {
__DEFAULT ->
- case f z1 ipv2 of sat { __DEFAULT -> ifoldl' f sat ipv3; };
+ case f z1 ipv2 of ifoldl'_sat {
+ __DEFAULT -> ifoldl' f ifoldl'_sat ipv3;
+ };
};
};
end Rec }
=====================================
testsuite/tests/simplCore/should_compile/T23083.stderr
=====================================
@@ -13,10 +13,10 @@ T23083.g :: ((GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer
T23083.g
= \ (f [Occ=Once1!] :: (GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer) -> GHC.Internal.Bignum.Integer.Integer) (h [Occ=OnceL1] :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer) ->
let {
- sat [Occ=Once1] :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer
+ g_sat [Occ=Once1] :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer
[LclId, Unf=OtherCon []]
- sat = \ (eta [Occ=Once1] :: GHC.Internal.Bignum.Integer.Integer) -> case h of h1 [Occ=Once1] { __DEFAULT -> T23083.$$ @GHC.Internal.Bignum.Integer.Integer @GHC.Internal.Bignum.Integer.Integer h1 eta } } in
- f sat
+ g_sat = \ (eta [Occ=Once1] :: GHC.Internal.Bignum.Integer.Integer) -> case h of h1 [Occ=Once1] { __DEFAULT -> T23083.$$ @GHC.Internal.Bignum.Integer.Integer @GHC.Internal.Bignum.Integer.Integer h1 eta } } in
+ f g_sat
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
T23083.$trModule4 :: GHC.Prim.Addr#
=====================================
testsuite/tests/simplStg/should_compile/T15226b.stderr
=====================================
@@ -8,13 +8,13 @@ T15226b.bar1
T15226b.Str (GHC.Internal.Maybe.Maybe a) #)
[GblId, Arity=2, Str=<L><L>, Cpr=1(, 1), Unf=OtherCon []] =
{} \r [x void]
- case x of sat {
+ case x of bar1_sat {
__DEFAULT ->
let {
- sat [Occ=Once1] :: T15226b.Str (GHC.Internal.Maybe.Maybe a)
+ bar1_sat [Occ=Once1] :: T15226b.Str (GHC.Internal.Maybe.Maybe a)
[LclId, Unf=OtherCon []] =
- T15226b.Str! [sat];
- } in GHC.Internal.Types.MkSolo# [sat];
+ T15226b.Str! [bar1_sat];
+ } in GHC.Internal.Types.MkSolo# [bar1_sat];
};
T15226b.bar
=====================================
testsuite/tests/simplStg/should_compile/T19717.stderr
=====================================
@@ -6,14 +6,14 @@ Foo.f :: forall {a}. a -> [GHC.Internal.Maybe.Maybe a]
case x of x1 {
__DEFAULT ->
let {
- sat [Occ=Once1] :: GHC.Internal.Maybe.Maybe a
+ f_sat [Occ=Once1] :: GHC.Internal.Maybe.Maybe a
[LclId, Unf=OtherCon []] =
GHC.Internal.Maybe.Just! [x1]; } in
let {
- sat [Occ=Once1] :: [GHC.Internal.Maybe.Maybe a]
+ f_sat [Occ=Once1] :: [GHC.Internal.Maybe.Maybe a]
[LclId, Unf=OtherCon []] =
- :! [sat GHC.Internal.Types.[]];
- } in : [sat sat];
+ :! [f_sat GHC.Internal.Types.[]];
+ } in : [f_sat f_sat];
};
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs
=====================================
@@ -36,6 +36,7 @@ parseArch :: Cc -> String -> M Arch
parseArch cc arch =
case arch of
"i386" -> pure ArchX86
+ "i686" -> pure ArchX86
"x86_64" -> pure ArchX86_64
"amd64" -> pure ArchX86_64
"powerpc" -> pure ArchPPC
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7db1988edb0a4de3b951ed76bdf255c6a97de91f...b666e6c8fcaf6cb2ed1f65ce7feae1bff4324669
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7db1988edb0a4de3b951ed76bdf255c6a97de91f...b666e6c8fcaf6cb2ed1f65ce7feae1bff4324669
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250205/6cea6783/attachment-0001.html>
More information about the ghc-commits
mailing list