14 Jul '25
Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC
Commits:
028e1bea by Simon Peyton Jones at 2025-07-14T09:02:59+01:00
Wibble imports again
- - - - -
1 changed file:
- compiler/GHC/Types/Var.hs
Changes:
=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -128,7 +128,7 @@ import {-# SOURCE #-} GHC.Builtin.Types ( manyDataConTy )
import GHC.Types.Name hiding (varName)
import GHC.Types.Unique ( Uniquable, Unique, getKey, getUnique
, nonDetCmpUnique )
-import GHC.Types.Basic( TypeOrConstraint(..), OccInfo, TyCoOccInfo(..) )
+import GHC.Types.Basic( TypeOrConstraint(..), TyCoOccInfo(..) )
import GHC.Utils.Misc
import GHC.Utils.Binary
import GHC.Utils.Outputable
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/028e1beaf3bd9c98ecb3d6c33793f20…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/028e1beaf3bd9c98ecb3d6c33793f20…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC
Commits:
26ad8ab2 by Simon Peyton Jones at 2025-07-14T08:13:03+01:00
Wibble imports
- - - - -
1 changed file:
- compiler/GHC/Types/Var.hs
Changes:
=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -128,7 +128,7 @@ import {-# SOURCE #-} GHC.Builtin.Types ( manyDataConTy )
import GHC.Types.Name hiding (varName)
import GHC.Types.Unique ( Uniquable, Unique, getKey, getUnique
, nonDetCmpUnique )
-import GHC.Types.Basic( TypeOrConstraint(..), OccInfo, noOccInfo, TyCoOccInfo(..) )
+import GHC.Types.Basic( TypeOrConstraint(..), OccInfo, TyCoOccInfo(..) )
import GHC.Utils.Misc
import GHC.Utils.Binary
import GHC.Utils.Outputable
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26ad8ab2d90bd3454eac1a3b14be9a0…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26ad8ab2d90bd3454eac1a3b14be9a0…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/ctorig-stuff] 6 commits: fix exprCtOrigin for HsProjection case. It was assigned to be SectionOrigin,...
by Apoorv Ingle (＠ani) 14 Jul '25
by Apoorv Ingle (＠ani) 14 Jul '25
14 Jul '25
Apoorv Ingle pushed to branch wip/ani/ctorig-stuff at Glasgow Haskell Compiler / GHC
Commits:
e12c1e9d by Apoorv Ingle at 2025-06-29T20:27:28-05:00
fix exprCtOrigin for HsProjection case. It was assigned to be SectionOrigin, but it should be GetFieldOrigin
- - - - -
d37adc69 by Apoorv Ingle at 2025-06-29T21:37:38-05:00
undo test changes
- - - - -
bde2465e by Apoorv Ingle at 2025-07-02T16:02:03-05:00
fix unused do binding warning error location
- - - - -
e199446b by Apoorv Ingle at 2025-07-02T16:11:44-05:00
FRRRecordUpdate message change
- - - - -
2fb3b1ba by Apoorv Ingle at 2025-07-07T00:16:14-05:00
- kill tcl_in_gen_code
- It is subsumed by `ErrCtxtStack` which keep tracks of `ErrCtxt` and code ctxt
- - - - -
e1864b1a by Apoorv Ingle at 2025-07-13T21:14:25-05:00
kill ExpectedFunTyOrig
- - - - -
17 changed files:
- compiler/GHC/Hs.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/Unify.hs
- testsuite/tests/deSugar/should_compile/T10662.stderr
- testsuite/tests/deSugar/should_compile/T3263-1.stderr
- testsuite/tests/deSugar/should_compile/T3263-2.stderr
- testsuite/tests/ghci.debugger/scripts/break029.script
- testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr
Changes:
=====================================
compiler/GHC/Hs.hs
=====================================
@@ -38,8 +38,6 @@ module GHC.Hs (
HsModule(..), AnnsModule(..),
HsParsedModule(..), XModulePs(..),
- SrcCodeCtxt(..), isUserCodeCtxt, isGeneratedCodeCtxt
-
) where
-- friends:
@@ -149,17 +147,3 @@ data HsParsedModule = HsParsedModule {
-- the .hi file, so that we can force recompilation if any of
-- them change (#3589)
}
-
--- Used in TcLclCtxt.tcl_in_gen_code to mark if the current expression
--- is a user generated code or a compiler generated expansion of some user written code
-data SrcCodeCtxt
- = UserCode
- | GeneratedCode SrcCodeOrigin
-
-isUserCodeCtxt :: SrcCodeCtxt -> Bool
-isUserCodeCtxt UserCode = True
-isUserCodeCtxt _ = False
-
-isGeneratedCodeCtxt :: SrcCodeCtxt -> Bool
-isGeneratedCodeCtxt UserCode = False
-isGeneratedCodeCtxt _ = True
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -1234,8 +1234,8 @@ Other places that requires from the same treatment:
-- Warn about certain types of values discarded in monadic bindings (#3263)
warnDiscardedDoBindings :: LHsExpr GhcTc -> Type -> Type -> DsM ()
-warnDiscardedDoBindings rhs m_ty elt_ty
- = do { warn_unused <- woptM Opt_WarnUnusedDoBind
+warnDiscardedDoBindings rhs@(L rhs_loc _) m_ty elt_ty
+ = putSrcSpanDsA rhs_loc $ do { warn_unused <- woptM Opt_WarnUnusedDoBind
; warn_wrong <- woptM Opt_WarnWrongDoBind
; when (warn_unused || warn_wrong) $
do { fam_inst_envs <- dsGetFamInstEnvs
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -189,8 +189,8 @@ tcExprSigma inst rn_expr
= do { (fun@(rn_fun,fun_ctxt), rn_args) <- splitHsApps rn_expr
; do_ql <- wantQuickLook rn_fun
; (tc_fun, fun_sigma) <- tcInferAppHead fun
- ; code_ctxt <- getSrcCodeCtxt
- ; let fun_orig = srcCodeCtxtCtOrigin rn_expr code_ctxt
+ ; code_orig <- getSrcCodeOrigin
+ ; let fun_orig = srcCodeOriginCtOrigin rn_expr code_orig
; (inst_args, app_res_sigma) <- tcInstFun do_ql inst fun_orig (tc_fun, rn_fun, fun_ctxt) fun_sigma rn_args
; tc_args <- tcValArgs do_ql rn_fun inst_args
; let tc_expr = rebuildHsApps (tc_fun, fun_ctxt) tc_args
@@ -417,8 +417,8 @@ tcApp rn_expr exp_res_ty
; let tc_head = (tc_fun, fun_loc)
-- Step 3: Instantiate the function type (taking a quick look at args)
; do_ql <- wantQuickLook rn_fun
- ; code_ctxt <- getSrcCodeCtxt
- ; let fun_orig = srcCodeCtxtCtOrigin rn_fun code_ctxt
+ ; code_orig <- getSrcCodeOrigin
+ ; let fun_orig = srcCodeOriginCtOrigin rn_fun code_orig
; traceTc "tcApp:inferAppHead" $
vcat [ text "tc_fun:" <+> ppr tc_fun
, text "fun_sigma:" <+> ppr fun_sigma
@@ -857,8 +857,7 @@ tcInstFun do_ql inst_final fun_orig (tc_fun, rn_fun, fun_ctxt) fun_sigma rn_args
-- Rule IARG from Fig 4 of the QL paper:
go1 pos acc fun_ty
(EValArg { ea_arg = arg, ea_ctxt = ctxt } : rest_args)
- = do { let herald | DoStmtOrigin <- fun_orig = ExpectedFunTySyntaxOp fun_orig tc_fun -- cf. RepPolyDoBind.hs
- | otherwise = ExpectedFunTyArg (HsExprTcThing tc_fun) (unLoc arg)
+ = do { let herald = ExpectedFunTyArg pos (HsExprTcThing tc_fun) (unLoc arg)
; (wrap, arg_ty, res_ty) <-
-- NB: matchActualFunTy does the rep-poly check.
-- For example, suppose we have f :: forall r (a::TYPE r). a -> Int
@@ -877,7 +876,7 @@ tcInstFun do_ql inst_final fun_orig (tc_fun, rn_fun, fun_ctxt) fun_sigma rn_args
-- Make a fresh nus for each argument in rule IVAR
new_arg_ty (L _ arg) i
= do { arg_nu <- newOpenFlexiFRRTyVarTy $
- FRRExpectedFunTy (ExpectedFunTyArg (HsExprTcThing tc_fun) arg) i
+ FRRExpectedFunTy (ExpectedFunTyArg i (HsExprTcThing tc_fun) arg) i
-- Following matchActualFunTy, we create nu_i :: TYPE kappa_i[conc],
-- thereby ensuring that the arguments have concrete runtime representations
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -976,7 +976,7 @@ tcSynArgE orig op sigma_ty syn_ty thing_inside
-- fixed RuntimeRep, as needed to call mkWpFun.
; return (result, match_wrapper <.> fun_wrap) }
where
- herald = ExpectedFunTySyntaxOp orig op
+ herald = ExpectedFunTySyntaxOp 1 orig op
go rho_ty (SynType the_ty)
= do { wrap <- tcSubTypePat orig GenSigCtxt the_ty rho_ty
@@ -1005,7 +1005,7 @@ tcSynArgA orig op sigma_ty arg_shapes res_shape thing_inside
thing_inside (arg_results ++ res_results) (map scaledMult arg_tys ++ arg_res_mults)
; return (result, match_wrapper, arg_wrappers, res_wrapper) }
where
- herald = ExpectedFunTySyntaxOp orig op
+ herald = ExpectedFunTySyntaxOp (length arg_shapes) orig op
tc_syn_args_e :: [TcSigmaTypeFRR] -> [SyntaxOpType]
-> ([TcSigmaTypeFRR] -> [Mult] -> TcM a)
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -655,7 +655,7 @@ tcInferOverLit lit@(OverLit { ol_val = val
; let
thing = NameThing from_name
mb_thing = Just thing
- herald = ExpectedFunTyArg thing (HsLit noExtField hs_lit)
+ herald = ExpectedFunTyArg 1 thing (HsLit noExtField hs_lit)
; (wrap2, sarg_ty, res_ty) <- matchActualFunTy herald mb_thing (1, from_ty) from_ty
; co <- unifyType mb_thing (hsLitType hs_lit) (scaledThing sarg_ty)
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -118,7 +118,7 @@ tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty
= assertPpr (funBindPrecondition matches) (pprMatches matches) $
do { -- Check that they all have the same no of arguments
arity <- checkArgCounts matches
-
+ ; let herald = ExpectedFunTyMatches arity (NameThing fun_name) matches
; traceTc "tcFunBindMatches 1" (ppr fun_name $$ ppr mult $$ ppr exp_ty $$ ppr arity)
; (wrap_fun, r)
@@ -138,7 +138,7 @@ tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty
; return (wrap_fun, r) }
where
mctxt = mkPrefixFunRhs (noLocA fun_name) noAnn
- herald = ExpectedFunTyMatches (NameThing fun_name) matches
+
funBindPrecondition :: MatchGroup GhcRn (LHsExpr GhcRn) -> Bool
funBindPrecondition (MG { mg_alts = L _ alts })
=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -698,7 +698,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
-- Note [View patterns and polymorphism]
-- Expression must be a function
- ; let herald = ExpectedFunTyViewPat $ unLoc expr
+ ; let herald = ExpectedFunTyViewPat 1 $ unLoc expr
; (expr_wrap1, Scaled _mult inf_arg_ty, inf_res_sigma)
<- matchActualFunTy herald (Just . HsExprRnThing $ unLoc expr) (1,expr_ty) expr_ty
-- See Note [View patterns and polymorphism]
=====================================
compiler/GHC/Tc/Types/ErrCtxt.hs
=====================================
@@ -17,7 +17,7 @@ import GHC.Hs.Extension
import GHC.Parser.Annotation ( LocatedN, SrcSpanAnnA )
import GHC.Tc.Errors.Types.PromotionErr ( TermLevelUseCtxt )
-import GHC.Tc.Types.Origin ( CtOrigin, UserTypeCtxt, ExpectedFunTyOrigin )
+import GHC.Tc.Types.Origin ( CtOrigin, UserTypeCtxt )
import GHC.Tc.Utils.TcType ( TcType, TcTyCon )
import GHC.Tc.Zonk.Monad ( ZonkM )
@@ -120,7 +120,7 @@ data ErrCtxtMsg
-- | In a function application.
| FunAppCtxt !FunAppCtxtFunArg !Int
-- | In a function call.
- | FunTysCtxt !ExpectedFunTyOrigin !Type !Int !Int
+ | FunTysCtxt !CtOrigin !Type !Int !Int
-- | In the result of a function call.
| FunResCtxt !(HsExpr GhcTc) !Int !Type !Type !Int !Int
-- | In the declaration of a type constructor.
=====================================
compiler/GHC/Tc/Types/LclEnv.hs
=====================================
@@ -21,13 +21,14 @@ module GHC.Tc.Types.LclEnv (
, setLclEnvTypeEnv
, modifyLclEnvTcLevel
- , getLclEnvSrcCodeCtxt
- , setLclEnvSrcCodeCtxt
- , setLclCtxtSrcCodeCtxt
+ , getLclEnvSrcCodeOrigin
+ , setLclEnvSrcCodeOrigin
+ , setLclCtxtSrcCodeOrigin
, lclEnvInGeneratedCode
, addLclEnvErrCtxt
+ , ErrCtxtStack (..)
, ArrowCtxt(..)
, ThBindEnv
, TcTypeEnv
@@ -35,7 +36,7 @@ module GHC.Tc.Types.LclEnv (
import GHC.Prelude
-import GHC.Hs ( SrcCodeCtxt (..), isGeneratedCodeCtxt )
+import GHC.Hs ( SrcCodeOrigin )
import GHC.Tc.Utils.TcType ( TcLevel )
import GHC.Tc.Errors.Types ( TcRnMessage )
@@ -90,11 +91,29 @@ data TcLclEnv -- Changes as we move inside an expression
tcl_errs :: TcRef (Messages TcRnMessage) -- Place to accumulate diagnostics
}
+
+data ErrCtxtStack
+ = UserCodeCtxt {err_ctxt :: [ErrCtxt]}
+ | GeneratedCodeCtxt { src_code_origin :: SrcCodeOrigin
+ , err_ctxt :: [ErrCtxt] }
+
+isGeneratedCodeCtxt :: ErrCtxtStack -> Bool
+isGeneratedCodeCtxt UserCodeCtxt{} = False
+isGeneratedCodeCtxt _ = True
+
+get_src_code_origin :: ErrCtxtStack -> Maybe SrcCodeOrigin
+get_src_code_origin (UserCodeCtxt{}) = Nothing
+get_src_code_origin es = Just $ src_code_origin es
+
+modify_err_ctxt_stack :: ([ErrCtxt] -> [ErrCtxt]) -> ErrCtxtStack -> ErrCtxtStack
+modify_err_ctxt_stack f (UserCodeCtxt e) = UserCodeCtxt (f e)
+modify_err_ctxt_stack _ c = c -- any updates on the err context in generated context should be ignored
+
+
data TcLclCtxt
= TcLclCtxt {
tcl_loc :: RealSrcSpan, -- Source span
- tcl_ctxt :: [ErrCtxt], -- Error context, innermost on top
- tcl_in_gen_code :: SrcCodeCtxt,
+ tcl_ctxt :: ErrCtxtStack,
tcl_tclvl :: TcLevel,
tcl_bndrs :: TcBinderStack, -- Used for reporting relevant bindings,
-- and for tidying type
@@ -159,28 +178,28 @@ getLclEnvLoc :: TcLclEnv -> RealSrcSpan
getLclEnvLoc = tcl_loc . tcl_lcl_ctxt
getLclEnvErrCtxt :: TcLclEnv -> [ErrCtxt]
-getLclEnvErrCtxt = tcl_ctxt . tcl_lcl_ctxt
+getLclEnvErrCtxt = err_ctxt . tcl_ctxt . tcl_lcl_ctxt
setLclEnvErrCtxt :: [ErrCtxt] -> TcLclEnv -> TcLclEnv
-setLclEnvErrCtxt ctxt = modifyLclCtxt (\env -> env { tcl_ctxt = ctxt })
+setLclEnvErrCtxt ctxt = modifyLclCtxt (\env -> env { tcl_ctxt = modify_err_ctxt_stack (\ _ -> ctxt) (tcl_ctxt env) })
addLclEnvErrCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv
-addLclEnvErrCtxt ctxt = modifyLclCtxt (\env -> env { tcl_ctxt = ctxt : (tcl_ctxt env) })
+addLclEnvErrCtxt ec = modifyLclCtxt (\env -> env { tcl_ctxt = modify_err_ctxt_stack (\ctxt -> ec : ctxt) (tcl_ctxt env) })
-getLclEnvSrcCodeCtxt :: TcLclEnv -> SrcCodeCtxt
-getLclEnvSrcCodeCtxt = tcl_in_gen_code . tcl_lcl_ctxt
+getLclEnvSrcCodeOrigin :: TcLclEnv -> Maybe SrcCodeOrigin
+getLclEnvSrcCodeOrigin = get_src_code_origin . tcl_ctxt . tcl_lcl_ctxt
-lclEnvInGeneratedCode :: TcLclEnv -> Bool
-lclEnvInGeneratedCode = lclCtxtInGeneratedCode . tcl_lcl_ctxt
+setLclEnvSrcCodeOrigin :: SrcCodeOrigin -> TcLclEnv -> TcLclEnv
+setLclEnvSrcCodeOrigin o = modifyLclCtxt (setLclCtxtSrcCodeOrigin o)
-lclCtxtInGeneratedCode :: TcLclCtxt -> Bool
-lclCtxtInGeneratedCode = isGeneratedCodeCtxt . tcl_in_gen_code
+setLclCtxtSrcCodeOrigin :: SrcCodeOrigin -> TcLclCtxt -> TcLclCtxt
+setLclCtxtSrcCodeOrigin o ctxt = ctxt { tcl_ctxt = GeneratedCodeCtxt o (err_ctxt $ tcl_ctxt ctxt) }
-setLclCtxtSrcCodeCtxt :: SrcCodeCtxt -> TcLclCtxt -> TcLclCtxt
-setLclCtxtSrcCodeCtxt userOrGen env = env { tcl_in_gen_code = userOrGen }
+lclCtxtInGeneratedCode :: TcLclCtxt -> Bool
+lclCtxtInGeneratedCode = isGeneratedCodeCtxt . tcl_ctxt
-setLclEnvSrcCodeCtxt :: SrcCodeCtxt -> TcLclEnv -> TcLclEnv
-setLclEnvSrcCodeCtxt userOrGen = modifyLclCtxt (\ctxt -> setLclCtxtSrcCodeCtxt userOrGen ctxt)
+lclEnvInGeneratedCode :: TcLclEnv -> Bool
+lclEnvInGeneratedCode = lclCtxtInGeneratedCode . tcl_lcl_ctxt
getLclEnvBinderStack :: TcLclEnv -> TcBinderStack
getLclEnvBinderStack = tcl_bndrs . tcl_lcl_ctxt
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -19,7 +19,7 @@ module GHC.Tc.Types.Origin (
-- * CtOrigin
CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
- srcCodeCtxtCtOrigin,
+ srcCodeOriginCtOrigin,
isVisibleOrigin, toInvisibleOrigin,
pprCtOrigin, isGivenOrigin, isWantedWantedFunDepOrigin,
isWantedSuperclassOrigin,
@@ -45,7 +45,7 @@ module GHC.Tc.Types.Origin (
FRRArrowContext(..), pprFRRArrowContext,
-- ** ExpectedFunTy FixedRuntimeRepOrigin
- ExpectedFunTyOrigin(..), pprExpectedFunTyOrigin, pprExpectedFunTyHerald,
+ pprExpectedFunTyHerald,
-- * InstanceWhat
InstanceWhat(..), SafeOverlapping
@@ -653,6 +653,62 @@ data CtOrigin
| AmbiguityCheckOrigin UserTypeCtxt
| ImplicitLiftOrigin HsImplicitLiftSplice
+ | ExpansionOrigin SrcCodeOrigin -- This is due to an expansion of the original thing given by SrcCodeOrigin
+
+
+
+ -- | A rebindable syntax operator is expected to have a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyDoBind, RepPolyDoBody{1,2}, RepPolyMc{Bind,Body,Guard}, RepPolyNPlusK
+ | forall (p :: Pass)
+ . (OutputableBndrId p)
+ => ExpectedFunTySyntaxOp Int
+ !CtOrigin !(HsExpr (GhcPass p))
+ -- ^ rebindable syntax operator
+
+ -- | A view pattern must have a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyBinder
+ | ExpectedFunTyViewPat Int
+ !(HsExpr GhcRn)
+ -- ^ function used in the view pattern
+
+ -- | Need to be able to extract an argument type from a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyApp
+ | forall (p :: Pass)
+ . Outputable (HsExpr (GhcPass p)) => ExpectedFunTyArg
+ Int
+ -- ^ Argument number
+ !TypedThing
+ -- ^ function
+ !(HsExpr (GhcPass p))
+ -- ^ argument
+
+ -- | Ensure that a function defined by equations indeed has a function type
+ -- with the appropriate number of arguments.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyBinder, RepPolyRecordPattern, RepPolyWildcardPattern
+ | ExpectedFunTyMatches Int
+ !TypedThing
+ -- ^ name of the function
+ !(MatchGroup GhcRn (LHsExpr GhcRn))
+ -- ^ equations
+
+ -- | Ensure that a lambda abstraction has a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyLambda, RepPolyMatch
+ | ExpectedFunTyLam HsLamVariant
+ !(HsExpr GhcRn)
+ -- ^ the entire lambda-case expression
+
+
+
data NonLinearPatternReason
= LazyPatternReason
| GeneralisedPatternReason
@@ -737,7 +793,7 @@ exprCtOrigin (HsAppType _ e1 _) = lexprCtOrigin e1
exprCtOrigin (OpApp _ _ op _) = lexprCtOrigin op
exprCtOrigin (NegApp _ e _) = lexprCtOrigin e
exprCtOrigin (HsPar _ e) = lexprCtOrigin e
-exprCtOrigin (HsProjection _ _) = SectionOrigin
+exprCtOrigin e@(HsProjection _ _) = ExpansionOrigin (OrigExpr e)
exprCtOrigin (SectionL _ _ _) = SectionOrigin
exprCtOrigin (SectionR _ _ _) = SectionOrigin
exprCtOrigin (ExplicitTuple {}) = Shouldn'tHappenOrigin "explicit tuple"
@@ -763,18 +819,14 @@ exprCtOrigin (HsHole _) = Shouldn'tHappenOrigin "hole expression"
exprCtOrigin (HsForAll {}) = Shouldn'tHappenOrigin "forall telescope" -- See Note [Types in terms]
exprCtOrigin (HsQual {}) = Shouldn'tHappenOrigin "constraint context" -- See Note [Types in terms]
exprCtOrigin (HsFunArr {}) = Shouldn'tHappenOrigin "function arrow" -- See Note [Types in terms]
-exprCtOrigin (XExpr (ExpandedThingRn o _)) = srcCodeOriginCtOrigin o
+exprCtOrigin (XExpr (ExpandedThingRn o _)) = ExpansionOrigin o
exprCtOrigin (XExpr (PopErrCtxt e)) = exprCtOrigin e
exprCtOrigin (XExpr (HsRecSelRn f)) = OccurrenceOfRecSel (foExt f)
-srcCodeOriginCtOrigin :: SrcCodeOrigin -> CtOrigin
-srcCodeOriginCtOrigin (OrigExpr e) = exprCtOrigin e
-srcCodeOriginCtOrigin (OrigStmt{}) = DoStmtOrigin
-srcCodeOriginCtOrigin (OrigPat p) = DoPatOrigin p
-srcCodeCtxtCtOrigin :: HsExpr GhcRn -> SrcCodeCtxt -> CtOrigin
-srcCodeCtxtCtOrigin e UserCode = exprCtOrigin e
-srcCodeCtxtCtOrigin _ (GeneratedCode e) = srcCodeOriginCtOrigin e
+srcCodeOriginCtOrigin :: HsExpr GhcRn -> Maybe SrcCodeOrigin -> CtOrigin
+srcCodeOriginCtOrigin e Nothing = exprCtOrigin e
+srcCodeOriginCtOrigin _ (Just e) = ExpansionOrigin e
-- | Extract a suitable CtOrigin from a MatchGroup
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
@@ -800,6 +852,14 @@ pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin (GivenOrigin sk)
= ctoHerald <+> ppr sk
+pprCtOrigin (ExpansionOrigin o)
+ = ctoHerald <+> what
+ where what :: SDoc
+ what = case o of
+ OrigStmt{} -> text "a do statement"
+ OrigExpr e -> pprCtO (exprCtOrigin e)
+ OrigPat p -> text "a pattern" <+> ppr p
+
pprCtOrigin (GivenSCOrigin sk d blk)
= vcat [ ctoHerald <+> pprSkolInfo sk
, whenPprDebug (braces (text "given-sc:" <+> ppr d <> comma <> ppr blk)) ]
@@ -912,9 +972,38 @@ pprCtOrigin (NonLinearPatternOrigin reason pat)
= hang (ctoHerald <+> text "a non-linear pattern" <+> quotes (ppr pat))
2 (pprNonLinearPatternReason reason)
+pprCtOrigin (ExpectedFunTySyntaxOp i orig op) =
+ vcat [ sep [ the_arg_of i
+ , text "the rebindable syntax operator"
+ , quotes (ppr op) ]
+ , nest 2 (ppr orig) ]
+pprCtOrigin (ExpectedFunTyViewPat i expr) =
+ vcat [ the_arg_of i <+> text "the view pattern"
+ , nest 2 (ppr expr) ]
+pprCtOrigin (ExpectedFunTyArg i fun arg) =
+ sep [ text "The" <+> speakNth i <+> text "argument"
+ , quotes (ppr arg)
+ , text "of"
+ , quotes (ppr fun) ]
+pprCtOrigin (ExpectedFunTyMatches i fun (MG { mg_alts = L _ alts }))
+ | null alts
+ = the_arg_of i <+> quotes (ppr fun)
+ | otherwise
+ = text "The" <+> speakNth i <+> text "pattern in the equation" <> plural alts
+ <+> text "for" <+> quotes (ppr fun)
+pprCtOrigin (ExpectedFunTyLam lam_variant _) = binder_of $ lamCaseKeyword lam_variant
+
pprCtOrigin simple_origin
= ctoHerald <+> pprCtO simple_origin
+
+the_arg_of :: Int -> SDoc
+the_arg_of i = text "The" <+> speakNth i <+> text "argument of"
+
+binder_of :: SDoc -> SDoc
+binder_of what = text "The binder of the" <+> what <+> text "expression"
+
+
-- | Short one-liners
pprCtO :: HasDebugCallStack => CtOrigin -> SDoc
pprCtO (OccurrenceOf name) = hsep [text "a use of", quotes (ppr name)]
@@ -940,7 +1029,7 @@ pprCtO (ScOrigin (IsQC {}) _) = text "the head of a quantified constraint"
pprCtO DerivClauseOrigin = text "the 'deriving' clause of a data type declaration"
pprCtO StandAloneDerivOrigin = text "a 'deriving' declaration"
pprCtO DefaultOrigin = text "a 'default' declaration"
-pprCtO DoStmtOrigin = text "a do statement"
+pprCtO DoStmtOrigin = text "a do statement"
pprCtO MCompOrigin = text "a statement in a monad comprehension"
pprCtO ProcOrigin = text "a proc expression"
pprCtO ArrowCmdOrigin = text "an arrow command"
@@ -983,6 +1072,14 @@ pprCtO (InstanceSigOrigin {}) = text "a type signature in an instance"
pprCtO (AmbiguityCheckOrigin {}) = text "a type ambiguity check"
pprCtO (ImpedanceMatching {}) = text "combining required constraints"
pprCtO (NonLinearPatternOrigin _ pat) = hsep [text "a non-linear pattern" <+> quotes (ppr pat)]
+pprCtO (ExpansionOrigin (OrigPat p)) = hsep [text "a pattern" <+> quotes (ppr p)]
+pprCtO (ExpansionOrigin (OrigStmt{})) = text "a do statement"
+pprCtO (ExpansionOrigin (OrigExpr e)) = text "an expression" <+> ppr e
+pprCtO (ExpectedFunTySyntaxOp{}) = text "a rebindable syntax operator"
+pprCtO (ExpectedFunTyViewPat{}) = text "a view pattern"
+pprCtO (ExpectedFunTyArg{}) = text "a funtion head"
+pprCtO (ExpectedFunTyMatches{}) = text "a match statement"
+pprCtO (ExpectedFunTyLam{}) = text "a lambda expression"
pprNonLinearPatternReason :: HasDebugCallStack => NonLinearPatternReason -> SDoc
pprNonLinearPatternReason LazyPatternReason = parens (text "non-variable lazy pattern aren't linear")
@@ -1195,7 +1292,7 @@ data FixedRuntimeRepContext
--
-- See 'ExpectedFunTyOrigin' for more details.
| FRRExpectedFunTy
- !ExpectedFunTyOrigin
+ !CtOrigin -- !ExpectedFunTyOrigin
!Int
-- ^ argument position (1-indexed)
@@ -1228,11 +1325,10 @@ mkFRRUnboxedSum = FRRUnboxedSum
-- and is reported separately.
pprFixedRuntimeRepContext :: FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext (FRRRecordCon lbl _arg)
- = sep [ text "The field", quotes (ppr lbl)
+ = sep [ text "The field", quotes (ppr lbl) -- TODO ANI: Where does this get used? Add missing test?
, text "of the record constructor" ]
-pprFixedRuntimeRepContext (FRRRecordUpdate lbl _arg)
- = sep [ text "The record update at field"
- , quotes (ppr lbl) ]
+pprFixedRuntimeRepContext (FRRRecordUpdate lbl _)
+ = sep [ text "The field", quotes (ppr lbl) ]
pprFixedRuntimeRepContext (FRRBinder binder)
= sep [ text "The binder"
, quotes (ppr binder) ]
@@ -1277,8 +1373,8 @@ pprFixedRuntimeRepContext FRRBindStmtGuard
= sep [ text "The body of the bind statement" ]
pprFixedRuntimeRepContext (FRRArrow arrowContext)
= pprFRRArrowContext arrowContext
-pprFixedRuntimeRepContext (FRRExpectedFunTy funTyOrig arg_pos)
- = pprExpectedFunTyOrigin funTyOrig arg_pos
+pprFixedRuntimeRepContext (FRRExpectedFunTy funTyOrig _)
+ = pprCtOrigin funTyOrig
instance Outputable FixedRuntimeRepContext where
ppr = pprFixedRuntimeRepContext
@@ -1431,102 +1527,56 @@ instance Outputable FRRArrowContext where
-- Uses 'pprExpectedFunTyOrigin'.
-- See 'FixedRuntimeRepContext' for the situations in which
-- representation-polymorphism checks are performed.
-data ExpectedFunTyOrigin
-
- -- | A rebindable syntax operator is expected to have a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyDoBind, RepPolyDoBody{1,2}, RepPolyMc{Bind,Body,Guard}, RepPolyNPlusK
- = forall (p :: Pass)
- . (OutputableBndrId p)
- => ExpectedFunTySyntaxOp !CtOrigin !(HsExpr (GhcPass p))
- -- ^ rebindable syntax operator
-
- -- | A view pattern must have a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyBinder
- | ExpectedFunTyViewPat
- !(HsExpr GhcRn)
- -- ^ function used in the view pattern
-
- -- | Need to be able to extract an argument type from a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyApp
- | forall (p :: Pass)
- . Outputable (HsExpr (GhcPass p)) => ExpectedFunTyArg
- !TypedThing
- -- ^ function
- !(HsExpr (GhcPass p))
- -- ^ argument
-
- -- | Ensure that a function defined by equations indeed has a function type
- -- with the appropriate number of arguments.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyBinder, RepPolyRecordPattern, RepPolyWildcardPattern
- | ExpectedFunTyMatches
- !TypedThing
- -- ^ name of the function
- !(MatchGroup GhcRn (LHsExpr GhcRn))
- -- ^ equations
-
- -- | Ensure that a lambda abstraction has a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyLambda, RepPolyMatch
- | ExpectedFunTyLam HsLamVariant
- !(HsExpr GhcRn)
- -- ^ the entire lambda-case expression
-
-pprExpectedFunTyOrigin :: ExpectedFunTyOrigin
- -> Int -- ^ argument position (starting at 1)
- -> SDoc
-pprExpectedFunTyOrigin funTy_origin i =
- case funTy_origin of
- ExpectedFunTySyntaxOp orig op ->
- vcat [ sep [ the_arg_of
- , text "the rebindable syntax operator"
- , quotes (ppr op) ]
- , nest 2 (ppr orig) ]
- ExpectedFunTyViewPat expr ->
- vcat [ the_arg_of <+> text "the view pattern"
- , nest 2 (ppr expr) ]
- ExpectedFunTyArg fun arg ->
- sep [ text "The argument"
- , quotes (ppr arg)
- , text "of"
- , quotes (ppr fun) ]
- ExpectedFunTyMatches fun (MG { mg_alts = L _ alts })
- | null alts
- -> the_arg_of <+> quotes (ppr fun)
- | otherwise
- -> text "The" <+> speakNth i <+> text "pattern in the equation" <> plural alts
- <+> text "for" <+> quotes (ppr fun)
- ExpectedFunTyLam lam_variant _ -> binder_of $ lamCaseKeyword lam_variant
- where
- the_arg_of :: SDoc
- the_arg_of = text "The" <+> speakNth i <+> text "argument of"
- binder_of :: SDoc -> SDoc
- binder_of what = text "The binder of the" <+> what <+> text "expression"
-pprExpectedFunTyHerald :: ExpectedFunTyOrigin -> SDoc
+-- pprExpectedFunTyOrigin :: -- ExpectedFunTyOrigin
+-- -- -> Int -- ^ argument position (starting at 1)
+-- -> SDoc
+-- pprExpectedFunTyOrigin funTy_origin =
+-- case funTy_origin of
+-- ExpectedFunTySyntaxOp i orig op ->
+-- vcat [ sep [ the_arg_of
+-- , text "the rebindable syntax operator"
+-- , quotes (ppr op) ]
+-- , nest 2 (ppr orig) ]
+-- ExpectedFunTyViewPat i expr ->
+-- vcat [ the_arg_of <+> text "the view pattern"
+-- , nest 2 (ppr expr) ]
+-- ExpectedFunTyArg fun arg ->
+-- sep [ text "The argument"
+-- , quotes (ppr arg)
+-- , text "of"
+-- , quotes (ppr fun) ]
+-- ExpectedFunTyMatches i fun (MG { mg_alts = L _ alts })
+-- | null alts
+-- -> the_arg_of <+> quotes (ppr fun)
+-- | otherwise
+-- -> text "The" <+> speakNth i <+> text "pattern in the equation" <> plural alts
+-- <+> text "for" <+> quotes (ppr fun)
+-- ExpectedFunTyLam lam_variant _ -> binder_of $ lamCaseKeyword lam_variant
+-- where
+-- the_arg_of :: Int -> SDoc
+-- the_arg_of i = text "The" <+> speakNth i <+> text "argument of"
+
+-- binder_of :: SDoc -> SDoc
+-- binder_of what = text "The binder of the" <+> what <+> text "expression"
+
+pprExpectedFunTyHerald :: CtOrigin -> SDoc
pprExpectedFunTyHerald (ExpectedFunTySyntaxOp {})
= text "This rebindable syntax expects a function with"
pprExpectedFunTyHerald (ExpectedFunTyViewPat {})
= text "A view pattern expression expects"
-pprExpectedFunTyHerald (ExpectedFunTyArg fun _)
+pprExpectedFunTyHerald (ExpectedFunTyArg _ fun _)
= sep [ text "The function" <+> quotes (ppr fun)
, text "is applied to" ]
-pprExpectedFunTyHerald (ExpectedFunTyMatches fun (MG { mg_alts = L _ alts }))
+pprExpectedFunTyHerald (ExpectedFunTyMatches _ fun (MG { mg_alts = L _ alts }))
= text "The equation" <> plural alts <+> text "for" <+> quotes (ppr fun) <+> hasOrHave alts
pprExpectedFunTyHerald (ExpectedFunTyLam lam_variant expr)
= sep [ text "The" <+> lamCaseKeyword lam_variant <+> text "expression"
<+> quotes (pprSetDepth (PartWay 1) (ppr expr))
-- The pprSetDepth makes the lambda abstraction print briefly
, text "has" ]
+pprExpectedFunTyHerald orig = ppr (Shouldn'tHappenOrigin "pprExpectedFunTyHerald") <+> ppr orig
{- *******************************************************************
* *
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -58,7 +58,7 @@ module GHC.Tc.Utils.Monad(
addDependentFiles,
-- * Error management
- getSrcCodeCtxt,
+ getSrcCodeOrigin,
getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
inGeneratedCode, setInGeneratedCode,
wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
@@ -400,8 +400,7 @@ initTcWithGbl hsc_env gbl_env loc do_this
tcl_lcl_ctxt = TcLclCtxt {
tcl_loc = loc,
-- tcl_loc should be over-ridden very soon!
- tcl_in_gen_code = UserCode,
- tcl_ctxt = [],
+ tcl_ctxt = UserCodeCtxt [],
tcl_rdr = emptyLocalRdrEnv,
tcl_th_ctxt = topLevel,
tcl_th_bndrs = emptyNameEnv,
@@ -978,21 +977,21 @@ setSrcSpan :: SrcSpan -> TcRn a -> TcRn a
-- See Note [Error contexts in generated code]
-- for the tcl_in_gen_code manipulation
setSrcSpan (RealSrcSpan loc _) thing_inside
- = updLclCtxt (\env -> env { tcl_loc = loc, tcl_in_gen_code = UserCode })
+ = updLclCtxt (\env -> env { tcl_loc = loc, tcl_ctxt = UserCodeCtxt (err_ctxt $ tcl_ctxt env)})
thing_inside
setSrcSpan (UnhelpfulSpan _) thing_inside
= thing_inside
-getSrcCodeCtxt :: TcRn SrcCodeCtxt
-getSrcCodeCtxt = getLclEnvSrcCodeCtxt <$> getLclEnv
+getSrcCodeOrigin :: TcRn (Maybe SrcCodeOrigin)
+getSrcCodeOrigin = getLclEnvSrcCodeOrigin <$> getLclEnv
-- | Mark the inner computation as being done inside generated code.
--
-- See Note [Error contexts in generated code]
setInGeneratedCode :: SrcCodeOrigin -> TcRn a -> TcRn a
-setInGeneratedCode scOrig thing_inside =
- updLclCtxt (setLclCtxtSrcCodeCtxt (GeneratedCode scOrig)) thing_inside
+setInGeneratedCode sco thing_inside =
+ updLclCtxt (setLclCtxtSrcCodeOrigin sco) thing_inside
setSrcSpanA :: EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA l = setSrcSpan (locA l)
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -135,7 +135,7 @@ import Data.Traversable (for)
--
-- See Note [Return arguments with a fixed RuntimeRep].
matchActualFunTy
- :: ExpectedFunTyOrigin
+ :: CtOrigin
-- ^ See Note [Herald for matchExpectedFunTys]
-> Maybe TypedThing
-- ^ The thing with type TcSigmaType
@@ -241,7 +241,7 @@ Ugh!
-- INVARIANT: the returned argument types all have a syntactically fixed RuntimeRep
-- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
-- See Note [Return arguments with a fixed RuntimeRep].
-matchActualFunTys :: ExpectedFunTyOrigin -- ^ See Note [Herald for matchExpectedFunTys]
+matchActualFunTys :: CtOrigin -- ^ See Note [Herald for matchExpectedFunTys]
-> CtOrigin
-> Arity
-> TcSigmaType
@@ -776,7 +776,7 @@ Example:
-- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
-- See Note [Return arguments with a fixed RuntimeRep].
matchExpectedFunTys :: forall a.
- ExpectedFunTyOrigin -- See Note [Herald for matchExpectedFunTys]
+ CtOrigin -- See Note [Herald for matchExpectedFunTys]
-> UserTypeCtxt
-> VisArity
-> ExpSigmaType
@@ -905,19 +905,19 @@ matchExpectedFunTys herald ctx arity (Check top_ty) thing_inside
; co <- unifyType Nothing (mkScaledFunTys more_arg_tys res_ty) fun_ty
; return (mkWpCastN co, result) }
-new_infer_arg_ty :: ExpectedFunTyOrigin -> Int -> TcM (Scaled ExpSigmaTypeFRR)
+new_infer_arg_ty :: CtOrigin -> Int -> TcM (Scaled ExpSigmaTypeFRR)
new_infer_arg_ty herald arg_pos -- position for error messages only
= do { mult <- newFlexiTyVarTy multiplicityTy
; inf_hole <- newInferExpTypeFRR (FRRExpectedFunTy herald arg_pos)
; return (mkScaled mult inf_hole) }
-new_check_arg_ty :: ExpectedFunTyOrigin -> Int -> TcM (Scaled TcType)
+new_check_arg_ty :: CtOrigin -> Int -> TcM (Scaled TcType)
new_check_arg_ty herald arg_pos -- Position for error messages only, 1 for first arg
= do { mult <- newFlexiTyVarTy multiplicityTy
; arg_ty <- newOpenFlexiFRRTyVarTy (FRRExpectedFunTy herald arg_pos)
; return (mkScaled mult arg_ty) }
-mkFunTysMsg :: ExpectedFunTyOrigin
+mkFunTysMsg :: CtOrigin
-> (VisArity, TcType)
-> TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)
-- See Note [Reporting application arity errors]
=====================================
testsuite/tests/deSugar/should_compile/T10662.stderr
=====================================
@@ -1,6 +1,6 @@
-T10662.hs:2:8: warning: [GHC-81995] [-Wunused-do-bind (in -Wall)]
+
+T10662.hs:3:3: warning: [GHC-81995] [-Wunused-do-bind (in -Wall)]
A do-notation statement discarded a result of type ‘String’
Suggested fix:
Suppress this warning by saying
‘_ <- return $ let a = "hello" in a’
-
=====================================
testsuite/tests/deSugar/should_compile/T3263-1.stderr
=====================================
@@ -1,8 +1,8 @@
-T3263-1.hs:24:6: warning: [GHC-81995] [-Wunused-do-bind (in -Wall)]
+
+T3263-1.hs:25:3: warning: [GHC-81995] [-Wunused-do-bind (in -Wall)]
A do-notation statement discarded a result of type ‘Int’
Suggested fix: Suppress this warning by saying ‘_ <- nonNullM’
-T3263-1.hs:34:6: warning: [GHC-81995] [-Wunused-do-bind (in -Wall)]
+T3263-1.hs:35:3: warning: [GHC-81995] [-Wunused-do-bind (in -Wall)]
A do-notation statement discarded a result of type ‘Int’
Suggested fix: Suppress this warning by saying ‘_ <- nonNullM’
-
=====================================
testsuite/tests/deSugar/should_compile/T3263-2.stderr
=====================================
@@ -1,10 +1,10 @@
-T3263-2.hs:24:6: warning: [GHC-08838] [-Wwrong-do-bind (in -Wdefault)]
+
+T3263-2.hs:25:3: warning: [GHC-08838] [-Wwrong-do-bind (in -Wdefault)]
A do-notation statement discarded a result of type ‘m Int’
Suggested fix:
Suppress this warning by saying ‘_ <- return (return 10 :: m Int)’
-T3263-2.hs:36:6: warning: [GHC-08838] [-Wwrong-do-bind (in -Wdefault)]
+T3263-2.hs:37:3: warning: [GHC-08838] [-Wwrong-do-bind (in -Wdefault)]
A do-notation statement discarded a result of type ‘m Int’
Suggested fix:
Suppress this warning by saying ‘_ <- return (return 10 :: m Int)’
-
=====================================
testsuite/tests/ghci.debugger/scripts/break029.script
=====================================
@@ -1,4 +1,5 @@
:load break029.hs
:step f 3
:step
+:step
y
=====================================
testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr
=====================================
@@ -13,8 +13,7 @@ RepPolyRecordUpdate.hs:7:35: error: [GHC-55287]
X a :: TYPE rep
RepPolyRecordUpdate.hs:13:9: error: [GHC-55287]
- • The argument ‘fld’ of ‘MkX’
- does not have a fixed runtime representation.
+ • The field ‘fld’ does not have a fixed runtime representation.
Its type is:
a0 :: TYPE rep0
When unifying:
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8b26e98f2b3699aba58e9c3928e71…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8b26e98f2b3699aba58e9c3928e71…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T20264] Proper occurrence analysis for TyCoVars
by Simon Peyton Jones (＠simonpj) 13 Jul '25
by Simon Peyton Jones (＠simonpj) 13 Jul '25
13 Jul '25
Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC
Commits:
e69b3f51 by Simon Peyton Jones at 2025-07-13T23:52:25+01:00
Proper occurrence analysis for TyCoVars
- - - - -
11 changed files:
- compiler/GHC/Core.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Var.hs
Changes:
=====================================
compiler/GHC/Core.hs
=====================================
@@ -42,7 +42,8 @@ module GHC.Core (
foldBindersOfBindStrict, foldBindersOfBindsStrict,
collectBinders, collectTyBinders, collectTyAndValBinders,
collectNBinders, collectNValBinders_maybe,
- collectArgs, collectValArgs, stripNArgs, collectArgsTicks, flattenBinds,
+ collectArgs, collectValArgs, stripNArgs, collectArgsTicks,
+ flattenBinds, glomValBinds, mapBindBndrs,
collectFunSimple,
exprToType,
@@ -2174,7 +2175,6 @@ foldBindersOfBindsStrict f = \z binds -> foldl' fold_bind z binds
where
fold_bind = (foldBindersOfBindStrict f)
-
rhssOfBind :: Bind b -> [Expr b]
rhssOfBind (NonRec _ rhs) = [rhs]
rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
@@ -2189,6 +2189,21 @@ flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
flattenBinds [] = []
+glomValBinds :: [Bind b] -> [Bind b]
+-- Glom all the value bindings into a single Rec;
+-- Leave any type bindings as NonRecs, bringing them to the front
+glomValBinds bs = go [] bs
+ where
+ go prs (b@(NonRec _ (Type {})) : bs) = b : go prs bs
+ go prs (NonRec b r : bs) = go ((b,r) : prs) bs
+ go prs (Rec rprs : bs) = go (rprs ++ prs) bs
+ go [] [] = []
+ go prs [] = [Rec prs]
+
+mapBindBndrs :: (b -> b) -> Bind b -> Bind b
+mapBindBndrs f (NonRec b r) = NonRec (f b) r
+mapBindBndrs f (Rec prs) = Rec (mapFst f prs)
+
-- | We often want to strip off leading lambdas before getting down to
-- business. Variants are 'collectTyBinders', 'collectValBinders',
-- and 'collectTyAndValBinders'
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -39,7 +39,6 @@ import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr )
import GHC.Core.Coercion
import GHC.Core.Predicate ( isDictId )
import GHC.Core.Type
-import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo )
import GHC.Data.Maybe( orElse )
@@ -50,6 +49,7 @@ import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.Set
import GHC.Types.Id
+import GHC.Types.Name( isExternalName )
import GHC.Types.Id.Info
import GHC.Types.Basic
import GHC.Types.Tickish
@@ -65,6 +65,8 @@ import GHC.Utils.Misc
import GHC.Builtin.Names( runRWKey )
import GHC.Unit.Module( Module )
+import qualified Data.Semigroup as S( Semigroup(..) )
+import qualified Data.Monoid as S( Monoid(..) )
import Data.List (mapAccumL)
import Data.List.NonEmpty (NonEmpty (..))
@@ -100,18 +102,15 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds
init_env = initOccEnv { occ_rule_act = active_rule
, occ_unf_act = active_unf }
- WUD final_usage occ_anald_binds = go binds init_env
- WUD _ occ_anald_glommed_binds = occAnalRecBind init_env TopLevel
- imp_rule_edges
- (flattenBinds binds)
- initial_uds
+ WUD final_usage occ_anald_binds = go binds init_env
+ WUD _ occ_anald_glommed_binds = go (glomValBinds binds) init_env
-- It's crucial to re-analyse the glommed-together bindings
-- so that we establish the right loop breakers. Otherwise
-- we can easily create an infinite loop (#9583 is an example)
--
- -- Also crucial to re-analyse the /original/ bindings
- -- in case the first pass accidentally discarded as dead code
- -- a binding that was actually needed (albeit before its
+ -- Also crucial to re-analyse the /original/ bindings, not the
+ -- occ_anald_binds, in case the first pass accidentally discarded as
+ -- dead code a binding that was actually needed (albeit before its
-- definition site). #17724 threw this up.
initial_uds = addManyOccs emptyDetails (rulesFreeVars imp_rules)
@@ -971,16 +970,32 @@ occAnalBind
-> WithUsageDetails r -- Of the whole let(rec)
occAnalBind env lvl ire (Rec pairs) thing_inside combine
- = addInScopeList env (map fst pairs) $ \env ->
+ = addInScope env (map fst pairs) $ \env ->
let WUD body_uds body' = thing_inside env
WUD bind_uds binds' = occAnalRecBind env lvl ire pairs body_uds
in WUD bind_uds (combine binds' body')
-occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine
- | isTyVar bndr -- A type let; we don't gather usage info
- = let !(WUD body_uds res) = addInScopeOne env bndr thing_inside
- in WUD body_uds (combine [NonRec bndr rhs] res)
+occAnalBind !env _lvl _ire (NonRec bndr rhs) thing_inside combine
+ | isTyCoVar bndr -- A type/coercion let
+ = let !(WUD body_uds (occ,res))
+ = addInScopeOne env bndr $ \env_body ->
+ let !(WUD inner_uds inner_res) = thing_inside env_body
+ !tyco_occ = lookupTyCoOcc inner_uds bndr
+ in (WUD inner_uds (tyco_occ, inner_res))
+
+ rhs_tyco_occs = case rhs of
+ Type ty -> occAnalTy ty
+ Coercion co -> occAnalCo co
+ _ -> pprPanic "occAnalBind" (ppr (NonRec bndr rhs))
+ in
+ case occ of
+ TyCoDead -> WUD body_uds res
+ _ -> WUD (body_uds `addTyCoOccs` rhs_tyco_occs)
+ (combine [NonRec bndr' rhs] res)
+ where
+ bndr' = tagTyCoBinder occ bndr
+occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine
-- /Existing/ non-recursive join points
-- See Note [Occurrence analysis for join points]
| mb_join@(JoinPoint {}) <- idJoinPointHood bndr
@@ -1134,19 +1149,13 @@ occAnalRec :: OccEnv -> TopLevelFlag
-> WithUsageDetails [CoreBind]
-- The NonRec case is just like a Let (NonRec ...) above
+-- except that type variables can't occur
occAnalRec !_ lvl
(AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = wtuds }))
(WUD body_uds binds)
- -- Currently we don't gather occ-info for tyvars,
- -- so we never discard dead bindings -- Need to fix this
- | isTyVar bndr
- = let (tagged_bndr, mb_join) = tagNonRecBinder lvl occ bndr
- !(WUD rhs_uds' rhs') = adjustNonRecRhs mb_join wtuds
- !bndr' = tagged_bndr
- in WUD (body_uds `andUDs` rhs_uds')
- (NonRec bndr' rhs' : binds)
-
- | isDeadOcc occ -- Check for dead code: see Note [Dead code]
+ | assertPpr (not (isTyVar bndr)) (ppr bndr) $
+ -- Rec blocks have no TyVar bindings in them
+ isDeadOcc occ -- Check for dead code: see Note [Dead code]
= WUD body_uds binds
| otherwise
@@ -1705,7 +1714,7 @@ rank (r, _, _) = r
makeNode :: OccEnv -> ImpRuleEdges -> VarSet
-> (Var, CoreExpr) -> LetrecNode
-- See Note [Recursive bindings: the grand plan]
-makeNode !env _imp_rule_edges bndr_set (bndr, rhs@(Type rhs_ty))
+makeNode !_env _imp_rule_edges bndr_set (bndr, rhs@(Type rhs_ty))
= -- This is a type binding, e.g. let @x = Maybe Int in ...
assert (isTyVar bndr) $
DigraphNode { node_payload = details
@@ -1719,8 +1728,7 @@ makeNode !env _imp_rule_edges bndr_set (bndr, rhs@(Type rhs_ty))
, nd_weak_fvs = emptyVarSet
, nd_active_rule_fvs = emptyVarSet }
- rhs_env = setNonTailCtxt OccRhs env
- rhs_uds = occAnalTy rhs_env rhs_ty
+ rhs_uds = mkTyCoUDs (occAnalTy rhs_ty)
rhs_fvs = udFreeVars bndr_set rhs_uds
makeNode !env imp_rule_edges bndr_set (bndr, rhs)
@@ -2229,9 +2237,9 @@ occ_anal_lam_tail env (Cast expr co)
= let WUD expr_uds expr' = occ_anal_lam_tail env expr
-- co_uds: see Note [Gather occurrences of coercion variables]
- co_uds = occAnalCo env co
+ co_uds = occAnalCo co
- usage1 = expr_uds `andUDs` co_uds
+ usage1 = expr_uds `addTyCoOccs` co_uds
-- usage2: see Note [Occ-anal and cast worker/wrapper]
usage2 = case expr of
@@ -2436,14 +2444,54 @@ float ==>
This is worse than the slow cascade, so we only want to say "certainly_inline"
if it really is certain. Look at the note with preInlineUnconditionally
for the various clauses. See #24582 for an example of the two getting out of sync.
+-}
+
+{- *********************************************************************
+* *
+ Types
+* *
+********************************************************************* -}
+newtype TyCoOccs = TyCoOccs { get_tyco_occs :: TyCoOccEnv }
-************************************************************************
+instance S.Semigroup TyCoOccs where
+ (TyCoOccs o1) <> (TyCoOccs o2) = TyCoOccs (plusTyCoOccEnv o1 o2)
+
+instance S.Monoid TyCoOccs where
+ mempty = TyCoOccs emptyVarEnv
+
+occTyCoFolder :: TyCoFolder TyCoVarSet TyCoOccs
+occTyCoFolder
+ = TyCoFolder { tcf_view = \_ -> Nothing -- No need to expand synonyms
+ , tcf_tyvar = do_var
+ , tcf_covar = do_var
+ , tcf_hole = \_ h -> pprPanic "occTyCoFolder:hole" (ppr h)
+ , tcf_tycobinder = do_binder }
+ where
+ do_var :: TyCoVarSet -> TyCoVar -> TyCoOccs
+ do_var locals tcv
+ | tcv `elemVarSet` locals = mempty
+ | isExternalName (varName tcv) = mempty -- TyVars from other modules
+ | otherwise = TyCoOccs (unitVarEnv tcv TyCoOne)
+
+ do_binder :: TyCoVarSet -> TyCoVar -> ForAllTyFlag -> TyCoVarSet
+ do_binder locals tcv _ = extendVarSet locals tcv
+
+occAnalTy :: Type -> TyCoOccEnv
+occAnalCo :: Coercion -> TyCoOccEnv
+occAnalTy ty = get_tyco_occs (occ_anal_ty ty)
+occAnalCo co = get_tyco_occs (occ_anal_co co)
+
+occ_anal_ty :: Type -> TyCoOccs
+occ_anal_co :: Coercion -> TyCoOccs
+(occ_anal_ty, _, occ_anal_co, _) = foldTyCo occTyCoFolder emptyVarSet
+-- No need to return a modified type, unlike expressions
+
+{- *********************************************************************
* *
Expressions
* *
-************************************************************************
--}
+********************************************************************* -}
occAnalList :: OccEnv -> [CoreExpr] -> WithUsageDetails [CoreExpr]
occAnalList !_ [] = WUD emptyDetails []
@@ -2452,50 +2500,6 @@ occAnalList env (e:es) = let
(WUD uds2 es') = occAnalList env es
in WUD (uds1 `andUDs` uds2) (e' : es')
-occAnalTys :: OccEnv -> [Type] -> UsageDetails
-occAnalTys env tys = foldr (andUDs . occAnalTy env) emptyDetails tys
-
-occAnalTy :: OccEnv -> Type -> UsageDetails
--- No need to return a modified type, unlike expressions
-occAnalTy env (TyVarTy tv) = mkOneTyVarOcc env tv
-occAnalTy _ (LitTy {}) = emptyDetails
-occAnalTy env (AppTy t1 t2) = occAnalTy env t1 `andUDs` occAnalTy env t2
-occAnalTy env (CastTy ty co) = occAnalTy env ty `andUDs` occAnalCo env co
-occAnalTy env (CoercionTy co) = occAnalCo env co
-occAnalTy env (TyConApp _ tys) = occAnalTys env tys
-occAnalTy env (ForAllTy (Bndr tv _) ty) = delBndrsFromUDs [tv] (occAnalTy env ty)
-occAnalTy env (FunTy { ft_mult = w, ft_arg = arg, ft_res = res })
- = occAnalTy env w `andUDs` occAnalTy env arg `andUDs` occAnalTy env res
-
-occAnalCos :: OccEnv -> [Coercion] -> UsageDetails
-occAnalCos env cos = foldr (andUDs . occAnalCo env) emptyDetails cos
-
-occAnalMCo :: OccEnv -> MCoercion -> UsageDetails
-occAnalMCo _ MRefl = emptyDetails
-occAnalMCo env (MCo co) = occAnalCo env co
-
-occAnalCo :: OccEnv -> Coercion -> UsageDetails
-occAnalCo !env (Refl ty) = occAnalTy env ty
-occAnalCo !env (GRefl _ ty mco) = occAnalTy env ty `andUDs` occAnalMCo env mco
-occAnalCo !env (AppCo co1 co2) = occAnalCo env co1 `andUDs` occAnalCo env co2
-occAnalCo env (CoVarCo cv) = mkOneIdOcc env cv NotInteresting 0
-occAnalCo _ (HoleCo hole) = pprPanic "occAnalCo:HoleCo" (ppr hole)
-occAnalCo env (SymCo co) = occAnalCo env co
-occAnalCo env (TransCo co1 co2) = occAnalCo env co1 `andUDs` occAnalCo env co2
-occAnalCo env (AxiomCo _ cos) = occAnalCos env cos
-occAnalCo env (SelCo _ co) = occAnalCo env co
-occAnalCo env (LRCo _ co) = occAnalCo env co
-occAnalCo env (InstCo co arg) = occAnalCo env co `andUDs` occAnalCo env arg
-occAnalCo env (KindCo co) = occAnalCo env co
-occAnalCo env (SubCo co) = occAnalCo env co
-occAnalCo env (TyConAppCo _ _ cos) = occAnalCos env cos
-occAnalCo !env (FunCo { fco_mult = cw, fco_arg = c1, fco_res = c2 })
- = occAnalCo env cw `andUDs` occAnalCo env c1 `andUDs` occAnalCo env c2
-occAnalCo env (UnivCo { uco_lty = t1, uco_rty = t2, uco_deps = cos })
- = occAnalTy env t1 `andUDs` occAnalTy env t2 `andUDs` occAnalCos env cos
-occAnalCo env (ForAllCo { fco_tcv = tv, fco_kind = kind_co, fco_body = co })
- = occAnalCo env kind_co `andUDs` delBndrsFromUDs [tv] (occAnalCo env co)
-
occAnal :: OccEnv
-> CoreExpr
-> WithUsageDetails CoreExpr -- Gives info only about the "interesting" Ids
@@ -2510,8 +2514,8 @@ occAnal env expr@(Var _) = occAnalApp env (expr, [], [])
-- rules in them, so the *specialised* versions looked as if they
-- weren't used at all.
-occAnal env (Type ty) = WUD (occAnalTy env ty) (Type ty)
-occAnal env (Coercion co) = WUD (occAnalCo env co) (Coercion co)
+occAnal _env (Type ty) = WUD (mkTyCoUDs (occAnalTy ty)) (Type ty)
+occAnal _env (Coercion co) = WUD (mkTyCoUDs (occAnalCo co)) (Coercion co)
{- Note [Gather occurrences of coercion variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2589,10 +2593,10 @@ occAnal env (Tick tickish body)
occAnal env (Cast expr co)
= let (WUD expr_uds expr') = occAnal env expr
- co_uds = occAnalCo env co
+ co_uds = occAnalCo co
-- co_uds: see Note [Gather occurrences of coercion variables]
- uds = markAllNonTail (expr_uds `andUDs` co_uds)
- -- co_uds': calls inside expr aren't tail calls any more
+ uds = markAllNonTail (expr_uds `addTyCoOccs` co_uds)
+ -- markAllNonTail: calls inside expr aren't tail calls any more
in WUD uds (Cast expr' co)
occAnal env app@(App _ _)
@@ -2614,7 +2618,9 @@ occAnal env (Case scrut bndr ty alts)
tagged_bndr = tagLamBinder alts_usage bndr
in WUD alts_usage (tagged_bndr, alts')
- total_usage = markAllNonTail scrut_usage `andUDs` alts_usage
+ total_usage = markAllNonTail scrut_usage
+ `andUDs` alts_usage
+ `addTyCoOccs` occAnalTy ty
-- Alts can have tail calls, but the scrutinee can't
in WUD total_usage (Case scrut' tagged_bndr ty alts')
@@ -2719,7 +2725,7 @@ occAnalApp !env (Var fun, args, ticks)
occAnalApp env (Var fun_id, args, ticks)
= WUD all_uds (mkTicks ticks app')
where
- -- Lots of banged bindings: this is a very heavily bit of code,
+ -- Lots of banged bindings: this is a very heavily used bit of code,
-- so it pays not to make lots of thunks here, all of which
-- will ultimately be forced.
!(fun', fun_id') = lookupBndrSwap env fun_id
@@ -3136,24 +3142,23 @@ addInScope :: OccEnv -> [Var]
-- We do not assume that the bndrs are in scope order; in fact the
-- call in occ_anal_lam_tail gives them to addInScope in /reverse/ order
--- Fast path when the is no environment-munging to do
--- This is rather common: notably at top level, but nested too
addInScope env bndrs thing_inside
| null bndrs -- E.g. nullary constructors in a `case`
= thing_inside env
+ -- Fast path when the is no environment-munging to do
+ -- This is rather common: notably at top level, but nested too
| isEmptyVarEnv (occ_bs_env env)
, isEmptyVarEnv (occ_join_points env)
, WUD uds res <- thing_inside env
= WUD (delBndrsFromUDs bndrs uds) res
-addInScope env bndrs thing_inside
+ -- Normal path
+ | let !(env', bad_joins) = preprocess_env env bndr_set
+ !(WUD uds res) = thing_inside env'
+ uds' = postprocess_uds bndrs bad_joins uds
+ bndr_set = mkVarSet bndrs
= WUD uds' res
- where
- bndr_set = mkVarSet bndrs
- !(env', bad_joins) = preprocess_env env bndr_set
- !(WUD uds res) = thing_inside env'
- uds' = postprocess_uds bndrs bad_joins uds
preprocess_env :: OccEnv -> VarSet -> (OccEnv, JoinPointInfo)
preprocess_env env@(OccEnv { occ_join_points = join_points
@@ -3668,8 +3673,8 @@ For example, in (case x of A -> y; B -> y; C -> True),
-}
-type IdOccEnv = VarEnv LocalOcc -- A finite map from an expression's
- -- free variables to their usage
+type IdOccEnv = IdEnv LocalOcc -- A finite map from an expression's
+ -- free variables to their usage
data LocalOcc -- See Note [LocalOcc]
= OneOccL { lo_n_br :: {-# UNPACK #-} !BranchCount -- Number of syntactic occurrences
@@ -3690,9 +3695,7 @@ localTailCallInfo (ManyOccL tci) = tci
-- For TyVars and CoVars we gather only whether it occurs once or
-- many times; we aren't interested in case-branches or tail-calls
-data TyCoOccEnv = VarEnv TyCoOcc
-
-data TyCoOcc = OneOccTyCo | ManyOccTyCo
+type TyCoOccEnv = TyCoVarEnv TyCoOccInfo
type ZappedSet = IdOccEnv
type ZappedTyCoSet = TyCoOccEnv
@@ -3704,24 +3707,19 @@ data UsageDetails
, ud_z_many :: !ZappedSet -- apply 'markMany' to these
, ud_z_in_lam :: !ZappedSet -- apply 'markInsideLam' to these
, ud_z_tail :: !ZappedSet -- zap tail-call info for these
+
, ud_tyco_env :: !TyCoOccEnv
- , ud_z_tyzo :: !ZappedTyCoSet
+ , ud_z_tyco :: !ZappedTyCoSet -- These ones occur many times
}
-- INVARIANT: `ud_z_many`, `ud_z_in_lam` and `ud_z_tail`
-o -- are all subsets of ud_id_env
- -- `ud_z_tyco` is a subset of ud_tycon_env
+ -- are all subsets of ud_id_env
+ -- `ud_z_tyco` is a subset of ud_tyco_env
instance Outputable UsageDetails where
- ppr ud@(UD { ud_id_env = env, ud_tyco_env = tyco_env })
- = text "UD" <+> (braces $ fsep $ punctuate comma $
- [ ppr uq <+> text ":->" <+> ppr (lookupOccByUnique ud uq)
- | uq <- nonDetStrictFoldVarEnv_Directly do_one [] id_env ]
- ++
- [ ppr uq <+> text ":->" <+> ppr (lookupTyCoOccByUnique ud uq)
- | uq <- nonDetStrictFoldVarEnv_Directly do_one [] tyco_env ])
- where
- do_one :: Unique -> a -> [Unique] -> [Unique]
- do_one uniq _ uniqs = uniq : uniqs
+ ppr (UD { ud_id_env = id_env, ud_tyco_env = tyco_env })
+ = text "UD" <+> (braces $ vcat
+ [ text "ud_id_env =" <+> ppr id_env
+ , text "ud_tyco_env =" <+> ppr tyco_env ])
---------------------
-- | TailUsageDetails captures the result of applying 'occAnalLamTail'
@@ -3743,18 +3741,13 @@ data WithTailUsageDetails a = WTUD !TailUsageDetails !a
-------------------
-- UsageDetails API
-andUDs, orUDs
- :: UsageDetails -> UsageDetails -> UsageDetails
+plusTyCoOccEnv :: TyCoOccEnv -> TyCoOccEnv -> TyCoOccEnv
+plusTyCoOccEnv env1 env2 = plusVarEnv_C plusTyCoOccInfo env1 env2
+
+andUDs, orUDs :: UsageDetails -> UsageDetails -> UsageDetails
andUDs = combineUsageDetailsWith andLocalOcc
orUDs = combineUsageDetailsWith orLocalOcc
-mkOneTyVarOcc :: OccEnv -> TyVar -> UsageDetails
-mkOneTyVarOcc !_env tv
- = mkSimpleDetails (unitVarEnv tv occ)
- where
- occ = OneOccL { lo_n_br = 1, lo_int_cxt = NotInteresting
- , lo_tail = NoTailCallInfo }
-
mkOneIdOcc :: OccEnv -> Var -> InterestingCxt -> JoinArity -> UsageDetails
mkOneIdOcc !env id int_cxt arity
| assert (not (isTyVar id)) $
@@ -3765,10 +3758,10 @@ mkOneIdOcc !env id int_cxt arity
= -- See Note [Occurrence analysis for join points]
assertPpr (not (isEmptyVarEnv join_uds)) (ppr id) $
-- We only put non-empty join-points into occ_join_points
- mkSimpleDetails (extendVarEnv join_uds id occ)
+ mkIdUDs (extendVarEnv join_uds id occ)
| otherwise
- = mkSimpleDetails (unitVarEnv id occ)
+ = mkIdUDs (unitVarEnv id occ)
where
occ = OneOccL { lo_n_br = 1, lo_int_cxt = int_cxt
@@ -3786,11 +3779,15 @@ add_many_occ v env = extendVarEnv env v (ManyOccL NoTailCallInfo)
addManyOccs :: UsageDetails -> VarSet -> UsageDetails
addManyOccs uds var_set
| isEmptyVarSet var_set = uds
- | otherwise = uds { ud_env = add_to (ud_env uds) }
+ | otherwise = uds { ud_id_env = add_to (ud_id_env uds) }
where
add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set
-- It's OK to use nonDetStrictFoldUniqSet here because add_many_occ commutes
+addTyCoOccs :: UsageDetails -> TyCoOccEnv -> UsageDetails
+addTyCoOccs uds@(UD { ud_tyco_env = env}) extras
+ = uds { ud_tyco_env = env `plusTyCoOccEnv` extras }
+
addLamTyCoVarOccs :: UsageDetails -> [Var] -> UsageDetails
-- occAnalLamBndrs :: OccEnv -> UsageDetails -> [Var] -> WithUsageDetails [Var]
-- Add any TyCoVars free in the type of a lambda-binder
@@ -3801,39 +3798,52 @@ addLamTyCoVarOccs uds bndrs
add bndr uds = uds `addManyOccs` tyCoVarsOfType (varType bndr)
emptyDetails :: UsageDetails
-emptyDetails = mkSimpleDetails emptyVarEnv
+emptyDetails = UD { ud_id_env = emptyVarEnv
+ , ud_z_many = emptyVarEnv
+ , ud_z_in_lam = emptyVarEnv
+ , ud_z_tail = emptyVarEnv
+ , ud_tyco_env = emptyVarEnv
+ , ud_z_tyco = emptyVarEnv }
isEmptyDetails :: UsageDetails -> Bool
-isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env
+isEmptyDetails (UD { ud_id_env = id_env, ud_tyco_env = tyco_env })
+ = isEmptyVarEnv id_env && isEmptyVarEnv tyco_env
+
+mkIdUDs :: IdOccEnv -> UsageDetails
+mkIdUDs env = emptyDetails { ud_id_env = env }
-mkSimpleDetails :: IdOccEnv -> UsageDetails
-mkSimpleDetails env = UD { ud_env = env
- , ud_z_many = emptyVarEnv
- , ud_z_in_lam = emptyVarEnv
- , ud_z_tail = emptyVarEnv }
+mkTyCoUDs :: TyCoOccEnv -> UsageDetails
+mkTyCoUDs env = emptyDetails { ud_tyco_env = env }
modifyUDEnv :: (IdOccEnv -> IdOccEnv) -> UsageDetails -> UsageDetails
-modifyUDEnv f uds@(UD { ud_env = env }) = uds { ud_env = f env }
+modifyUDEnv f uds@(UD { ud_id_env = env }) = uds { ud_id_env = f env }
delBndrsFromUDs :: [Var] -> UsageDetails -> UsageDetails
-- Delete these binders from the UsageDetails
--- But /add/ the free vars of the types
-delBndrsFromUDs bndrs (UD { ud_env = env, ud_z_many = z_many
- , ud_z_in_lam = z_in_lam, ud_z_tail = z_tail })
- = UD { ud_env = env `delVarEnvList` bndrs
+-- But /add/ the free vars of the types. That may seem odd, but this is
+-- a very convenient place to do it!
+delBndrsFromUDs bndrs (UD { ud_id_env = env, ud_z_many = z_many
+ , ud_z_in_lam = z_in_lam, ud_z_tail = z_tail
+ , ud_tyco_env = tyco_env, ud_z_tyco = z_tyco })
+ = UD { ud_id_env = env `delVarEnvList` bndrs
, ud_z_many = z_many `delVarEnvList` bndrs
, ud_z_in_lam = z_in_lam `delVarEnvList` bndrs
- , ud_z_tail = z_tail `delVarEnvList` bndrs }
+ , ud_z_tail = z_tail `delVarEnvList` bndrs
+ , ud_tyco_env = adjust bndrs tyco_env
+ , ud_z_tyco = z_tyco `delVarEnvList` bndrs
+ }
where
- ty_fvs [] = emptyVarSet
- ty_fvs (b:bs) = tyCoVarsOfType b `unionVarSet`
- (ty_fvs bs `delVarSet` b)
+ adjust :: [Var] -> TyCoOccEnv -> TyCoOccEnv
+ -- Delete binders, but add the free vars of their types
+ adjust [] env = env
+ adjust (b:bs) env = occAnalTy (varType b) `plusTyCoOccEnv`
+ (adjust bs env `delVarEnv` b)
markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail
:: UsageDetails -> UsageDetails
-markAllMany ud@(UD { ud_env = env }) = ud { ud_z_many = env }
-markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env }
-markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = env }
+markAllMany ud@(UD { ud_id_env = env }) = ud { ud_z_many = env }
+markAllInsideLam ud@(UD { ud_id_env = env }) = ud { ud_z_in_lam = env }
+markAllNonTail ud@(UD { ud_id_env = env }) = ud { ud_z_tail = env }
markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo
markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails
@@ -3846,7 +3856,7 @@ markAllNonTailIf False ud = ud
lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo
lookupTailCallInfo uds id
- | UD { ud_z_tail = z_tail, ud_env = env } <- uds
+ | UD { ud_z_tail = z_tail, ud_id_env = env } <- uds
, not (id `elemVarEnv` z_tail)
, Just occ <- lookupVarEnv env id
= localTailCallInfo occ
@@ -3855,9 +3865,10 @@ lookupTailCallInfo uds id
udFreeVars :: VarSet -> UsageDetails -> VarSet
-- Find the subset of bndrs that are mentioned in uds
-udFreeVars bndrs (UD { ud_env = env }) = restrictFreeVars bndrs env
+udFreeVars bndrs (UD { ud_id_env = id_env, ud_tyco_env = tyco_env })
+ = restrictFreeVars bndrs id_env `unionVarSet` restrictFreeVars bndrs tyco_env
-restrictFreeVars :: VarSet -> IdOccEnv -> VarSet
+restrictFreeVars :: VarSet -> VarEnv a -> VarSet
restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs
-------------------
@@ -3867,15 +3878,19 @@ combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc)
-> UsageDetails -> UsageDetails -> UsageDetails
{-# INLINE combineUsageDetailsWith #-}
combineUsageDetailsWith plus_occ_info
- uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 })
- uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 })
- | isEmptyVarEnv env1 = uds2
- | isEmptyVarEnv env2 = uds1
+ uds1@(UD { ud_id_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1
+ , ud_tyco_env = tyco_env1, ud_z_tyco = z_tyco1 })
+ uds2@(UD { ud_id_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2
+ , ud_tyco_env = tyco_env2, ud_z_tyco = z_tyco2 })
+ | isEmptyDetails uds1 = uds2
+ | isEmptyDetails uds2 = uds1
| otherwise
- = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2
- , ud_z_many = plusVarEnv z_many1 z_many2
- , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2
- , ud_z_tail = plusVarEnv z_tail1 z_tail2 }
+ = UD { ud_id_env = plusVarEnv_C plus_occ_info env1 env2
+ , ud_z_many = plusVarEnv z_many1 z_many2
+ , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2
+ , ud_z_tail = plusVarEnv z_tail1 z_tail2
+ , ud_tyco_env = plusTyCoOccEnv tyco_env1 tyco_env2
+ , ud_z_tyco = plusVarEnv z_tyco1 z_tyco2 }
lookupLetOccInfo :: UsageDetails -> Id -> OccInfo
-- Don't use locally-generated occ_info for exported (visible-elsewhere)
@@ -3884,21 +3899,24 @@ lookupLetOccInfo :: UsageDetails -> Id -> OccInfo
-- we are about to re-generate it and it shouldn't be "sticky"
lookupLetOccInfo ud id
| isExportedId id = noOccInfo
- | otherwise = lookupOccByUnique ud (idUnique id)
+ | otherwise = lookupIdOccByUnique ud (idUnique id)
+
+lookupIdOccInfo :: UsageDetails -> Id -> OccInfo
+lookupIdOccInfo ud id = lookupIdOccByUnique ud (idUnique id)
-lookupOccInfo :: UsageDetails -> Id -> OccInfo
-lookupOccInfo ud id = lookupOccByUnique ud (idUnique id)
+lookupTyCoOcc :: UsageDetails -> TyCoVar -> TyCoOccInfo
+lookupTyCoOcc uds tcv = lookupTyCoOccByUnique uds (varUnique tcv)
-lookupTyCoOccByUnique :: UsageDetails -> Unique -> TyCoOcc
-lookupTyCoByUnique (UD { ud_tyco_env = env, ud_z_tyco = z_tyco }) uniq
+lookupTyCoOccByUnique :: UsageDetails -> Unique -> TyCoOccInfo
+lookupTyCoOccByUnique (UD { ud_tyco_env = env, ud_z_tyco = z_tyco }) uniq
= case lookupVarEnv_Directly env uniq of
- Nothing -> Nothing
- Just ManyOccTyCo -> Just ManyOccTyCo
- Just OneOccTyCo | uniq `elemVarEnvByKey` z_tyco = Just ManyOccTyCo
- | otherwise = Just OneOccTyCo
+ Nothing -> TyCoDead
+ Just TyCoOne | uniq `elemVarEnvByKey` z_tyco -> TyCoMany
+ | otherwise -> TyCoOne
+ Just occ -> occ
-lookupOccByUnique :: UsageDetails -> Unique -> OccInfo
-lookupOccByUnique (UD { ud_env = env
+lookupIdOccByUnique :: UsageDetails -> Unique -> OccInfo
+lookupIdOccByUnique (UD { ud_id_env = env
, ud_z_many = z_many
, ud_z_in_lam = z_in_lam
, ud_z_tail = z_tail })
@@ -3925,6 +3943,12 @@ lookupOccByUnique (UD { ud_env = env
| otherwise = ti
+tyCoOccToIdOcc :: TyCoOccInfo -> OccInfo
+-- Used for CoVars
+tyCoOccToIdOcc TyCoDead = IAmDead
+tyCoOccToIdOcc TyCoOne = OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1
+ , occ_int_cxt = NotInteresting, occ_tail = NoTailCallInfo }
+tyCoOccToIdOcc TyCoMany = noOccInfo
-------------------
-- See Note [Adjusting right-hand sides]
@@ -3958,34 +3982,42 @@ adjustTailArity mb_rhs_ja (TUD ja usage)
type IdWithOccInfo = Id
tagLamBinders :: UsageDetails -- Of scope
- -> [Id] -- Binders
+ -> [CoreBndr] -- Binders
-> [IdWithOccInfo] -- Tagged binders
tagLamBinders usage binders
= map (tagLamBinder usage) binders
tagLamBinder :: UsageDetails -- Of scope
- -> Id -- Binder
+ -> CoreBndr -- Binder
-> IdWithOccInfo -- Tagged binders
-- Used for lambda and case binders
--- No-op on TyVars
+-- No-op on TyVars; we could tag them but not much point
-- A lambda binder never has an unfolding, so no need to look for that
tagLamBinder usage bndr
- = setBinderOcc (markNonTail occ) bndr
+ | isTyCoVar bndr
+ = bndr
+ | otherwise
+ = setIdBinderOcc (markNonTail occ) bndr
-- markNonTail: don't try to make an argument into a join point
where
- occ = lookupOccInfo usage bndr
+ occ = lookupIdOccInfo usage bndr
+
+tagTyCoBinder :: TyCoOccInfo -> TyCoVar -> TyCoVar
+tagTyCoBinder occ bndr
+ | isId bndr = setIdOccInfo bndr (tyCoOccToIdOcc occ)
+ | otherwise = setTyVarOccInfo bndr occ
tagNonRecBinder :: TopLevelFlag -- At top level?
-> OccInfo -- Of scope
- -> CoreBndr -- Binder
+ -> Id -- Binder
-> (IdWithOccInfo, JoinPointHood) -- Tagged binder
-- Precondition: OccInfo is not IAmDead
tagNonRecBinder lvl occ bndr
| okForJoinPoint lvl bndr tail_call_info
, AlwaysTailCalled ar <- tail_call_info
- = (setBinderOcc occ bndr, JoinPoint ar)
+ = (setIdBinderOcc occ bndr, JoinPoint ar)
| otherwise
- = (setBinderOcc zapped_occ bndr, NotJoinPoint)
+ = (setIdBinderOcc zapped_occ bndr, NotJoinPoint)
where
tail_call_info = tailCallInfo occ
zapped_occ = markNonTail occ
@@ -4035,18 +4067,17 @@ tagRecBinders lvl body_uds details_s
adj_uds = foldr andUDs body_uds rhs_udss'
-- 4. Tag each binder with its adjusted details
- bndrs' = [ setBinderOcc (lookupLetOccInfo adj_uds bndr) bndr
+ bndrs' = [ setIdBinderOcc (lookupLetOccInfo adj_uds bndr) bndr
| bndr <- bndrs ]
in
WUD adj_uds bndrs'
-setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr
-setBinderOcc occ_info bndr
- | isTyVar bndr = if (occ_info == tyVarOccInfo bndr) then bndr
- else setTyVarOccInfo bndr occ_info
- | otherwise = if (occ_info == idOccInfo bndr) then bndr
- else setIdOccInfo bndr occ_info
+setIdBinderOcc :: OccInfo -> CoreBndr -> CoreBndr
+setIdBinderOcc occ_info bndr
+ = assertPpr (isNonCoVarId bndr) (ppr bndr) $
+ if (occ_info == idOccInfo bndr) then bndr
+ else setIdOccInfo bndr occ_info
-- | Decide whether some bindings should be made into join points or not, based
-- on its occurrences. This is
=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -441,8 +441,8 @@ type IndEnv = IdEnv (Id, [CoreTickish]) -- Maps local_id -> exported_id, ticks
shortOutIndirections :: CoreProgram -> CoreProgram
shortOutIndirections binds
| isEmptyVarEnv ind_env = binds
- | no_need_to_flatten = binds' -- See Note [Rules and indirection-zapping]
- | otherwise = [Rec (flattenBinds binds')] -- for this no_need_to_flatten stuff
+ | no_need_to_flatten = binds' -- See Note [Rules and indirection-zapping]
+ | otherwise = glomValBinds binds' -- for this no_need_to_flatten stuff
where
ind_env = makeIndEnv binds
-- These exported Ids are the subjects of the indirection-elimination
=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -930,22 +930,19 @@ mkRecFloats :: SimplFloats -> SimplFloats
-- If any are type bindings they must be non-recursive, so
-- do not need to be joined into a letrec; indeed they must not
-- since Rec{} is not allowed to have type binders
-mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff
+mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats val_bs ff
, sfJoinFloats = join_bs
, sfInScope = in_scope })
- = assertPpr (isNilOL bs || isNilOL join_bs) (ppr floats) $
- SimplFloats { sfLetFloats = LetFloats (type_bs `appOL` val_b) ff
+ = assertPpr (isNilOL val_bs || isNilOL join_bs) (ppr floats) $
+ SimplFloats { sfLetFloats = LetFloats val_b ff
, sfJoinFloats = join_b
, sfInScope = in_scope }
where
- type_bs, val_bs :: OrdList OutBind
- (type_bs, val_bs) = partitionOL isTypeBind bs
-
-- See Note [Bangs in the Simplifier]
!val_b | isNilOL val_bs = nilOL
- | otherwise = unitOL (Rec (flattenBinds (fromOL val_bs)))
+ | otherwise = toOL (glomValBinds (fromOL val_bs))
!join_b | isNilOL join_bs = nilOL
- | otherwise = unitOL (Rec (flattenBinds (fromOL join_bs)))
+ | otherwise = toOL (glomValBinds (fromOL join_bs))
wrapFloats :: SimplFloats -> OutExpr -> OutExpr
-- Wrap the floats around the expression
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -204,6 +204,9 @@ simplTopBinds env0 binds0
-- anything into scope, then we don't get a complaint about that.
-- It's rather as if the top-level binders were imported.
-- See Note [Glomming] in "GHC.Core.Opt.OccurAnal".
+ --
+ -- But the type of that top-level binder might mention a let-bound
+ -- type variable, so we put all those let-bindings at the front
-- See Note [Bangs in the Simplifier]
; (ty_floats, env1) <- {-#SCC "simplTopBinds-simplRecBndrs" #-}
simplTopTyVarBinds env0 binds0
@@ -291,10 +294,12 @@ simplTyVarBind :: SimplEnv -> InTyVar -> InType
-- Returned SimplFloats is empty, or singleton type binding
simplTyVarBind env tv ty
| Just env' <- preInlineTypeUnconditionally env tv ty
- = return (emptyFloats env', env')
+ = -- pprTrace "Pre-inline-tv" (ppr tv <+> equals <+> ppr ty) $
+ return (emptyFloats env', env')
| otherwise
= do { ty' <- simplType env ty
- ; completeTyVarBindX env (zapTyVarUnfolding tv) ty' }
+ ; -- pprTrace "Don't pre-inline-tv" (ppr tv <+> equals <+> ppr ty') $
+ completeTyVarBindX env (zapTyVarUnfolding tv) ty' }
-- Zap any unfolding because competeTyVarBindX will add
-- the new unfolding and we don't wnat to waste work
-- substituting the old one
@@ -303,7 +308,8 @@ completeTyVarBindX :: SimplEnv -> InTyVar -> OutType
-> SimplM (SimplFloats, SimplEnv)
completeTyVarBindX env in_tv out_ty
| postInlineTypeUnconditionally out_ty
- = return (emptyFloats env, extendTvSubst env in_tv out_ty)
+ = -- pprTrace "Post-inline-tv" (ppr in_tv <+> equals <+> ppr out_ty) $
+ return (emptyFloats env, extendTvSubst env in_tv out_ty)
| otherwise
= do { (env1, out_tv) <- simplTyVarBndr env in_tv
@@ -314,7 +320,9 @@ completeTyVarBindX env in_tv out_ty
-- occurrence of in_tv. After all, in a beta-redex, in_tv
-- had no unfolding. See (TCL2) in
-- Note [Type and coercion lets] in GHC.Core
- ; return (mkFloatBind env2 (NonRec out_tv_w_unf (Type out_ty))) }
+ ; -- pprTrace "Don't post-inline-tv" (ppr in_tv <+> equals <+> ppr out_tv_w_unf
+ -- <+> equals <+> ppr out_ty) $
+ return (mkFloatBind env2 (NonRec out_tv_w_unf (Type out_ty))) }
{-
************************************************************************
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -1444,7 +1444,7 @@ preInlineTypeUnconditionally env tv rhs_ty
-- Inline unconditionally if it occurs exactly once, inside a lambda or not.
-- No work is wasted by substituting inside a lambda, although if the
-- lambda is inlined a lot, we migth duplicate the type.
- | OneOcc{ occ_n_br = 1 } <- tyVarOccInfo tv
+ | isOneTyCoOcc (tyVarOccInfo tv)
= Just $! extendTvSubst env tv $! substTy env rhs_ty
| otherwise
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -780,10 +780,10 @@ specImports top_env (MkUD { ud_binds = dict_binds, ud_calls = calls })
local_rule_base = extendRuleBaseList emptyRuleBase rules_for_locals
final_binds
| null spec_binds = wrapDictBinds dict_binds []
- | otherwise = [Rec $ mapFst (addRulesToId local_rule_base) $
- flattenBinds $
- wrapDictBinds dict_binds $
- spec_binds]
+ | otherwise = glomValBinds $
+ wrapDictBinds dict_binds $
+ map (mapBindBndrs (addRulesToId local_rule_base)) $
+ spec_binds
; return (rules_for_imps, final_binds)
}
=====================================
compiler/GHC/Core/Ppr.hs
=====================================
@@ -472,7 +472,12 @@ pprTypedLetBinder binder
pprKindedTyVarBndr :: TyVar -> SDoc
-- Print a type variable binder with its kind (but not if *)
pprKindedTyVarBndr tyvar
- = text "@" <> pprTyVarWithKind tyvar
+ = text "@" <> pp_occ <> pprTyVarWithKind tyvar
+ where
+ pp_occ = case tyVarOccInfo tyvar of
+ TyCoDead -> text "[dead]"
+ TyCoOne -> text "[one]"
+ TyCoMany -> empty
-- pprId x prints x :: ty
pprId :: Id -> SDoc
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -153,8 +153,7 @@ simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
-- created from DynFlags, but not necessarily.
simpleOptExpr opts expr
- = -- pprTrace "simpleOptExpr" (ppr init_subst $$ ppr expr)
- simpleOptExprWith opts init_subst expr
+ = simpleOptExprWith opts init_subst expr
where
init_subst = mkEmptySubst (mkInScopeSet (mapVarSet zapIdUnfolding (exprFreeVars expr)))
-- zapIdUnfolding: see Note [The InScopeSet for simpleOptExpr]
@@ -176,9 +175,10 @@ simpleOptExprNoInline opts expr
simpleOptExprWith :: HasDebugCallStack => SimpleOpts -> Subst -> InExpr -> OutExpr
-- See Note [The simple optimiser]
simpleOptExprWith opts subst expr
- = simple_opt_expr init_env (occurAnalyseExpr expr)
+ = simple_opt_expr init_env occ_expr
where
init_env = (emptyEnv opts) { soe_subst = subst }
+ occ_expr = occurAnalyseExpr expr
----------------------
simpleOptPgm :: SimpleOpts
@@ -493,7 +493,7 @@ simple_type_bind env@(SOE { soe_subst = subst })
| occurs_once || typeIsSmallEnoughToInline out_ty
= (env { soe_subst = extendTvSubst subst in_tv out_ty }, Nothing)
- | otherwise
+ | otherwise -- Make a type binding
= let (subst1, tv1) = substTyVarBndr subst in_tv
out_tv = tv1 `setTyVarUnfolding` out_ty
in ( env { soe_subst = extendTvSubst subst1 in_tv (mkTyVarTy out_tv) }
@@ -504,7 +504,7 @@ simple_type_bind env@(SOE { soe_subst = subst })
subst_for_rhs = setInScope (soe_subst rhs_env) (substInScopeSet subst)
out_ty = substTyUnchecked subst_for_rhs in_ty
bndr_occ = tyVarOccInfo in_tv
- occurs_once {- syntactically -} = isOneOcc bndr_occ && occ_n_br bndr_occ == 1
+ occurs_once {- syntactically -} = isOneTyCoOcc bndr_occ
----------------------
simple_bind_pair :: SimpleOptEnv
@@ -1621,7 +1621,7 @@ exprIsLambda_maybe ise@(ISE in_scope_set _) (Cast casted_e co)
| Just (x, e,ts) <- exprIsLambda_maybe ise casted_e
-- Only do value lambdas.
-- this implies that x is not in scope in gamma (makes this code simpler)
- , not (isTyVar x) && not (isCoVar x)
+ , isNonCoVarId x
, assert (not $ x `elemVarSet` tyCoVarsOfCo co) True
, Just (x',e') <- pushCoercionIntoLambda in_scope_set x e co
, let res = Just (x',e',ts)
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -73,6 +73,8 @@ module GHC.Types.Basic (
isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,
isNoOccInfo, strongLoopBreaker, weakLoopBreaker,
+ TyCoOccInfo(..), plusTyCoOccInfo, isOneTyCoOcc,
+
InsideLam(..),
BranchCount, oneBranch,
InterestingCxt(..),
@@ -1380,8 +1382,25 @@ point can also be invoked from other join points, not just from case branches:
Here both 'j1' and 'j2' will get marked AlwaysTailCalled, but j1 will get
ManyOccs and j2 will get `OneOcc { occ_n_br = 2 }`.
+-}
-************************************************************************
+data TyCoOccInfo = TyCoDead | TyCoOne | TyCoMany
+
+instance Outputable TyCoOccInfo where
+ ppr TyCoDead = text "dead"
+ ppr TyCoOne = text "one"
+ ppr TyCoMany = text "many"
+
+isOneTyCoOcc :: TyCoOccInfo -> Bool
+isOneTyCoOcc TyCoOne = True
+isOneTyCoOcc _ = False
+
+plusTyCoOccInfo :: TyCoOccInfo -> TyCoOccInfo -> TyCoOccInfo
+plusTyCoOccInfo TyCoDead occ = occ
+plusTyCoOccInfo occ TyCoDead = occ
+plusTyCoOccInfo _ _ = TyCoMany
+
+{-**********************************************************************
* *
Default method specification
* *
@@ -2461,4 +2480,4 @@ convImportLevel NotLevelled = NormalLevel
convImportLevelSpec :: ImportDeclLevel -> ImportLevel
convImportLevelSpec ImportDeclQuote = QuoteLevel
-convImportLevelSpec ImportDeclSplice = SpliceLevel
\ No newline at end of file
+convImportLevelSpec ImportDeclSplice = SpliceLevel
=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -128,7 +128,7 @@ import {-# SOURCE #-} GHC.Builtin.Types ( manyDataConTy )
import GHC.Types.Name hiding (varName)
import GHC.Types.Unique ( Uniquable, Unique, getKey, getUnique
, nonDetCmpUnique )
-import GHC.Types.Basic( TypeOrConstraint(..), OccInfo, noOccInfo )
+import GHC.Types.Basic( TypeOrConstraint(..), OccInfo, noOccInfo, TyCoOccInfo(..) )
import GHC.Utils.Misc
import GHC.Utils.Binary
import GHC.Utils.Outputable
@@ -269,7 +269,7 @@ data Var
varType :: Kind, -- ^ The type or kind of the 'Var' in question
tv_unfolding :: Maybe Type, -- ^ The type to which the variable is bound to,
-- if any, see Note [Type and coercion lets] in GHC.Core
- tv_occ_info :: OccInfo
+ tv_occ_info :: TyCoOccInfo
}
| TcTyVar { -- Used only during type inference
@@ -1032,8 +1032,8 @@ tyVarUnfolding_maybe :: TyVar -> Maybe Type
tyVarUnfolding_maybe (TyVar { tv_unfolding = unf }) = unf
tyVarUnfolding_maybe _ = Nothing
-tyVarOccInfo :: TyVar -> OccInfo
-tyVarOccInfo (TcTyVar {}) = noOccInfo
+tyVarOccInfo :: TyVar -> TyCoOccInfo
+tyVarOccInfo (TcTyVar {}) = TyCoMany
tyVarOccInfo tv = assertPpr (isTyVar tv) (ppr tv) $ tv_occ_info tv
setTyVarUnique :: TyVar -> Unique -> TyVar
@@ -1059,7 +1059,7 @@ zapTyVarUnfolding tv@(TcTyVar {}) = tv
-- Why: because zapTyVarUnfolding is called by substTyBndr during typechecking
zapTyVarUnfolding v = pprPanic "zapTyVarUnfolding" (ppr v)
-setTyVarOccInfo :: HasDebugCallStack => TyVar -> OccInfo -> TyVar
+setTyVarOccInfo :: HasDebugCallStack => TyVar -> TyCoOccInfo -> TyVar
setTyVarOccInfo tv@(TyVar {}) occ_info
= tv {tv_occ_info = occ_info}
setTyVarOccInfo tv occ_info
@@ -1101,7 +1101,7 @@ mkTyVar name kind = TyVar { varName = name
, realUnique = nameUnique name
, varType = kind
, tv_unfolding = Nothing
- , tv_occ_info = noOccInfo
+ , tv_occ_info = TyCoMany
}
mkTyVarWithUnfolding :: Name -> Kind -> Type -> TyVar
@@ -1109,7 +1109,7 @@ mkTyVarWithUnfolding name kind unf = TyVar { varName = name
, realUnique = nameUnique name
, varType = kind
, tv_unfolding = Just unf
- , tv_occ_info = noOccInfo
+ , tv_occ_info = TyCoMany
}
mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e69b3f51045360e53260aec1734f23f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e69b3f51045360e53260aec1734f23f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/bump-win32-tarballs] rts/LoadArchive: Handle string table entries terminated with /
by Ben Gamari (＠bgamari) 13 Jul '25
by Ben Gamari (＠bgamari) 13 Jul '25
13 Jul '25
Ben Gamari pushed to branch wip/bump-win32-tarballs at Glasgow Haskell Compiler / GHC
Commits:
5d8fce70 by Ben Gamari at 2025-07-13T18:26:28-04:00
rts/LoadArchive: Handle string table entries terminated with /
llvm-ar appears to terminate string table entries with `/\n` [1]. This
matters in the case of thin archives, since the filename is used. In the
past this worked since `llvm-ar` would produce archives with "small"
filenames when possible. However, now it appears to always use the
string table.
[1] https://github.com/llvm/llvm-project/blob/bfb686bb5ba503e9386dc899e1ebbe248…
- - - - -
1 changed file:
- rts/linker/LoadArchive.c
Changes:
=====================================
rts/linker/LoadArchive.c
=====================================
@@ -275,6 +275,13 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_,
"loadArchive(fileName)");
}
memcpy(fileName, gnuFileIndex + n, FileNameSize);
+
+
+ /* llvm-ar terminates string table entries with `/\n`. */
+ if (fileName[FileNameSize-1] == '/') {
+ FileNameSize--;
+ }
+
fileName[FileNameSize] = '\0';
*thisFileNameSize = FileNameSize;
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d8fce70410b784a2da1c73a82fbb8a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d8fce70410b784a2da1c73a82fbb8a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/warning-for-last-and-init] 4 commits: Fix documentation for HEAP_PROF_SAMPLE_STRING
by Bodigrim (＠Bodigrim) 12 Jul '25
by Bodigrim (＠Bodigrim) 12 Jul '25
12 Jul '25
Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC
Commits:
01d3154e by Wen Kokke at 2025-07-10T17:06:36+01:00
Fix documentation for HEAP_PROF_SAMPLE_STRING
- - - - -
ac259c48 by Wen Kokke at 2025-07-10T17:06:38+01:00
Fix documentation for HEAP_PROF_SAMPLE_COST_CENTRE
- - - - -
2b4db9ba by Pi Delport at 2025-07-11T16:40:52-04:00
(Applicative docs typo: missing "one")
- - - - -
d842c8c5 by Mike Pilgrem at 2025-07-12T18:40:17+01:00
Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial
Also corrects the warning for `tail` to refer to `Data.List.uncons` (like the existing warning for `head`).
In module `Settings.Warnings`, applies `-Wno-unrecognised-warning-flags` `-Wno-x-partial` to the `Cabal`, `filepath`, `hsc2hs`, `hpc`, `parsec`, `text` and `time` packages (outside GHC's repository).
- - - - -
21 changed files:
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Driver/Session/Units.hs
- compiler/GHC/Prelude/Basic.hs
- docs/users_guide/eventlog-formats.rst
- ghc/GHCi/UI.hs
- ghc/Main.hs
- hadrian/src/Settings/Warnings.hs
- libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs
- libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs
- libraries/time
- testsuite/tests/driver/j-space/jspace.hs
- testsuite/tests/rts/KeepCafsBase.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
- utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
Changes:
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -112,8 +112,7 @@ import GHC.Utils.Misc
import Data.ByteString ( ByteString )
import Data.Function ( on )
-import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL )
-import qualified Data.List as Partial ( init, last )
+import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL, unsnoc )
import Data.Ord ( comparing )
import Control.Monad ( guard )
import qualified Data.Set as Set
@@ -1871,10 +1870,10 @@ app_ok fun_ok primop_ok fun args
PrimOpId op _
| primOpIsDiv op
- , Lit divisor <- Partial.last args
+ , Just (initArgs, Lit divisor) <- unsnoc args
-- there can be 2 args (most div primops) or 3 args
-- (WordQuotRem2Op), hence the use of last/init
- -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (Partial.init args)
+ -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) initArgs
-- Special case for dividing operations that fail
-- In general they are NOT ok-for-speculation
-- (which primop_ok will catch), but they ARE OK
=====================================
compiler/GHC/Driver/Session/Units.hs
=====================================
@@ -183,7 +183,7 @@ checkUnitCycles dflags graph = processSCCs (HUG.hugSCCs graph)
processSCCs [] = return ()
processSCCs (AcyclicSCC _: other_sccs) = processSCCs other_sccs
- processSCCs (CyclicSCC uids: _) = throwGhcException $ CmdLineError $ showSDoc dflags (cycle_err uids)
+ processSCCs (NECyclicSCC uids: _) = throwGhcException $ CmdLineError $ showSDoc dflags (cycle_err uids)
cycle_err uids =
@@ -195,8 +195,8 @@ checkUnitCycles dflags graph = processSCCs (HUG.hugSCCs graph)
(map (\uid -> text "-" <+> ppr uid <+> text "depends on") start)
++ [text "-" <+> ppr final]
where
- start = init uids
- final = last uids
+ start = NE.init uids
+ final = NE.last uids
-- | Check that we don't have multiple units with the same UnitId.
checkDuplicateUnits :: DynFlags -> [(FilePath, DynFlags)] -> Ghc ()
=====================================
compiler/GHC/Prelude/Basic.hs
=====================================
@@ -2,8 +2,8 @@
{-# OPTIONS_HADDOCK not-home #-}
{-# OPTIONS_GHC -O2 #-} -- See Note [-O2 Prelude]
--- See Note [Proxies for head and tail]
-{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-x-partial #-}
+-- See Note [Proxies for partial list functions]
+{-# OPTIONS_GHC -Wno-x-partial #-}
-- | Custom minimal GHC "Prelude"
--
@@ -24,7 +24,7 @@ module GHC.Prelude.Basic
, bit
, shiftL, shiftR
, setBit, clearBit
- , head, tail, unzip
+ , head, tail, init, last, unzip
, strictGenericLength
) where
@@ -59,7 +59,7 @@ NoImplicitPrelude. There are two motivations for this:
-}
import qualified Prelude
-import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, unzip)
+import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, init, last, unzip)
import Control.Applicative (Applicative(..))
import Data.Foldable as X (Foldable (elem, foldMap, foldl, foldl', foldr, length, null, product, sum))
import Data.Foldable1 as X hiding (head, last)
@@ -118,24 +118,35 @@ setBit = \ x i -> x Bits..|. bit i
clearBit :: (Num a, Bits.Bits a) => a -> Int -> a
clearBit = \ x i -> x Bits..&. Bits.complement (bit i)
-{- Note [Proxies for head and tail]
+{- Note [Proxies for partial list functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Prelude.head and Prelude.tail have recently acquired {-# WARNING in "x-partial" #-},
+Prelude.head, Prelude.tail, Prelude.init and Prelude.last
+have recently acquired {-# WARNING in "x-partial" #-},
but the GHC codebase uses them fairly extensively and insists on building warning-free.
Thus, instead of adding {-# OPTIONS_GHC -Wno-x-partial #-} to every module which
employs them, we define warning-less proxies and export them from GHC.Prelude.
-}
--- See Note [Proxies for head and tail]
+-- See Note [Proxies for partial list functions]
head :: HasCallStack => [a] -> a
head = Prelude.head
{-# INLINE head #-}
--- See Note [Proxies for head and tail]
+-- See Note [Proxies for partial list functions]
tail :: HasCallStack => [a] -> [a]
tail = Prelude.tail
{-# INLINE tail #-}
+-- See Note [Proxies for partial list functions]
+init :: HasCallStack => [a] -> [a]
+init = Prelude.init
+{-# INLINE init #-}
+
+-- See Note [Proxies for partial list functions]
+last :: HasCallStack => [a] -> a
+last = Prelude.last
+{-# INLINE last #-}
+
{- |
The 'genericLength' function defined in base can't be specialised due to the
NOINLINE pragma.
=====================================
docs/users_guide/eventlog-formats.rst
=====================================
@@ -779,9 +779,9 @@ the total time spent profiling.
Cost-centre break-down
^^^^^^^^^^^^^^^^^^^^^^
-A variable-length packet encoding a heap profile sample broken down by,
- * cost-centre (:rts-flag:`-hc`)
-
+A variable-length packet encoding a heap profile sample.
+This event is only emitted when the heap profile type is set to :rts-flag:`-hc` or :rts-flag:`-hb`.
+Otherwise, a :event-type:`HEAP_PROF_SAMPLE_STRING` event is emitted instead.
.. event-type:: HEAP_PROF_SAMPLE_COST_CENTRE
@@ -796,11 +796,19 @@ A variable-length packet encoding a heap profile sample broken down by,
String break-down
^^^^^^^^^^^^^^^^^
-A variable-length event encoding a heap sample broken down by,
+A variable-length event encoding a heap sample.
+The content of the sample label varies depending on the heap profile type:
+
+ * :rts-flag:`-hT` The sample label contains a closure type, e.g., ``"ghc-bignum:GHC.Num.Integer.IS"``.
+ * :rts-flag:`-hm` The sample label contains a module name, e.g., ``"GHC.Num.Integer"``.
+ * :rts-flag:`-hd` The sample label contains a closure description, e.g., ``"IS"``.
+ * :rts-flag:`-hy` The sample label contains a type description, e.g., ``"Integer"``.
+ * :rts-flag:`-he` The sample label contains a stringified era, e.g., ``"1"``.
+ * :rts-flag:`-hr` The sample label contains a retainer set description, e.g., ``"(184)$stoIntegralSized1"``.
+ * :rts-flag:`-hi` The sample label contains a stringified pointer, e.g., ``"0x1008b7588"``,
+ which can be matched to an info table description emitted by the :event-type:`IPE` event.
- * type description (:rts-flag:`-hy`)
- * closure description (:rts-flag:`-hd`)
- * module (:rts-flag:`-hm`)
+If the heap profile type is set to :rts-flag:`-hc` or :rts-flag:`-hb`, a :event-type:`HEAP_PROF_SAMPLE_COST_CENTRE` event is emitted instead.
.. event-type:: HEAP_PROF_SAMPLE_STRING
@@ -808,7 +816,7 @@ A variable-length event encoding a heap sample broken down by,
:length: variable
:field Word8: profile ID
:field Word64: heap residency in bytes
- :field String: type or closure description, or module name
+ :field String: sample label
.. _time-profiler-events:
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -133,7 +133,7 @@ import Data.Char
import Data.Function
import qualified Data.Foldable as Foldable
import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
-import Data.List ( find, intercalate, intersperse,
+import Data.List ( find, intercalate, intersperse, unsnoc,
isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as S
@@ -2399,9 +2399,9 @@ setContextAfterLoad keep_ctxt (Just graph) = do
[] ->
let graph' = flattenSCCs $ filterToposortToModules $
GHC.topSortModuleGraph True (GHC.mkModuleGraph loaded_graph) Nothing
- in case graph' of
- [] -> setContextKeepingPackageModules keep_ctxt []
- xs -> load_this (last xs)
+ in case unsnoc graph' of
+ Nothing -> setContextKeepingPackageModules keep_ctxt []
+ Just (_, lst) -> load_this lst
(m:_) ->
load_this m
where
=====================================
ghc/Main.hs
=====================================
@@ -88,7 +88,7 @@ import System.Exit
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except (throwE, runExceptT)
-import Data.List ( isPrefixOf, partition, intercalate )
+import Data.List ( isPrefixOf, partition, intercalate, unsnoc )
import Prelude
import qualified Data.List.NonEmpty as NE
@@ -115,8 +115,7 @@ main = do
argv0 <- getArgs
let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0
- mbMinusB | null minusB_args = Nothing
- | otherwise = Just (drop 2 (last minusB_args))
+ mbMinusB = drop 2 . snd <$> unsnoc minusB_args
let argv2 = map (mkGeneralLocated "on the commandline") argv1
=====================================
hadrian/src/Settings/Warnings.hs
=====================================
@@ -72,7 +72,10 @@ ghcWarningsArgs = do
, package terminfo ? pure [ "-Wno-unused-imports", "-Wno-deriving-typeable" ]
, package stm ? pure [ "-Wno-deriving-typeable" ]
, package osString ? pure [ "-Wno-deriving-typeable", "-Wno-unused-imports" ]
- , package parsec ? pure [ "-Wno-deriving-typeable" ]
+ , package parsec ? pure [ "-Wno-deriving-typeable"
+ , "-Wno-x-partial"
+ -- https://github.com/haskell/parsec/issues/194
+ ]
, package cabal ? pure [ "-Wno-deriving-typeable", "-Wno-incomplete-record-selectors" ]
-- The -Wno-incomplete-record-selectors is due to
=====================================
libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs
=====================================
@@ -13,7 +13,7 @@ import GHC.Boot.TH.PprLib
import GHC.Boot.TH.Syntax
import Data.Word ( Word8 )
import Data.Char ( toLower, chr )
-import Data.List ( intersperse )
+import Data.List ( intersperse, unsnoc )
import GHC.Show ( showMultiLineString )
import GHC.Lexeme( isVarSymChar )
import Data.Ratio ( numerator, denominator )
@@ -214,9 +214,10 @@ pprExp i (MDoE m ss_) = parensIf (i > noPrec) $
pprStms [s] = ppr s
pprStms ss = braces (semiSep ss)
-pprExp _ (CompE []) = text "<<Empty CompExp>>"
-- This will probably break with fixity declarations - would need a ';'
-pprExp _ (CompE ss) =
+pprExp _ (CompE ss) = case unsnoc ss of
+ Nothing -> text "<<Empty CompExp>>"
+ Just (ss', s) ->
if null ss'
-- If there are no statements in a list comprehension besides the last
-- one, we simply treat it like a normal list.
@@ -225,8 +226,6 @@ pprExp _ (CompE ss) =
<+> bar
<+> commaSep ss'
<> text "]"
- where s = last ss
- ss' = init ss
pprExp _ (ArithSeqE d) = ppr d
pprExp _ (ListE es) = brackets (commaSep es)
pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e
=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -1047,7 +1047,7 @@ class Functor f where
-- * sequence computations and combine their results ('<*>' and 'liftA2').
--
-- A minimal complete definition must include implementations of 'pure'
--- and of either '<*>' or 'liftA2'. If it defines both, then they must behave
+-- and one of either '<*>' or 'liftA2'. If it defines both, then they must behave
-- the same as their default definitions:
--
-- @('<*>') = 'liftA2' 'id'@
=====================================
libraries/ghc-internal/src/GHC/Internal/Float.hs
=====================================
@@ -13,6 +13,9 @@
{-# OPTIONS_HADDOCK not-home #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+-- For init in formatRealFloatAlt
+{-# OPTIONS_GHC -Wno-x-partial #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Internal.Float
=====================================
libraries/ghc-internal/src/GHC/Internal/List.hs
=====================================
@@ -190,12 +190,18 @@ tail :: HasCallStack => [a] -> [a]
tail (_:xs) = xs
tail [] = errorEmptyList "tail"
-{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'GHC.Internal.Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-}
+{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-}
-- | \(\mathcal{O}(n)\). Extract the last element of a list, which must be
-- finite and non-empty.
--
--- WARNING: This function is partial. Consider using 'unsnoc' instead.
+-- To disable the warning about partiality put
+-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@
+-- at the top of the file. To disable it throughout a package put the same
+-- options into @ghc-options@ section of Cabal file. To disable it in GHCi
+-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@
+-- config file. See also the
+-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides….
--
-- ==== __Examples__
--
@@ -218,10 +224,18 @@ last xs = foldl (\_ x -> x) lastError xs
lastError :: HasCallStack => a
lastError = errorEmptyList "last"
+{-# WARNING in "x-partial" last "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-}
+
-- | \(\mathcal{O}(n)\). Return all the elements of a list except the last one.
-- The list must be non-empty.
--
--- WARNING: This function is partial. Consider using 'unsnoc' instead.
+-- To disable the warning about partiality put
+-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@
+-- at the top of the file. To disable it throughout a package put the same
+-- options into @ghc-options@ section of Cabal file. To disable it in GHCi
+-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@
+-- config file. See also the
+-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides….
--
-- ==== __Examples__
--
@@ -240,6 +254,8 @@ init (x:xs) = init' x xs
where init' _ [] = []
init' y (z:zs) = y : init' z zs
+{-# WARNING in "x-partial" init "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-}
+
-- | \(\mathcal{O}(1)\). Test whether a list is empty.
--
-- >>> null []
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO.hs
=====================================
@@ -825,11 +825,12 @@ output_flags = std_flags
where
-- XXX bits copied from System.FilePath, since that's not available here
- combine a b
- | null b = a
- | null a = b
- | pathSeparator [last a] = a ++ b
- | otherwise = a ++ [pathSeparatorChar] ++ b
+ combine a [] = a
+ combine a b = case unsnoc a of
+ Nothing -> b
+ Just (_, lastA)
+ | pathSeparator [lastA] -> a ++ b
+ | otherwise -> a ++ [pathSeparatorChar] ++ b
tempCounter :: IORef Int
tempCounter = unsafePerformIO $ newIORef 0
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
=====================================
@@ -54,6 +54,7 @@ import GHC.Internal.Base hiding (NonEmpty(..),Type, Module, sequence)
import GHC.Internal.Data.Data hiding (Fixity(..))
import GHC.Internal.Data.NonEmpty (NonEmpty(..))
import GHC.Internal.Data.Traversable
+import GHC.Internal.List (unsnoc)
import GHC.Internal.Word
import GHC.Internal.Generics (Generic)
import GHC.Internal.IORef
@@ -73,7 +74,7 @@ import GHC.Internal.Control.Monad.Fix
import GHC.Internal.Control.Exception
import GHC.Internal.Num
import GHC.Internal.IO.Unsafe
-import GHC.Internal.List (dropWhile, break, replicate, reverse, last)
+import GHC.Internal.List (dropWhile, break, replicate, reverse)
import GHC.Internal.MVar
import GHC.Internal.IO.Exception
import GHC.Internal.Unicode
@@ -82,6 +83,16 @@ import qualified GHC.Internal.Types as Kind (Type)
import GHC.Internal.ForeignSrcLang
import GHC.Internal.LanguageExtensions
+#ifdef BOOTSTRAP_TH
+#if MIN_VERSION_base(4,19,0)
+import Data.List (unsnoc)
+#else
+import Data.Maybe (maybe)
+unsnoc :: [a] -> Maybe ([a], a)
+unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing
+#endif
+#endif
+
-----------------------------------------------------
--
-- The Quasi class
@@ -1296,7 +1307,7 @@ mkName str
-- (i.e. non-empty, starts with capital, all alpha)
is_rev_mod_name rev_mod_str
| (compt, rest) <- break (== '.') rev_mod_str
- , not (null compt), isUpper (last compt), all is_mod_char compt
+ , Just (_, lastCompt) <- unsnoc compt, isUpper lastCompt, all is_mod_char compt
= case rest of
[] -> True
(_dot : rest') -> is_rev_mod_name rest'
=====================================
libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs
=====================================
@@ -104,7 +104,7 @@ module System.FilePath.Posix
import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
import Data.Maybe(isJust)
-import Data.List(stripPrefix, isSuffixOf)
+import Data.List(stripPrefix, isSuffixOf, uncons, unsnoc)
import System.Environment(getEnv)
@@ -203,14 +203,20 @@ isExtSeparator = (== extSeparator)
splitSearchPath :: String -> [FilePath]
splitSearchPath = f
where
- f xs = case break isSearchPathSeparator xs of
- (pre, [] ) -> g pre
- (pre, _:post) -> g pre ++ f post
-
- g "" = ["." | isPosix]
- g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]
- g x = [x]
-
+ f xs = let (pre, post) = break isSearchPathSeparator xs
+ in case uncons post of
+ Nothing -> g pre
+ Just (_, t) -> g pre ++ f t
+
+ g x = case uncons x of
+ Nothing -> ["." | isPosix]
+ Just (h, t)
+ | h == '"'
+ , Just{} <- uncons t -- >= 2
+ , isWindows
+ , Just (i, l) <- unsnoc t
+ , l == '"' -> [i]
+ | otherwise -> [x]
-- | Get a list of 'FilePath's in the $PATH variable.
getSearchPath :: IO [FilePath]
@@ -233,12 +239,17 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH")
-- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
-- > splitExtension "file/path.txt/" == ("file/path.txt/","")
splitExtension :: FilePath -> (String, String)
-splitExtension x = case nameDot of
- "" -> (x,"")
- _ -> (dir ++ init nameDot, extSeparator : ext)
- where
- (dir,file) = splitFileName_ x
- (nameDot,ext) = breakEnd isExtSeparator file
+splitExtension x = case unsnoc nameDot of
+ -- Imagine x = "no-dots", then nameDot = ""
+ Nothing -> (x, mempty)
+ Just (initNameDot, _)
+ -- Imagine x = "\\shared.with.dots\no-dots"
+ | isWindows && null (dropDrive nameDot) -> (x, mempty)
+ -- Imagine x = "dir.with.dots/no-dots"
+ | any isPathSeparator ext -> (x, mempty)
+ | otherwise -> (initNameDot, extSeparator : ext)
+ where
+ (nameDot, ext) = breakEnd isExtSeparator x
-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
--
@@ -594,9 +605,13 @@ replaceBaseName pth nam = combineAlways a (nam <.> ext)
-- > hasTrailingPathSeparator "test" == False
-- > hasTrailingPathSeparator "test/" == True
hasTrailingPathSeparator :: FilePath -> Bool
-hasTrailingPathSeparator "" = False
-hasTrailingPathSeparator x = isPathSeparator (last x)
+hasTrailingPathSeparator = isJust . getTrailingPathSeparator
+getTrailingPathSeparator :: FilePath -> Maybe Char
+getTrailingPathSeparator x = case unsnoc x of
+ Just (_, lastX)
+ | isPathSeparator lastX -> Just lastX
+ _ -> Nothing
hasLeadingPathSeparator :: FilePath -> Bool
hasLeadingPathSeparator "" = False
@@ -619,12 +634,12 @@ addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pat
-- > Windows: dropTrailingPathSeparator "\\" == "\\"
-- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
dropTrailingPathSeparator :: FilePath -> FilePath
-dropTrailingPathSeparator x =
- if hasTrailingPathSeparator x && not (isDrive x)
- then let x' = dropWhileEnd isPathSeparator x
- in if null x' then [last x] else x'
- else x
-
+dropTrailingPathSeparator x = case getTrailingPathSeparator x of
+ Just lastX
+ | not (isDrive x)
+ -> let x' = dropWhileEnd isPathSeparator x
+ in if null x' then [lastX] else x'
+ _ -> x
-- | Get the directory name, move up one level.
--
@@ -863,28 +878,37 @@ makeRelative root path
-- > Posix: normalise "bob/fred/." == "bob/fred/"
-- > Posix: normalise "//home" == "/home"
normalise :: FilePath -> FilePath
-normalise path = result ++ [pathSeparator | addPathSeparator]
- where
- (drv,pth) = splitDrive path
- result = joinDrive' (normaliseDrive drv) (f pth)
+normalise filepath =
+ result <>
+ (if addPathSeparator
+ then [pathSeparator]
+ else mempty)
+ where
+ (drv,pth) = splitDrive filepath
+
+ result = joinDrive' (normaliseDrive drv) (f pth)
- joinDrive' "" "" = "."
- joinDrive' d p = joinDrive d p
+ joinDrive' d p
+ = if null d && null p
+ then "."
+ else joinDrive d p
- addPathSeparator = isDirPath pth
- && not (hasTrailingPathSeparator result)
- && not (isRelativeDrive drv)
+ addPathSeparator = isDirPath pth
+ && not (hasTrailingPathSeparator result)
+ && not (isRelativeDrive drv)
- isDirPath xs = hasTrailingPathSeparator xs
- || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)
+ isDirPath xs = hasTrailingPathSeparator xs || case unsnoc xs of
+ Nothing -> False
+ Just (initXs, lastXs) -> lastXs == '.' && hasTrailingPathSeparator initXs
- f = joinPath . dropDots . propSep . splitDirectories
+ f = joinPath . dropDots . propSep . splitDirectories
- propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs
- | otherwise = x : xs
- propSep [] = []
+ propSep (x:xs)
+ | all isPathSeparator x = [pathSeparator] : xs
+ | otherwise = x : xs
+ propSep [] = []
- dropDots = filter ("." /=)
+ dropDots = filter ("." /=)
normaliseDrive :: FilePath -> FilePath
normaliseDrive "" = ""
=====================================
libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs
=====================================
@@ -104,7 +104,7 @@ module System.FilePath.Windows
import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
import Data.Maybe(isJust)
-import Data.List(stripPrefix, isSuffixOf)
+import Data.List(stripPrefix, isSuffixOf, uncons, unsnoc)
import System.Environment(getEnv)
@@ -203,14 +203,20 @@ isExtSeparator = (== extSeparator)
splitSearchPath :: String -> [FilePath]
splitSearchPath = f
where
- f xs = case break isSearchPathSeparator xs of
- (pre, [] ) -> g pre
- (pre, _:post) -> g pre ++ f post
-
- g "" = ["." | isPosix]
- g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]
- g x = [x]
-
+ f xs = let (pre, post) = break isSearchPathSeparator xs
+ in case uncons post of
+ Nothing -> g pre
+ Just (_, t) -> g pre ++ f t
+
+ g x = case uncons x of
+ Nothing -> ["." | isPosix]
+ Just (h, t)
+ | h == '"'
+ , Just{} <- uncons t -- >= 2
+ , isWindows
+ , Just (i, l) <- unsnoc t
+ , l == '"' -> [i]
+ | otherwise -> [x]
-- | Get a list of 'FilePath's in the $PATH variable.
getSearchPath :: IO [FilePath]
@@ -233,12 +239,17 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH")
-- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
-- > splitExtension "file/path.txt/" == ("file/path.txt/","")
splitExtension :: FilePath -> (String, String)
-splitExtension x = case nameDot of
- "" -> (x,"")
- _ -> (dir ++ init nameDot, extSeparator : ext)
- where
- (dir,file) = splitFileName_ x
- (nameDot,ext) = breakEnd isExtSeparator file
+splitExtension x = case unsnoc nameDot of
+ -- Imagine x = "no-dots", then nameDot = ""
+ Nothing -> (x, mempty)
+ Just (initNameDot, _)
+ -- Imagine x = "\\shared.with.dots\no-dots"
+ | isWindows && null (dropDrive nameDot) -> (x, mempty)
+ -- Imagine x = "dir.with.dots/no-dots"
+ | any isPathSeparator ext -> (x, mempty)
+ | otherwise -> (initNameDot, extSeparator : ext)
+ where
+ (nameDot, ext) = breakEnd isExtSeparator x
-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
--
@@ -594,9 +605,13 @@ replaceBaseName pth nam = combineAlways a (nam <.> ext)
-- > hasTrailingPathSeparator "test" == False
-- > hasTrailingPathSeparator "test/" == True
hasTrailingPathSeparator :: FilePath -> Bool
-hasTrailingPathSeparator "" = False
-hasTrailingPathSeparator x = isPathSeparator (last x)
+hasTrailingPathSeparator = isJust . getTrailingPathSeparator
+getTrailingPathSeparator :: FilePath -> Maybe Char
+getTrailingPathSeparator x = case unsnoc x of
+ Just (_, lastX)
+ | isPathSeparator lastX -> Just lastX
+ _ -> Nothing
hasLeadingPathSeparator :: FilePath -> Bool
hasLeadingPathSeparator "" = False
@@ -619,12 +634,12 @@ addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pat
-- > Windows: dropTrailingPathSeparator "\\" == "\\"
-- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
dropTrailingPathSeparator :: FilePath -> FilePath
-dropTrailingPathSeparator x =
- if hasTrailingPathSeparator x && not (isDrive x)
- then let x' = dropWhileEnd isPathSeparator x
- in if null x' then [last x] else x'
- else x
-
+dropTrailingPathSeparator x = case getTrailingPathSeparator x of
+ Just lastX
+ | not (isDrive x)
+ -> let x' = dropWhileEnd isPathSeparator x
+ in if null x' then [lastX] else x'
+ _ -> x
-- | Get the directory name, move up one level.
--
@@ -863,28 +878,37 @@ makeRelative root path
-- > Posix: normalise "bob/fred/." == "bob/fred/"
-- > Posix: normalise "//home" == "/home"
normalise :: FilePath -> FilePath
-normalise path = result ++ [pathSeparator | addPathSeparator]
- where
- (drv,pth) = splitDrive path
- result = joinDrive' (normaliseDrive drv) (f pth)
+normalise filepath =
+ result <>
+ (if addPathSeparator
+ then [pathSeparator]
+ else mempty)
+ where
+ (drv,pth) = splitDrive filepath
+
+ result = joinDrive' (normaliseDrive drv) (f pth)
- joinDrive' "" "" = "."
- joinDrive' d p = joinDrive d p
+ joinDrive' d p
+ = if null d && null p
+ then "."
+ else joinDrive d p
- addPathSeparator = isDirPath pth
- && not (hasTrailingPathSeparator result)
- && not (isRelativeDrive drv)
+ addPathSeparator = isDirPath pth
+ && not (hasTrailingPathSeparator result)
+ && not (isRelativeDrive drv)
- isDirPath xs = hasTrailingPathSeparator xs
- || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)
+ isDirPath xs = hasTrailingPathSeparator xs || case unsnoc xs of
+ Nothing -> False
+ Just (initXs, lastXs) -> lastXs == '.' && hasTrailingPathSeparator initXs
- f = joinPath . dropDots . propSep . splitDirectories
+ f = joinPath . dropDots . propSep . splitDirectories
- propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs
- | otherwise = x : xs
- propSep [] = []
+ propSep (x:xs)
+ | all isPathSeparator x = [pathSeparator] : xs
+ | otherwise = x : xs
+ propSep [] = []
- dropDots = filter ("." /=)
+ dropDots = filter ("." /=)
normaliseDrive :: FilePath -> FilePath
normaliseDrive "" = ""
=====================================
libraries/time
=====================================
@@ -1 +1 @@
-Subproject commit e5c5d1987011efe88a21ab6ded45aaa33a16274f
+Subproject commit 989a09cd173e23d5a52e43efa06c43015f267416
=====================================
testsuite/tests/driver/j-space/jspace.hs
=====================================
@@ -7,7 +7,7 @@ import System.Environment
import GHC.Driver.Env.Types
import GHC.Profiling
import System.Mem
-import Data.List (isPrefixOf)
+import Data.List (isPrefixOf, unsnoc)
import Control.Monad
import System.Exit
import GHC.Platform
@@ -41,7 +41,9 @@ initGhcM xs = do
requestHeapCensus
performGC
[ys] <- filter (isPrefixOf (ghcUnitId <> ":GHC.Unit.Module.ModDetails.ModDetails")) . lines <$> readFile "jspace.hp"
- let (n :: Int) = read (last (words ys))
+ let (n :: Int) = case unsnoc (words ys) of
+ Nothing -> error "input is unexpectedly empty"
+ Just (_, lst) -> read lst
-- The output should be 50 * 8 * word_size (i.e. 3600, or 1600 on 32-bit architectures):
-- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH,
-- and each ModDetails contains 1 (info table) + 8 word-sized fields.
=====================================
testsuite/tests/rts/KeepCafsBase.hs
=====================================
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-x-partial #-}
+
module KeepCafsBase (x) where
x :: Int
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -37,7 +37,7 @@ import GHC.Base (NonEmpty(..))
import GHC.Parser.Lexer (allocateComments)
import Data.Data hiding ( Fixity )
-import Data.List (sortBy, partition)
+import Data.List (sortBy, partition, unsnoc)
import qualified Data.Map.Strict as Map
import Debug.Trace
@@ -734,8 +734,9 @@ ghead info [] = error $ "ghead "++info++" []"
ghead _info (h:_) = h
glast :: String -> [a] -> a
-glast info [] = error $ "glast " ++ info ++ " []"
-glast _info h = last h
+glast info xs = case unsnoc xs of
+ Nothing -> error $ "glast " ++ info ++ " []"
+ Just (_, lst) -> lst
gtail :: String -> [a] -> [a]
gtail info [] = error $ "gtail " ++ info ++ " []"
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
=====================================
@@ -755,7 +755,7 @@ ppHtmlIndex
divAlphabet
<< unordList
( map (\str -> anchor ! [href (subIndexHtmlFile str)] << str) $
- [ [c] | c <- initialChars, any ((== c) . toUpper . head . fst) index
+ [ [c] | c <- initialChars, any (maybe False ((== c) . toUpper . fst) . List.uncons . fst) index
]
++ [merged_name]
)
@@ -772,7 +772,7 @@ ppHtmlIndex
writeUtf8File (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html)
where
html = indexPage True (Just c) index_part
- index_part = [(n, stuff) | (n, stuff) <- this_ix, toUpper (head n) == c]
+ index_part = [(n, stuff) | (n@(headN : _), stuff) <- this_ix, toUpper headN == c]
index :: [(String, Map GHC.Name [(Module, Bool)])]
index = sortBy cmp (Map.toAscList full_index)
=====================================
utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
=====================================
@@ -30,7 +30,7 @@ import Control.Arrow (first)
import Control.Monad
import Data.Char (chr, isAlpha, isSpace, isUpper)
import Data.Functor (($>))
-import Data.List (elemIndex, intercalate, intersperse, unfoldr)
+import Data.List (elemIndex, intercalate, intersperse, unfoldr, unsnoc)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Monoid
import qualified Data.Set as Set
@@ -870,10 +870,10 @@ codeblock =
DocCodeBlock . parseParagraph . dropSpaces
<$> ("@" *> skipHorizontalSpace *> "\n" *> block' <* "@")
where
- dropSpaces xs =
- case splitByNl xs of
- [] -> xs
- ys -> case T.uncons (last ys) of
+ dropSpaces xs = let ys = splitByNl xs in
+ case unsnoc ys of
+ Nothing -> xs
+ Just (_, lastYs) -> case T.uncons lastYs of
Just (' ', _) -> case mapM dropSpace ys of
Nothing -> xs
Just zs -> T.intercalate "\n" zs
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f16552d7617e1f41b5da85b8d2ed2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f16552d7617e1f41b5da85b8d2ed2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/supersven/riscv-vectors] Fix unix submodule ref
by Sven Tennie (＠supersven) 12 Jul '25
by Sven Tennie (＠supersven) 12 Jul '25
12 Jul '25
Sven Tennie pushed to branch wip/supersven/riscv-vectors at Glasgow Haskell Compiler / GHC
Commits:
d9b00fa2 by Sven Tennie at 2025-07-12T18:52:05+02:00
Fix unix submodule ref
- - - - -
1 changed file:
- libraries/unix
Changes:
=====================================
libraries/unix
=====================================
@@ -1 +1 @@
-Subproject commit 47d5fc4a8f19207819030725e7de23c65fa61a04
+Subproject commit 1c3548c3906bb0d912eda5685968934183f4b51f
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9b00fa2044fc011609bd2fec016ef5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9b00fa2044fc011609bd2fec016ef5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/supersven/riscv-vectors] 81 commits: Consider `PromotedDataCon` in `tyConStupidTheta`
by Sven Tennie (＠supersven) 12 Jul '25
by Sven Tennie (＠supersven) 12 Jul '25
12 Jul '25
Sven Tennie pushed to branch wip/supersven/riscv-vectors at Glasgow Haskell Compiler / GHC
Commits:
8d33d048 by Berk Özkütük at 2025-07-07T20:42:20-04:00
Consider `PromotedDataCon` in `tyConStupidTheta`
Haddock checks data declarations for the stupid theta so as not to
pretty-print them as empty contexts. Type data declarations end up as
`PromotedDataCon`s by the time Haddock performs this check, causing a
panic. This commit extends `tyConStupidTheta` so that it returns an
empty list for `PromotedDataCon`s. This decision was guided by the fact
that type data declarations never have data type contexts (see (R1) in
Note [Type data declarations]).
Fixes #25739.
- - - - -
a26243fd by Ryan Hendrickson at 2025-07-07T20:43:07-04:00
haddock: Document instances from other packages
When attaching instances to `Interface`s, it isn't enough just to look
for instances in the list of `Interface`s being processed. We also need
to look in the modules on which they depend, including those outside of
this package.
Fixes #25147.
Fixes #26079.
- - - - -
0fb24420 by Rodrigo Mesquita at 2025-07-07T20:43:49-04:00
hadrian: Fallback logic for internal interpreter
When determining whether to build the internal interpreter, the `make`
build system had a fallback case for platforms not in the list of
explicitly-supported operating systems and architectures.
This fallback says we should try to build the internal interpreter if
building dynamic GHC programs (if the architecture is unknown).
Fixes #24098
- - - - -
fe925bd4 by Ben Gamari at 2025-07-07T20:44:30-04:00
users-guide: Reference Wasm FFI section
- - - - -
5856284b by Ben Gamari at 2025-07-07T20:44:30-04:00
users-guide: Fix too-short heading warning
- - - - -
a48dcdf3 by Duncan Coutts at 2025-07-07T20:45:18-04:00
Reorganise documentation for allocate* functions
Consolodate interface information into the .h file, keeping just
implementation details in the .c file.
Use Notes stlye in the .h file and refer to notes from the .c file.
- - - - -
de5b528c by Duncan Coutts at 2025-07-07T20:45:18-04:00
Introduce common utilities for allocating arrays
The intention is to share code among the several places that do this
already.
- - - - -
b321319d by Duncan Coutts at 2025-07-07T20:45:18-04:00
Use new array alloc utils in Heap.c
The CMM primop can now report heap overflow.
- - - - -
1d557ffb by Duncan Coutts at 2025-07-07T20:45:18-04:00
Use new array alloc utils in ThreadLabels.c
Replacing a local utility.
- - - - -
e59a1430 by Duncan Coutts at 2025-07-07T20:45:18-04:00
Use new array alloc utils in Threads.c
Replacing local open coded version.
- - - - -
482df1c9 by Duncan Coutts at 2025-07-07T20:45:18-04:00
Add exitHeapOverflow helper utility
This will be useful with the array alloc functions, since unlike
allocate/allocateMaybeFail, they do not come in two versions. So if it's
not convenient to propagate failure, then one can use this.
- - - - -
4d3ec8f9 by Duncan Coutts at 2025-07-07T20:45:18-04:00
Use new array alloc utils in Weak.c
Also add a cpp macro CCS_SYSTEM_OR_NULL which does what it says. The
benefit of this is that it allows us to referece CCS_SYSTEM even when
we're not in PROFILING mode. That makes abstracting over profiling vs
normal mode a lot easier.
- - - - -
0c4f2fde by Duncan Coutts at 2025-07-07T20:45:18-04:00
Convert the array alloc primops to use the new array alloc utils
- - - - -
a3354ad9 by Duncan Coutts at 2025-07-07T20:45:18-04:00
While we're at it, add one missing 'likely' hint
To a cmm primops that raises an exception, like the others now do.
- - - - -
33b546bd by meooow25 at 2025-07-07T20:46:09-04:00
Keep scanl' strict in the head on rewrite
`scanl'` forces elements to WHNF when the corresponding `(:)`s are
forced. The rewrite rule for `scanl'` missed forcing the first element,
which is fixed here with a `seq`.
- - - - -
8a69196e by Rodrigo Mesquita at 2025-07-08T07:39:47-04:00
debugger/rts: Allow toggling step-in per thread
The RTS global flag `rts_stop_next_breakpoint` globally sets the
interpreter to stop at the immediate next breakpoint.
With this commit, single step mode can additionally be set per thread in
the TSO flag (TSO_STOP_NEXT_BREAKPOINT).
Being able to toggle "stop at next breakpoint" per thread is an
important requirement for implementing "stepping out" of a function in a
multi-threaded context.
And, more generally, having a per-thread flag for single-stepping paves the
way for multi-threaded debugging.
That said, when we want to enable "single step" mode for the whole
interpreted program we still want to stop at the immediate next
breakpoint, whichever thread it belongs to.
That's why we also keep the global `rts_stop_next_breakpoint` flag, with
`rts_enableStopNextBreakpointAll` and `rts_disableStopNextBreakpointAll` helpers.
Preparation for #26042
- - - - -
73d3f864 by Rodrigo Mesquita at 2025-07-08T07:39:47-04:00
docs: Case continuation BCOs
This commit documents a subtle interaction between frames for case BCOs
and their parents frames. Namely, case continuation BCOs may refer to
(non-local) variables that are part of the parent's frame.
The note expanding a bit on these details is called [Case continuation BCOs]
- - - - -
d7aeddcf by Rodrigo Mesquita at 2025-07-08T07:39:47-04:00
debugger: Implement step-out feature
Implements support for stepping-out of a function (aka breaking right after
returning from a function) in the interactive debugger.
It also introduces a GHCi command :stepout to step-out of a function
being debugged in the interpreter. The feature is described as:
Stop at the first breakpoint immediately after returning from the current
function scope.
Known limitations: because a function tail-call does not push a stack
frame, if step-out is used inside of a function that was tail-called,
execution will not be returned to its caller, but rather its caller's
first non-tail caller. On the other hand, it means the debugger
follows the more realistic execution of the program.
In the following example:
.. code-block:: none
f = do
a
b <--- (1) set breakpoint then step in here
c
b = do
...
d <--- (2) step-into this tail call
d = do
...
something <--- (3) step-out here
...
Stepping-out will stop execution at the `c` invokation in `f`, rather than
stopping at `b`.
The key idea is simple: When step-out is enabled, traverse the runtime
stack until a continuation BCO is found -- and enable the breakpoint
heading that BCO explicitly using its tick-index.
The details are specified in `Note [Debugger: Step-out]` in `rts/Interpreter.c`.
Since PUSH_ALTS BCOs (representing case continuations) were never headed
by a breakpoint (unlike the case alternatives they push), we introduced
the BRK_ALTS instruction to allow the debugger to set a case
continuation to stop at the breakpoint heading the alternative that is
taken. This is further described in `Note [Debugger: BRK_ALTS]`.
Fixes #26042
- - - - -
5d9adf51 by Rodrigo Mesquita at 2025-07-08T07:39:47-04:00
debugger: Filter step-out stops by SrcSpan
To implement step-out, the RTS looks for the first continuation frame on
the stack and explicitly enables its entry breakpoint. However, some
continuations will be contained in the function from which step-out was
initiated (trivial example is a case expression).
Similarly to steplocal, we will filter the breakpoints at which the RTS
yields to the debugger based on the SrcSpan. When doing step-out, only
stop if the breakpoint is /not/ contained in the function from which we
initiated it.
This is especially relevant in monadic statements such as IO which is
compiled to a long chain of case expressions.
See Note [Debugger: Filtering step-out stops]
- - - - -
7677adcc by Cheng Shao at 2025-07-08T07:40:29-04:00
compiler: make ModBreaks serializable
- - - - -
14f67c6d by Rodrigo Mesquita at 2025-07-08T07:40:29-04:00
refactor: "Inspecting the session" moved from GHC
Moved utilities for inspecting the session from the GHC module to
GHC.Driver.Session.Inspect
Purely a clean up
- - - - -
9d3f484a by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00
cleanup: Pass the HUG to readModBreaks, not HscEnv
A minor cleanup. The associated history and setupBreakpoint functions
are changed accordingly.
- - - - -
b595f713 by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00
cleanup: Move readModBreaks to GHC.Runtime.Interpreter
With some small docs changes
- - - - -
d223227a by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00
cleanup: Move interpreterProfiled to Interp.Types
Moves interpreterProfiled and interpreterDynamic to
GHC.Runtime.Interpreter.Types from GHC.Runtime.Interpreter.
- - - - -
7fdd0a3d by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00
cleanup: Don't import GHC in Debugger.Breakpoints
Remove the top-level
import GHC
from GHC.Runtime.Debugger.Breakpoints
This makes the module dependencies more granular and cleans up the
qualified imports from the code.
- - - - -
5e4da31b by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00
refactor: Use BreakpointId in Core and Ifaces
- - - - -
741ac3a8 by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00
stg2bc: Derive BcM via ReaderT StateT
A small refactor that simplifies GHC.StgToByteCode by deriving-via the
Monad instances for BcM. This is done along the lines of previous
similar refactors like 72b54c0760bbf85be1f73c1a364d4701e5720465.
- - - - -
0414fcc9 by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00
refact: Split InternalModBreaks out of ModBreaks
There are currently two competing ways of referring to a Breakpoint:
1. Using the Tick module + Tick index
2. Using the Info module + Info index
1. The Tick index is allocated during desugaring in `mkModBreaks`. It is
used to refer to a breakpoint associated to a Core Tick. For a given
Tick module, there are N Ticks indexed by Tick index.
2. The Info index is allocated during code generation (in StgToByteCode)
and uniquely identifies the breakpoints at runtime (and is indeed used
to determine which breakpoint was hit at runtime).
Why we need both is described by Note [Breakpoint identifiers].
For every info index we used to keep a `CgBreakInfo`, a datatype containing
information relevant to ByteCode Generation, in `ModBreaks`.
This commit splits out the `IntMap CgBreakInfo` out of `ModBreaks` into
a new datatype `InternalModBreaks`.
- The purpose is to separate the `ModBreaks` datatype, which stores
data associated from tick-level information which is fixed after
desugaring, from the unrelated `IntMap CgBreakInfo` information
accumulated during bytecode generation.
- We move `ModBreaks` to GHC.HsToCore.Breakpoints
The new `InternalModBreaks` simply combines the `IntMap CgBreakInfo`
with `ModBreaks`. After code generation we construct an
`InternalModBreaks` with the `CgBreakInfo`s we accumulated and the
existing `ModBreaks` and store that in the compiled BCO in `bc_breaks`.
- Note that we previously only updated the `modBreaks_breakInfo`
field of `ModBreaks` at this exact location, and then stored the
updated `ModBreaks` in the same `bc_breaks`.
- We put this new datatype in GHC.ByteCode.Breakpoints
The rest of the pipeline for which CgBreakInfo is relevant is
accordingly updated to also use `InternalModBreaks`
- - - - -
2a097955 by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00
cleanup: Use BreakpointIds in bytecode gen
Small clean up to use BreakpointId and InternalBreakpointId more
uniformly in bytecode generation rather than using Module + Ix pairs
- - - - -
0515cc2f by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00
ghci: Allocate BreakArrays at link time only
Previously, a BreakArray would be allocated with a slot for every tick
in a module at `mkModBreaks`, in HsToCore. However, this approach has
a few downsides:
- It interleaves interpreter behaviour (allocating arrays for
breakpoints) within the desugarer
- It is inflexible in the sense it is impossible for the bytecode
generator to add "internal" breakpoints that can be triggered at
runtime, because those wouldn't have a source tick. (This is relevant
for our intended implementation plan of step-out in #26042)
- It ties the BreakArray indices to the *tick* indexes, while at runtime
we would rather just have the *info* indexes (currently we have both
because BreakArrays are indexed by the *tick* one).
Paving the way for #26042 and #26064, this commit moves the allocation
of BreakArrays to bytecode-loading time -- akin to what is done for CCS
arrays.
Since a BreakArray is allocated only when bytecode is linked, if a
breakpoint is set (e.g. `:break 10`) before the bytecode is linked,
there will exist no BreakArray to trigger the breakpoint in.
Therefore, the function to allocate break arrays (`allocateBreakArrays`)
is exposed and also used in GHC.Runtime.Eval to allocate a break array
when a breakpoint is set, if it doesn't exist yet (in the linker env).
- - - - -
8016561f by Simon Peyton Jones at 2025-07-08T07:41:13-04:00
Add a test for T26176
- - - - -
454cd682 by Simon Peyton Jones at 2025-07-08T07:41:13-04:00
Add test for #14010
This test started to work in GHC 9.6 and has worked since.
This MR just adds a regression test
- - - - -
ea2c6673 by Teo Camarasu at 2025-07-08T13:24:43-04:00
Implement user-defined allocation limit handlers
Allocation Limits allow killing a thread if they allocate more than a
user-specified limit.
We extend this feature to allow more versatile behaviour.
- We allow not killing the thread if the limit is exceeded.
- We allow setting a custom handler to be called when the limit is exceeded.
User-specified allocation limit handlers run in a fresh thread and are passed
the ThreadId of the thread that exceeded its limit.
We introduce utility functions for getting and setting the allocation
limits of other threads, so that users can reset the limit of a thread
from a handler. Both of these are somewhat coarse-grained as we are
unaware of the allocations in the current nursery chunk.
We provide several examples of usages in testsuite/tests/rts/T22859.hs
Resolves #22859
- - - - -
03e047f9 by Simon Hengel at 2025-07-08T13:25:25-04:00
Fix typo in using.rst
- - - - -
67957854 by Ben Gamari at 2025-07-09T09:44:44-04:00
compiler: Import AnnotationWrapper from ghc-internal
Since `GHC.Desugar` exported from `base` has been deprecated.
- - - - -
813d99d6 by Ben Gamari at 2025-07-09T09:44:44-04:00
ghc-compact: Eliminate dependency on ghc-prim
- - - - -
0ec952a1 by Ben Gamari at 2025-07-09T09:44:44-04:00
ghc-heap: Eliminate dependency on ghc-prim
- - - - -
480074c3 by Ben Gamari at 2025-07-09T09:44:44-04:00
ghc-heap: Drop redundant import
- - - - -
03455829 by Ben Gamari at 2025-07-09T09:44:45-04:00
ghc-prim: Bump version to 0.13.1
There are no interface changes from 0.13.0 but the implementation now
lives in `ghc-internal`.
- - - - -
d315345a by Ben Gamari at 2025-07-09T09:44:45-04:00
template-haskell: Bump version number to 2.24.0.0
Bumps exceptions submodule.
- - - - -
004c800e by Ben Gamari at 2025-07-09T09:44:45-04:00
Bump GHC version number to 9.14
- - - - -
eb1a3816 by Ben Gamari at 2025-07-09T09:44:45-04:00
Bump parsec to 3.1.18.0
Bumps parsec submodule.
- - - - -
86f83296 by Ben Gamari at 2025-07-09T09:44:45-04:00
unix: Bump to 2.8.7.0
Bumps unix submodule.
- - - - -
89e13998 by Ben Gamari at 2025-07-09T09:44:45-04:00
binary: Bump to 0.8.9.3
Bumps binary submodule.
- - - - -
55fff191 by Ben Gamari at 2025-07-09T09:44:45-04:00
Win32: Bump to 2.14.2.0
Bumps Win32 submodule.
- - - - -
7dafa40c by Ben Gamari at 2025-07-09T09:44:45-04:00
base: Bump version to 4.22.0
Bumps various submodules.
- - - - -
ef03d8b8 by Rodrigo Mesquita at 2025-07-09T09:45:28-04:00
base: Export displayExceptionWithInfo
This function should be exposed from base following CLC#285
Approved change in CLC#344
Fixes #26058
- - - - -
01d3154e by Wen Kokke at 2025-07-10T17:06:36+01:00
Fix documentation for HEAP_PROF_SAMPLE_STRING
- - - - -
ac259c48 by Wen Kokke at 2025-07-10T17:06:38+01:00
Fix documentation for HEAP_PROF_SAMPLE_COST_CENTRE
- - - - -
2b4db9ba by Pi Delport at 2025-07-11T16:40:52-04:00
(Applicative docs typo: missing "one")
- - - - -
c82449af by Sven Tennie at 2025-07-12T17:31:52+02:00
Implement CPU vector support (RVV) detection for RISC-V
- - - - -
a8ed9cb6 by Sven Tennie at 2025-07-12T17:31:52+02:00
Introduce -mriscv-vlen driver argument with runtime check
Ensure that the configured vlen fits to the detected one.
- - - - -
3f518c78 by Sven Tennie at 2025-07-12T17:31:52+02:00
Compile AutoApply_V*.cmm and Jumps_V*.cmm with vector support
If the running CPU does not support RVV, this code will not be executed.
However, at build time, we have to emit (prepare) it.
- - - - -
05254c62 by Sven Tennie at 2025-07-12T17:31:52+02:00
Emit code for RVV
This includes adding the vector registers to the register allocator and
adding support for the related MachOps to the cod generator.
- - - - -
d61d190c by Sven Tennie at 2025-07-12T17:31:52+02:00
Detect RVV CPU features and make them configurable for CROSS_EMULATOR
Unfortunately, the cpuinfo Python package is abandonned. Thus, we just
add RVV detection here (and not upstream.)
cpuinfo is not executed on the CROSS_EMULATOR. So, we make supported
features configurable.
- - - - -
22eee14b by Sven Tennie at 2025-07-12T17:31:52+02:00
Adjust SIMD test to support/use RISC-V
- - - - -
ea40c726 by Sven Tennie at 2025-07-12T17:31:52+02:00
WIP: Test for the RVV c calling convention
- - - - -
675ebd0f by Sven Tennie at 2025-07-12T17:31:52+02:00
Fix CheckVectorSupport
- - - - -
602b69c9 by Sven Tennie at 2025-07-12T17:31:52+02:00
Always configure -march=rv64gcv
- - - - -
1576ebcf by Sven Tennie at 2025-07-12T17:31:52+02:00
Adjust vector check in all.T
- - - - -
520f7d8b by Sven Tennie at 2025-07-12T17:31:52+02:00
Print vectors to show that the stack is intact
- - - - -
8500c505 by Sven Tennie at 2025-07-12T17:31:52+02:00
Check for GCC >= 14 in autoconf
- - - - -
223377d6 by Sven Tennie at 2025-07-12T17:31:52+02:00
VectorCCallConv test: Test doubles as well
- - - - -
50e19387 by Sven Tennie at 2025-07-12T17:31:52+02:00
Formatting
- - - - -
380c23a1 by Sven Tennie at 2025-07-12T17:31:52+02:00
Add haddock
- - - - -
db2288c9 by Sven Tennie at 2025-07-12T17:31:52+02:00
Haddock
- - - - -
9e4c2dd5 by Sven Tennie at 2025-07-12T17:31:52+02:00
Add calculations to TrivColorable
- - - - -
181ac50c by Sven Tennie at 2025-07-12T17:31:52+02:00
Better allocReg check (check upper boundary for floats)
- - - - -
481f7b9a by Sven Tennie at 2025-07-12T17:31:52+02:00
point free: floatVecFormat & intVecFormat
- - - - -
34a8f4c4 by Sven Tennie at 2025-07-12T17:31:52+02:00
Delete trailing whitespace
- - - - -
1c1cbe2d by Sven Tennie at 2025-07-12T17:31:53+02:00
Formatting
- - - - -
fad2f676 by Sven Tennie at 2025-07-12T17:31:53+02:00
Comment t Haddock
- - - - -
b8a8ce44 by Sven Tennie at 2025-07-12T17:31:53+02:00
Cleanup session functions
- - - - -
d6d66d62 by Sven Tennie at 2025-07-12T17:31:53+02:00
Update comment
- - - - -
3e820218 by Sven Tennie at 2025-07-12T17:31:53+02:00
Formatting / better error message
- - - - -
49b4a7b8 by Sven Tennie at 2025-07-12T17:31:53+02:00
Prepare for more cpu_features
- - - - -
751fd4fc by Sven Tennie at 2025-07-12T17:31:53+02:00
Improve comment
- - - - -
31be1ad7 by Sven Tennie at 2025-07-12T17:31:53+02:00
cpuinfo.py: Better comments
- - - - -
126f1674 by Sven Tennie at 2025-07-12T17:31:53+02:00
Cleanup Instr
- - - - -
f5c80f0c by Sven Tennie at 2025-07-12T17:31:53+02:00
Refactor vector configuration
- - - - -
c274fae2 by Sven Tennie at 2025-07-12T17:31:53+02:00
Delete obsolete TODO
- - - - -
219 changed files:
- compiler/CodeGen.Platform.h
- compiler/GHC.hs
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Asm.hs
- + compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/CallConv.hs
- compiler/GHC/CmmToAsm/Config.hs
- compiler/GHC/CmmToAsm/Format.hs
- compiler/GHC/CmmToAsm/RV64.hs
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
- compiler/GHC/CmmToAsm/RV64/Regs.hs
- compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/RV64.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Map/Expr.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Config.hs
- compiler/GHC/Driver/Config/CmmToAsm.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- + compiler/GHC/Driver/Session/Inspect.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/ExtraObj.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Platform/Reg/Class.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Eval/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/FVs.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Config.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- compiler/GHC/Tc/Gen/Splice.hs
- − compiler/GHC/Types/Breakpoint.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/ghc.cabal.in
- configure.ac
- distrib/configure.ac.in
- docs/users_guide/eventlog-formats.rst
- docs/users_guide/exts/doandifthenelse.rst
- docs/users_guide/exts/ffi.rst
- docs/users_guide/ghci.rst
- docs/users_guide/using.rst
- ghc/GHCi/UI.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Packages.hs
- hadrian/src/Settings/Program.hs
- libraries/Win32
- libraries/array
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- libraries/base/src/Control/Exception.hs
- libraries/binary
- libraries/deepseq
- libraries/directory
- libraries/exceptions
- libraries/filepath
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-compact/GHC/Compact.hs
- libraries/ghc-compact/GHC/Compact/Serialized.hs
- libraries/ghc-compact/ghc-compact.cabal
- libraries/ghc-experimental/ghc-experimental.cabal.in
- + libraries/ghc-experimental/src/System/Mem/Experimental.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
- libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/tests/parse_tso_flags.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- + libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-prim/changelog.md
- libraries/ghc-prim/ghc-prim.cabal
- + libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- libraries/haskeline
- libraries/hpc
- libraries/os-string
- libraries/parsec
- libraries/process
- libraries/semaphore-compat
- libraries/stm
- libraries/template-haskell/template-haskell.cabal.in
- libraries/terminfo
- libraries/text
- + m4/fp_riscv_check_gcc_version.m4
- + m4/fp_riscv_march.m4
- + rts/AllocArray.c
- + rts/AllocArray.h
- rts/CheckVectorSupport.c
- rts/Disassembler.c
- rts/Heap.c
- rts/Interpreter.c
- rts/Interpreter.h
- rts/Prelude.h
- rts/PrimOps.cmm
- rts/RtsStartup.c
- rts/RtsSymbols.c
- rts/RtsUtils.c
- rts/Schedule.c
- rts/StgMiscClosures.cmm
- rts/ThreadLabels.c
- rts/Threads.c
- rts/Weak.c
- rts/external-symbols.list.in
- rts/include/Rts.h
- rts/include/rts/Bytecodes.h
- rts/include/rts/Constants.h
- rts/include/rts/prof/CCS.h
- rts/include/rts/storage/Closures.h
- rts/include/rts/storage/GC.h
- rts/include/rts/storage/Heap.h
- rts/include/rts/storage/TSO.h
- rts/include/stg/MachRegs.h
- rts/include/stg/MachRegs/riscv64.h
- rts/include/stg/MiscClosures.h
- rts/rts.cabal
- rts/sm/Storage.c
- testsuite/driver/cpu_features.py
- testsuite/driver/cpuinfo.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042b.hs
- + testsuite/tests/ghci.debugger/scripts/T26042b.script
- + testsuite/tests/ghci.debugger/scripts/T26042b.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042c.hs
- + testsuite/tests/ghci.debugger/scripts/T26042c.script
- + testsuite/tests/ghci.debugger/scripts/T26042c.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042d.hs
- + testsuite/tests/ghci.debugger/scripts/T26042d.script
- + testsuite/tests/ghci.debugger/scripts/T26042d.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042e.hs
- + testsuite/tests/ghci.debugger/scripts/T26042e.script
- + testsuite/tests/ghci.debugger/scripts/T26042e.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042f.hs
- + testsuite/tests/ghci.debugger/scripts/T26042f.script
- + testsuite/tests/ghci.debugger/scripts/T26042f1.stderr
- + testsuite/tests/ghci.debugger/scripts/T26042f1.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042f2.stdout
- + testsuite/tests/ghci.debugger/scripts/T26042g.hs
- + testsuite/tests/ghci.debugger/scripts/T26042g.script
- + testsuite/tests/ghci.debugger/scripts/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
- + testsuite/tests/indexed-types/should_fail/T26176.hs
- + testsuite/tests/indexed-types/should_fail/T26176.stderr
- testsuite/tests/indexed-types/should_fail/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- + testsuite/tests/rts/T22859.hs
- + testsuite/tests/rts/T22859.stderr
- testsuite/tests/rts/all.T
- + testsuite/tests/simd/should_run/VectorCCallConv.hs
- + testsuite/tests/simd/should_run/VectorCCallConv.stdout
- + testsuite/tests/simd/should_run/VectorCCallConv_c.c
- testsuite/tests/simd/should_run/all.T
- testsuite/tests/simd/should_run/simd013C.c
- + testsuite/tests/typecheck/should_compile/T14010.hs
- testsuite/tests/typecheck/should_compile/all.T
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
- utils/haddock/CHANGES.md
- utils/haddock/haddock-api/haddock-api.cabal
- utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/haddock/haddock-library/haddock-library.cabal
- utils/haddock/haddock-test/haddock-test.cabal
- utils/haddock/haddock-test/src/Test/Haddock/Config.hs
- utils/haddock/haddock.cabal
- utils/haddock/html-test/ref/Bug1004.html
- + utils/haddock/html-test/ref/Bug25739.html
- + utils/haddock/html-test/src/Bug25739.hs
- utils/hsc2hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1b5fe558ee7aa1c08ee525b9a40ca…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1b5fe558ee7aa1c08ee525b9a40ca…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/supersven/riscv-vectors] 3 commits: Cleanup Instr
by Sven Tennie (＠supersven) 12 Jul '25
by Sven Tennie (＠supersven) 12 Jul '25
12 Jul '25
Sven Tennie pushed to branch wip/supersven/riscv-vectors at Glasgow Haskell Compiler / GHC
Commits:
15bfd8bc by Sven Tennie at 2025-07-12T15:20:51+02:00
Cleanup Instr
- - - - -
4320c021 by Sven Tennie at 2025-07-12T16:59:22+02:00
Refactor vector configuration
- - - - -
e1b5fe55 by Sven Tennie at 2025-07-12T17:21:02+02:00
Delete obsolete TODO
- - - - -
2 changed files:
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -138,21 +138,6 @@ regUsageOfInstr platform instr = case instr of
usage (regOp op1 ++ regOp op2 ++ regOp op3, regOp op1)
_ -> panic $ "regUsageOfInstr: " ++ instrCon instr
where
- -- filtering the usage is necessary, otherwise the register
- -- allocator will try to allocate pre-defined fixed stg
- -- registers as well, as they show up.
- usage :: ([(Reg, Format)], [(Reg, Format)]) -> RegUsage
- usage (srcRegs, dstRegs) =
- RU
- (map mkFmt $ filter (interesting platform) srcRegs)
- (map mkFmt $ filter (interesting platform) dstRegs)
-
- mkFmt (r, fmt) = RegWithFormat r fmt
-
- regAddr :: AddrMode -> [(Reg, Format)]
- regAddr (AddrRegImm r1 _imm) = [(r1, II64)]
- regAddr (AddrReg r1) = [(r1, II64)]
-
regOp :: Operand -> [(Reg, Format)]
regOp (OpReg fmt r1) = [(r1, fmt)]
regOp (OpAddr a) = regAddr a
@@ -162,10 +147,25 @@ regUsageOfInstr platform instr = case instr of
regTarget (TBlock _bid) = []
regTarget (TReg r1) = [(r1, II64)]
- -- Is this register interesting for the register allocator?
- interesting :: Platform -> (Reg, Format) -> Bool
- interesting _ ((RegVirtual _), _) = True
- interesting platform ((RegReal (RealRegSingle i)), _) = freeReg platform i
+ regAddr :: AddrMode -> [(Reg, Format)]
+ regAddr (AddrRegImm r1 _imm) = [(r1, II64)]
+ regAddr (AddrReg r1) = [(r1, II64)]
+
+ -- filtering the usage is necessary, otherwise the register
+ -- allocator will try to allocate pre-defined fixed stg
+ -- registers as well, as they show up.
+ usage :: ([(Reg, Format)], [(Reg, Format)]) -> RegUsage
+ usage (srcRegs, dstRegs) =
+ RU
+ (map mkFmt $ filter (interesting platform) srcRegs)
+ (map mkFmt $ filter (interesting platform) dstRegs)
+ where
+ mkFmt (r, fmt) = RegWithFormat r fmt
+
+ -- Is this register interesting for the register allocator?
+ interesting :: Platform -> (Reg, Format) -> Bool
+ interesting _ ((RegVirtual _), _) = True
+ interesting platform ((RegReal (RealRegSingle i)), _) = freeReg platform i
-- | Caller-saved registers (according to calling convention)
--
@@ -240,7 +240,7 @@ patchRegsOfInstr instr env = case instr of
VSUB o1 o2 o3 -> VSUB (patchOp o1) (patchOp o2) (patchOp o3)
VMUL o1 o2 o3 -> VMUL (patchOp o1) (patchOp o2) (patchOp o3)
VQUOT mbS o1 o2 o3 -> VQUOT mbS (patchOp o1) (patchOp o2) (patchOp o3)
- VREM s o1 o2 o3 -> VREM s (patchOp o1) (patchOp o2) (patchOp o3)
+ VREM s o1 o2 o3 -> VREM s (patchOp o1) (patchOp o2) (patchOp o3)
VSMIN o1 o2 o3 -> VSMIN (patchOp o1) (patchOp o2) (patchOp o3)
VSMAX o1 o2 o3 -> VSMAX (patchOp o1) (patchOp o2) (patchOp o3)
VUMIN o1 o2 o3 -> VUMIN (patchOp o1) (patchOp o2) (patchOp o3)
@@ -452,7 +452,7 @@ mkRegRegMoveInstr :: Format -> Reg -> Reg -> Instr
mkRegRegMoveInstr fmt src dst = ANN desc instr
where
desc = text "Reg->Reg Move: " <> ppr src <> text " -> " <> ppr dst
- instr = MOV (operandFromReg fmt dst) (operandFromReg fmt src)
+ instr = MOV (OpReg fmt dst) (OpReg fmt src)
-- | Take the source and destination from this (potential) reg -> reg move instruction
--
@@ -678,8 +678,7 @@ data Instr
-- - fmsub : d = - r1 * r2 + r3
-- - fnmadd: d = - r1 * r2 - r3
FMA FMASign Operand Operand Operand Operand
- | -- TODO: Care about the variants (<instr>.x.y) -> sum type
- VMV Operand Operand
+ | VMV Operand Operand
| VID Operand
| VMSEQ Operand Operand Operand
| VMERGE Operand Operand Operand Operand
@@ -816,21 +815,17 @@ data Operand
OpAddr AddrMode
deriving (Eq, Show)
--- TODO: This just wraps a constructor... Inline?
-operandFromReg :: Format -> Reg -> Operand
-operandFromReg = OpReg
-
operandFromRegNo :: Format -> RegNo -> Operand
-operandFromRegNo fmt = operandFromReg fmt . regSingle
+operandFromRegNo fmt = OpReg fmt . regSingle
zero, ra, sp, gp, tp, fp, tmp :: Operand
-zero = operandFromReg II64 zeroReg
-ra = operandFromReg II64 raReg
-sp = operandFromReg II64 spMachReg
+zero = OpReg II64 zeroReg
+ra = OpReg II64 raReg
+sp = OpReg II64 spMachReg
gp = operandFromRegNo II64 3
tp = operandFromRegNo II64 4
fp = operandFromRegNo II64 8
-tmp = operandFromReg II64 tmpReg
+tmp = OpReg II64 tmpReg
x0, x1, x2, x3, x4, x5, x6, x7 :: Operand
x8, x9, x10, x11, x12, x13, x14, x15 :: Operand
@@ -844,13 +839,9 @@ x4 = operandFromRegNo II64 4
x5 = operandFromRegNo II64 x5RegNo
x6 = operandFromRegNo II64 6
x7 = operandFromRegNo II64 x7RegNo
-
x8 = operandFromRegNo II64 8
-
x9 = operandFromRegNo II64 9
-
x10 = operandFromRegNo II64 x10RegNo
-
x11 = operandFromRegNo II64 11
x12 = operandFromRegNo II64 12
x13 = operandFromRegNo II64 13
@@ -885,53 +876,29 @@ d4 = operandFromRegNo FF64 36
d5 = operandFromRegNo FF64 37
d6 = operandFromRegNo FF64 38
d7 = operandFromRegNo FF64 d7RegNo
-
d8 = operandFromRegNo FF64 40
-
d9 = operandFromRegNo FF64 41
-
d10 = operandFromRegNo FF64 d10RegNo
-
d11 = operandFromRegNo FF64 43
-
d12 = operandFromRegNo FF64 44
-
d13 = operandFromRegNo FF64 45
-
d14 = operandFromRegNo FF64 46
-
d15 = operandFromRegNo FF64 47
-
d16 = operandFromRegNo FF64 48
-
d17 = operandFromRegNo FF64 d17RegNo
-
d18 = operandFromRegNo FF64 50
-
d19 = operandFromRegNo FF64 51
-
d20 = operandFromRegNo FF64 52
-
d21 = operandFromRegNo FF64 53
-
d22 = operandFromRegNo FF64 54
-
d23 = operandFromRegNo FF64 55
-
d24 = operandFromRegNo FF64 56
-
d25 = operandFromRegNo FF64 57
-
d26 = operandFromRegNo FF64 58
-
d27 = operandFromRegNo FF64 59
-
d28 = operandFromRegNo FF64 60
-
d29 = operandFromRegNo FF64 61
-
d30 = operandFromRegNo FF64 62
-
d31 = operandFromRegNo FF64 d31RegNo
fitsIn12bitImm :: (Num a, Ord a, Bits a) => a -> Bool
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -2,6 +2,7 @@
module GHC.CmmToAsm.RV64.Ppr (pprNatCmmDecl, pprInstr) where
+import Data.Maybe
import GHC.Cmm hiding (topInfoTable)
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
@@ -155,7 +156,11 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) =
)
)
where
- instrs' = injectVectorConfig (toOL optInstrs)
+ instrs' :: OrdList Instr
+ instrs'
+ | isJust (ncgVectorMinBits config) = injectVectorConfig (toOL optInstrs)
+ | otherwise = toOL optInstrs
+
-- TODO: Check if we can filter more instructions here.
-- TODO: Shouldn't this be a more general check on a higher level? And, is this still needed?
-- Filter out identity moves. E.g. mov x18, x18 will be dropped.
@@ -168,8 +173,6 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) =
injectVectorConfig instrs = fst $ foldlOL injectVectorConfig' (nilOL, Nothing) instrs
-- TODO: Fuse this with optInstrs
- -- TODO: Check config and only run this when vectors are configured
- -- TODO: Check if vectorMinBits is sufficient for the vector config
injectVectorConfig' :: (OrdList Instr, Maybe Format) -> Instr -> (OrdList Instr, Maybe Format)
injectVectorConfig' (accInstr, configuredVecFmt) currInstr =
let configuredVecFmt' Nothing = Nothing
@@ -217,14 +220,16 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) =
)
configVec :: Format -> Instr
- configVec (VecFormat length fmt) =
- VSETIVLI
- (OpReg II64 zeroReg)
- (fromIntegral length)
- ((formatToWidth . scalarFormatFormat) fmt)
- M1
- TA
- MA
+ configVec vFmt@(VecFormat length fmt)
+ | Just vlen <- (ncgVectorMinBits config),
+ (formatInBytes vFmt) * 8 <= fromIntegral vlen =
+ VSETIVLI
+ (OpReg II64 zeroReg)
+ (fromIntegral length)
+ ((formatToWidth . scalarFormatFormat) fmt)
+ M1
+ TA
+ MA
configVec fmt = pprPanic "Unsupported vector configuration" ((text . show) fmt)
asmLbl = blockLbl blockid
@@ -620,7 +625,6 @@ pprInstr platform instr = case instr of
| isFloatRegOp o1 && isIntRegOp o2 && isDoubleOp o1 -> op2 (text "\tfmv.d.x") o1 o2
| isIntRegOp o1 && isFloatRegOp o2 && isSingleOp o2 -> op2 (text "\tfmv.x.w") o1 o2
| isIntRegOp o1 && isFloatRegOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.x.d") o1 o2
- -- TODO: Why does this NOP (reg1 == reg2) happen?
| isVectorRegOp o1 && isVectorRegOp o2 -> op2 (text "\tvmv.v.v") o1 o2
| (OpImm (ImmInteger i)) <- o2,
fitsIn12bitImm i ->
@@ -833,7 +837,6 @@ pprInstr platform instr = case instr of
VMERGE o1 o2 o3 o4 -> pprPanic "RV64.pprInstr - VMERGE wrong operands." (pprOps platform [o1, o2, o3, o4])
VSLIDEDOWN o1 o2 o3 | allVectorRegOps [o1, o2] && isIntOp o3 -> op3 (text "\tvslidedown.vx") o1 o2 o3
VSLIDEDOWN o1 o2 o3 -> pprPanic "RV64.pprInstr - VSLIDEDOWN wrong operands." (pprOps platform [o1, o2, o3])
- -- TODO: adjust VSETIVLI to contain only format?
VSETIVLI (OpReg fmt dst) len width grouping ta ma ->
line
$ text "\tvsetivli"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b1096a6b4db4c53085f53cff62572…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b1096a6b4db4c53085f53cff62572…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/andreask/spec_tyfams] 19 commits: compiler: Import AnnotationWrapper from ghc-internal
by Simon Peyton Jones (＠simonpj) 12 Jul '25
by Simon Peyton Jones (＠simonpj) 12 Jul '25
12 Jul '25
Simon Peyton Jones pushed to branch wip/andreask/spec_tyfams at Glasgow Haskell Compiler / GHC
Commits:
67957854 by Ben Gamari at 2025-07-09T09:44:44-04:00
compiler: Import AnnotationWrapper from ghc-internal
Since `GHC.Desugar` exported from `base` has been deprecated.
- - - - -
813d99d6 by Ben Gamari at 2025-07-09T09:44:44-04:00
ghc-compact: Eliminate dependency on ghc-prim
- - - - -
0ec952a1 by Ben Gamari at 2025-07-09T09:44:44-04:00
ghc-heap: Eliminate dependency on ghc-prim
- - - - -
480074c3 by Ben Gamari at 2025-07-09T09:44:44-04:00
ghc-heap: Drop redundant import
- - - - -
03455829 by Ben Gamari at 2025-07-09T09:44:45-04:00
ghc-prim: Bump version to 0.13.1
There are no interface changes from 0.13.0 but the implementation now
lives in `ghc-internal`.
- - - - -
d315345a by Ben Gamari at 2025-07-09T09:44:45-04:00
template-haskell: Bump version number to 2.24.0.0
Bumps exceptions submodule.
- - - - -
004c800e by Ben Gamari at 2025-07-09T09:44:45-04:00
Bump GHC version number to 9.14
- - - - -
eb1a3816 by Ben Gamari at 2025-07-09T09:44:45-04:00
Bump parsec to 3.1.18.0
Bumps parsec submodule.
- - - - -
86f83296 by Ben Gamari at 2025-07-09T09:44:45-04:00
unix: Bump to 2.8.7.0
Bumps unix submodule.
- - - - -
89e13998 by Ben Gamari at 2025-07-09T09:44:45-04:00
binary: Bump to 0.8.9.3
Bumps binary submodule.
- - - - -
55fff191 by Ben Gamari at 2025-07-09T09:44:45-04:00
Win32: Bump to 2.14.2.0
Bumps Win32 submodule.
- - - - -
7dafa40c by Ben Gamari at 2025-07-09T09:44:45-04:00
base: Bump version to 4.22.0
Bumps various submodules.
- - - - -
ef03d8b8 by Rodrigo Mesquita at 2025-07-09T09:45:28-04:00
base: Export displayExceptionWithInfo
This function should be exposed from base following CLC#285
Approved change in CLC#344
Fixes #26058
- - - - -
01d3154e by Wen Kokke at 2025-07-10T17:06:36+01:00
Fix documentation for HEAP_PROF_SAMPLE_STRING
- - - - -
ac259c48 by Wen Kokke at 2025-07-10T17:06:38+01:00
Fix documentation for HEAP_PROF_SAMPLE_COST_CENTRE
- - - - -
2b4db9ba by Pi Delport at 2025-07-11T16:40:52-04:00
(Applicative docs typo: missing "one")
- - - - -
f707bab4 by Andreas Klebinger at 2025-07-12T14:56:16+01:00
Specialise: Improve specialisation by refactoring interestingDict
This MR addresses #26051, which concerns missed type-class specialisation.
The main payload of the MR is to completely refactor the key function
`interestingDict` in GHC.Core.Opt.Specialise
The main change is that we now also look at the structure of the
dictionary we consider specializing on, rather than only the type.
See the big `Note [Interesting dictionary arguments]`
- - - - -
ca7a9d42 by Simon Peyton Jones at 2025-07-12T14:56:16+01:00
Treat tuple dictionaries uniformly; don't unbox them
See `Note [Do not unbox class dictionaries]` in DmdAnal.hs,
sep (DNB1).
This MR reverses the plan in #23398, which suggested a special case to
unbox tuple dictionaries in worker/wrapper. But:
- This was the cause of a pile of complexity in the specialiser (#26158)
- Even with that complexity, specialision was still bad, very bad
See https://gitlab.haskell.org/ghc/ghc/-/issues/19747#note_626297
And it's entirely unnecessary! Specialision works fine without
unboxing tuple dictionaries.
- - - - -
be7296c9 by Andreas Klebinger at 2025-07-12T14:56:16+01:00
Remove complex special case from the type-class specialiser
There was a pretty tricky special case in Specialise which is no
longer necessary.
* Historical Note [Floating dictionaries out of cases]
* #26158
* #19747 https://gitlab.haskell.org/ghc/ghc/-/issues/19747#note_626297
This MR removes it. Hooray.
- - - - -
65 changed files:
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/ghc.cabal.in
- configure.ac
- docs/users_guide/eventlog-formats.rst
- libraries/Win32
- libraries/array
- libraries/base/base.cabal.in
- libraries/base/src/Control/Exception.hs
- libraries/binary
- libraries/deepseq
- libraries/directory
- libraries/exceptions
- libraries/filepath
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-compact/GHC/Compact.hs
- libraries/ghc-compact/GHC/Compact/Serialized.hs
- libraries/ghc-compact/ghc-compact.cabal
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-prim/changelog.md
- libraries/ghc-prim/ghc-prim.cabal
- libraries/ghci/ghci.cabal.in
- libraries/haskeline
- libraries/hpc
- libraries/os-string
- libraries/parsec
- libraries/process
- libraries/semaphore-compat
- libraries/stm
- libraries/template-haskell/template-haskell.cabal.in
- libraries/terminfo
- libraries/text
- libraries/unix
- testsuite/tests/dmdanal/should_compile/T23398.hs
- testsuite/tests/dmdanal/should_compile/T23398.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/perf/should_run/SpecTyFamRun.hs
- + testsuite/tests/perf/should_run/SpecTyFamRun.stdout
- + testsuite/tests/perf/should_run/SpecTyFam_Import.hs
- testsuite/tests/perf/should_run/all.T
- + testsuite/tests/simplCore/should_compile/T26051.hs
- + testsuite/tests/simplCore/should_compile/T26051.stderr
- + testsuite/tests/simplCore/should_compile/T26051_Import.hs
- testsuite/tests/simplCore/should_compile/all.T
- utils/haddock/haddock-api/haddock-api.cabal
- utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
- utils/haddock/haddock-library/haddock-library.cabal
- utils/haddock/haddock-test/haddock-test.cabal
- utils/haddock/haddock.cabal
- utils/hsc2hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68e88cfcde40ccfef20b6f8751056d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68e88cfcde40ccfef20b6f8751056d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0