- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/ani/better-expansion] Do expansions properly
by Apoorv Ingle (＠ani) 01 Apr '26

01 Apr '26

Apoorv Ingle pushed to branch wip/ani/better-expansion at Glasgow Haskell Compiler / GHC Commits: a091fcbb by Apoorv Ingle at 2026-04-01T09:43:04-05:00 Do expansions properly - move splitHsTypes out of tcApp - splitHsApps now looks through HsExpansions - create a new file for expansions Co-authored-by: simonpj <simon.peytonjones(a)gmail.com> - - - - - 11 changed files: - compiler/GHC/Tc/Gen/App.hs - − compiler/GHC/Tc/Gen/App.hs-boot - + compiler/GHC/Tc/Gen/Expand.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs-boot - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/ghc.cabal.in - testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -11,7 +11,6 @@ module GHC.Tc.Gen.App ( tcApp - , tcExprSigma , tcExprPrag ) where import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr ) @@ -165,34 +164,6 @@ Note [Instantiation variables are short lived] -} -{- ********************************************************************* -* * - tcInferSigma -* * -********************************************************************* -} - --- Very similar to tcApp, but returns a sigma (uninstantiated) type --- CAUTION: Any changes to tcApp should be reflected here --- cf. T19167. the head is an expanded expression applied to a type --- Caution: Currently we assume that the expression is compiler generated/expanded --- Because that is what T19167 test case expects. --- This function should go away after MR!15778 lands -tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) -tcExprSigma inst fun_orig rn_expr - = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr - ; do_ql <- wantQuickLook rn_fun - ; (tc_fun, fun_sigma) <- tcInferAppHead fun - ; inGenCode <- inGeneratedCode - ; traceTc "tcExprSigma" (vcat [ text "rn_expr:" <+> ppr rn_expr - , text "tc_fun" <+> ppr tc_fun - , text "inGeneratedCode:" <+> ppr inGenCode]) - ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (fun_orig, rn_fun, fun_lspan) - tc_fun fun_sigma rn_args - ; tc_args <- tcValArgs do_ql (rn_fun, fun_lspan) inst_args - ; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args - ; return (tc_expr, app_res_sigma) } - - {- ********************************************************************* * * Typechecking n-ary applications @@ -379,24 +350,22 @@ Unify result type /before/ typechecking the args The latter is much better. That is why we call `checkResultTy` before tcValArgs. -} --- CAUTION: Any changes to tcApp should be reflected in tcExprSigma -tcApp :: HsExpr GhcRn + +-------------------- +tcApp :: HsExpr GhcRn -- The whole application + -> HsExpr GhcRn -> [HsExprArg 'TcpRn] -- Function and arguments -> ExpRhoType -- When checking, -XDeepSubsumption <=> deeply skolemised -> TcM (HsExpr GhcTc) -- See Note [tcApp: typechecking applications] -tcApp rn_expr exp_res_ty - = do { -- Step 1: Split the application chain - (fun@(rn_fun, fun_lspan), rn_args) <- splitHsApps rn_expr - ; inGenCode <- inGeneratedCode +tcApp rn_expr rn_fun rn_args exp_res_ty + = do { fun_lspan <- getFunSrcSpan rn_args ; traceTc "tcApp {" $ - vcat [ text "generated? " <+> ppr inGenCode - , text "rn_expr:" <+> ppr rn_expr - , text "rn_fun:" <+> ppr rn_fun + vcat [ text "rn_fun:" <+> ppr rn_fun , text "fun_lspan:" <+> ppr fun_lspan , text "rn_args:" <+> ppr rn_args ] -- Step 2: Infer the type of `fun`, the head of the application - ; (tc_fun, fun_sigma) <- tcInferAppHead fun + ; (tc_fun, fun_sigma) <- tcInferAppHead (rn_fun, fun_lspan) ; let tc_head = (tc_fun, fun_lspan) -- inst_final: top-instantiate the result type of the application, -- EXCEPT if we are trying to infer a sigma-type @@ -411,22 +380,12 @@ tcApp rn_expr exp_res_ty -- Step 3.1: Instantiate the function type (taking a quick look at args) ; do_ql <- wantQuickLook rn_fun - -- Setp 3.2 Set the correct origin to blame for the error message - -- What should be the origin for this function call? - -- If the head of the function is user written - -- then it can be used in the error message - -- If it is generated code location span, blame it on the - -- origin that can be retrived from the top of the error ctxt stack. - -- See Note [Error contexts in generated code] - ; fun_orig <- mk_origin fun_lspan rn_fun - ; traceTc "tcApp:inferAppHead" $ vcat [ text "tc_fun:" <+> ppr tc_fun , text "fun_sigma:" <+> ppr fun_sigma - , text "fun_origin" <+> ppr fun_orig , text "do_ql:" <+> ppr do_ql] ; (inst_args, app_res_rho) - <- tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args + <- tcInstFun do_ql inst_final (rn_fun, fun_lspan) tc_fun fun_sigma rn_args -- See (TCAPP1) and (TCAPP2) in -- Note [tcApp: typechecking applications] @@ -440,7 +399,7 @@ tcApp rn_expr exp_res_ty -- Step 4.2: typecheck the arguments ; tc_args <- tcValArgs NoQL (rn_fun, fun_lspan) inst_args -- Step 4.3: wrap up - ; finishApp tc_head tc_args app_res_rho res_wrap } + ; finishApp tc_fun tc_args app_res_rho res_wrap } DoQL -> do { traceTc "tcApp:DoQL" (ppr rn_fun $$ ppr app_res_rho) @@ -458,7 +417,7 @@ tcApp rn_expr exp_res_ty ; res_wrap <- checkResultTy rn_expr tc_head inst_args app_res_rho exp_res_ty -- Step 5.5: wrap up - ; finishApp tc_head tc_args app_res_rho res_wrap } } + ; finishApp tc_fun tc_args app_res_rho res_wrap } } quickLookResultType :: TcRhoType -> ExpRhoType -> TcM () -- This function implements the shaded bit of rule APP-Downarrow in @@ -466,16 +425,16 @@ quickLookResultType :: TcRhoType -> ExpRhoType -> TcM () quickLookResultType app_res_rho (Check exp_rho) = qlUnify app_res_rho exp_rho quickLookResultType _ _ = return () -finishApp :: (HsExpr GhcTc, SrcSpan) -> [HsExprArg 'TcpTc] +finishApp :: HsExpr GhcTc -> [HsExprArg 'TcpTc] -> TcRhoType -> HsWrapper -> TcM (HsExpr GhcTc) -- Do final checks and wrap up the result -finishApp tc_head@(tc_fun,_) tc_args app_res_rho res_wrap +finishApp tc_fun tc_args app_res_rho res_wrap = do { -- Reconstruct, with a horrible special case for tagToEnum#. res_expr <- if isTagToEnum tc_fun - then tcTagToEnum tc_head tc_args app_res_rho - else return (rebuildHsApps tc_head tc_args) + then tcTagToEnum tc_fun tc_args app_res_rho + else return (rebuildHsApps tc_fun tc_args) ; traceTc "End tcApp }" (ppr tc_fun) ; return (mkHsWrap res_wrap res_expr) } @@ -488,11 +447,12 @@ checkResultTy :: HsExpr GhcRn -- expose foralls, but maybe not /deeply/ instantiated -> ExpRhoType -- Expected type; this is deeply skolemised -> TcM HsWrapper -checkResultTy rn_expr (tc_fun, _) _ app_res_rho (Infer inf_res) +checkResultTy rn_expr (tc_fun,_) _ app_res_rho (Infer inf_res) = do { ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun + -- Why the "DataConHead" bit? See (IIR5) in + -- Note [Instantiation of InferResult] in GHC.Tc.Utils.Unify. ; fillInferResult ds_flag (exprCtOrigin rn_expr) app_res_rho inf_res } - checkResultTy rn_expr (tc_fun, fun_loc) inst_args app_res_rho (Check res_ty) -- Unify with expected type from the context -- See Note [Unify with expected type before typechecking arguments] @@ -561,7 +521,7 @@ tcValArgs do_ql (fun, fun_lspan) args = go do_ql 0 args | EValArgQL{} <- arg = pos + 1 | ETypeArg{ ea_loc_span = l } <- arg - , not (isGeneratedSrcSpan l) + , not (isGeneratedSrcSpan (locA l)) = pos + 1 | otherwise = pos @@ -618,7 +578,7 @@ tcValArg _ pos (fun, fun_lspan) (EValArgQL { , eaql_loc_span = lspan , eaql_arg_ty = sc_arg_ty , eaql_larg = larg@(L arg_loc rn_expr) - , eaql_tc_fun = tc_head + , eaql_tc_fun = tc_head@(tc_fun,_) , eaql_rn_fun = rn_fun , eaql_fun_ue = head_ue , eaql_args = inst_args @@ -636,7 +596,8 @@ tcValArg _ pos (fun, fun_lspan) (EValArgQL { , text "app_lspan" <+> ppr lspan , text "head_lspan" <+> ppr fun_lspan , text "tc_head" <+> ppr tc_head]) - ; ds_flag <- getDeepSubsumptionFlag_DataConHead (fst tc_head) + ; ds_flag <- getDeepSubsumptionFlag + -- NB: whether to do deep /skolemisation/ is independent of data constructors ; (wrap, arg') <- tcScalingUsage mult $ tcSkolemise ds_flag GenSigCtxt exp_arg_ty $ \ exp_arg_rho -> @@ -656,7 +617,7 @@ tcValArg _ pos (fun, fun_lspan) (EValArgQL { ; app_res_rho <- liftZonkM $ zonkTcType app_res_rho ; res_wrap <- checkResultTy rn_expr tc_head inst_args app_res_rho (mkCheckExpType exp_arg_rho) - ; finishApp tc_head tc_args app_res_rho res_wrap } + ; finishApp tc_fun tc_args app_res_rho res_wrap } ; traceTc "tcEValArgQL }" $ vcat [ text "app_res_rho:" <+> ppr app_res_rho ] @@ -690,26 +651,48 @@ tcInstFun :: QLFlag -- always return a rho-type (but not a deep-rho type) -- Generally speaking we pass in True; in Fig 5 of the paper -- |-inst returns a rho-type - -> (CtOrigin, HsExpr GhcRn, SrcSpan) + -> (HsExpr GhcRn, SrcSpan) -> HsExpr GhcTc -> TcSigmaType -> [HsExprArg 'TcpRn] -> TcM ( [HsExprArg 'TcpInst] , TcSigmaType ) -- Does not instantiate trailing invisible foralls --- This crucial function implements the |-inst judgement in Fig 4, plus the --- modification in Fig 5, of the QL paper: +-- This crucial function implements the |-inst judgement in Fig 4, +-- plus the modification in Fig 5, of the QL paper: -- "A quick look at impredicativity" (ICFP'20). -tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args - = do { traceTc "tcInstFun" (vcat [ text "origin" <+> ppr fun_orig - , text "tc_fun" <+> ppr tc_fun +tcInstFun do_ql inst_final rn_head@(_, fun_lspan) tc_fun fun_sigma rn_args + = do { traceTc "tcInstFun" (vcat [ text "tc_fun" <+> ppr tc_fun + , text "rn_fun" <+> ppr rn_head , text "fun_sigma" <+> ppr fun_sigma , text "args:" <+> ppr rn_args - , text "do_ql" <+> ppr do_ql - , text "ctx" <+> ppr fun_lspan]) - ; res@(_, fun_ty) <- go 1 [] fun_sigma rn_args + , text "do_ql" <+> ppr do_ql]) + ; fun_origin <- mk_origin rn_head + ; res@(_, fun_ty) <- go fun_origin 1 [] fun_sigma rn_args ; traceTc "tcInstFun:ret" (ppr fun_ty) ; return res } where + -- What should be the origin for this function call? + -- If the head of the function is user written + -- then it can be used in the error message + -- If it is generated code location span, blame it on the + -- origin that can be retrived from the top of the error ctxt stack. + -- See Note [Error contexts in generated code] + mk_origin :: (HsExpr GhcRn, SrcSpan) -- The head of the application chain and its location + -> TcM CtOrigin + mk_origin (rn_fun, fun_lspan) + | not (isGeneratedSrcSpan fun_lspan) + = return $ exprCtOrigin rn_fun + + | otherwise -- If the location is generated, the best we can do is to + -- approximate by looking on top of the error message stack + = do { err_ctxt_stack <- getErrCtxt + ; let hs_ctxt = case err_ctxt_stack of + (c:_) -> c + [] -> pprPanic "mk_origin" (ppr rn_fun) + ; traceTc "mk_origin" (pprHsCtxt hs_ctxt) + ; return $ hsCtxtCtOrigin hs_ctxt + } + -- These are the type variables which must be instantiated to concrete -- types. See Note [Representation-polymorphic Ids with no binding] -- in GHC.Tc.Utils.Concrete @@ -741,34 +724,35 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg inst_fun _ = isInferredForAllTyFlag ----------- - go, go1 :: Int -- Value-argument position of next arg + go, go1 :: CtOrigin -- Of the function + -> Int -- Value-argument position of next arg -> [HsExprArg 'TcpInst] -- Accumulator, reversed -> TcSigmaType -> [HsExprArg 'TcpRn] -> TcM ([HsExprArg 'TcpInst], TcSigmaType) -- go: If fun_ty=kappa, look it up in Theta - go pos acc fun_ty args + go fun_orig pos acc fun_ty args | Just kappa <- getTyVar_maybe fun_ty , isQLInstTyVar kappa = do { cts <- readMetaTyVar kappa ; case cts of - Indirect fun_ty' -> go pos acc fun_ty' args - Flexi -> go1 pos acc fun_ty args } + Indirect fun_ty' -> go fun_orig pos acc fun_ty' args + Flexi -> go1 fun_orig pos acc fun_ty args } | otherwise - = go1 pos acc fun_ty args + = go1 fun_orig pos acc fun_ty args -- go1: fun_ty is not filled-in instantiation variable -- ('go' dealt with that case) -- Handle out-of-scope functions gracefully - go1 pos acc fun_ty (arg : rest_args) + go1 fun_orig pos acc fun_ty (arg : rest_args) | fun_is_out_of_scope, looks_like_type_arg arg -- See Note [VTA for out-of-scope functions] - = go pos acc fun_ty rest_args + = go fun_orig pos acc fun_ty rest_args -- Rule IALL from Fig 4 of the QL paper; applies even if args = [] -- Instantiate invisible foralls and dictionaries. -- c.f. GHC.Tc.Utils.Instantiate.topInstantiate - go1 pos acc fun_ty args + go1 fun_orig pos acc fun_ty args | (tvs, body1) <- tcSplitSomeForAllTyVars (inst_fun args) fun_ty , (theta, body2) <- if inst_fun args Inferred then tcSplitPhiTy body1 @@ -797,12 +781,12 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg -- argument of (#,#) to @LiftedRep, but want to rule out the -- second instantiation @r. - ; go pos (addArgWrap wrap acc) fun_rho args } + ; go fun_orig pos (addArgWrap wrap acc) fun_rho args } -- Going around again means we deal easily with -- nested forall a. Eq a => forall b. Show b => blah -- Rule IRESULT from Fig 4 of the QL paper; no more arguments - go1 _pos acc fun_ty [] + go1 _fun_orig _pos acc fun_ty [] | XExpr (ConLikeTc (RealDataCon dc)) <- tc_fun , isNewDataCon dc , [Scaled _ orig_arg_ty] <- dataConOrigArgTys dc @@ -822,30 +806,30 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg = return (reverse acc, fun_ty) -- Rule ITVDQ from the GHC Proposal #281 - go1 pos acc fun_ty ((EValArg { ea_arg = arg }) : rest_args) + go1 fun_orig pos acc fun_ty ((EValArg { ea_arg = arg }) : rest_args) | Just (tvb, body) <- tcSplitForAllTyVarBinder_maybe fun_ty = assertPpr (binderFlag tvb == Required) (ppr fun_ty $$ ppr arg) $ -- Any invisible binders have been instantiated by IALL above, -- so this forall must be visible (i.e. Required) do { (ty_arg, inst_body) <- tcVDQ fun_conc_tvs (tvb, body) arg ; let wrap = mkWpTyApps [ty_arg] - ; go (pos+1) (addArgWrap wrap acc) inst_body rest_args } + ; go fun_orig (pos+1) (addArgWrap wrap acc) inst_body rest_args } - go1 pos acc fun_ty (EWrap w : args) - = go1 pos (EWrap w : acc) fun_ty args + go1 fun_orig pos acc fun_ty (EWrap w : args) + = go1 fun_orig pos (EWrap w : acc) fun_ty args - go1 pos acc fun_ty (EPrag sp prag : args) - = go1 pos (EPrag sp prag : acc) fun_ty args + go1 fun_orig pos acc fun_ty (EPrag sp prag : args) + = go1 fun_orig pos (EPrag sp prag : acc) fun_ty args -- Rule ITYARG from Fig 4 of the QL paper - go1 pos acc fun_ty ( ETypeArg { ea_loc_span = ctxt, ea_hs_ty = hs_ty } - : rest_args ) + go1 fun_orig pos acc fun_ty ( ETypeArg { ea_loc_span = ctxt, ea_hs_ty = hs_ty } + : rest_args ) = do { (ty_arg, inst_ty) <- tcVTA fun_conc_tvs fun_ty hs_ty ; let arg' = ETypeArg { ea_loc_span = ctxt, ea_hs_ty = hs_ty, ea_ty_arg = ty_arg } - ; go pos (arg' : acc) inst_ty rest_args } + ; go fun_orig pos (arg' : acc) inst_ty rest_args } -- Rule IVAR from Fig 4 of the QL paper: - go1 pos acc fun_ty args@(EValArg {} : _) + go1 fun_orig pos acc fun_ty args@(EValArg {} : _) | Just kappa <- getTyVar_maybe fun_ty , isQLInstTyVar kappa = -- Function type was of form f :: forall a b. t1 -> t2 -> b @@ -861,7 +845,7 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg -- - We must be sure to actually update the variable right now, -- not defer in any way, because this is a QL instantiation variable. -- It's easier just to do the job directly here. - do { arg_tys <- zipWithM new_arg_ty (leadingValArgs args) [pos..] + do { arg_tys <- zipWithM (new_arg_ty fun_orig) (leadingValArgs args) [pos..] ; res_ty <- newOpenFlexiTyVarTyQL do_ql TauTv ; let fun_ty' = mkScaledFunTys arg_tys res_ty @@ -877,12 +861,12 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg -- Then fun_ty :: kk, fun_ty' :: Type, kind_co :: Type ~ kk -- co_wrap :: (fun_ty' |> kind_co) ~ fun_ty' - ; go pos acc' fun_ty' args } + ; go fun_orig pos acc' fun_ty' args } -- Rule IARG from Fig 4 of the QL paper: - go1 pos acc fun_ty + go1 fun_orig pos acc fun_ty (EValArg { ea_arg = arg, ea_loc_span = ctxt } : rest_args) - = do { let herald = mk_herald tc_fun (unLoc arg) + = do { let herald = mk_herald fun_orig tc_fun (unLoc arg) ; (fun_co, arg_ty, res_ty) <- -- NB: matchActualFunTy does the rep-poly check. -- For example, suppose we have f :: forall r (a::TYPE r). a -> Int @@ -894,16 +878,15 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg matchActualFunTy herald (Just $ HsExprTcThing tc_fun) (n_val_args, fun_sigma) fun_ty - ; ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun - ; arg' <- quickLookArg ds_flag do_ql pos ctxt (rn_fun, fun_lspan) arg arg_ty + ; arg' <- quickLookArg do_ql pos ctxt rn_head arg arg_ty ; let acc' = arg' : addArgWrap (mkWpCastN fun_co) acc - ; go (pos+1) acc' res_ty rest_args } + ; go fun_orig (pos+1) acc' res_ty rest_args } - new_arg_ty :: LHsExpr GhcRn -> Int -> TcM (Scaled TcType) + new_arg_ty :: CtOrigin -> LHsExpr GhcRn -> Int -> TcM (Scaled TcType) -- Make a fresh nus for each argument in rule IVAR - new_arg_ty (L _ arg) i + new_arg_ty fun_orig (L _ arg) i = do { arg_nu <- newArgTyVarTyQL do_ql $ - FRRExpectedFunTy (mk_herald tc_fun arg) i + FRRExpectedFunTy (mk_herald fun_orig tc_fun arg) i -- Following matchActualFunTy, we create nu_i :: TYPE kappa_i[conc], -- thereby ensuring that the arguments have concrete runtime representations @@ -913,12 +896,13 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg ; return (mkScaled mult_ty arg_nu) } - mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> ExpectedFunTyCtxt - mk_herald tc_fun arg + mk_herald :: CtOrigin -> HsExpr GhcTc -> HsExpr GhcRn -> ExpectedFunTyCtxt + mk_herald fun_orig tc_fun arg = case fun_orig of DoStmtOrigin -> ExpectedFunTySyntaxOp DoStmtOrigin tc_fun _ -> ExpectedFunTyArg (HsExprTcThing tc_fun) arg + -- Is the argument supposed to instantiate a forall? -- -- In other words, given a function application `fn arg`, @@ -1883,23 +1867,23 @@ This turned out to be more subtle than I expected. Wrinkles: -} -quickLookArg :: DeepSubsumptionFlag -> QLFlag -> Int - -> SrcSpan -- ^ location span of the whole application +quickLookArg :: QLFlag -> Int + -> HsExprLoc -- ^ location span of the whole application -> (HsExpr GhcRn, SrcSpan) -- ^ Head of the application chain and its source span -> LHsExpr GhcRn -- ^ Argument -> Scaled TcSigmaTypeFRR -- ^ Type expected by the function -> TcM (HsExprArg 'TcpInst) -- See Note [Quick Look at value arguments] -quickLookArg _ NoQL _ app_lspan _ larg orig_arg_ty +quickLookArg NoQL _ app_lspan _ larg orig_arg_ty = skipQuickLook app_lspan larg orig_arg_ty -quickLookArg ds_flag DoQL pos app_lspan fun_and_lspan larg orig_arg_ty - = do { is_rho <- tcIsDeepRho ds_flag (scaledThing orig_arg_ty) +quickLookArg DoQL pos app_lspan fun_and_lspan larg orig_arg_ty + = do { is_rho <- qlArgHasRhoType (scaledThing orig_arg_ty) ; traceTc "qla" (ppr orig_arg_ty $$ ppr is_rho) ; if not is_rho then skipQuickLook app_lspan larg orig_arg_ty else quickLookArg1 pos app_lspan fun_and_lspan larg orig_arg_ty } -skipQuickLook :: SrcSpan -> LHsExpr GhcRn -> Scaled TcRhoType +skipQuickLook :: HsExprLoc -> LHsExpr GhcRn -> Scaled TcRhoType -> TcM (HsExprArg 'TcpInst) skipQuickLook app_lspan larg arg_ty = return (EValArg { ea_loc_span = app_lspan @@ -1910,13 +1894,26 @@ whenQL :: QLFlag -> ZonkM () -> TcM () whenQL DoQL thing_inside = liftZonkM thing_inside whenQL NoQL _ = return () -tcIsDeepRho :: DeepSubsumptionFlag -> TcType -> TcM Bool --- This top-level zonk step, which is the reason we need a local 'go' loop, --- is subtle. See Section 9 of the QL paper +qlArgHasRhoType :: TcType -> TcM Bool +-- `qlArgHasRhoType` checks that the expected argument type in rule +-- App-lightning-bolt (Fig 5 in the paper) is indeed a rho-type. +-- +-- It must apply the current QL substitution, so it any QLInstTyVar that it +-- comes across. Why? See Section 5.7 in the paper; argument order matters. +-- +-- What if we find an /un-filled/ QLInstVar? We treat this as a rho-type +-- even though a later argument might force it to be sigma-type. See +-- Section 9 in the paper. +-- +-- With -XDeepSubsunption we need a /deep/ rho-type. +-- (We don't need getDeepSubsumptionFlag_DataConHead here because this +-- is only about QuickLook.) -tcIsDeepRho ds_flag = go +qlArgHasRhoType ty + = do { ds_flag <- getDeepSubsumptionFlag + ; go ds_flag ty } where - go ty + go ds_flag ty | isSigmaTy ty = return False @@ -1924,12 +1921,12 @@ tcIsDeepRho ds_flag = go , isQLInstTyVar kappa = do { info <- readMetaTyVar kappa ; case info of - Indirect arg_ty' -> go arg_ty' + Indirect arg_ty' -> go ds_flag arg_ty' Flexi -> return True } | Deep {} <- ds_flag , Just (_, res_ty) <- tcSplitFunTy_maybe ty - = go res_ty + = go ds_flag res_ty | otherwise = return True @@ -1940,14 +1937,20 @@ isGuardedTy ty | Just {} <- tcSplitAppTy_maybe ty = True | otherwise = False -quickLookArg1 :: Int -> SrcSpan -> (HsExpr GhcRn, SrcSpan) -> LHsExpr GhcRn +quickLookArg1 :: Int -> HsExprLoc -> (HsExpr GhcRn, SrcSpan) -> LHsExpr GhcRn -> Scaled TcRhoType -- Deeply skolemised -> TcM (HsExprArg 'TcpInst) -- quickLookArg1 implements the "QL Argument" judgement in Fig 5 of the paper quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_rho) = addArgCtxt pos (fun, fun_lspan) larg $ -- Context needed for constraints - -- generated by calls in arg - do { ((rn_fun_arg, fun_lspan_arg), rn_args) <- splitHsApps arg + -- generated by calls in arg + do { traceTc "qla1" (ppr arg) + + ; (rn_fun_arg, rn_args) <- splitHsApps arg + + ; traceTc "qla2" (ppr arg) + + ; fun_lspan_arg <- getFunSrcSpan rn_args -- Step 1: get the type of the head of the argument ; (fun_ue, mb_fun_ty) <- tcCollectingUsage $ tcInferAppHead_maybe rn_fun_arg @@ -1970,17 +1973,15 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ do { let arg_tc_head = (tc_fun_arg_head, fun_lspan_arg) ; do_ql <- wantQuickLook rn_fun_arg - ; arg_orig <- mk_origin fun_lspan_arg rn_fun_arg ; ((inst_args, app_res_rho), wanted) <- captureConstraints $ - tcInstFun do_ql True (arg_orig, rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args + tcInstFun do_ql True (rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args -- We must capture type-class and equality constraints here, but -- not usage information. See (QLA6) in Note [Quick Look at -- value arguments] ; traceTc "quickLookArg 2" $ vcat [ text "arg:" <+> ppr arg - , text "orig:" <+> ppr arg_orig , text "orig_arg_rho:" <+> ppr orig_arg_rho , text "app_res_rho:" <+> ppr app_res_rho ] @@ -2018,24 +2019,6 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ , eaql_res_rho = app_res_rho }) }}} -mk_origin :: SrcSpan -- SrcSpan of the function - -> HsExpr GhcRn -- The head of the expression application chain - -> TcM CtOrigin -mk_origin fun_lspan rn_fun - | not (isGeneratedSrcSpan fun_lspan) - = return $ exprCtOrigin rn_fun - - | otherwise -- If the location is generated, the best we can do is to - -- approximate by looking on top of the error message stack - = do { err_ctxt_stack <- getErrCtxt - ; let hs_ctxt = case err_ctxt_stack of - (c:_) -> c - [] -> pprPanic "mk_origin" (ppr rn_fun) - ; traceTc "mk_origin" (pprHsCtxt hs_ctxt) - ; return $ hsCtxtCtOrigin hs_ctxt - } - - {- ********************************************************************* * * Folding over instantiation variables @@ -2437,12 +2420,11 @@ isTagToEnum :: HsExpr GhcTc -> Bool isTagToEnum (HsVar _ (L _ fun_id)) = fun_id `hasKey` tagToEnumKey isTagToEnum _ = False -tcTagToEnum :: (HsExpr GhcTc, SrcSpan) -> [HsExprArg 'TcpTc] - -> TcRhoType +tcTagToEnum :: HsExpr GhcTc -> [HsExprArg 'TcpTc] -> TcRhoType -> TcM (HsExpr GhcTc) -- tagToEnum# :: forall a. Int# -> a -- See Note [tagToEnum#] Urgh! -tcTagToEnum (tc_fun, fun_lspan) tc_args res_ty +tcTagToEnum tc_fun tc_args res_ty | [val_arg] <- dropWhile (not . isHsValArg) tc_args = do { res_ty <- liftZonkM $ zonkTcType res_ty @@ -2464,14 +2446,14 @@ tcTagToEnum (tc_fun, fun_lspan) tc_args res_ty ; let rep_ty = mkTyConApp rep_tc rep_args tc_fun' = mkHsWrap (WpTyApp rep_ty) tc_fun df_wrap = mkWpCastR (mkSymCo coi) - tc_expr = rebuildHsApps (tc_fun', fun_lspan) [val_arg] + tc_expr = rebuildHsApps tc_fun' [val_arg] ; return (mkHsWrap df_wrap tc_expr) }}}}} | otherwise = failWithTc TcRnTagToEnumMissingValArg where - vanilla_result = return (rebuildHsApps (tc_fun, fun_lspan) tc_args) + vanilla_result = return (rebuildHsApps tc_fun tc_args) check_enumeration ty' tc | -- isTypeDataTyCon: see wrinkle (W1) in ===================================== compiler/GHC/Tc/Gen/App.hs-boot deleted ===================================== @@ -1,12 +0,0 @@ -module GHC.Tc.Gen.App where - -import GHC.Hs ( HsExpr ) -import GHC.Tc.Types ( TcM ) -import GHC.Tc.Types.Origin ( CtOrigin ) -import GHC.Tc.Utils.TcType ( TcSigmaType ) -import GHC.Hs.Extension ( GhcRn, GhcTc ) - - -import GHC.Prelude (Bool) - -tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) ===================================== compiler/GHC/Tc/Gen/Expand.hs ===================================== @@ -0,0 +1,107 @@ +{-# LANGUAGE TypeFamilies #-} + +{- +(c) The University of Glasgow 2006 +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +-} + +module GHC.Tc.Gen.Expand( tcExpand ) where + +import GHC.Prelude + +import {-# SOURCE #-} GHC.Tc.Gen.Splice( getUntypedSpliceBody ) + +import GHC.Hs + +import GHC.Tc.Utils.Monad +import GHC.Tc.Types.ErrCtxt + +import GHC.Rename.Utils + +{- Note [Typechecking by expansion: overview] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For many constructs, rather than typechecking the user-written code +directly, it's much easier to + * Expand (or desugar) the code to something simpler + * Typecheck that simpler expression + +Example: Typechecking the do expression. The typechecker looks (somewhat) like this: + + tcExpr e@(HsDo _ stmts) rho = do { hse <- expandDoStmts stmts + ; tcHsExpansion hse rho } + +The `expandDoStmts` replaces the HsDo { x <- e1; return x } +with something like + HSE { hse_ctxt = ExprCtxt e + , hse_exp = e1 >>= \ x -> x } +and we then typecheck the expression `e1 >>= \ x -> x` + +See also Note [Handling overloaded and rebindable constructs] + and Note [Doing XXExprGhcRn in the Renamer vs Typechecker] + +The Big Question is how to ensure that error messages mention +only user-written source code, and never talk about the expanded code. +The rest of this Note explains how that is done. + +* The expansion process typically takes a user written thing + L lspan ue + and returns + L lspan (XExpr (ExpandedThingRn (HSE { hse_ctxt = ue + , hse_exp = ee } )) + where `ee` is the expansion of the user written thing `ue` + +* The type checker context has 3 key fields that describe the context: + TcLclCtxt { tcl_loc :: RealSrcSpan + , tcl_in_gen_code :: Bool + , tcl_err_ctxt :: ErrCtxtStack + , ... } + Note `tcl_loc` always points to a real place in the source code, + hence `RealSrcSpan`. + + The `tcl_err_ctxt` is a stack of contexts, each saying something + like "In the expression: x+y" or "In second argument of `$` namely 'r { x=2 }'" + + The `tcl_in_gen_code` is a boolean that keeps track of whether + the current expression being typechecked is compiler generated + or user generated. + + INVARIANT: `tcl_loc` and `tcl_in_gen_code` are modified only in `setSrcSpan`. + +* Now, when + tcMonoLExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) + gets a located expression, it does 3 things: + (a) Calls `setSrcSpanA` to set the ambient source-code location + (b) Calls `addExprCtxt` to push a suitable `HsCtxt` on top of the `tcl_err_ctxt`. + (c) Calls `tcExpr` to typecheck the expression. + +* In these calls, if the `span` is generated (see `isGeneratedSrcSpan`), then + - `setSrcSpanA` sets `tcl_in_gen_code` to `True`, and leaves `tcl_loc` unchanged + - `addExprCtxt` is a no-op if `tcl_in_gen_code` is True + The result is that `tcl_loc` has the span from the innermost /user/ tree node; + and the ErrCtxtStack in `tcl_err_ctxt` only has contexts arisign from user code. + +* Note that inside an expansion we have sub-expressions from the original program. + As soon as we enter one of those, identified by a /user/ span, `setSrcSpanA` will + sets the `tcl_loc` to reflect that span, and switch off `tcl_in_gen_code`. Nice! +-} + +--------------- +tcExpand :: HsExpr GhcRn -> TcM (Maybe (HsExpansion GhcRn)) +tcExpand e@(OpApp _ arg1 op arg2) + = return $ Just $ + HSE { hse_ctxt = ExprCtxt e + , hse_exp = foldl ap op [arg1,arg2] } + where + ap f a = wrapGenSpan (HsApp noExtField f a) + +tcExpand (XExpr (ExpandedThingRn hse)) + = return (Just hse) + +tcExpand e@(HsUntypedSplice splice_res _) +-- See Note [Looking through Template Haskell splices in splitHsApps] + = do { fun <- getUntypedSpliceBody splice_res + ; return $ Just $ + HSE { hse_ctxt = ExprCtxt e + , hse_exp = wrapGenSpan fun } } + +tcExpand _ = return Nothing ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Tc.Gen.Expr ( tcCheckPolyExpr, tcCheckPolyExprNC, tcCheckMonoExpr, tcCheckMonoExprNC, - tcInferExpr, tcInferSigma, + tcInferExpr, tcInferSigma, tcInferExprSigma, tcInferRho, tcInferRhoNC, tcMonoLExpr, tcMonoLExprNC, tcInferRhoFRR, tcInferRhoFRRNC, @@ -30,10 +30,10 @@ import {-# SOURCE #-} GHC.Tc.Gen.Splice import GHC.Hs import GHC.Hs.Syn.Type - import GHC.Rename.Utils import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls ) +import GHC.Tc.Gen.Expand( tcExpand ) import GHC.Tc.Gen.App import GHC.Tc.Gen.Head import GHC.Tc.Gen.Do @@ -237,6 +237,9 @@ tcPolyExprCheck expr res_ty tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcSigmaType) tcInferSigma = tcInferExpr IIF_Sigma +tcInferExprSigma :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) +tcInferExprSigma e = runInfer IIF_Sigma IFRR_Any (tcExpr e) + tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType) -- Infer a *rho*-type. The return type is always instantiated. tcInferRho = tcInferExpr IIF_DeepRho @@ -291,6 +294,12 @@ tcMonoLExprNC (L loc expr) res_ty do { expr' <- tcExpr expr res_ty ; return (L loc expr') } +--------------- +tcCollectApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) +tcCollectApp the_app res_ty + = do { (fun, args) <- splitHsApps the_app + ; tcApp the_app fun args res_ty } + --------------- tcExpr :: HsExpr GhcRn -> ExpRhoType -- DeepSubsumption <=> when checking, this type @@ -312,19 +321,11 @@ tcExpr :: HsExpr GhcRn -- - ones taken apart by GHC.Tc.Gen.Head.splitHsApps -- - ones understood by GHC.Tc.Gen.Head.tcInferAppHead_maybe -- See Note [Application chains and heads] in GHC.Tc.Gen.App -tcExpr e@(HsVar {}) res_ty = tcApp e res_ty -tcExpr e@(HsApp {}) res_ty = tcApp e res_ty -tcExpr e@(OpApp {}) res_ty = tcApp e res_ty -tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty -tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty -tcExpr e@(XExpr (HsRecSelRn{})) res_ty = tcApp e res_ty - --- Renamer expanded expressions (eg. Right/Left sections) --- or tcExpr expanded expressions (eg. Do statements and Record updates) --- are type checked using tcHsExpansion. --- See Note [Typechecking by expansion: overview] -tcExpr (XExpr (ExpandedThingRn hse)) res_ty = tcHsExpansion hse res_ty - +tcExpr e@(HsVar {}) res_ty = tcApp e e [] res_ty +tcExpr e@(ExprWithTySig {}) res_ty = tcApp e e [] res_ty +tcExpr e@(XExpr (HsRecSelRn{})) res_ty = tcApp e e [] res_ty +tcExpr e@(HsAppType {}) res_ty = tcCollectApp e res_ty +tcExpr e@(HsApp {}) res_ty = tcCollectApp e res_ty -- Typecheck an occurrence of an unbound Id -- @@ -392,7 +393,7 @@ tcExpr e@(HsOverLit _ lit) res_ty -- See Note [Short cut for overloaded literals] in GHC.Tc.Utils.TcMType ; case mb_res of Just lit' -> return (HsOverLit noExtField lit') - Nothing -> tcApp e res_ty } + Nothing -> tcApp e e [] res_ty } -- Why go via tcApp? See Note [Typechecking overloaded literals] {- Note [Typechecking overloaded literals] @@ -530,8 +531,9 @@ tcExpr (HsCase ctxt scrut matches) res_ty tcExpr (HsIf x pred b1 b2) res_ty = do { pred' <- tcCheckMonoExpr pred boolTy - ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty - ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty + ; let res_ty' = adjustExpTypeForCaseBranches res_ty [b1,b2] + ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty' + ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty' ; tcEmitBindingUsage (supUE u1 u2) ; return (HsIf x pred' b1' b2') } @@ -730,19 +732,6 @@ tcExpr e@(RecordUpd { rupd_flds = OverloadedRecUpdFields {}}) _ tcExpr (ArithSeq _ witness seq) res_ty = tcArithSeq witness seq res_ty -{- -************************************************************************ -* * - Record dot syntax -* * -************************************************************************ --} - --- These terms have been replaced by their expanded expressions in the renamer. See --- Note [Overview of record dot syntax]. -tcExpr (HsGetField _ _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsGetField: Not implemented" -tcExpr (HsProjection _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsProjection: Not implemented" - {- ************************************************************************ * * @@ -755,17 +744,7 @@ tcExpr (HsProjection _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsProjection: Not -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. tcExpr (HsTypedSplice ext splice) res_ty = tcTypedSplice ext splice res_ty tcExpr e@(HsTypedBracket _ext body) res_ty = tcTypedBracket e body res_ty - tcExpr e@(HsUntypedBracket ps body) res_ty = tcUntypedBracket e body ps res_ty -tcExpr (HsUntypedSplice splice _) res_ty - -- Since `tcApp` deals with `HsUntypedSplice` (in `splitHsApps`), you might - -- wonder why we don't delegate to `tcApp` as we do for `HsVar`, etc. - -- (See the initial block of equations for `tcExpr`.) But we can't do this - -- for `HsUntypedSplice`; to see why, read Wrinkle (UTS1) in - -- Note [Looking through Template Haskell splices in splitHsApps] in - -- GHC.Tc.Gen.Head. - = do { expr <- getUntypedSpliceBody splice - ; tcExpr expr res_ty } {- ************************************************************************ @@ -775,10 +754,12 @@ tcExpr (HsUntypedSplice splice _) res_ty ************************************************************************ -} -tcExpr (HsOverLabel {}) ty = pprPanic "tcExpr:HsOverLabel" (ppr ty) -tcExpr (SectionL {}) ty = pprPanic "tcExpr:SectionL" (ppr ty) -tcExpr (SectionR {}) ty = pprPanic "tcExpr:SectionR" (ppr ty) - +-- See Note [Typechecking by expansion: overview] +tcExpr e res_ty + = do { mb_hse <- tcExpand e + ; case mb_hse of + Just hse -> tcHsExpansion hse res_ty + Nothing -> pprPanic "tcExpr: unhandled case:" (ppr e) } {- ************************************************************************ @@ -788,73 +769,6 @@ tcExpr (SectionR {}) ty = pprPanic "tcExpr:SectionR" (ppr ty) ************************************************************************ -} -{- Note [Typechecking by expansion: overview] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For many constructs, rather than typechecking the user-written code -directly, it's much easier to - * Expand (or desugar) the code to something simpler - * Typecheck that simpler expression - -Example: Typechecking the do expression. The typechecker looks (somewhat) like this: - - tcExpr e@(HsDo _ stmts) rho = do { hse <- expandDoStmts stmts - ; tcHsExpansion hse rho } - -The `expandDoStmts` replaces the HsDo { x <- e1; return x } -with something like - HSE { hse_ctxt = ExprCtxt e - , hse_exp = e1 >>= \ x -> x } -and we then typecheck the expression `e1 >>= \ x -> x` - -See also Note [Handling overloaded and rebindable constructs] - and Note [Doing XXExprGhcRn in the Renamer vs Typechecker] - -The Big Question is how to ensure that error messages mention -only user-written source code, and never talk about the expanded code. -The rest of this Note explains how that is done. - -* The expansion process typically takes a user written thing - L lspan ue - and returns - L lspan (XExpr (ExpandedThingRn (HSE { hse_ctxt = ue - , hse_exp = ee } )) - where `ee` is the expansion of the user written thing `ue` - -* The type checker context has 3 key fields that describe the context: - TcLclCtxt { tcl_loc :: RealSrcSpan - , tcl_in_gen_code :: Bool - , tcl_err_ctxt :: ErrCtxtStack - , ... } - Note `tcl_loc` always points to a real place in the source code, - hence `RealSrcSpan`. - - The `tcl_err_ctxt` is a stack of contexts, each saying something - like "In the expression: x+y" or "In second argument of `$` namely 'r { x=2 }'" - - The `tcl_in_gen_code` is a boolean that keeps track of whether - the current expression being typechecked is compiler generated - or user generated. - - INVARIANT: `tcl_loc` and `tcl_in_gen_code` are modified only in `setSrcSpan`. - -* Now, when - tcMonoLExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) - gets a located expression, it does 3 things: - (a) Calls `setSrcSpanA` to set the ambient source-code location - (b) Calls `addExprCtxt` to push a suitable `HsCtxt` on top of the `tcl_err_ctxt`. - (c) Calls `tcExpr` to typecheck the expression. - -* In these calls, if the `span` is generated (see `isGeneratedSrcSpan`), then - - `setSrcSpanA` sets `tcl_in_gen_code` to `True`, and leaves `tcl_loc` unchanged - - `addExprCtxt` is a no-op if `tcl_in_gen_code` is True - The result is that `tcl_loc` has the span from the innermost /user/ tree node; - and the ErrCtxtStack in `tcl_err_ctxt` only has contexts arisign from user code. - -* Note that inside an expansion we have sub-expressions from the original program. - As soon as we enter one of those, identified by a /user/ span, `setSrcSpanA` will - sets the `tcl_loc` to reflect that span, and switch off `tcl_in_gen_code`. Nice! --} - tcHsExpansion :: HsExpansion GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) tcHsExpansion (HSE { hse_ctxt = o, hse_exp = e }) res_ty = do { e' <- tcMonoLExpr e res_ty ===================================== compiler/GHC/Tc/Gen/Expr.hs-boot ===================================== @@ -35,6 +35,8 @@ tcInferRho, tcInferRhoNC :: tcInferRhoFRR, tcInferRhoFRRNC :: FixedRuntimeRepContext -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType) +tcInferExprSigma :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) + tcInferExpr :: InferInstFlag -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType) tcSyntaxOp :: CtOrigin ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -9,9 +9,9 @@ -} module GHC.Tc.Gen.Head - ( HsExprArg(..), TcPass(..), QLFlag(..), EWrap(..) + ( HsExprArg(..), HsExprLoc, TcPass(..), QLFlag(..), EWrap(..) , splitHsApps, rebuildHsApps - , addArgWrap, isHsValArg + , addArgWrap, isHsValArg, getFunSrcSpan , leadingValArgs, isVisibleArg, getDeepSubsumptionFlag_DataConHead , tcInferAppHead, tcInferAppHead_maybe @@ -22,16 +22,13 @@ module GHC.Tc.Gen.Head , pprArgInst, addFunResCtxt ) where import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckPolyExprNC, tcPolyLExprSig ) -import {-# SOURCE #-} GHC.Tc.Gen.Splice( getUntypedSpliceBody ) -import {-# SOURCE #-} GHC.Tc.Gen.App( tcExprSigma ) import GHC.Prelude import GHC.Hs import GHC.Hs.Syn.Type -import GHC.Rename.Utils (mkExpandedTc, mkExpandedExprTc) - import GHC.Tc.Gen.HsType +import GHC.Tc.Gen.Expand( tcExpand ) import GHC.Tc.Gen.Bind( chooseInferredQuantifiers ) import GHC.Tc.Gen.Sig( tcUserTypeSig, tcInstSig ) import GHC.Tc.TyCl.PatSyn( patSynBuilderOcc ) @@ -86,7 +83,7 @@ import GHC.Data.Maybe The data type HsExprArg :: TcPass -> Type is a very local type, used only within this module and GHC.Tc.Gen.App -* It's really a zipper for an application chain +* It's just a bog-standard zipper for an application chain See Note [Application chains and heads] in GHC.Tc.Gen.App for what an "application chain" is. @@ -147,6 +144,8 @@ takes apart either an HsApp, or an infix OpApp, returning * We do not look through expanded expressions (except PopErrCtxt.) -} +type HsExprLoc = EpAnn AnnListItem -- The location attached to a HsExpr + data TcPass = TcpRn -- Arguments decomposed | TcpInst -- Function instantiated | TcpTc -- Typechecked @@ -154,34 +153,34 @@ data TcPass = TcpRn -- Arguments decomposed data HsExprArg (p :: TcPass) where -- See Note [HsExprArg] -- Data constructor EValArg represents a value argument - EValArg :: { ea_loc_span :: SrcSpan - , ea_arg_ty :: !(XEVAType p) - , ea_arg :: LHsExpr (GhcPass (XPass p)) } + EValArg :: { ea_loc_span :: HsExprLoc + , ea_arg_ty :: !(XEVAType p) + , ea_arg :: LHsExpr (GhcPass (XPass p)) } -> HsExprArg p -- Data constructor EValArgQL represents an argument that has been -- partly-type-checked by Quick Look; see Note [EValArgQL] - EValArgQL :: { eaql_loc_span :: SrcSpan - , eaql_arg_ty :: Scaled TcSigmaType -- Argument type expected by function - , eaql_larg :: LHsExpr GhcRn -- Original application, for - -- location and error msgs - , eaql_rn_fun :: HsExpr GhcRn -- Head of the argument if it is an application - , eaql_tc_fun :: (HsExpr GhcTc, SrcSpan) -- Typechecked head and its location span - , eaql_fun_ue :: UsageEnv -- Usage environment of the typechecked head (QLA5) - , eaql_args :: [HsExprArg 'TcpInst] -- Args: instantiated, not typechecked - , eaql_wanted :: WantedConstraints - , eaql_encl :: Bool -- True <=> we have already qlUnified - -- eaql_arg_ty and eaql_res_rho - , eaql_res_rho :: TcRhoType } -- Result type of the application + EValArgQL :: { eaql_loc_span :: HsExprLoc + , eaql_arg_ty :: Scaled TcSigmaType -- Argument type expected by function + , eaql_larg :: LHsExpr GhcRn -- Original application, for + -- location and error msgs + , eaql_rn_fun :: HsExpr GhcRn -- Head of the argument if it is an application + , eaql_tc_fun :: (HsExpr GhcTc, SrcSpan) -- Typechecked head and its location span + , eaql_fun_ue :: UsageEnv -- Usage environment of the typechecked head (QLA5) + , eaql_args :: [HsExprArg 'TcpInst] -- Args: instantiated, not typechecked + , eaql_wanted :: WantedConstraints + , eaql_encl :: Bool -- True <=> we have already qlUnified + -- eaql_arg_ty and eaql_res_rho + , eaql_res_rho :: TcRhoType } -- Result type of the application -> HsExprArg 'TcpInst -- Only exists in TcpInst phase - ETypeArg :: { ea_loc_span :: SrcSpan - , ea_hs_ty :: LHsWcType GhcRn -- The type arg - , ea_ty_arg :: !(XETAType p) } -- Kind-checked type arg + ETypeArg :: { ea_loc_span :: HsExprLoc + , ea_hs_ty :: LHsWcType GhcRn -- The type arg + , ea_ty_arg :: !(XETAType p) } -- Kind-checked type arg -> HsExprArg p - EPrag :: SrcSpan -> (HsPragE (GhcPass (XPass p))) -> HsExprArg p - EWrap :: EWrap -> HsExprArg p + EPrag :: HsExprLoc -> (HsPragE (GhcPass (XPass p))) -> HsExprArg p + EWrap :: EWrap -> HsExprArg p type family XETAType (p :: TcPass) where -- Type arguments XETAType 'TcpRn = NoExtField @@ -193,8 +192,8 @@ type family XEVAType (p :: TcPass) where -- Value arguments data QLFlag = DoQL | NoQL -data EWrap = EPar SrcSpan - | EExpand (HsExpr GhcRn) +data EWrap = EPar HsExprLoc + | EExpand HsExprLoc HsCtxt | EHsWrap HsWrapper @@ -207,11 +206,11 @@ type family XPass (p :: TcPass) where XPass 'TcpInst = 'Renamed XPass 'TcpTc = 'Typechecked -mkEValArg :: SrcSpan -> LHsExpr GhcRn -> HsExprArg 'TcpRn +mkEValArg :: HsExprLoc -> LHsExpr GhcRn -> HsExprArg 'TcpRn mkEValArg src_loc e = EValArg { ea_arg = e, ea_loc_span = src_loc , ea_arg_ty = noExtField } -mkETypeArg :: SrcSpan -> LHsWcType GhcRn -> HsExprArg 'TcpRn +mkETypeArg :: HsExprLoc -> LHsWcType GhcRn -> HsExprArg 'TcpRn mkETypeArg src_loc hs_ty = ETypeArg { ea_loc_span = src_loc , ea_hs_ty = hs_ty @@ -223,74 +222,17 @@ addArgWrap wrap args | otherwise = EWrap (EHsWrap wrap) : args -splitHsApps :: HsExpr GhcRn - -> TcM ( (HsExpr GhcRn, SrcSpan) -- Head - , [HsExprArg 'TcpRn]) -- Args --- See Note [splitHsApps]. --- --- This uses the TcM monad solely because we must run modFinalizers when looking --- through HsUntypedSplices --- (see Note [Looking through Template Haskell splices in splitHsApps]). -splitHsApps e = go e noSrcSpan [] - where - go :: HsExpr GhcRn -> SrcSpan -> [HsExprArg 'TcpRn] - -> TcM ((HsExpr GhcRn, SrcSpan), [HsExprArg 'TcpRn]) - -- Modify the SrcSpan as we walk inwards, so it describes the next argument - go (HsPar _ (L l fun)) lspan args = go fun (locA l) (EWrap (EPar lspan) : args) - go (HsPragE _ p (L l fun)) lspan args = go fun (locA l) (EPrag lspan p : args) - go (HsAppType _ (L l fun) ty) lspan args = go fun (locA l) (mkETypeArg lspan ty : args) - go (HsApp _ (L l fun) arg) lspan args = go fun (locA l) (mkEValArg lspan arg : args) - - -- See Note [Looking through Template Haskell splices in splitHsApps] - go e@(HsUntypedSplice splice_res splice) _ args - = do { fun <- getUntypedSpliceBody splice_res - ; go fun lspan' (EWrap (EExpand e) : args) } - where - lspan' :: SrcSpan - lspan' = case splice of - HsUntypedSpliceExpr _ (L l _) -> locA l -- l :: SrcAnn AnnListItem - HsQuasiQuote _ _ (L l _) -> locA l -- l :: SrcAnn NoEpAnns - (XUntypedSplice (HsImplicitLiftSplice _ _ _ (L l _))) -> locA l - - -- See Note [Desugar OpApp in the typechecker] - go e@(OpApp _ arg1 (L l op) arg2) _ args - = pure ( (op, locA l) - , mkEValArg noSrcSpan arg1 - : mkEValArg noSrcSpan arg2 - -- noSrcSpan because this the span of the call, - -- and its hard to say exactly what that is - : EWrap (EExpand e) - : args ) - - go e lspan args = pure ((e, lspan), args) - - --- | Rebuild an application: takes a type-checked application head --- expression together with arguments in the form of typechecked 'HsExprArg's --- and returns a typechecked application of the head to the arguments. -rebuildHsApps :: (HsExpr GhcTc, SrcSpan) - -- ^ the function being applied - -> [HsExprArg 'TcpTc] - -- ^ the arguments to the function - -> HsExpr GhcTc -rebuildHsApps (fun, _) [] = fun -rebuildHsApps (fun, sloc) (arg : args) - = case arg of - EValArg { ea_arg = arg, ea_loc_span = sloc' } - -> rebuildHsApps (HsApp noExtField lfun arg, sloc') args - ETypeArg { ea_hs_ty = hs_ty, ea_ty_arg = ty, ea_loc_span = sloc' } - -> rebuildHsApps (HsAppType ty lfun hs_ty, sloc') args - EPrag sloc' p - -> rebuildHsApps (HsPragE noExtField p lfun, sloc') args - EWrap (EPar sloc') - -> rebuildHsApps (gHsPar lfun, sloc') args - EWrap (EExpand o) - -> rebuildHsApps (mkExpandedExprTc o fun, sloc) args - EWrap (EHsWrap wrap) - -> rebuildHsApps (mkHsWrap wrap fun, sloc) args - where - lfun = L (noAnnSrcSpan sloc) fun +-------------------- +getFunSrcSpan :: [HsExprArg 'TcpRn] -> TcM SrcSpan +getFunSrcSpan [] = getSrcSpanM +getFunSrcSpan (ETypeArg { ea_loc_span = l } : _) = return (locA l) +getFunSrcSpan (EValArg { ea_loc_span = l } : _) = return (locA l) +getFunSrcSpan (EPrag l _ : _) = return (locA l) +getFunSrcSpan (EWrap (EPar l) : _) = return (locA l) +getFunSrcSpan (EWrap (EExpand l _) : _) = return (locA l) +getFunSrcSpan (EWrap (EHsWrap {}) : args) = getFunSrcSpan args +-------------------- isHsValArg :: HsExprArg id -> Bool isHsValArg (EValArg {}) = True isHsValArg _ = False @@ -334,13 +276,60 @@ pprArgInst (EValArgQL { eaql_tc_fun = fun, eaql_args = args, eaql_res_rho = ty}) 2 (vcat [ vcat (map pprArgInst args), text "ea_ql_ty:" <+> ppr ty ]) instance Outputable EWrap where - ppr (EPar _) = text "EPar" - ppr (EHsWrap w) = text "EHsWrap" <+> ppr w - ppr (EExpand orig) = text "EExpand" <+> ppr orig + ppr (EPar _) = text "EPar" + ppr (EHsWrap w) = text "EHsWrap" <+> ppr w + ppr (EExpand _ _) = text "EExpand" -- No Outputable instance for HsCtxt yet + + + +{- ********************************************************************* +* * + Splitting and rebuilding +* * +********************************************************************* -} + +splitHsApps :: HsExpr GhcRn -> TcM (HsExpr GhcRn, [HsExprArg 'TcpRn]) +splitHsApps e = go e [] + where + go (HsPar _ (L l fun)) args = go fun (EWrap (EPar l) : args) + go (HsPragE _ p (L l fun)) args = go fun (EPrag l p : args) + go (HsAppType _ (L l fun) ty) args = go fun (mkETypeArg l ty : args) + go (HsApp _ (L l fun) arg) args = go fun (mkEValArg l arg : args) + go fun args = do { mb_hse <- tcExpand fun + ; case mb_hse of + Just (HSE { hse_ctxt = orig, hse_exp = L l fun' }) + -> go fun' (EWrap (EExpand l orig) : args) + Nothing + -> return (fun, args) } + +-- | Rebuild an application: takes a type-checked application head +-- expression together with arguments in the form of typechecked 'HsExprArg's +-- and returns a typechecked application of the head to the arguments. +rebuildHsApps :: HsExpr GhcTc + -- ^ the function being applied + -> [HsExprArg 'TcpTc] + -- ^ the arguments to the function + -> HsExpr GhcTc +rebuildHsApps fun [] = fun +rebuildHsApps fun (arg : args) + = case arg of + EValArg { ea_arg = arg, ea_loc_span = l } + -> rebuildHsApps (HsApp noExtField (L l fun) arg) args + ETypeArg { ea_hs_ty = hs_ty, ea_ty_arg = ty, ea_loc_span = l } + -> rebuildHsApps (HsAppType ty (L l fun) hs_ty) args + EPrag l p + -> rebuildHsApps (HsPragE noExtField p (L l fun)) args + EWrap (EPar l) + -> rebuildHsApps (HsPar noExtField (L l fun)) args + EWrap (EExpand l o) + -> rebuildHsApps (XExpr (ExpandedThingTc (HSE o (L l fun)))) args + EWrap (EHsWrap wrap) + -> rebuildHsApps (mkHsWrap wrap fun) args + {- Note [Desugar OpApp in the typechecker] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Operator sections are desugared in the renamer; see GHC.Rename.Expr +pOperator sections are desugared in the renamer; see GHC.Rename.Expr Note [Handling overloaded and rebindable constructs]. But for reasons explained there, we rename OpApp to OpApp. Then, here in the typechecker, we desugar it to a use of ExpandedThingRn. @@ -401,6 +390,8 @@ handling splices and quasiquotes has already been performed by the renamer by the time we get to `splitHsApps`. Wrinkle (UTS1): +*** TODO *** put this somewhere else + `tcExpr` has a separate case for `HsUntypedSplice`s that do /not/ occur at the head of an application. This is important to handle programs like this one: @@ -446,9 +437,7 @@ tcInferAppHead (fun,fun_lspan) do { mb_tc_fun <- tcInferAppHead_maybe fun ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) - Nothing -> runInferRho (tcExpr fun) - - } + Nothing -> runInferRho (tcExpr fun) } tcInferAppHead_maybe :: HsExpr GhcRn -> TcM (Maybe (HsExpr GhcTc, TcSigmaType)) @@ -457,23 +446,11 @@ tcInferAppHead_maybe :: HsExpr GhcRn -- XExpr's although complicated needs to be looked through, useful for QL things when -- the argument is an XExpr tcInferAppHead_maybe fun = case fun of - HsVar _ nm - -> Just <$> tcInferId nm - ExprWithTySig _ e hs_ty - -> Just <$>tcExprWithSig e hs_ty - HsOverLit _ lit - -> Just <$> tcInferOverLit lit - XExpr (HsRecSelRn f) - -> Just <$> tcInferRecSelId f - XExpr (ExpandedThingRn (HSE o (L loc e))) - -> setSrcSpan (locA loc) $ Just <$> - do { (e', ty) <- tcExprSigma False (hsCtxtCtOrigin o) e - ; return (mkExpandedTc o (L loc e'), ty) } - -- We do not want to instantiate the type of the head as there may be - -- visible type applications in the argument. - -- c.f. T19167 - _ - -> return Nothing + HsVar _ nm -> Just <$> tcInferId nm + ExprWithTySig _ e hs_ty -> Just <$> tcExprWithSig e hs_ty + HsOverLit _ lit -> Just <$> tcInferOverLit lit + XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f + _ -> return Nothing {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -219,10 +219,10 @@ tcMatches :: (AnnoBody body, Outputable (body GhcTc)) -> MatchGroup GhcRn (LocatedA (body GhcRn)) -> TcM (MatchGroup GhcTc (LocatedA (body GhcTc))) -tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches +tcMatches ctxt tc_body pat_tys exp_ty (MG { mg_alts = L l matches , mg_ext = origin }) | null matches -- Deal with case e of {} - -- Since there are no branches, no one else will fill in rhs_ty + -- Since there are no branches, no one else will fill in exp_ty -- when in inference mode, so we must do it ourselves, -- here, using expTypeToType = do { tcEmitBindingUsage bottomUE @@ -233,17 +233,19 @@ tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches [ExpForAllPatTy tvb] -> failWithTc $ TcRnEmptyCase ctxt (EmptyCaseForall tvb) [] -> panic "tcMatches: no arguments in EmptyCase" _t1:(_t2:_ts) -> panic "tcMatches: multiple arguments in EmptyCase" - ; rhs_ty <- expTypeToType rhs_ty + ; rhs_ty <- expTypeToType exp_ty ; return (MG { mg_alts = L l [] , mg_ext = MatchGroupTc [pat_ty] rhs_ty origin }) } | otherwise - = do { umatches <- mapM (tcCollectingUsage . tcMatch tc_body pat_tys rhs_ty) matches - ; let (usages, matches') = unzip umatches + = do { let exp_ty' = adjustExpTypeForCaseBranches exp_ty matches + tc_match match = tcCollectingUsage $ + tcMatch tc_body pat_tys exp_ty' match + ; (usages, matches') <- mapAndUnzipM tc_match matches ; tcEmitBindingUsage $ supUEs usages ; pat_tys <- mapM readScaledExpType (filter_out_forall_pat_tys pat_tys) - ; rhs_ty <- readExpType rhs_ty + ; rhs_ty <- readExpType exp_ty ; traceTc "tcMatches" (ppr matches' $$ ppr pat_tys $$ ppr rhs_ty) ; return (MG { mg_alts = L l matches' , mg_ext = MatchGroupTc pat_tys rhs_ty origin ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -63,7 +63,7 @@ module GHC.Tc.Utils.TcMType ( mkCheckExpType, newInferExpType, newInferExpTypeFRR, runInfer, runInferRho, runInferSigma, runInferKind, runInferRhoFRR, runInferSigmaFRR, readExpType, readExpType_maybe, readScaledExpType, - expTypeToType, scaledExpTypeToType, + expTypeToType, scaledExpTypeToType, adjustExpTypeForCaseBranches, checkingExpType_maybe, checkingExpType, inferResultToType, ensureMonoType, promoteTcType, @@ -499,6 +499,17 @@ inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr ; return tau } +adjustExpTypeForCaseBranches :: ExpRhoType -> [branch] -> ExpRhoType +-- See Note [fillInferResult: multiple branches] +adjustExpTypeForCaseBranches exp_ty branches + = case exp_ty of + Infer ir | IR { ir_inst = IIF_Sigma } <- ir + , branches `lengthAtLeast` 2 + -> Infer (ir { ir_inst = IIF_DeepRho }) + | otherwise + -> exp_ty + Check {} -> exp_ty + {- Note [inferResultToType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ expTypeToType and inferResultType convert an InferResult to a monotype. ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -99,13 +99,12 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Builtin.Types import GHC.Types.Name -import GHC.Types.Id( idType, isDataConId ) +import GHC.Types.Id( idType ) import GHC.Types.Var as Var import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Basic import GHC.Types.Unique.Set (nonDetEltsUniqSet) -import GHC.Types.SrcLoc (unLoc, GenLocated (..)) import GHC.Utils.Misc import GHC.Utils.Outputable as Outputable @@ -426,7 +425,7 @@ Some examples: tcSkolemiseGeneral :: HasDebugCallStack - => DeepSubsumptionFlag + => DeepSubsumptionFlag -- Ignores the DeepSubsumptionDepth -> UserTypeCtxt -> TcType -> TcType -- top_ty and expected_ty -- Here, top_ty is the type we started to skolemise; used only in SigSkol @@ -1169,7 +1168,7 @@ fillInferResultNoInst act_res_ty (IR { ir_uniq = u ; return final_co } } -fillInferResult :: DeepSubsumptionFlag -> CtOrigin -> TcType -> InferResult -> TcM HsWrapper +fillInferResult :: DeepSubsumptionFlag -> CtOrigin -> TcSigmaType -> InferResult -> TcM HsWrapper -- See Note [Instantiation of InferResult] fillInferResult ds_flag ct_orig res_ty ires@(IR { ir_inst = iif }) = case iif of @@ -1203,7 +1202,7 @@ There are two things to worry about: T1 -> e1 T2 -> e2 -Our typing rules are: +In general our typing rules are: * The RHS of a existential or GADT alternative must always be a monotype, regardless of the number of alternatives. @@ -1218,17 +1217,13 @@ Our typing rules are: We use choice (2) in that Section. (GHC 8.10 and earlier used choice (1).) - But note that - case e of - True -> hr - False -> \x -> hr x - will fail, because we still /infer/ both branches, so the \x will get - a (monotype) unification variable, which will fail to unify with - (forall a. a->a) +Note [fillInferResult: GADTs and existentials] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We can detect the GADT/existential situation, case (1) of Note [fillInferResult], +by seeing that the current TcLevel is greater than that stored in ir_lvl of the +Infer ExpType. We bump the level whenever we go past a GADT/existential match. -For (1) we can detect the GADT/existential situation by seeing that -the current TcLevel is greater than that stored in ir_lvl of the Infer -ExpType. We bump the level whenever we go past a GADT/existential match. +We insist that the RHS has a monotype, regardless of the number of alternatives. Then, before filling the hole use promoteTcType to promote the type to the outer ir_lvl. promoteTcType does this @@ -1239,11 +1234,6 @@ That forces the type to be a monotype (since unification variables can only unify with monotypes); and catches skolem-escapes because the alpha is untouchable until the equality floats out. -For (2), we simply look to see if the hole is filled already. - - if not, we promote (as above) and fill the hole - - if it is filled, we simply unify with the type that is - already there - (FIR1) There is one wrinkle. Suppose we have case e of T1 -> e1 :: (forall a. a->a) -> Int @@ -1258,7 +1248,47 @@ For (2), we simply look to see if the hole is filled already. So if we check G2 second, we still want to emit a constraint that restricts the RHS to be a monotype. This is done by ensureMonoType, and it works by simply generating a constraint (alpha ~ ty), where alpha is a fresh -unification variable. We discard the evidence. + unification variable. We discard the evidence. + +Note [fillInferResult: multiple branches] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If there are multiple case branches, case (2) of Note [fillInferResult] +we simply look to see if the hole is filled already. + - if not, we promote (as above) and fill the hole + - if it is filled, we simply unify with the type that is already there + +But consider + case x of + True -> True + False -> undefined +and suppose we call `tcInferSigma` on this expression, so that the `ir_inst` +field of the expected result type is `IIF_Sigma`. The danger is that we'll +fill the hole with `Bool` (from the `True`) and then reject when we try to +unify that with `forall a. a->a`, from the call to `undefined`. + +Another example: + case x of + True -> (e1 :: forall a b. a->b) + False -> (e3 :: forall b a. a->b) + +To avoid this, we never infer a sigma-type from a multi-branch `case`. Instead +we just zap the `IIF_Sigma` to `IIF_DeepRho` when walking inside the branches +of multi-arm case-expression, or an if-expression. See calls to +`adjustExpTypeForCaseBranches`. + +This does mean that this would work: + (let x = 77+55 in h x x) @Int +where + h :: Int -> Int -> forall a. a->a +The `@Int` would instantiate the `forall a`. + +Note that + case e of + True -> hr + False -> \x -> hr x + where hr :: (forall a. a->a) -> Int +will fail, because we still /infer/ both branches, so the \x will get a +(monotype) unification variable, which will fail to unify with (forall a. a->a) Note [Instantiation of InferResult] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1274,7 +1304,7 @@ Usually this field is `IIF_DeepRho` meaning "return a (possibly deep) rho-type". Why is this the common case? See #17173 for discussion. Here are some examples of why: -1. Consider +(IIR1) Consider f x = (*) We want to instantiate the type of (*) before returning, else we will infer the type @@ -1286,21 +1316,46 @@ of why: instantiating. This could perhaps be worked around, but it may be hard to know even when instantiation should happen. -2. Another reason. Consider +(IIR2) Another reason. Consider f :: (?x :: Int) => a -> a g y = let ?x = 3::Int in f Here want to instantiate f's type so that the ?x::Int constraint gets discharged by the enclosing implicit-parameter binding. -3. Suppose one defines plus = (+). If we instantiate lazily, we will +(IIR3) Suppose one defines plus = (+). If we instantiate lazily, we will infer plus :: forall a. Num a => a -> a -> a. However, the monomorphism restriction compels us to infer plus :: Integer -> Integer -> Integer (or similar monotype). Indeed, the only way to know whether to apply the monomorphism restriction at all is to instantiate -HOWEVER, not always! Here are places where we want `IIF_Sigma` meaning -"return a sigma-type": +(IIR4) When -XDeepSubsumption is on, we /deeply/ instantiate. Why isn't + top-instantiation enough? Answer: to accept the following program (T26225b) with + -XDeepSubsumption, we need to deeply instantiate when inferring in checkResultTy: + + f :: Int -> (forall a. a->a) + g :: Int -> Bool -> Bool + + test b = case b of + True -> f + False -> g + + If we don't deeply instantiate in the branches of the case expression, we will + try to unify the type of `f` with that of `g`, which fails. If we instead + deeply instantiate `f`, we will fill the `InferResult` with `Int -> alpha -> alpha` + which then successfully unifies with the type of `g` when we come to fill the + `InferResult` hole a second time for the second case branch. + +(IIR5) When inferring, even /without/ -XDeepSubsumption, we must deeply instantiate + the types of data constructors. E.g + data T = MkT Int int + f = MkT 3 + We must infer MkT 3 :: Int ->{mu} T (fresh mu) + and not MkT 3 :: Int ->{one} T + See Note [Typechecking data constructors] in GHC.Tc.Gen.Head + Hence the use of `getDeepSubsumptionFlag_DataConHead` in `checkResultTy`. + +HOWEVER, `ir_inst` is not always `IIF_DeepRho`! Here are places when it isn't: * IIF_Sigma: In GHC.Tc.Module.tcRnExpr, which implements GHCi's :type command, we want to return a completely uninstantiated type. @@ -1316,23 +1371,6 @@ HOWEVER, not always! Here are places where we want `IIF_Sigma` meaning but /not/ deeply instantiate (#26331). See Note [View patterns and polymorphism] in GHC.Tc.Gen.Pat. This the only place we use IIF_ShallowRho. -Why do we want to deeply instantiate, ever? Why isn't top-instantiation enough? -Answer: to accept the following program (T26225b) with -XDeepSubsumption, we -need to deeply instantiate when inferring in checkResultTy: - - f :: Int -> (forall a. a->a) - g :: Int -> Bool -> Bool - - test b = - case b of - True -> f - False -> g - -If we don't deeply instantiate in the branches of the case expression, we will -try to unify the type of 'f' with that of 'g', which fails. If we instead -deeply instantiate 'f', we will fill the 'InferResult' with 'Int -> alpha -> alpha' -which then successfully unifies with the type of 'g' when we come to fill the -'InferResult' hole a second time for the second case branch. -} {- @@ -2068,24 +2106,14 @@ getDeepSubsumptionFlag = -- | Variant of 'getDeepSubsumptionFlag' which enables a top-level subsumption -- in order to implement the plan of Note [Typechecking data constructors]. getDeepSubsumptionFlag_DataConHead :: HsExpr GhcTc -> TcM DeepSubsumptionFlag -getDeepSubsumptionFlag_DataConHead app_head = - do { user_ds <- xoptM LangExt.DeepSubsumption - ; traceTc "getDeepSubsumptionFlag_DataConHead" (ppr app_head) - ; return $ - if | user_ds - -> Deep DeepSub - | otherwise - -> go app_head - } +getDeepSubsumptionFlag_DataConHead app_head + = do { user_ds <- xoptM LangExt.DeepSubsumption + ; return $ if | user_ds -> Deep DeepSub + | dc_head app_head -> Deep TopSub + | otherwise -> Shallow } where - go :: HsExpr GhcTc -> DeepSubsumptionFlag - go (XExpr (ConLikeTc (RealDataCon {}))) = Deep TopSub - go (XExpr (ExpandedThingTc (HSE _ (L _ f)))) = go f - go (XExpr (WrapExpr _ f)) = go f - go (HsApp _ f _) = go (unLoc f) - go (HsAppType _ f _) = go (unLoc f) - go _ = Shallow - + dc_head (XExpr (ConLikeTc (RealDataCon {}))) = True + dc_head _ = False -- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption. -- ===================================== compiler/ghc.cabal.in ===================================== @@ -832,6 +832,7 @@ Library GHC.Tc.Gen.Bind GHC.Tc.Gen.Default GHC.Tc.Gen.Do + GHC.Tc.Gen.Expand GHC.Tc.Gen.Export GHC.Tc.Gen.Expr GHC.Tc.Gen.Foreign ===================================== testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr ===================================== @@ -1,6 +1,5 @@ [1 of 2] Compiling Splices ( Splices.hs, Splices.o ) [2 of 2] Compiling SplicesUsed ( SplicesUsed.hs, SplicesUsed.o ) - SplicesUsed.hs:7:15: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Maybe Bool’ • In the type signature: maybeBool :: _ @@ -21,8 +20,7 @@ SplicesUsed.hs:8:26: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefau • Found type wildcard ‘_’ standing for ‘Bool’ • In the first argument of ‘Maybe’, namely ‘_’ In an expression type signature: Maybe _ - In the first argument of ‘id :: _a -> _a’, namely - ‘(Just True :: Maybe _)’ + In the expression: Just True :: Maybe _ • Relevant bindings include maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1) @@ -78,3 +76,4 @@ SplicesUsed.hs:18:2: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefau the inferred type of bar :: Bool -> w -> (Bool, w) at SplicesUsed.hs:18:2-11 • In the type signature: bar :: _a -> _b -> (_a, _b) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a091fcbb975d514542e66e4d456bb99… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a091fcbb975d514542e66e4d456bb99… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T27078] 48 commits: rts: fix -Wcompare-distinct-pointer-types errors
by Simon Peyton Jones (＠simonpj) 01 Apr '26

01 Apr '26

Simon Peyton Jones pushed to branch wip/T27078 at Glasgow Haskell Compiler / GHC Commits: de54e264 by Cheng Shao at 2026-03-21T17:52:08+01:00 rts: fix -Wcompare-distinct-pointer-types errors This commit fixes `-Wcompare-distinct-pointer-types` errors in the RTS which should have been caught by the `validate` flavour but was warnings in CI due to the recent `+werror` regression. - - - - - b9bd73de by Cheng Shao at 2026-03-21T17:52:08+01:00 ghc-internal: fix unused imports This commit fixes unused imports in `ghc-internal` which should have been caught by the `validate` flavour but was warnings in CI due to the recent `+werror` regression. Fixes #26987 #27059. - - - - - da946a16 by Cheng Shao at 2026-03-21T17:03:51+00:00 ghci: fix unused imports This commit fixes unused imports in `ghci` which should have been caught by the `validate` flavour but was warnings in CI due to the recent `+werror` regression. Fixes #26987 #27059. - - - - - 955b1cf8 by Cheng Shao at 2026-03-21T17:03:51+00:00 compiler: fix unused imports in GHC.Tc.Types.Origin This commit fixes unused imports in `GHC.Tc.Types.Origin` which should have been caught by the `validate` flavour but was warnings in CI due to the recent `+werror` regression. Fixes #27059. - - - - - 3b1aeb50 by Cheng Shao at 2026-03-21T17:03:51+00:00 hadrian: fix missing +werror in validate flavour This patch fixes missing `+werror` in validate flavour, which was an oversight in bb3a2ba1eefadf0b2ef4f39b31337a23eec67f29. Fixes #27066. - - - - - 44f118f0 by Cheng Shao at 2026-03-22T04:54:01-04:00 ci: bump CACHE_REV and add the missing reminder This patch bumps `CACHE_REV` to address recent `[Cabal-7159]` CI errors due to stale cabal cache on some runners, and also adds a reminder to remind future maintainers. Fixes #27075. - - - - - 2a218737 by ARATA Mizuki at 2026-03-23T11:11:39-04:00 Add 128-bit SIMD support to AArch64 NCG Changes: - Add `Format` field to vector-capable instructions. These instructions will emit `vN.4s` (for example) as a operand. - Additional constructors for `Operand`: `OpVecLane` represents a vector lane and will be emitted as `vN.<width>[<index>]` (`vN.s[3]` for example). `OpScalarAsVec` represents a scalar, but printed as a vector lane like `vN.<width>[0]` (`vN.s[0]` for example). - Integer quot/rem are implemented in C, like x86. Closes #26536 Metric Increase: T3294 - - - - - 5d6e2be9 by ARATA Mizuki at 2026-03-23T11:11:39-04:00 AArch64 NCG: Improve code generation for floating-point and vector constants Some floating-point constants can be directly encoded using the FMOV instruction. Similarly, a class of vectors with same values can be encoded using FMOV, MOVI, or MVNI. - - - - - c6d262aa by Simon Jakobi at 2026-03-23T11:12:22-04:00 Add regression test for #13729 Closes #13729. - - - - - aa5dfe67 by Sylvain Henry at 2026-03-26T03:48:56-04:00 Check that shift values are valid In GHC's codebase in non-DEBUG builds we silently substitute shiftL/R with unsafeShiftL/R for performance reasons. However we were not checking that the shift value was valid for unsafeShiftL/R, leading to wrong computations, but only in non-DEBUG builds. This patch adds the necessary checks and reports an error when a wrong shift value is passed. - - - - - c8a7b588 by Sylvain Henry at 2026-03-26T03:48:56-04:00 Implement basic value range analysis (#25718) Perform basic value range analysis to try to determine at compile time the result of the application of some comparison primops (ltWord#, etc.). This subsumes the built-in rewrite rules used previously to check if one of the comparison argument was a bound (e.g. (x :: Word8) <= 255 is always True). Our analysis is more powerful and handles type conversions: e.g. word8ToWord x <= 255 is now detected as always True too. We also use value range analysis to filter unreachable alternatives in case-expressions. To support this, we had to allow case-expressions for primitive types to not have a DEFAULT alternative (as was assumed before and checked in Core lint). - - - - - a5ec467e by ARATA Mizuki at 2026-03-26T03:49:49-04:00 rts: Align stack to 64-byte boundary in StgRun on x86 When LLVM spills AVX/AVX-512 vector registers to the stack, it requires 32-byte (__m256) or 64-byte (__m512) alignment. If the stack is not sufficiently aligned, LLVM inserts a realignment prologue that reserves %rbp as a frame pointer, conflicting with GHC's use of %rbp as an STG callee-saved register and breaking the tail-call-based calling convention. Previously, GHC worked around this by lying to LLVM about the stack alignment and rewriting aligned vector loads/stores (VMOVDQA, VMOVAPS) to unaligned ones (VMOVDQU, VMOVUPS) in the LLVM Mangler. This had two problems: - It did not extend to AVX-512, which requires 64-byte alignment. (#26595) - When Haskell calls a C function that takes __m256/__m512 arguments on the stack, the callee requires genuine alignment, which could cause a segfault. (#26822) This patch genuinely aligns the stack to 64 bytes in StgRun by saving the original stack pointer before alignment and restoring it in StgReturn. We now unconditionally advertise 64-byte stack alignment to LLVM for all x86 targets, making rewriteAVX in the LLVM Mangler unnecessary. STG_RUN_STACK_FRAME_SIZE is increased from 48 to 56 bytes on non-Windows x86-64 to store the saved stack pointer. Closes #26595 and #26822 Co-Authored-By: Claude Opus 4.5 <noreply(a)anthropic.com> - - - - - 661da815 by Teo Camarasu at 2026-03-26T03:50:33-04:00 ghc-internal: Float Generics to near top of module graph We remove GHC.Internal.Generics from the critical path of the `ghc-internal` module graph. GHC.Internal.Generics used to be in the middle of the module graph, but now it is nearer the top (built later). This change thins out the module graph and allows us to get rid of the ByteOrder hs-boot file. We implement this by moving Generics instances from the module where the datatype is defined to the GHC.Internal.Generics module. This trades off increasing the compiled size of GHC.Internal.Generics with reducing the dependency footprint of datatype modules. Not all instances are moved to GHC.Internal.Generics. For instance, `GHC.Internal.Control.Monad.Fix` keeps its instance as it is one of the very last modules compiled in `ghc-internal` and so inverting the relationship here would risk adding GHC.Internal.Generics back onto the critical path. We also don't change modules that are re-exported from the `template-haskell` or `ghc-heap`. This is done to make it easy to eventually move `Generics` to `base` once something like #26657 is implemented. Resolves #26930 Metric Decrease: T21839c - - - - - 45428f88 by sheaf at 2026-03-26T03:51:31-04:00 Avoid infinite loop in deep subsumption This commit ensures we only unify after we recur in the deep subsumption code in the FunTy vs non-FunTy case of GHC.Tc.Utils.Unify.tc_sub_type_deep, to avoid falling into an infinite loop. See the new Wrinkle [Avoiding a loop in tc_sub_type_deep] in Note [FunTy vs non-FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify. Fixes #26823 Co-authored-by: simonpj <simon.peytonjones(a)gmail.com> - - - - - 2823b039 by Ian Duncan at 2026-03-26T03:52:21-04:00 AArch64: fix MOVK regUsageOfInstr to mark dst as both read and written MOVK (move with keep) modifies only a 16-bit slice of the destination register, so the destination is both read and written. The register allocator must know this to avoid clobbering live values. Update regUsageOfInstr to list the destination in both src and dst sets. No regression test: triggering the misallocation requires specific register pressure around a MOVK sequence, which is difficult to reliably provoke from Haskell source. - - - - - 57b7878d by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #12002 Closes #12002. - - - - - c8f9df2d by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #12046 Closes #12046. Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at> - - - - - 615d72ac by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #13180 Closes #13180. - - - - - 423eebcf by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #11141 Closes #11141. - - - - - 286849a4 by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #11505 Closes #11505. - - - - - 7db149d9 by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression perf test for #13820 Closes #13820. - - - - - e73c4adb by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #10381 Closes #10381. - - - - - 5ebcfb57 by Benjamin Maurer at 2026-03-26T03:54:02-04:00 Generate assembly on x86 for word2float (#22252) We used to emit C function call for MO_UF_Conv primitive. Now emits direct assembly instead. Co-Authored-By: Sylvain Henry <sylvain(a)haskus.fr> Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com> - - - - - 5b550754 by Matthew Pickering at 2026-03-26T03:54:51-04:00 rts: forward clone-stack messages after TSO migration MSG_CLONE_STACK assumed that the target TSO was still owned by the capability that received the message. This is not always true: the TSO can migrate before the inbox entry is handled. When that happened, handleCloneStackMessage could clone a live stack from the wrong capability and use the wrong capability for allocation and performTryPutMVar, leading to stack sanity failures such as checkStackFrame: weird activation record found on stack. Fix this by passing the current capability into handleCloneStackMessage, rechecking msg->tso->cap at handling time, and forwarding the message if the TSO has migrated. Once ownership matches, use the executing capability consistently for cloneStack, rts_apply, and performTryPutMVar. Fixes #27008 - - - - - ef0a1bd2 by mangoiv at 2026-03-26T03:55:34-04:00 release tracking: adopt release tracking ticket from #16816 - - - - - a7f40fd9 by mangoiv at 2026-03-26T03:55:34-04:00 release tracking: add a release tracking ticket Brings the information in the release tracking ticket up to date with https://gitlab.haskell.org/ghc/ghc-hq/-/blob/main/release-management.mkd Resolves #26691 - - - - - 161d3285 by Teo Camarasu at 2026-03-26T03:56:18-04:00 Revert "Set default eventlog-flush-interval to 5s" Flushing the eventlog forces a synchronisation of all the capabilities and there was a worry that this might lead to a performance cost for some highly parallel workloads. This reverts commit 66b96e2a591d8e3d60e74af3671344dfe4061cf2. - - - - - 36eed985 by Cheng Shao at 2026-03-26T03:57:03-04:00 ghc-boot: move GHC.Data.SmallArray to ghc-boot This commit moves `GHC.Data.SmallArray` from the `ghc` library to `ghc-boot`, so that it can be used by `ghci` as well: - The `Binary` (from `ghc`) instance of `SmallArray` is moved to `GHC.Utils.Binary` - Util functions `replicateSmallArrayIO`, `mapSmallArrayIO`, `mapSmallArrayM_`, `imapSmallArrayM_` , `smallArrayFromList` and `smallArrayToList` are added - The `Show` instance is added - The `Binary` (from `binary`) instance is added - - - - - fdf828ae by Cheng Shao at 2026-03-26T03:57:03-04:00 compiler: use `Binary` instance of `BCOByteArray` for bytecode objects This commit defines `Binary` (from `compiler`) instance of `BCOByteArray` which serializes the underlying buffer directly, and uses it directly in bytecode object serialization. Previously we reuse the `Binary` (from `binary`) instance, and this change allows us to avoid double-copying via an intermediate `ByteString` when using `put`/`get` in `binnary`. Also see added comment for explanation. - - - - - 3bf62d0a by Cheng Shao at 2026-03-26T03:57:03-04:00 ghci: use SmallArray directly in ResolvedBCO This patch makes ghci use `SmallArray` directly in `ResolvedBCO` when applicable, making the memory representation more compact and reducing marshaling overhead. Closes #27058. - - - - - 3d6492ce by Wen Kokke at 2026-03-26T03:57:53-04:00 Fix race condition between flushEventLog and start/endEventLogging. This commit changes `flushEventLog` to acquire/release the `state_change` mutex to prevent interleaving with `startEventLogging` and `endEventLogging`. In the current RTS, `flushEventLog` _does not_ acquire this mutex, which may lead to eventlog corruption on the following interleaving: - `startEventLogging` writes the new `EventLogWriter` to `event_log_writer`. - `flushEventLog` flushes some events to `event_log_writer`. - `startEventLogging` writes the eventlog header to `event_log_writer`. This causes the eventlog to be written out in an unreadable state, with one or more events preceding the eventlog header. This commit renames the old function to `flushEventLog_` and defines `flushEventLog` simply as: ```c void flushEventLog(Capability **cap USED_IF_THREADS) { ACQUIRE_LOCK(&state_change_mutex); flushEventLog_(cap); RELEASE_LOCK(&state_change_mutex); } ``` The old function is still needed internally within the compilation unit, where it is used in `endEventLogging` in a context where the `state_change` mutex has already been acquired. I've chosen to mark `flushEventLog_` as static and let other uses of `flushEventLog` within the RTS refer to the new version. There is one use in `hs_init_ghc` via `flushTrace`, where the new locking behaviour should be harmless, and one use in `handle_tick`, which I believe was likely vulnerable to the same race condition, so the new locking behaviour is desirable. I have not added a test. The behaviour is highly non-deterministic and requires a program that concurrently calls `flushEventLog` and `startEventLogging`/`endEventLogging`. I encountered the issue while developing `eventlog-socket` and within that context have verified that my patch likely addresses the issue: a test that used to fail within the first dozen or so runs now has been running on repeat for several hours. - - - - - 7b9a75f0 by Phil Hazelden at 2026-03-26T03:58:37-04:00 Fix build with werror on glibc 2.43. We've been defining `_XOPEN_SOURCE` and `_POSIX_C_SOURCE` to the same values as defined in glibc prior to 2.43. But in 2.43, glibc changes them to new values, which means we get a warning when redefining them. By `#undef`ing them first, we no longer get a warning. Closes #27076. - - - - - fe6e76c5 by Tobias Haslop at 2026-03-26T03:59:30-04:00 Fix broken Haddock link to Bifunctor class in description of Functor class - - - - - 404b71c1 by Luite Stegeman at 2026-03-27T04:40:49-04:00 Fix assert in Interpreter.c If we skip exactly the number of words on the stack we end up on the first word in the next chunk. - - - - - a85bd503 by Luite Stegeman at 2026-03-27T04:40:49-04:00 Support arbitrary size unboxed tuples in bytecode This stores the size (number of words on the stack) of the next expected tuple in the TSO, ctoi_spill_size field, eliminating the need of stg_ctoi_tN frames for each size. Note: On 32 bit platform there is still a bytecode tuple size limit of 255 words on the stack. Fixes #26946 - - - - - e2209031 by Luite Stegeman at 2026-03-27T04:40:49-04:00 Add specialized frames for small tuples Small tuples are now returned more efficiently to the interpreter. They use one less word of stack space and don't need manipulation of the TSO anymore. - - - - - b26bb2ea by VeryMilkyJoe at 2026-03-27T04:41:38-04:00 Remove backwards compatibility pattern synonym `ModLocation` Fixes #24932 - - - - - 66e5e324 by Vladislav Zavialov at 2026-03-27T04:42:25-04:00 Extend HsExpr with the StarIsType syntax (#26587, #26967) This patch allows kinds of the form `k -> *` and `* -> k` to occur in expression syntax, i.e. to be used as required type arguments. For example: {-# LANGUAGE RequiredTypeArguments, StarIsType #-} x1 = f (* -> * -> *) x2 = f (forall k. k -> *) x3 = f ((* -> *) -> Constraint) Summary of the changes: * Introduce the HsStar constructor of HsExpr and its extension field XStar. It is analogous to HsStarTy in HsType. * Refactor HsStarTy to store the unicode flag as TokStar, defined as type TokStar = EpUniToken "*" "★" -- similar to TokForall, TokRArrow, etc. The token is stored in the extension field and replaces the Bool field. * Extend the `infixexp2` nonterminal to parse `*` as a direct argument of `->`. This is more limited than the full StarIsType syntax, but has the nice property of not conflicting with the multiplication operator `a * b`. Test case: T26967 T26967_tyop - - - - - f8de456f by Sylvain Henry at 2026-03-27T04:43:22-04:00 STM: don't create a transaction in the rhs of catchRetry# (#26028) We don't need to create a transaction for the rhs of (catchRetry#) because contrary to the lhs we don't need to abort it on retry. Moreover it is particularly harmful if we have code such as (#26028): let cN = readTVar vN >> retry tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...)) atomically tree Because it will stack transactions for the rhss and the read-sets of all the transactions will be iteratively merged in O(n^2) after the execution of the most nested retry. This is the second attempt at implementing this. The first attempt triggered segfaults (#26291) and has been reverted. Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com> - - - - - fcf092dd by Luite Stegeman at 2026-03-27T04:44:17-04:00 Windows: remove StgAsyncIOResult and fix crash/leaks In stg_block_async{_void}, a stack slot was reserved for an StgAsyncIOResult. This slot would be filled by the IO manager upon completion of the async call. However, if the blocked thread was interrupted by an async exception, we would end up in an invalid state: - If the blocked computation was never re-entered, the StgAsyncIOResult would never be freed. - If the blocked computation was re-entered, the thread would find an unitialized stack slot for the StgAsyncIOResult, leading to a crash reading its fields, or freeing the pointer. We fix this by removing the StgAsyncIOResult altogether and writing the result directly to the stack. Fixes #26341 - - - - - 05094993 by Luite Stegeman at 2026-03-27T04:45:12-04:00 Don't refine DEFAULT alt for unary typeclasses A non-DEFAULT data alt for a unary typeclass dictionary would interfere with Unary Class Magic, leading to segfaults. fixes #27071 - - - - - 4ee260cf by sheaf at 2026-03-27T04:46:06-04:00 Fix several oversights in hsExprType This commit fixes several oversights in GHC.Hs.Syn.Type.hsExprType: - The 'RecordCon' case was returning the type of the constructor, instead of the constructor application. This is fixed by using 'splitFunTys'. - The 'ExplicitTuple' case failed to take into account tuple sections, and was also incorrectly handling 1-tuples (e.g. 'Solo') which can be constructed using Template Haskell. - The 'NegApp' case was returning the type of the negation operator, again failing to apply it to the argument. Fixed by using 'funResultTy'. - The 'HsProc' case was computing the result type of the arrow proc block, without taking into account the argument type. Fix that by adding a new field to 'CmdTopTc' that stores the arrow type, so that we can construct the correct result type `arr a b` for `proc (pat :: a) -> (cmd :: b)`. - The 'ArithSeq' and 'NegApp' cases were failing to take into account the result 'HsWrapper', which could e.g. silently drop casts. This is fixed by introducing 'syntaxExpr_wrappedFunResTy' which, on top of taking the result type, applies the result 'HsWrapper'. These fixes are validated by the new GHC API test T26910. Fixes #26910 - - - - - e97232ce by Hai at 2026-03-27T04:47:04-04:00 Parser.y: avoid looking at token with QualifiedDo This changes the behavior of 'hintQualifiedDo' so that the supplied token is not inspected when the QualifiedDo language extension bit is set. - - - - - 9831385b by Vladislav Zavialov at 2026-03-27T17:22:30-04:00 Infix holes in types (#11107) This patch introduces several improvements that follow naturally from refactoring HsOpTy to represent the operator as an HsType, aligning it with the approach taken by OpApp and HsExpr. User-facing changes: 1. Infix holes (t1 `_` t2) are now permitted in types, following the precedent set by term-level expressions. Test case: T11107 2. Error messages for illegal promotion ticks are now reported at more precise source locations. Test case: T17865 Internal changes: * The definition of HsOpTy now mirrors that of OpApp: | HsOpTy (XOpTy p) (LHsType p) (LHsType p) (LHsType p) | OpApp (XOpApp p) (LHsExpr p) (LHsExpr p) (LHsExpr p) This moves us one step closer to unifying HsType and HsExpr. * Ignoring locations, the old pattern match (HsOpTy x prom lhs op rhs) is now written as (HsOpTy x lhs (HsTyVar x' prom op) rhs) but we also handle (HsOpTy x lhs (HsWildCardTy x') rhs) Constructors other than HsTyVar and HsWildCardTy never appear in the operator position. * The various definitions across the compiler have been updated to work with the new representation, drawing inspiration from the term-level pipeline where appropriate. For example, ppr_infix_ty <=> ppr_infix_expr get_tyop <=> get_op lookupTypeFixityRn <=> lookupExprFixityRn (the latter is factored out from rnExpr) Test cases: T11107 T17865 - - - - - 5b6757d7 by mangoiv at 2026-03-27T17:23:19-04:00 ci: build i386 non-validate for deb12 This is a small fix that will unlock ghcup metadata to run, i386 debian 12 was missing as a job. - - - - - 196cc1fa by Simon Peyton Jones at 2026-03-30T12:45:45+01:00 Add Invariant (NoTypeShadowing) to Core This commit addresses #26868, by adding a new invariant (NoTypeShadowing) to Core. See Note [No type-shadowing in Core] in GHC.Core - - - - - 56ab30db by Simon Peyton Jones at 2026-03-30T12:51:31+01:00 Major refactor of free-variable functions For some time we have had two free-variable mechanims for types: * The "FV" mechanism, embodied in GHC.Utils.FV, which worked OK, but was fragile where eta-expansion was concerned. * The TyCoFolder mechanism, using a one-shot EndoOS accumulator I finally got tired of this and refactored the whole thing, thereby addressing #27080. Now we have * `GHC.Types.Var.FV`, which has a composable free-variable result type, very much in the spirit of the old `FV`, but much more robust. (It uses the "one shot trick".) * GHC.Core.TyCo.FVs now has just one technology for free variables. All this led to a lot of renaming. There are couple of error-message changes. The change in T18451 makes an already-poor error message even more mysterious. But it really needs a separate look. - - - - - e2a965b2 by Simon Peyton Jones at 2026-04-01T15:38:53+01:00 Experiement wth killing off special treatment... ...of type lets in Lint, * add special treatment of join points in OccurAnal * special passs after the desugarer * Worker-wrapper uses lambdas - - - - - 349 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - + .gitlab/issue_templates/release_tracking.md - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Config.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - + compiler/GHC/Core/Opt/Range.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Subst.hs - + compiler/GHC/Core/SubstTypeLets.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/AddImplicitBinds.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Prelude/Basic.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Expr.hs-boot - compiler/GHC/Rename/Fixity.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Utils.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Name/Set.hs - + compiler/GHC/Types/Var/FV.hs - compiler/GHC/Types/Var/Set.hs - compiler/GHC/Unit/Module/Location.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/EndoOS.hs - − compiler/GHC/Utils/FV.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - docs/users_guide/9.16.1-notes.rst - docs/users_guide/exts/required_type_arguments.rst - hadrian/cabal.project - hadrian/src/Settings/Flavours/Validate.hs - compiler/GHC/Data/SmallArray.hs → libraries/ghc-boot/GHC/Data/SmallArray.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-internal/src/GHC/Internal/Base.hs - libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs - − libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs-boot - libraries/ghc-internal/src/GHC/Internal/Char.hs - libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs - libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs - libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs - libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Version.hs - libraries/ghc-internal/src/GHC/Internal/Event/Control.hs - libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs - libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs - libraries/ghc-internal/src/GHC/Internal/Generics.hs - libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs - libraries/ghc-internal/src/GHC/Internal/IO/FD.hs - libraries/ghc-internal/src/GHC/Internal/Int.hs - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc - libraries/ghc-internal/src/GHC/Internal/Read.hs - libraries/ghc-internal/src/GHC/Internal/System/Environment.hs - libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs - libraries/ghc-internal/src/GHC/Internal/TopHandler.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/ResolvedBCO.hs - libraries/ghci/GHCi/Server.hs - rts/Apply.cmm - rts/CloneStack.c - rts/CloneStack.h - rts/Continuation.c - rts/ContinuationOps.cmm - rts/HeapStackCheck.cmm - rts/IOManager.c - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/Printer.c - rts/RaiseAsync.c - rts/RtsFlags.c - rts/RtsSymbols.c - rts/STM.c - rts/STM.h - rts/Schedule.c - rts/StgCRun.c - rts/StgMiscClosures.cmm - rts/Threads.c - rts/Threads.h - rts/eventlog/EventLog.c - rts/include/rts/Bytecodes.h - rts/include/rts/Constants.h - rts/include/rts/PosixSource.h - rts/include/rts/storage/TSO.h - rts/include/stg/MiscClosures.h - rts/include/stg/Prim.h - rts/prim/vectorQuotRem.c - rts/win32/AsyncMIO.c - rts/win32/AsyncMIO.h - + testsuite/tests/bytecode/tuplestress/ByteCode.hs - + testsuite/tests/bytecode/tuplestress/Common.hs-incl - + testsuite/tests/bytecode/tuplestress/Obj.hs - + testsuite/tests/bytecode/tuplestress/TupleStress.hs - + testsuite/tests/bytecode/tuplestress/TupleStress.stdout - + testsuite/tests/bytecode/tuplestress/all.T - testsuite/tests/codeGen/should_run/Word2Float32.hs - testsuite/tests/codeGen/should_run/Word2Float32.stdout - testsuite/tests/codeGen/should_run/Word2Float64.hs - testsuite/tests/codeGen/should_run/Word2Float64.stdout - + testsuite/tests/concurrent/should_run/T26341.hs - + testsuite/tests/concurrent/should_run/T26341.stdout - + testsuite/tests/concurrent/should_run/T26341a.hs - + testsuite/tests/concurrent/should_run/T26341a.stdout - + testsuite/tests/concurrent/should_run/T26341b.hs - + testsuite/tests/concurrent/should_run/T26341b.stdout - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/cpranal/should_compile/T18401.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr - + testsuite/tests/driver/T13729/A/A.cabal - + testsuite/tests/driver/T13729/A/Setup.hs - + testsuite/tests/driver/T13729/A/TH.hs - + testsuite/tests/driver/T13729/A/Types1.hs - + testsuite/tests/driver/T13729/A/Types2.hs - + testsuite/tests/driver/T13729/B/B.cabal - + testsuite/tests/driver/T13729/B/Main.hs - + testsuite/tests/driver/T13729/B/Setup.hs - + testsuite/tests/driver/T13729/Makefile - + testsuite/tests/driver/T13729/Setup.hs - + testsuite/tests/driver/T13729/all.T - + testsuite/tests/ghc-api/T26910.hs - + testsuite/tests/ghc-api/T26910.stdout - + testsuite/tests/ghc-api/T26910_Input.hs - testsuite/tests/ghc-api/all.T - testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs - testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs - testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout - testsuite/tests/ghci/scripts/T10963.stderr - testsuite/tests/ghci/scripts/ghci064.stdout - testsuite/tests/indexed-types/should_fail/T2693.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/lib/stm/T26028.hs - + testsuite/tests/lib/stm/T26028.stdout - + testsuite/tests/lib/stm/T26291a.hs - + testsuite/tests/lib/stm/T26291a.stdout - + testsuite/tests/lib/stm/T26291b.hs - + testsuite/tests/lib/stm/T26291b.stdout - + testsuite/tests/lib/stm/all.T - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - + testsuite/tests/parser/should_compile/T12002.hs - + testsuite/tests/parser/should_compile/T12002.stderr - testsuite/tests/parser/should_compile/all.T - testsuite/tests/parser/should_fail/T17865.stderr - testsuite/tests/partial-sigs/should_compile/T10403.stderr - + testsuite/tests/partial-sigs/should_compile/T11107.hs - + testsuite/tests/partial-sigs/should_compile/T11107.stderr - testsuite/tests/partial-sigs/should_compile/T12844.stderr - testsuite/tests/partial-sigs/should_compile/T15039a.stderr - testsuite/tests/partial-sigs/should_compile/T15039b.stderr - testsuite/tests/partial-sigs/should_compile/T15039c.stderr - testsuite/tests/partial-sigs/should_compile/T15039d.stderr - testsuite/tests/partial-sigs/should_compile/all.T - testsuite/tests/partial-sigs/should_fail/T10999.stderr - testsuite/tests/partial-sigs/should_fail/T12634.stderr - + testsuite/tests/perf/compiler/T13820.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/polykinds/T15789.stderr - testsuite/tests/polykinds/T18451.stderr - testsuite/tests/polykinds/T7328.stderr - + testsuite/tests/rebindable/T10381.hs - testsuite/tests/rebindable/all.T - testsuite/tests/rts/all.T - + testsuite/tests/rts/cloneThreadStackMigrating.hs - + testsuite/tests/simd/should_run/FloatConstant.hs - + testsuite/tests/simd/should_run/FloatConstant.stdout - + testsuite/tests/simd/should_run/IntConstant.hs - + testsuite/tests/simd/should_run/IntConstant.stdout - + testsuite/tests/simd/should_run/StackAlignment32.hs - + testsuite/tests/simd/should_run/StackAlignment32.stdout - + testsuite/tests/simd/should_run/StackAlignment32_main.c - + testsuite/tests/simd/should_run/StackAlignment64.hs - + testsuite/tests/simd/should_run/StackAlignment64.stdout - + testsuite/tests/simd/should_run/StackAlignment64_main.c - testsuite/tests/simd/should_run/all.T - testsuite/tests/simd/should_run/int16x8_shuffle.hs - testsuite/tests/simd/should_run/int16x8_shuffle.stdout - testsuite/tests/simd/should_run/int16x8_shuffle_baseline.hs - testsuite/tests/simd/should_run/int16x8_shuffle_baseline.stdout - testsuite/tests/simd/should_run/int8x16_shuffle.hs - testsuite/tests/simd/should_run/int8x16_shuffle.stdout - testsuite/tests/simd/should_run/int8x16_shuffle_baseline.hs - testsuite/tests/simd/should_run/int8x16_shuffle_baseline.stdout - testsuite/tests/simd/should_run/simd013C.c - testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr - + testsuite/tests/simplCore/should_compile/T19166.hs - + testsuite/tests/simplCore/should_compile/T19166.stderr - testsuite/tests/simplCore/should_compile/T24229a.stderr - testsuite/tests/simplCore/should_compile/T24229b.stderr - testsuite/tests/simplCore/should_compile/T24359a.stderr - + testsuite/tests/simplCore/should_compile/T25718.hs - + testsuite/tests/simplCore/should_compile/T25718.stderr - + testsuite/tests/simplCore/should_compile/T25718a.hs - + testsuite/tests/simplCore/should_compile/T25718a.stderr - + testsuite/tests/simplCore/should_compile/T25718b.hs - + testsuite/tests/simplCore/should_compile/T25718b.stderr - + testsuite/tests/simplCore/should_compile/T25718c.hs - + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32 - + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64 - testsuite/tests/simplCore/should_compile/T26116.stderr - testsuite/tests/simplCore/should_compile/T4908.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/simplCore/should_compile/spec-inline.stderr - + testsuite/tests/simplCore/should_run/T27071.hs - + testsuite/tests/simplCore/should_run/T27071.stdout - testsuite/tests/simplCore/should_run/all.T - + testsuite/tests/typecheck/T13180/T13180.hs - + testsuite/tests/typecheck/T13180/T13180.hs-boot - + testsuite/tests/typecheck/T13180/T13180.stderr - + testsuite/tests/typecheck/T13180/T13180A.hs - + testsuite/tests/typecheck/T13180/all.T - testsuite/tests/typecheck/no_skolem_info/T20063.stderr - + testsuite/tests/typecheck/should_compile/T11141.hs - + testsuite/tests/typecheck/should_compile/T11141.stderr - + testsuite/tests/typecheck/should_compile/T11505Bar.hs - + testsuite/tests/typecheck/should_compile/T11505Foo.hs - + testsuite/tests/typecheck/should_compile/T11505Foo.hs-boot - + testsuite/tests/typecheck/should_compile/T12046.hs - testsuite/tests/typecheck/should_compile/T25180.stderr - testsuite/tests/typecheck/should_compile/T26225.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr - testsuite/tests/typecheck/should_fail/T10971d.stderr - testsuite/tests/typecheck/should_fail/T12589.stderr - testsuite/tests/typecheck/should_fail/T13311.stderr - testsuite/tests/typecheck/should_fail/T17773.stderr - + testsuite/tests/typecheck/should_fail/T26823.hs - + testsuite/tests/typecheck/should_fail/T26823.stderr - testsuite/tests/typecheck/should_fail/T2846b.stderr - testsuite/tests/typecheck/should_fail/T7851.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/vdq-rta/should_compile/T26967.hs - + testsuite/tests/vdq-rta/should_compile/T26967.stderr - + testsuite/tests/vdq-rta/should_compile/T26967_tyop.hs - + testsuite/tests/vdq-rta/should_compile/T26967_tyop.stderr - testsuite/tests/vdq-rta/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/deriveConstants/Main.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Interface/RenameType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8ddc8c3b61ac4fc2d2399db876351… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8ddc8c3b61ac4fc2d2399db876351… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/25636] test: Validate topoSort logic in createBCOs
by Rodrigo Mesquita (＠alt-romes) 01 Apr '26

01 Apr '26

Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC Commits: 638eef06 by Rodrigo Mesquita at 2026-04-01T15:19:15+01:00 test: Validate topoSort logic in createBCOs This test validates that the topological sorting and ordering of the unlifted constructors and lifted constructors in `createBCOs` is correct. See `Note [Tying the knot in createBCOs]` for why tying the knot for the created BCOs is slightly difficult and why the topological sorting is necessary. This test fails when `let topoSortedObjs = topSortObjs objs` is substituted by `let topoSortedObjs = zip [0..] objs`, thus witnessing the toposort logic is correct and necessary. The test calls the ghci `createBCOs` directly because it is currently impossible to construct in Source Haskell a situation where a top-level static unlifted constructor depends on another (we don't have top-level unlifted constructors except for nullary constructors like `Leaf :: (UTree :: UnliftedType)`). This is another test for fix for #25636 - - - - - 3 changed files: - + testsuite/tests/ghci/should_run/T25636f.hs - + testsuite/tests/ghci/should_run/T25636f.stdout - testsuite/tests/ghci/should_run/all.T Changes: ===================================== testsuite/tests/ghci/should_run/T25636f.hs ===================================== @@ -0,0 +1,160 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedDatatypes #-} + +module Main where + +import Prelude +import Control.Monad (unless) +import Data.Array.Unboxed (UArray, listArray) +import qualified Data.ByteString.Char8 as BS +import Data.Word (Word) +import GHC.Data.SmallArray (smallArrayFromList) +import GHC.Exts +import GHCi.CreateBCO (createBCOs) +import GHCi.InfoTable (mkConInfoTable) +import GHCi.RemoteTypes (HValue(..), HValueRef, RemotePtr, localRef, toRemotePtr) +import GHCi.ResolvedBCO + ( BCOByteArray + , ResolvedBCO(..) + , ResolvedBCOPtr(..) + , isLittleEndian + , mkBCOByteArray + ) +import qualified GHC.Exts.Heap as Heap + +type UTree :: UnliftedType +data UTree where + LeafA :: UTree + LeafB :: UTree + Bin :: UTree -> UTree -> UTree + +data Boxed where + RootBox :: UTree -> Boxed + PairBox :: UTree -> UTree -> Boxed + +main :: IO () +main = do + leafAInfo <- mkInfoTable 1 0 "LeafA" + leafBInfo <- mkInfoTable 2 0 "LeafB" + binInfo <- mkInfoTable 3 2 "Bin" + rootInfo <- mkInfoTable 1 1 "RootBox" + pairInfo <- mkInfoTable 2 2 "PairBox" + -- This test tests the topological sorting done to unlifted constructor + -- applications in `createBCOs` (call to `createUnliftedStaticCons`) + -- When the topological sort isn't done, this test fails with weird results. + refs <- createBCOs + [ rootBoxCon rootInfo 1 + , binCon binInfo 1 2 + , binCon binInfo 3 4 + , binCon binInfo 4 3 -- recall ResolvedUnliftedStaticConRef are indices into the unl-objs-only-array + , rootBoxCon rootInfo 0 + , leafCon leafAInfo + , leafCon leafBInfo + , pairBoxCon pairInfo 3 1 -- these are indices into unl-objs-array too (ResolvedUnliftedStaticConRef) + ] + actual <- mapM (\(unbx, ref) -> if unbx then extractUTree ref else extractBoxedRef ref) + -- test also that output order of references from createBCOs matches the + -- input order of Resolved objects + $ zip [False, True, True, True, False, True, True, False] refs + let expected = + ["RootBox (Bin LeafA LeafB)" + ,"Bin (Bin LeafA LeafB) (Bin LeafB LeafA)" + ,"Bin LeafA LeafB" + ,"Bin LeafB LeafA" + ,"RootBox (Bin (Bin LeafA LeafB) (Bin LeafB LeafA))" + ,"LeafA" + ,"LeafB" + ,"PairBox (LeafA) (Bin LeafA LeafB)"] + unless (actual == expected) $ + putStrLn "expected result of createBCOs differ from actual!" + print actual + where + leafCon leafInfo = + ResolvedStaticCon + { resolvedBCOIsLE = isLittleEndian + , resolvedStaticConInfoPtr = leafInfo + , resolvedStaticConArity = 0 + , resolvedStaticConLits = wordArray [] + , resolvedStaticConPtrs = smallArrayFromList [] + , resolvedStaticConIsUnlifted = True + } + + binCon binInfo left right = + ResolvedStaticCon + { resolvedBCOIsLE = isLittleEndian + , resolvedStaticConInfoPtr = binInfo + , resolvedStaticConArity = 2 + , resolvedStaticConLits = wordArray [] + , resolvedStaticConPtrs = + smallArrayFromList + [ ResolvedUnliftedStaticConRef left + , ResolvedUnliftedStaticConRef right + ] + , resolvedStaticConIsUnlifted = True + } + + rootBoxCon rootBoxInfo tree = + ResolvedStaticCon + { resolvedBCOIsLE = isLittleEndian + , resolvedStaticConInfoPtr = rootBoxInfo + , resolvedStaticConArity = 1 + , resolvedStaticConLits = wordArray [] + , resolvedStaticConPtrs = + smallArrayFromList [ResolvedUnliftedStaticConRef tree] + , resolvedStaticConIsUnlifted = False + } + + pairBoxCon pairBoxInfo left right = + ResolvedStaticCon + { resolvedBCOIsLE = isLittleEndian + , resolvedStaticConInfoPtr = pairBoxInfo + , resolvedStaticConArity = 2 + , resolvedStaticConLits = wordArray [] + , resolvedStaticConPtrs = + smallArrayFromList + [ ResolvedUnliftedStaticConRef left + , ResolvedUnliftedStaticConRef right + ] + , resolvedStaticConIsUnlifted = False + } + +mkInfoTable :: Int -> Int -> String -> IO (RemotePtr Heap.StgInfoTable) +mkInfoTable tag ptrs desc = + toRemotePtr <$> mkConInfoTable True ptrs 0 (tag - 1) tag (BS.pack desc) + +extractBoxedRef :: HValueRef -> IO String +extractBoxedRef ref = do + HValue hv <- localRef ref + pure $ case unsafeCoerce# hv of + boxed -> flattenBoxed boxed + +extractUTree :: HValueRef -> IO String +extractUTree ref = do + HValue hv <- localRef ref + pure $ case unsafeCoerce# hv of + utree -> flattenUTree utree + +flattenBoxed :: Boxed -> String +flattenBoxed = \case + RootBox tree -> "RootBox (" ++ flattenUTree tree ++ ")" + PairBox left right -> + "PairBox (" ++ flattenUTree left ++ ") (" ++ flattenUTree right ++ ")" + +flattenUTree :: UTree -> String +flattenUTree = \case + LeafA -> "LeafA" + LeafB -> "LeafB" + Bin left right -> "Bin " ++ par (flattenUTree left) ++ " " ++ par (flattenUTree right) + where + par s + | s == "LeafA" || s == "LeafB" = s + | otherwise = "(" ++ s ++ ")" + +wordArray :: [Word] -> BCOByteArray Word +wordArray ws = mkBCOByteArray (listArray (0, length ws - 1) ws) ===================================== testsuite/tests/ghci/should_run/T25636f.stdout ===================================== @@ -0,0 +1 @@ +["RootBox (Bin LeafA LeafB)","Bin (Bin LeafA LeafB) (Bin LeafB LeafA)","Bin LeafA LeafB","Bin LeafB LeafA","RootBox (Bin (Bin LeafA LeafB) (Bin LeafB LeafA))","LeafA","LeafB","PairBox (LeafA) (Bin LeafA LeafB)"] ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -98,3 +98,10 @@ test('T24115', just_ghci + [extra_run_opts("-e ':add T24115.hs'")], ghci_script, test('T10920', [only_ways(ghci_ways), extra_files(['LocalPrelude/Prelude.hs'])], ghci_script, ['T10920.script']) test('TopEnvIface', [only_ways(ghci_ways)], makefile_test, []) test('T25790', [only_ways(ghci_ways), extra_ways(["ghci-opt"])], ghci_script, ['T25790.script']) +test('T25636f', + just_ghci + [ + extra_hc_opts("-package ghci -package ghc-heap"), + when(arch('wasm32'), skip) + ], + compile_and_run, + ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/638eef0609d0f4a2cb9924b8667808a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/638eef0609d0f4a2cb9924b8667808a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26831] Make inlining a bit more eager for overloaded functions
by Simon Peyton Jones (＠simonpj) 01 Apr '26

01 Apr '26

Simon Peyton Jones pushed to branch wip/T26831 at Glasgow Haskell Compiler / GHC Commits: c60d2eb6 by Simon Peyton Jones at 2026-04-01T15:06:31+01:00 Make inlining a bit more eager for overloaded functions If we have f d = ... (class-op d x y) ... we should be eager to inline `f`, because that may change the higher order call (class-op d x y) into a call to a statically known function. See the discussion on #26831. Even though this does a bit /more/ inlining, compile times decrease by an average of 0.4%. Compile time changes: DsIncompleteRecSel3(normal) 431,786,104 -2.2% ManyAlternatives(normal) 670,883,768 -1.6% ManyConstructors(normal) 3,758,493,832 -2.6% GOOD MultilineStringsPerf(normal) 29,900,576 -2.8% T14052Type(ghci) 1,047,600,848 -1.2% T17836(normal) 392,852,328 -5.2% T18478(normal) 442,785,768 -1.4% T21839c(normal) 341,536,992 -14.1% GOOD T3064(normal) 174,086,152 +5.3% BAD T5631(normal) 506,867,800 +1.0% hard_hole_fits(normal) 209,530,736 -1.3% info_table_map_perf(normal) 19,523,093,184 -1.2% parsing001(normal) 377,810,528 -1.1% pmcOrPats(normal) 60,075,264 -0.5% geo. mean -0.4% minimum -14.1% maximum +5.3% Runtime changes haddock.Cabal(normal) 27,351,988,792 -0.7% haddock.base(normal) 26,997,212,560 -0.6% haddock.compiler(normal) 219,531,332,960 -1.0% Metric Decrease: LinkableUsage01 ManyConstructors T17949 T21839c T13035 TcPlugin_RewritePerf hard_hole_fits Metric Increase: T3064 - - - - - 7 changed files: - compiler/GHC/Core/Unfold.hs - testsuite/tests/arityanal/should_compile/Arity01.stderr - testsuite/tests/arityanal/should_compile/Arity05.stderr - testsuite/tests/arityanal/should_compile/Arity08.stderr - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity14.stderr - testsuite/tests/simplCore/should_compile/T15205.stderr Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -779,22 +779,28 @@ litSize _other = 0 -- Must match size of nullary constructors classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize -- See (IA1) in Note [Interesting arguments] in GHC.Core.Opt.Simplify.Utils -classOpSize opts cls top_args args - | isUnaryClass cls - = sizeZero -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon - | otherwise - = case args of - [] -> sizeZero - (arg1:other_args) -> SizeIs (size other_args) (arg_discount arg1) 0 +classOpSize _opts _cls _top_args [] + = sizeZero -- A non-applied classop +classOpSize opts cls top_args (dict_arg:other_val_args) + = SizeIs size (arg_discount dict_arg) 0 where - size other_args = 20 + (10 * length other_args) + size | isUnaryClass cls = 0 -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon + | otherwise = 20 + (10 * length other_val_args) -- If the class op is scrutinising a lambda bound dictionary then -- give it a discount, to encourage the inlining of this function - -- The actual discount is rather arbitrarily chosen - arg_discount (Var dict) | dict `elem` top_args - = unitBag (dict, unfoldingDictDiscount opts) - arg_discount _ = emptyBag + arg_discount (Cast arg _co) = arg_discount arg + arg_discount (Var dict) | dict `elem` top_args = unitBag (dict, dict_discount) + arg_discount _ = emptyBag + + -- If we have (class-op d arg1 .. argn) then it's super-good to inline + -- to expose `d`; not only can we do the dictionary selection + -- (class-op d), but that will likely expose a lambda which we can then + -- apply. In that case (n > 0), we add `unfoldingFunAppDiscount`. + -- See the discussion on #26831, esp "Delicate inlining". + dict_discount + | null other_val_args = unfoldingDictDiscount opts + | otherwise = unfoldingDictDiscount opts + unfoldingFunAppDiscount opts -- | The size of a function call callSize ===================================== testsuite/tests/arityanal/should_compile/Arity01.stderr ===================================== @@ -5,19 +5,19 @@ Result size of Tidy Core = {terms: 71, types: 43, coercions: 0, joins: 0/0} -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F1.f2 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F1.f2 = GHC.Num.Integer.IS 1# +F1.f2 = GHC.Internal.Bignum.Integer.IS 1# Rec { -- RHS size: {terms: 24, types: 6, coercions: 0, joins: 0/0} F1.f1_h1 [Occ=LoopBreaker] :: Integer -> Integer -> Integer -> Integer [GblId, Arity=3, Str=<1L><1L><SL>, Unf=OtherCon []] F1.f1_h1 - = \ (n :: Integer) (x :: Integer) (eta [OS=OneShot] :: Integer) -> + = \ (n :: Integer) (x [OS=OneShot] :: Integer) (eta [OS=OneShot] :: Integer) -> case x of x1 { __DEFAULT -> case n of y1 { __DEFAULT -> - case GHC.Num.Integer.integerLt# x1 y1 of { + case GHC.Internal.Bignum.Integer.integerLt# x1 y1 of { __DEFAULT -> eta; - 1# -> F1.f1_h1 y1 (GHC.Num.Integer.integerAdd x1 F1.f2) (GHC.Num.Integer.integerAdd x1 eta) + 1# -> F1.f1_h1 y1 (GHC.Internal.Bignum.Integer.integerAdd x1 F1.f2) (GHC.Internal.Bignum.Integer.integerAdd x1 eta) } } } @@ -26,7 +26,7 @@ end Rec } -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F1.f3 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F1.f3 = GHC.Num.Integer.IS 5# +F1.f3 = GHC.Internal.Bignum.Integer.IS 5# -- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0} f1 :: Integer @@ -36,27 +36,27 @@ f1 = F1.f1_h1 F1.f3 F1.f2 F1.f3 -- RHS size: {terms: 14, types: 5, coercions: 0, joins: 0/0} g :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer [GblId, Arity=5, Str=<1L><SL><SL><SL><SL>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0 0 0 0] 120 0}] -g = \ (x1 :: Integer) (x2 :: Integer) (x3 :: Integer) (x4 :: Integer) (x5 :: Integer) -> GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd x1 x2) x3) x4) x5 +g = \ (x1 :: Integer) (x2 :: Integer) (x3 :: Integer) (x4 :: Integer) (x5 :: Integer) -> GHC.Internal.Bignum.Integer.integerAdd (GHC.Internal.Bignum.Integer.integerAdd (GHC.Internal.Bignum.Integer.integerAdd (GHC.Internal.Bignum.Integer.integerAdd x1 x2) x3) x4) x5 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F1.s1 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F1.s1 = GHC.Num.Integer.IS 3# +F1.s1 = GHC.Internal.Bignum.Integer.IS 3# -- RHS size: {terms: 8, types: 7, coercions: 0, joins: 0/0} s :: forall {t1} {t2}. Num t1 => (t1 -> t2) -> t2 -[GblId, Arity=2, Str=<MP(A,A,A,A,A,A,1C(1,L))><1C(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 60] 50 0}] +[GblId, Arity=2, Str=<MP(A,A,A,A,A,A,1C(1,L))><1C(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 60] 50 0}] s = \ (@t) (@t1) ($dNum :: Num t) (f :: t -> t1) -> f (fromInteger @t $dNum F1.s1) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F1.h1 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F1.h1 = GHC.Num.Integer.IS 24# +F1.h1 = GHC.Internal.Bignum.Integer.IS 24# -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} h :: Integer -> Integer [GblId, Arity=1, Str=<SL>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}] -h = \ (x5 :: Integer) -> GHC.Num.Integer.integerAdd F1.h1 x5 +h = \ (x5 :: Integer) -> GHC.Internal.Bignum.Integer.integerAdd F1.h1 x5 ===================================== testsuite/tests/arityanal/should_compile/Arity05.stderr ===================================== @@ -5,27 +5,27 @@ Result size of Tidy Core = {terms: 42, types: 44, coercions: 0, joins: 0/0} -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F5.f5g1 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F5.f5g1 = GHC.Num.Integer.IS 1# +F5.f5g1 = GHC.Internal.Bignum.Integer.IS 1# -- RHS size: {terms: 12, types: 9, coercions: 0, joins: 0/0} f5g :: forall {a} {t}. Num a => (t -> a) -> t -> a -[GblId, Arity=3, Str=<SP(1C(1,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60 0] 90 0}] +[GblId, Arity=3, Str=<SP(1C(1,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [180 60 0] 90 0}] f5g = \ (@a) (@t) ($dNum :: Num a) (h :: t -> a) (z :: t) -> + @a $dNum (h z) (fromInteger @a $dNum F5.f5g1) -- RHS size: {terms: 17, types: 12, coercions: 0, joins: 0/0} f5h :: forall {a} {t}. Num a => (t -> a) -> t -> (t -> a) -> a -[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L><MC(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 60 0 60] 150 0}] +[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L><MC(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [270 60 0 60] 150 0}] f5h = \ (@a) (@t) ($dNum :: Num a) (f :: t -> a) (x :: t) (g :: t -> a) -> + @a $dNum (f x) (+ @a $dNum (g x) (fromInteger @a $dNum F5.f5g1)) -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} f5y :: Integer -> Integer [GblId, Arity=1, Str=<1L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}] -f5y = \ (y :: Integer) -> GHC.Num.Integer.integerAdd y F5.f5g1 +f5y = \ (y :: Integer) -> GHC.Internal.Bignum.Integer.integerAdd y F5.f5g1 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} f5 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -f5 = GHC.Num.Integer.IS 3# +f5 = GHC.Internal.Bignum.Integer.IS 3# ===================================== testsuite/tests/arityanal/should_compile/Arity08.stderr ===================================== @@ -4,7 +4,7 @@ Result size of Tidy Core = {terms: 24, types: 18, coercions: 0, joins: 0/0} -- RHS size: {terms: 20, types: 10, coercions: 0, joins: 0/0} f8f :: forall {p}. Num p => Bool -> p -> p -> p -[GblId, Arity=4, Str=<LP(SC(S,C(1,L)),A,MC(1,C(1,L)),A,A,A,A)><1L><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 30 0 0] 140 0}] +[GblId, Arity=4, Str=<LP(SC(S,C(1,L)),A,MC(1,C(1,L)),A,A,A,A)><1L><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [270 30 0 0] 140 0}] f8f = \ (@p) ($dNum :: Num p) (b :: Bool) (x :: p) (y :: p) -> case b of { @@ -15,7 +15,7 @@ f8f -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} f8 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -f8 = GHC.Num.Integer.IS 2# +f8 = GHC.Internal.Bignum.Integer.IS 2# ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -5,57 +5,23 @@ Result size of Tidy Core = {terms: 136, types: 75, coercions: 0, joins: 2/7} -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F11.fib3 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F11.fib3 = GHC.Num.Integer.IS 1# +F11.fib3 = GHC.Internal.Bignum.Integer.IS 1# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F11.fib2 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F11.fib2 = GHC.Num.Integer.IS 2# - -Rec { --- RHS size: {terms: 38, types: 13, coercions: 0, joins: 2/2} -F11.f11_fib [Occ=LoopBreaker] :: Integer -> Integer -[GblId, Arity=1, Str=<SL>, Unf=OtherCon []] -F11.f11_fib - = \ (ds :: Integer) -> - join { - $j [Dmd=ML] :: Integer - [LclId[JoinId(0)(Nothing)]] - $j - = join { - $j1 [Dmd=ML] :: Integer - [LclId[JoinId(0)(Nothing)]] - $j1 = GHC.Num.Integer.integerAdd (F11.f11_fib (GHC.Num.Integer.integerSub ds F11.fib3)) (F11.f11_fib (GHC.Num.Integer.integerSub ds F11.fib2)) } in - case ds of { - GHC.Num.Integer.IS x1 -> - case x1 of { - __DEFAULT -> jump $j1; - 1# -> F11.fib3 - }; - GHC.Num.Integer.IP x1 -> jump $j1; - GHC.Num.Integer.IN x1 -> jump $j1 - } } in - case ds of { - GHC.Num.Integer.IS x1 -> - case x1 of { - __DEFAULT -> jump $j; - 0# -> F11.fib3 - }; - GHC.Num.Integer.IP x1 -> jump $j; - GHC.Num.Integer.IN x1 -> jump $j - } -end Rec } +F11.fib2 = GHC.Internal.Bignum.Integer.IS 2# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F11.fib1 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F11.fib1 = GHC.Num.Integer.IS 0# +F11.fib1 = GHC.Internal.Bignum.Integer.IS 0# -- RHS size: {terms: 54, types: 27, coercions: 0, joins: 0/5} -fib :: forall {t} {a}. (Eq t, Num t, Num a) => t -> a -[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A)><LP(A,LC(L,C(1,L)),A,A,A,A,L)><LP(LC(S,C(1,L)),A,A,A,A,A,MC(1,L))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 480 0}] +fib :: forall {t1} {t2}. (Eq t1, Num t1, Num t2) => t1 -> t2 +[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A)><LP(A,LC(L,C(1,L)),A,A,A,A,L)><LP(LC(S,C(1,L)),A,A,A,A,A,MC(1,L))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [180 450 180 0] 480 0}] fib - = \ (@t) (@a) ($dEq :: Eq t) ($dNum :: Num t) ($dNum1 :: Num a) (eta :: t) -> + = \ (@t) (@t1) ($dEq :: Eq t) ($dNum :: Num t) ($dNum1 :: Num t1) (eta :: t) -> let { lvl :: t [LclId] @@ -65,32 +31,66 @@ fib [LclId] lvl1 = fromInteger @t $dNum F11.fib2 } in let { - lvl2 :: a + lvl2 :: t1 [LclId] - lvl2 = fromInteger @a $dNum1 F11.fib3 } in + lvl2 = fromInteger @t1 $dNum1 F11.fib3 } in let { lvl3 :: t [LclId] lvl3 = fromInteger @t $dNum F11.fib1 } in letrec { - fib4 [Occ=LoopBreaker, Dmd=SC(S,L)] :: t -> a + fib4 [Occ=LoopBreaker, Dmd=SC(S,L)] :: t -> t1 [LclId, Arity=1, Str=<L>, Unf=OtherCon []] fib4 = \ (ds :: t) -> case == @t $dEq ds lvl3 of { False -> case == @t $dEq ds lvl of { - False -> + @a $dNum1 (fib4 (- @t $dNum ds lvl)) (fib4 (- @t $dNum ds lvl1)); + False -> + @t1 $dNum1 (fib4 (- @t $dNum ds lvl)) (fib4 (- @t $dNum ds lvl1)); True -> lvl2 }; True -> lvl2 }; } in fib4 eta +Rec { +-- RHS size: {terms: 38, types: 13, coercions: 0, joins: 2/2} +F11.f11_fib [Occ=LoopBreaker] :: Integer -> Integer +[GblId, Arity=1, Str=<SL>, Unf=OtherCon []] +F11.f11_fib + = \ (ds :: Integer) -> + join { + $j [Dmd=ML] :: Integer + [LclId[JoinId(0)(Nothing)]] + $j + = join { + $j1 [Dmd=ML] :: Integer + [LclId[JoinId(0)(Nothing)]] + $j1 = GHC.Internal.Bignum.Integer.integerAdd (F11.f11_fib (GHC.Internal.Bignum.Integer.integerSub ds F11.fib3)) (F11.f11_fib (GHC.Internal.Bignum.Integer.integerSub ds F11.fib2)) } in + case ds of { + GHC.Internal.Bignum.Integer.IS x -> + case x of { + __DEFAULT -> jump $j1; + 1# -> F11.fib3 + }; + GHC.Internal.Bignum.Integer.IP x -> jump $j1; + GHC.Internal.Bignum.Integer.IN x -> jump $j1 + } } in + case ds of { + GHC.Internal.Bignum.Integer.IS x -> + case x of { + __DEFAULT -> jump $j; + 0# -> F11.fib3 + }; + GHC.Internal.Bignum.Integer.IP x -> jump $j; + GHC.Internal.Bignum.Integer.IN x -> jump $j + } +end Rec } + -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F11.f3 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F11.f3 = GHC.Num.Integer.IS 1000# +F11.f3 = GHC.Internal.Bignum.Integer.IS 1000# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F11.f11_x :: Integer @@ -100,7 +100,7 @@ F11.f11_x = F11.f11_fib F11.f3 -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} F11.f11f1 :: Integer -> Integer [GblId, Arity=1, Str=<SL>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}] -F11.f11f1 = \ (y :: Integer) -> GHC.Num.Integer.integerAdd F11.f11_x y +F11.f11f1 = \ (y :: Integer) -> GHC.Internal.Bignum.Integer.integerAdd F11.f11_x y -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} f11f :: forall {p}. p -> Integer -> Integer @@ -110,22 +110,22 @@ f11f = \ (@p) _ [Occ=Dead] -> F11.f11f1 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F11.f5 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F11.f5 = GHC.Num.Integer.IS 6# +F11.f5 = GHC.Internal.Bignum.Integer.IS 6# -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} F11.f4 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] -F11.f4 = GHC.Num.Integer.integerAdd F11.f11_x F11.f5 +F11.f4 = GHC.Internal.Bignum.Integer.integerAdd F11.f11_x F11.f5 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F11.f2 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F11.f2 = GHC.Num.Integer.IS 8# +F11.f2 = GHC.Internal.Bignum.Integer.IS 8# -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} F11.f1 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}] -F11.f1 = GHC.Num.Integer.integerAdd F11.f11_x F11.f2 +F11.f1 = GHC.Internal.Bignum.Integer.integerAdd F11.f11_x F11.f2 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} f11 :: (Integer, Integer) @@ -133,7 +133,4 @@ f11 :: (Integer, Integer) f11 = (F11.f4, F11.f1) ------- Local rules for imported ids -------- -"SPEC fib @Integer @Integer" forall ($dEq :: Eq Integer) ($dNum :: Num Integer) ($dNum1 :: Num Integer). fib @Integer @Integer $dEq $dNum $dNum1 = F11.f11_fib - ===================================== testsuite/tests/arityanal/should_compile/Arity14.stderr ===================================== @@ -3,18 +3,18 @@ Result size of Tidy Core = {terms: 44, types: 38, coercions: 0, joins: 0/3} -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -F14.f1 :: forall {t}. t -> t +F14.f1 :: forall t. t -> t [GblId, Arity=1, Str=<1L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}] F14.f1 = \ (@t) (y :: t) -> y -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F14.f2 :: Integer [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -F14.f2 = GHC.Num.Integer.IS 1# +F14.f2 = GHC.Internal.Bignum.Integer.IS 1# -- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/3} f14 :: forall {t}. (Ord t, Num t) => t -> t -> t -> t -[GblId, Arity=4, Str=<SP(A,A,SC(S,C(1,L)),A,A,A,A,A)><LP(LC(L,C(1,L)),A,A,A,A,A,MC(1,L))><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 90 0 0] 310 0}] +[GblId, Arity=4, Str=<SP(A,A,SC(S,C(1,L)),A,A,A,A,A)><LP(LC(L,C(1,L)),A,A,A,A,A,MC(1,L))><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 270 0 0] 310 0}] f14 = \ (@t) ($dOrd :: Ord t) ($dNum :: Num t) (eta :: t) (eta1 :: t) -> let { @@ -25,7 +25,7 @@ f14 f3 [Occ=LoopBreaker, Dmd=SC(S,C(1,L))] :: t -> t -> t -> t [LclId, Arity=2, Str=<L><L>, Unf=OtherCon []] f3 - = \ (n :: t) (x :: t) -> + = \ (n :: t) (x [OS=OneShot] :: t) -> case < @t $dOrd x n of { False -> F14.f1 @t; True -> ===================================== testsuite/tests/simplCore/should_compile/T15205.stderr ===================================== @@ -10,7 +10,7 @@ f :: forall a b. C a b => a -> b Str=<1P(A,1C(1,C(1,L)))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [30 0] 40 0}] + Guidance=IF_ARGS [90 0] 40 0}] f = \ (@a) (@b) ($dC :: C a b) (x :: a) -> op @a @b $dC x x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c60d2eb698383d4c54dbd393cdc1a31… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c60d2eb698383d4c54dbd393cdc1a31… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/hpc-bc-support] Make HPC work with bytecode interpreter
by Hannes Siebenhandl (＠fendor) 01 Apr '26

01 Apr '26

Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC Commits: 5c26b161 by fendor at 2026-04-01T15:03:25+02:00 Make HPC work with bytecode interpreter - - - - - 20 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Linker/ByteCode.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Types/HpcInfo.hs - compiler/GHC/Unit/Module/ModGuts.hs - + libraries/ghci/GHCi/Coverage.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - rts/Hpc.c - rts/Interpreter.c Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -71,6 +71,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64) import qualified Data.List as List ( any ) import GHC.Exts +import qualified GHC.Data.Strict as Strict -- ----------------------------------------------------------------------------- @@ -110,8 +111,9 @@ assembleBCOs -> [(Name, ByteString)] -> Maybe InternalModBreaks -> [SptEntry] + -> Strict.Maybe ByteCodeHpcInfo -> IO CompiledByteCode -assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do +assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries use_hpc = do -- TODO: the profile should be bundled with the interpreter: the rts ways are -- fixed for an interpreter let itbls = mkITbls profile tycons @@ -122,6 +124,7 @@ assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do , bc_strs = top_strs , bc_breaks = modbreaks , bc_spt_entries = spt_entries + , bc_hpc_info = use_hpc } -- Note [Allocating string literals] ===================================== compiler/GHC/ByteCode/Serialize.hs ===================================== @@ -112,7 +112,7 @@ type BytecodeLib = BytecodeLibX (Maybe InterpreterLibrary) -- | A bytecode library is a collection of CompiledByteCode objects and a .so file containing the combination of foreign stubs data BytecodeLibX a = BytecodeLib { bytecodeLibUnitId :: UnitId, - bytecodeLibFiles :: [CompiledByteCode], + bytecodeLibFiles :: [(Module, CompiledByteCode)], bytecodeLibForeign :: a -- A library file containing the combination of foreign stubs. (Ie arising from CApiFFI) } @@ -295,13 +295,15 @@ instance Binary CompiledByteCode where replicateM bc_strs_len $ (,) <$> getViaBinName bh <*> get bh bc_breaks <- get bh bc_spt_entries <- get bh + bc_hpc_info <- get bh return $ CompiledByteCode { bc_bcos, bc_itbls, bc_strs, bc_breaks, - bc_spt_entries + bc_spt_entries, + bc_hpc_info } put_ bh CompiledByteCode {..} = do @@ -314,6 +316,23 @@ instance Binary CompiledByteCode where for_ bc_strs $ \(nm, str) -> putViaBinName bh nm *> put_ bh str put_ bh bc_breaks put_ bh bc_spt_entries + put_ bh bc_hpc_info + +instance Binary ByteCodeHpcInfo where + put_ bh ByteCodeHpcInfo{bchi_tick_count,bchi_hash,bchi_tickboxes} = do + put_ bh bchi_tick_count + put_ bh bchi_hash + put_ bh bchi_tickboxes + + get bh = do + bchi_tick_count <- get bh + bchi_hash <- get bh + bchi_tickboxes <- get bh + pure ByteCodeHpcInfo + { bchi_tick_count + , bchi_hash + , bchi_tickboxes + } instance Binary UnlinkedBCO where get bh = ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -22,6 +22,9 @@ module GHC.ByteCode.Types -- * Mod Breaks , ModBreaks (..), BreakpointId(..), BreakTickIndex + -- * Hpc Info + , ByteCodeHpcInfo(..) + -- * Internal Mod Breaks , InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks -- ** Internal breakpoint identifier @@ -32,6 +35,7 @@ import GHC.Prelude import GHC.Data.FastString import GHC.Data.FlatBag +import qualified GHC.Data.Strict as Strict import GHC.Types.Name import GHC.Types.Name.Env import GHC.Utils.Binary @@ -76,6 +80,13 @@ data CompiledByteCode = CompiledByteCode -- ^ Static pointer table entries which should be loaded along with the -- BCOs. See Note [Grand plan for static forms] in -- "GHC.Iface.Tidy.StaticPtrTable". + , bc_hpc_info :: !(Strict.Maybe ByteCodeHpcInfo) -- ^ TODO: @fendor + } + +data ByteCodeHpcInfo = ByteCodeHpcInfo + { bchi_tick_count :: {-# UNPACK #-} !Int + , bchi_hash :: {-# UNPACK #-} !Int + , bchi_tickboxes :: !ByteString } -- | A libffi ffi_cif function prototype. ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -278,13 +278,12 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs ForeignStubs (CHeader h_code) cstub -> do let - stub_c_output_d = pprCode (getCStub cstub $$ pprCStubInitFiniDecls platform cstub) + stub_c_output_d = pprCode (getCStub cstub) stub_c_output_w = showSDoc dflags stub_c_output_d -- Header file protos for "foreign export"ed functions. stub_h_output_d = pprCode h_code stub_h_output_w = showSDoc dflags stub_h_output_d - platform = targetPlatform dflags putDumpFileMaybe logger Opt_D_dump_foreign "Foreign export header file" @@ -344,29 +343,6 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs cplusplus_hdr = "#if defined(__cplusplus)\nextern \"C\" {\n#endif\n" cplusplus_ftr = "#if defined(__cplusplus)\n}\n#endif\n" -pprCStubInitFiniDecls :: Platform -> CStub -> SDoc -pprCStubInitFiniDecls platform cstub = - vcat (zipWith (pprInitOrFiniDecl "ini" ".init_array") [0 :: Int ..] (getInitializers cstub)) - $$ vcat (zipWith (pprInitOrFiniDecl "fini" ".fini_array") [0 :: Int ..] (getFinalizers cstub)) - where - pprInitOrFiniDecl :: String -> String -> Int -> CLabel -> SDoc - pprInitOrFiniDecl suf section_name n lbl = - vcat - [ hsep [text "extern void", pprCLabel platform lbl, text "(void);"] - , hsep [ text "static void (*" - <> text "__ghc_" <> text suf <> text "_" - <> int n - <> text ")(void)" - , text "__attribute__((used, section(" - <> doubleQuotes (text section_name) - <> text ")))" - , equals - , pprCLabel platform lbl - <> semi - ] - ] - - -- It is more than likely that the stubs file will -- turn out to be empty, in which case no file should be created. outputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -151,6 +151,7 @@ import GHC.Hs.Dump import GHC.Hs.Stats ( ppSourceStats ) import GHC.HsToCore +import GHC.HsToCore.Coverage ( hpcTickBoxes ) import GHC.StgToByteCode ( byteCodeGen ) import GHC.StgToJS ( stgToJS ) @@ -237,6 +238,7 @@ import GHC.Types.Var.Set import GHC.Types.Error import GHC.Types.Fixity.Env import GHC.Types.CostCentre +import GHC.Types.HpcInfo (HpcInfo (..)) import GHC.Types.IPE import GHC.Types.SourceFile import GHC.Types.SrcLoc @@ -299,6 +301,9 @@ import qualified GHC.Unit.Home.Graph as HUG import GHC.Unit.Home.PackageTable import GHC.ByteCode.Serialize +import GHC.Driver.Ppr (showSDoc) +import qualified Data.ByteString.Char8 as BS8 +import qualified GHC.Data.Strict as Strict {- ********************************************************************** %* * @@ -1186,7 +1191,7 @@ compileWholeCoreBindings hsc_env type_env wcb = do gen_bytecode core_binds stubs foreign_files = do let cgi_guts = CgInteractiveGuts wcb_module core_binds (typeEnvTyCons type_env) stubs foreign_files - Nothing [] + Nothing [] NoHpcInfo trace_if logger (text "Generating ByteCode for" <+> ppr wcb_module) mkModuleByteCode hsc_env wcb_module wcb_mod_location cgi_guts @@ -2136,11 +2141,12 @@ data CgInteractiveGuts = CgInteractiveGuts { cgi_module :: Module , cgi_foreign_files :: [(ForeignSrcLang, FilePath)] , cgi_modBreaks :: Maybe ModBreaks , cgi_spt_entries :: [SptEntry] + , cgi_hpc_info :: HpcInfo } mkCgInteractiveGuts :: CgGuts -> CgInteractiveGuts -mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries} - = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries +mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries, cg_hpc_info} + = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries cg_hpc_info hscInteractive :: HscEnv -> CgInteractiveGuts @@ -2163,13 +2169,15 @@ hscGenerateByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO Compiled hscGenerateByteCode hsc_env cgguts location = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env + let platform = targetPlatform dflags let CgInteractiveGuts{ -- This is the last use of the ModGuts in a compilation. -- From now on, we just use the bits we need. cgi_module = this_mod, cgi_binds = core_binds, cgi_tycons = tycons, cgi_modBreaks = mod_breaks, - cgi_spt_entries = spt_entries } = cgguts + cgi_spt_entries = spt_entries, + cgi_hpc_info = hpc_info } = cgguts ------------------- -- ADD IMPLICIT BINDINGS @@ -2194,8 +2202,21 @@ hscGenerateByteCode hsc_env cgguts location = do let (stg_binds,_stg_deps) = unzip stg_binds_with_deps + ------------------- + -- Setup HPC info + let + -- Strict to not retain a reference to the 'CgInteractiveGuts' of 'cgguts' + !bytecodeHpcInfo = case hpc_info of + NoHpcInfo -> Strict.Nothing + HpcInfo{hpcInfoTickCount, hpcInfoHash} -> + Strict.Just ByteCodeHpcInfo + { bchi_tick_count = hpcInfoTickCount + , bchi_hash = hpcInfoHash + , bchi_tickboxes = BS8.pack . (++ "\0") . showSDoc dflags $ hpcTickBoxes platform this_mod + } + ----------------- Generate byte code ------------------ - byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries + byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries bytecodeHpcInfo -- | Generate a byte code object linkable and write it to a file if `-fwrite-byte-code` is enabled. generateAndWriteByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO ModuleByteCode @@ -2844,6 +2865,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do [] Nothing -- modbreaks [] -- spt entries + Strict.Nothing -- no hpc info {- load it -} bco_time <- getCurrentTime ===================================== compiler/GHC/HsToCore/Coverage.hs ===================================== @@ -6,6 +6,9 @@ module GHC.HsToCore.Coverage ( writeMixEntries , hpcInitCode + , hpcStubLabel + , hpcModuleName + , hpcTickBoxes ) where import GHC.Prelude as Prelude @@ -116,24 +119,33 @@ hpcInitCode _ _ (NoHpcInfo {}) = mempty hpcInitCode platform this_mod (HpcInfo tickCount hashNo) = initializerCStub platform fn_name decls body where - fn_name = mkInitializerStubLabel this_mod (fsLit "hpc") + fn_name = hpcStubLabel this_mod decls = text "StgWord64 " <> tickboxes <> brackets (int tickCount) <> semi body = text "hs_hpc_module" <> parens (hcat (punctuate comma [ - doubleQuotes full_name_str, + doubleQuotes (hpcModuleName this_mod), int tickCount, -- really StgWord32 int hashNo, -- really StgWord32 tickboxes ])) <> semi + tickboxes = hpcTickBoxes platform this_mod - tickboxes = pprCLabel platform (mkHpcTicksLabel $ this_mod) - - module_name = hcat (map (text.charToC) $ BS.unpack $ - bytesFS (moduleNameFS (moduleName this_mod))) - package_name = hcat (map (text.charToC) $ BS.unpack $ - bytesFS (unitFS (moduleUnit this_mod))) - full_name_str - | moduleUnit this_mod == mainUnit - = module_name - | otherwise - = package_name <> char '/' <> module_name +hpcStubLabel :: Module -> CLabel +hpcStubLabel this_mod = mkInitializerStubLabel this_mod (fsLit "hpc") + +hpcModuleName :: Module -> SDoc +hpcModuleName this_mod = full_name_str + where + full_name_str + | moduleUnit this_mod == mainUnit + = module_name + | otherwise + = package_name <> char '/' <> module_name + module_name = hcat (map (text.charToC) $ BS.unpack $ + bytesFS (moduleNameFS (moduleName this_mod))) + + package_name = hcat (map (text.charToC) $ BS.unpack $ + bytesFS (unitFS (moduleUnit this_mod))) + +hpcTickBoxes :: Platform -> Module -> SDoc +hpcTickBoxes platform this_mod = pprCLabel platform (mkHpcTicksLabel this_mod) ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -402,6 +402,7 @@ tidyProgram opts (ModGuts { mg_module = mod , mg_foreign_files = foreign_files , mg_modBreaks = modBreaks , mg_boot_exports = boot_exports + , mg_hpc_info = hpc_info }) = do (unfold_env, tidy_occ_env) <- chooseExternalIds opts mod tcs binds imp_rules @@ -471,6 +472,7 @@ tidyProgram opts (ModGuts { mg_module = mod , cg_dep_pkgs = S.map snd (dep_direct_pkgs deps) , cg_modBreaks = modBreaks , cg_spt_entries = spt_entries + , cg_hpc_info = hpc_info } , ModDetails { md_types = tidy_type_env , md_rules = tidy_rules ===================================== compiler/GHC/Linker/ByteCode.hs ===================================== @@ -31,7 +31,7 @@ linkBytecodeLib hsc_env gbcs = do on_disk_bcos <- mapM (readBinByteCode hsc_env) bytecodeObjects - let (all_cbcs, foreign_stubs) = unzip [ (bs, fs) | ModuleByteCode _m bs fs <- on_disk_bcos ++ gbcs] + let (all_cbcs, foreign_stubs) = unzip [ ((m, bs), fs) | ModuleByteCode m bs fs <- on_disk_bcos ++ gbcs] interpreter_foreign_lib <- mkInterpreterLib hsc_env (concat foreign_stubs ++ objectFiles) @@ -67,4 +67,4 @@ mkInterpreterLib hsc_env files = return $ Just (InterpreterSharedObject foreign_stub_lib_path foreign_stub_lib_dir foreign_stub_lib_name) Nothing -> pure Nothing False -> do - pure $ Just (InterpreterStaticObjects files) \ No newline at end of file + pure $ Just (InterpreterStaticObjects files) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -137,6 +137,10 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M import Foreign.Ptr (nullPtr) import GHC.ByteCode.Serialize +-- TODO: this import is wrong +import GHC.HsToCore.Coverage (hpcModuleName) +import qualified Data.ByteString.Char8 as BS8 +import qualified GHC.Data.Strict as Strict -- Note [Linkers and loaders] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -988,10 +992,11 @@ dynLinkBCOs interp pls keep_spec bcos = let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos pls1 = pls { bcos_loaded = bcos_loaded' } - cbcs :: [CompiledByteCode] - cbcs = concatMap linkableBCOs new_bcos + -- cbcs :: [CompiledByteCode] + mbcs = concatMap linkableModuleByteCodes new_bcos + m = map (\ mbc -> (gbc_module mbc, gbc_compiled_byte_code mbc)) mbcs in do - bco_state <- dynLinkCompiledByteCode interp (pkgs_loaded pls) (bco_loader_state pls) traverseHomePackageBytecodeState keep_spec cbcs + bco_state <- dynLinkCompiledByteCode interp (pkgs_loaded pls) (bco_loader_state pls) traverseHomePackageBytecodeState keep_spec m return $! pls1 { bco_loader_state = bco_state } dynLinkCompiledByteCode :: Interp @@ -999,9 +1004,10 @@ dynLinkCompiledByteCode :: Interp -> BytecodeLoaderState -> BytecodeLoaderStateTraverser IO -- ^ The traverser tells us to update home package bytecode state or external package bytecode state -> KeepModuleLinkableDefinitions - -> [CompiledByteCode] + -> [(Module, CompiledByteCode)] -> IO BytecodeLoaderState -dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecode_state keep_spec cbcs = do +dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecode_state keep_spec mbcs = do + let cbcs = map snd mbcs st1 <- traverse_bytecode_state whole_bytecode_state $ \bytecode_state -> do let le1 = bco_linker_env bytecode_state @@ -1030,6 +1036,8 @@ dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecod let ce2 = extendClosureEnv (closure_env (bco_linker_env bytecode_state)) new_binds -- Add SPT entries mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs) + -- Load HPC modules + mapM_ (\(modn, cbc) -> linkHpcEntry interp modn (bc_hpc_info cbc)) mbcs return $! bytecode_state { bco_linker_env = (bco_linker_env bytecode_state) { closure_env = ce2 } } -- | Register SPT entries for this module in the interpreter @@ -1042,8 +1050,18 @@ linkSptEntry interp ce (SptEntry name fpr) = do Nothing -> pprPanic "linkSptEntry" (ppr name) Just (_, hval) -> addSptEntry interp fpr hval - - +linkHpcEntry :: Interp -> Module -> Strict.Maybe ByteCodeHpcInfo -> IO () +linkHpcEntry _interp _modl Strict.Nothing = pure () +linkHpcEntry interp modl (Strict.Just info) = do + addHpcModule interp + (toBS $ hpcModuleName modl) + (bchi_tick_count info) + (bchi_hash info) + (bchi_tickboxes info) + where + toBS :: SDoc -> ByteString + -- TODO: @fendor showSDocUnsafe is wrong, add info to 'ByteCodeHpcInfo' + toBS = BS8.pack . (++ "\0") . showSDocUnsafe . pprCode -- Link a bunch of BCOs and return references to their values linkSomeBCOs :: Interp ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -204,36 +204,37 @@ data BytecodeLoaderState = BytecodeLoaderState -- ^ Information about bytecode objects from the home package we have loaded into the interpreter. , externalPackage_loaded :: BytecodeState -- ^ Information about bytecode objects from external packages we have loaded into the interpreter. + , hpcInitialised :: !Bool } -- | Find a name loaded from bytecode lookupNameBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ForeignHValue) -lookupNameBytecodeState (BytecodeLoaderState home_package external_package) name = do +lookupNameBytecodeState (BytecodeLoaderState home_package external_package _) name = do lookupNameEnv (closure_env (bco_linker_env home_package)) name <|> lookupNameEnv (closure_env (bco_linker_env external_package)) name -- | Look up a break array in the bytecode loader state. lookupBreakArrayBytecodeState :: BytecodeLoaderState -> Module -> Maybe (ForeignRef BreakArray) -lookupBreakArrayBytecodeState (BytecodeLoaderState home_package external_package) break_mod = do +lookupBreakArrayBytecodeState (BytecodeLoaderState home_package external_package _) break_mod = do lookupModuleEnv (breakarray_env (bco_linked_breaks home_package)) break_mod <|> lookupModuleEnv (breakarray_env (bco_linked_breaks external_package)) break_mod -- | Look up an info table in the bytecode loader state. lookupInfoTableBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ItblPtr) -lookupInfoTableBytecodeState (BytecodeLoaderState home_package external_package) info_mod = do +lookupInfoTableBytecodeState (BytecodeLoaderState home_package external_package _) info_mod = do lookupNameEnv (itbl_env (bco_linker_env home_package)) info_mod <|> lookupNameEnv (itbl_env (bco_linker_env external_package)) info_mod -- | Look up an address in the bytecode loader state. lookupAddressBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, AddrPtr) -lookupAddressBytecodeState (BytecodeLoaderState home_package external_package) addr_mod = do +lookupAddressBytecodeState (BytecodeLoaderState home_package external_package _) addr_mod = do lookupNameEnv (addr_env (bco_linker_env home_package)) addr_mod <|> lookupNameEnv (addr_env (bco_linker_env external_package)) addr_mod -- | Look up a cost centre stack in the bytecode loader state. lookupCCSBytecodeState :: BytecodeLoaderState -> Module -> Maybe (Array BreakTickIndex (RemotePtr CostCentre)) -lookupCCSBytecodeState (BytecodeLoaderState home_package external_package) ccs_mod = do +lookupCCSBytecodeState (BytecodeLoaderState home_package external_package _) ccs_mod = do lookupModuleEnv (ccs_env (bco_linked_breaks home_package)) ccs_mod <|> lookupModuleEnv (ccs_env (bco_linked_breaks external_package)) ccs_mod @@ -241,6 +242,7 @@ emptyBytecodeLoaderState :: BytecodeLoaderState emptyBytecodeLoaderState = BytecodeLoaderState { homePackage_loaded = emptyBytecodeState , externalPackage_loaded = emptyBytecodeState + , hpcInitialised = False } emptyBytecodeState :: BytecodeState ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -17,6 +17,7 @@ module GHC.Runtime.Interpreter , mallocData , createBCOs , addSptEntry + , addHpcModule , mkCostCentres , costCentreStackInfo , newBreakArray @@ -366,6 +367,10 @@ addSptEntry interp fpr ref = withForeignRef ref $ \val -> interpCmd interp (AddSptEntry fpr val) +addHpcModule :: Interp -> ByteString -> Int -> Int -> ByteString -> IO () +addHpcModule interp modLabel tickNo hash tickboxes = + interpCmd interp (AddHpcModule modLabel tickNo hash tickboxes) + costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String] costCentreStackInfo interp ccs = interpCmd interp (CostCentreStackInfo ccs) ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -74,7 +74,6 @@ import Data.List ( genericReplicate, intersperse import Foreign hiding (shiftL, shiftR) import Control.Monad import Data.Char -import Data.Word import GHC.Unit.Module @@ -98,6 +97,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Reader (ReaderT(..)) import Control.Monad.Trans.State (StateT(..)) import Data.Bifunctor (Bifunctor(..)) +import qualified GHC.Data.Strict as Strict -- ----------------------------------------------------------------------------- -- Generating byte code for a complete module @@ -108,8 +108,9 @@ byteCodeGen :: HscEnv -> [TyCon] -> Maybe ModBreaks -> [SptEntry] + -> Strict.Maybe ByteCodeHpcInfo -> IO CompiledByteCode -byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries +byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries hpc_info = withTiming logger (text "GHC.StgToByteCode"<+>brackets (ppr this_mod)) (const ()) $ do @@ -135,7 +136,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries let mod_breaks = case mb_modBreaks of Nothing -> Nothing Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb - cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries + cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries hpc_info -- Squash space leaks in the CompiledByteCode. This is really -- important, because when loading a set of modules into GHCi ===================================== compiler/GHC/Types/HpcInfo.hs ===================================== @@ -18,4 +18,3 @@ data HpcInfo emptyHpcInfo :: HpcInfo emptyHpcInfo = NoHpcInfo - ===================================== compiler/GHC/Unit/Module/ModGuts.hs ===================================== @@ -141,8 +141,9 @@ data CgGuts cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to -- generate #includes for C code gen cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints - cg_spt_entries :: [SptEntry] + cg_spt_entries :: [SptEntry], -- ^ Static pointer table entries for static forms defined in -- the module. -- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable" + cg_hpc_info :: HpcInfo } ===================================== libraries/ghci/GHCi/Coverage.hs ===================================== @@ -0,0 +1,32 @@ +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE LambdaCase #-} + +module GHCi.Coverage ( hpcAddModule ) where + +import Prelude -- See note [Why do we import Prelude here?] +import Data.Word +import Foreign +import GHC.Fingerprint +import GHCi.RemoteTypes +import Data.ByteString +import GHC.Foreign (CString) +import qualified Data.ByteString.Unsafe as B +import qualified Data.ByteString.Char8 as BS8 +import GHCi.ObjLink (lookupSymbol) +import Debug.Trace + +hpcAddModule :: ByteString -> Int -> Int -> ByteString -> IO () +hpcAddModule modl ticks hash tickboxes = do + B.unsafeUseAsCString modl $ \modlLiteral -> do + lookupSymbol (BS8.unpack tickboxes) >>= \ case + Nothing -> pure () + Just tickBoxRef -> do + hpc_register_module modlLiteral (fromIntegral ticks) (fromIntegral hash) (castPtr tickBoxRef) + hpc_startup + +foreign import ccall "hs_hpc_module" + hpc_register_module :: CString -> Word32 -> Word32 -> Ptr Word64 -> IO () + +foreign import ccall "startupHpc" + hpc_startup :: IO () ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -111,6 +111,8 @@ data Message a where -- | Add entries to the Static Pointer Table AddSptEntry :: Fingerprint -> HValueRef -> Message () + -- | Add module to hpc + AddHpcModule :: ByteString -> Int -> Int -> ByteString -> Message () -- | Malloc some data and return a 'RemotePtr' to it MallocData :: ByteString -> Message (RemotePtr ()) @@ -602,6 +604,7 @@ getMessage = do 38 -> Msg <$> (ResumeSeq <$> get) 39 -> Msg <$> (LookupSymbolInDLL <$> get <*> get) 40 -> Msg <$> (WhereFrom <$> get) + 41 -> Msg <$> (AddHpcModule <$> get <*> get <*> get <*> get) _ -> error $ "Unknown Message code " ++ (show b) putMessage :: Message a -> Put @@ -648,6 +651,7 @@ putMessage m = case m of ResumeSeq a -> putWord8 38 >> put a LookupSymbolInDLL dll str -> putWord8 39 >> put dll >> put str WhereFrom a -> putWord8 40 >> put a + AddHpcModule lbl ticks hash tickboxes -> putWord8 41 >> put lbl >> put ticks >> put hash >> put tickboxes {- Note [Parallelize CreateBCOs serialization] ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -19,6 +19,7 @@ import GHCi.CreateBCO import GHCi.InfoTable #endif +import GHCi.Coverage import qualified GHC.InfoProv as InfoProv import GHCi.Debugger import GHCi.FFI @@ -88,6 +89,7 @@ run m = case m of fmap toRemotePtr <$> lookupSymbolInDLL (fromRemotePtr dll) str FreeHValueRefs rs -> mapM_ freeRemoteRef rs AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr + AddHpcModule modl ticks hash tickboxes -> hpcAddModule modl ticks hash tickboxes EvalStmt opts r -> evalStmt opts r ResumeStmt opts r -> resumeStmt opts r AbandonStmt r -> abandonStmt r ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -59,6 +59,7 @@ library if flag(internal-interpreter) CPP-Options: -DHAVE_INTERNAL_INTERPRETER exposed-modules: + GHCi.Coverage GHCi.Run GHCi.Debugger GHCi.CreateBCO ===================================== rts/Hpc.c ===================================== @@ -323,8 +323,6 @@ hs_hpc_module(char *modName, } tmpModule->from_file = false; } - - startupHpc(); } static void ===================================== rts/Interpreter.c ===================================== @@ -1740,7 +1740,6 @@ run_BCO: &&lbl_bci_PRIMCALL - &&lbl_bci_DEFAULT, &&lbl_bci_BCO_NAME - &&lbl_bci_DEFAULT, &&lbl_bci_HPC_TICK - &&lbl_bci_DEFAULT, - &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, &&lbl_bci_OP_ADD_64 - &&lbl_bci_DEFAULT, &&lbl_bci_OP_SUB_64 - &&lbl_bci_DEFAULT, &&lbl_bci_OP_AND_64 - &&lbl_bci_DEFAULT, @@ -2111,6 +2110,9 @@ run_BCO: W_ arg1_ticks_array, arg2_tick_index; arg1_ticks_array = BCO_GET_LARGE_ARG; arg2_tick_index = BCO_READ_NEXT_32; + IF_DEBUG(hpc, + debugBelch("\tHPC Tick %lu %lu %lu\n", BCO_LIT(arg1_ticks_array), arg1_ticks_array, arg2_tick_index); + ); ((StgWord64*)BCO_LIT(arg1_ticks_array))[arg2_tick_index]++; NEXT_INSTRUCTION; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c26b1610407b3cfe086e4a9f8fff4c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c26b1610407b3cfe086e4a9f8fff4c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/elem-tests] Improve tests for `elem`
by Simon Jakobi (＠sjakobi2) 01 Apr '26

01 Apr '26

Simon Jakobi pushed to branch wip/sjakobi/elem-tests at Glasgow Haskell Compiler / GHC Commits: ae3037e9 by Simon Jakobi at 2026-04-01T14:50:34+02:00 Improve tests for `elem` * Improve T17752 by including the Core output in golden files, checking both -O1 and -O2. * Add tests for fusion and no-fusion cases. Fixes #27101. - - - - - 12 changed files: - + libraries/base/tests/perf/ElemFusionUnknownList.hs - + libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr - + libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr - + libraries/base/tests/perf/ElemNoFusion.hs - + libraries/base/tests/perf/ElemNoFusion_O1.stderr - + libraries/base/tests/perf/ElemNoFusion_O2.stderr - − libraries/base/tests/perf/Makefile - libraries/base/tests/perf/T17752.hs - − libraries/base/tests/perf/T17752.stdout - + libraries/base/tests/perf/T17752_O1.stderr - + libraries/base/tests/perf/T17752_O2.stderr - libraries/base/tests/perf/all.T Changes: ===================================== libraries/base/tests/perf/ElemFusionUnknownList.hs ===================================== @@ -0,0 +1,21 @@ +-- We expect `elem` to fuse with good producers such as `map`, `concatMap`, +-- and `filter`. +module ElemFusionUnknownList where + +fusionElemMap :: Int -> [Int] -> Bool +fusionElemMap x = elem x . map (+1) + +fusionNotElemMap :: Int -> [Int] -> Bool +fusionNotElemMap x = notElem x . map (+1) + +fusionElemConcatMap :: Int -> [Int] -> Bool +fusionElemConcatMap x = elem x . concatMap (\y -> [y + 1, y + 2]) + +fusionNotElemConcatMap :: Int -> [Int] -> Bool +fusionNotElemConcatMap x = notElem x . concatMap (\y -> [y + 1, y + 2]) + +fusionElemFilter :: Int -> [Int] -> Bool +fusionElemFilter x = elem x . filter odd + +fusionNotElemFilter :: Int -> [Int] -> Bool +fusionNotElemFilter x = notElem x . filter odd ===================================== libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr ===================================== @@ -0,0 +1,124 @@ +fusionNotElemFilter + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y ys -> + case y of { I# ipv -> + case remInt# ipv 2# of { + __DEFAULT -> + case x of { I# x1 -> + case ==# x1 ipv of { + __DEFAULT -> jump go1 ys; + 1# -> False + } + }; + 0# -> jump go1 ys + } + } + }; } in + jump go1 eta + +fusionElemFilter + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case y of { I# ipv -> + case remInt# ipv 2# of { + __DEFAULT -> + case x of { I# x1 -> + case ==# x1 ipv of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + }; + 0# -> jump go1 ys + } + } + }; } in + jump go1 eta + +fusionNotElemConcatMap + = \ x x1 -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y ys -> + case y of { I# x2 -> + case x of { I# x3 -> + case ==# x3 (+# x2 1#) of { + __DEFAULT -> + case ==# x3 (+# x2 2#) of { + __DEFAULT -> jump go1 ys; + 1# -> False + }; + 1# -> False + } + } + } + }; } in + jump go1 x1 + +fusionElemConcatMap + = \ x x1 -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case y of { I# x2 -> + case x of { I# x3 -> + case ==# x3 (+# x2 1#) of { + __DEFAULT -> + case ==# x3 (+# x2 2#) of { + __DEFAULT -> jump go1 ys; + 1# -> True + }; + 1# -> True + } + } + } + }; } in + jump go1 x1 + +fusionNotElemMap + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y ys -> + case x of { I# x1 -> + case y of { I# x2 -> + case ==# x1 (+# x2 1#) of { + __DEFAULT -> jump go1 ys; + 1# -> False + } + } + } + }; } in + jump go1 eta + +fusionElemMap + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case x of { I# x1 -> + case y of { I# x2 -> + case ==# x1 (+# x2 1#) of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + } + } + }; } in + jump go1 eta + ===================================== libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr ===================================== @@ -0,0 +1,206 @@ +fusionNotElemFilter + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y ys -> + case y of { I# ipv -> + case remInt# ipv 2# of { + __DEFAULT -> + case x of { I# x1 -> + case ==# x1 ipv of { + __DEFAULT -> + joinrec { + go2 ds1 + = case ds1 of { + [] -> True; + : y1 ys1 -> + case y1 of { I# ipv1 -> + case remInt# ipv1 2# of { + __DEFAULT -> + case ==# x1 ipv1 of { + __DEFAULT -> jump go2 ys1; + 1# -> False + }; + 0# -> jump go2 ys1 + } + } + }; } in + jump go2 ys; + 1# -> False + } + }; + 0# -> jump go1 ys + } + } + }; } in + jump go1 eta + +fusionElemFilter + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case y of { I# ipv -> + case remInt# ipv 2# of { + __DEFAULT -> + case x of { I# x1 -> + case ==# x1 ipv of { + __DEFAULT -> + joinrec { + go2 ds1 + = case ds1 of { + [] -> False; + : y1 ys1 -> + case y1 of { I# ipv1 -> + case remInt# ipv1 2# of { + __DEFAULT -> + case ==# x1 ipv1 of { + __DEFAULT -> jump go2 ys1; + 1# -> True + }; + 0# -> jump go2 ys1 + } + } + }; } in + jump go2 ys; + 1# -> True + } + }; + 0# -> jump go1 ys + } + } + }; } in + jump go1 eta + +fusionNotElemConcatMap + = \ x x1 -> + case x1 of { + [] -> True; + : y ys -> + case y of { I# x2 -> + case x of { I# x3 -> + case ==# x3 (+# x2 1#) of { + __DEFAULT -> + case ==# x3 (+# x2 2#) of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y1 ys1 -> + case y1 of { I# x4 -> + case ==# x3 (+# x4 1#) of { + __DEFAULT -> + case ==# x3 (+# x4 2#) of { + __DEFAULT -> jump go1 ys1; + 1# -> False + }; + 1# -> False + } + } + }; } in + jump go1 ys; + 1# -> False + }; + 1# -> False + } + } + } + } + +fusionElemConcatMap + = \ x x1 -> + case x1 of { + [] -> False; + : y ys -> + case y of { I# x2 -> + case x of { I# x3 -> + case ==# x3 (+# x2 1#) of { + __DEFAULT -> + case ==# x3 (+# x2 2#) of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y1 ys1 -> + case y1 of { I# x4 -> + case ==# x3 (+# x4 1#) of { + __DEFAULT -> + case ==# x3 (+# x4 2#) of { + __DEFAULT -> jump go1 ys1; + 1# -> True + }; + 1# -> True + } + } + }; } in + jump go1 ys; + 1# -> True + }; + 1# -> True + } + } + } + } + +fusionNotElemMap + = \ x eta -> + case eta of { + [] -> True; + : y ys -> + case x of { I# x1 -> + case y of { I# x2 -> + case ==# x1 (+# x2 1#) of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y1 ys1 -> + case y1 of { I# x3 -> + case ==# x1 (+# x3 1#) of { + __DEFAULT -> jump go1 ys1; + 1# -> False + } + } + }; } in + jump go1 ys; + 1# -> False + } + } + } + } + +fusionElemMap + = \ x eta -> + case eta of { + [] -> False; + : y ys -> + case x of { I# x1 -> + case y of { I# x2 -> + case ==# x1 (+# x2 1#) of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y1 ys1 -> + case y1 of { I# x3 -> + case ==# x1 (+# x3 1#) of { + __DEFAULT -> jump go1 ys1; + 1# -> True + } + } + }; } in + jump go1 ys; + 1# -> True + } + } + } + } + ===================================== libraries/base/tests/perf/ElemNoFusion.hs ===================================== @@ -0,0 +1,14 @@ +-- As of March 2026, we don't expect `elem` to fuse with `sort` or `NonEmpty.toList`. +-- `elem` isn't even specialized, and performs dictionary-passing, but that may +-- change: #27096 +module ElemNoFusion where + +import Data.List (sort) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty + +noFusionElemNonEmptyToList :: Int -> NonEmpty Int -> Bool +noFusionElemNonEmptyToList x = elem x . NonEmpty.toList + +noFusionElemSort :: Int -> [Int] -> Bool +noFusionElemSort x = elem x . sort ===================================== libraries/base/tests/perf/ElemNoFusion_O1.stderr ===================================== @@ -0,0 +1,5 @@ +noFusionElemSort = \ x x1 -> elem $fEqInt x (actualSort gtInt x1) + +noFusionElemNonEmptyToList + = \ x x1 -> case x1 of { :| a1 as -> elem $fEqInt x (: a1 as) } + ===================================== libraries/base/tests/perf/ElemNoFusion_O2.stderr ===================================== @@ -0,0 +1,5 @@ +noFusionElemSort = \ x x1 -> elem $fEqInt x (actualSort gtInt x1) + +noFusionElemNonEmptyToList + = \ x x1 -> case x1 of { :| a1 as -> elem $fEqInt x (: a1 as) } + ===================================== libraries/base/tests/perf/Makefile deleted ===================================== @@ -1,15 +0,0 @@ -# This Makefile runs the tests using GHC's testsuite framework. It -# assumes the package is part of a GHC build tree with the testsuite -# installed in ../../../testsuite. - -TOP=../../../../testsuite -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - - -T17752: - '$(TEST_HC)' $(TEST_HC_OPTS) -O --make T17752 -rtsopts -ddump-simpl -ddump-to-file -dsuppress-uniques -dsuppress-all - # All occurrences of elem should be optimized away. - # For strings these should result in loops after inlining foldCString. - # For lists it should result in a case expression. - echo $$(grep -A4 "elem" T17752.dump-simpl) ===================================== libraries/base/tests/perf/T17752.hs ===================================== @@ -6,7 +6,7 @@ module T17752 where -- Should compile to a pattern match if the rules fire isElemList x = x `elem` ['a','b','c'] -isNotElemList x = x `elem` ['x','y','z'] +isNotElemList x = x `notElem` ['x','y','z'] isOneOfThese x = x `elem` [1,2,3,4,5::Int] isNotOneOfThese x = x `notElem` [1,2,3,4,5::Int] ===================================== libraries/base/tests/perf/T17752.stdout deleted ===================================== @@ -1,2 +0,0 @@ -[1 of 1] Compiling T17752 ( T17752.hs, T17752.o ) - ===================================== libraries/base/tests/perf/T17752_O1.stderr ===================================== @@ -0,0 +1,118 @@ +isElemList + = \ x -> + case x of { C# x1 -> + case x1 of { + __DEFAULT -> False; + 'a'# -> True; + 'b'# -> True; + 'c'# -> True + } + } + +isNotElemList + = \ x -> + case x of { C# x1 -> + case x1 of { + __DEFAULT -> True; + 'x'# -> False; + 'y'# -> False; + 'z'# -> False + } + } + +isOneOfThese + = \ x -> + case x of { I# x1 -> + case x1 of { + __DEFAULT -> False; + 1# -> True; + 2# -> True; + 3# -> True; + 4# -> True; + 5# -> True + } + } + +isNotOneOfThese + = \ x -> + case x of { I# x1 -> + case x1 of { + __DEFAULT -> True; + 1# -> False; + 2# -> False; + 3# -> False; + 4# -> False; + 5# -> False + } + } + +isElemString + = \ x -> + joinrec { + go addr z + = case indexCharOffAddr# addr 0# of ch { + __DEFAULT -> + case x of { C# x1 -> + case eqChar# x1 ch of { + __DEFAULT -> jump go (plusAddr# addr 1#) z; + 1# -> True + } + }; + '\NUL'# -> z + }; } in + jump go isElemString1 False + +isNotElemString + = \ x -> + joinrec { + go addr z + = case indexCharOffAddr# addr 0# of ch { + __DEFAULT -> + case x of { C# x1 -> + case eqChar# x1 ch of { + __DEFAULT -> jump go (plusAddr# addr 1#) z; + 1# -> False + } + }; + '\NUL'# -> + case z of { + False -> True; + True -> False + } + }; } in + jump go isNotElemString1 False + +isElemStringUtf + = \ x -> + unpackFoldrCStringUtf8# + isElemStringUtf1 + (\ y r -> + case x of { C# x1 -> + case y of { C# y1 -> + case eqChar# x1 y1 of { + __DEFAULT -> r; + 1# -> True + } + } + }) + False + +isNotElemStringUtf + = \ x -> + case unpackFoldrCStringUtf8# + isNotElemStringUtf1 + (\ y r -> + case x of { C# x1 -> + case y of { C# y1 -> + case eqChar# x1 y1 of { + __DEFAULT -> r; + 1# -> True + } + } + }) + False + of { + False -> True; + True -> False + } + ===================================== libraries/base/tests/perf/T17752_O2.stderr ===================================== @@ -0,0 +1,130 @@ +isElemList + = \ x -> + case x of { C# x1 -> + case x1 of { + __DEFAULT -> False; + 'a'# -> True; + 'b'# -> True; + 'c'# -> True + } + } + +isNotElemList + = \ x -> + case x of { C# x1 -> + case x1 of { + __DEFAULT -> True; + 'x'# -> False; + 'y'# -> False; + 'z'# -> False + } + } + +isOneOfThese + = \ x -> + case x of { I# x1 -> + case x1 of { + __DEFAULT -> False; + 1# -> True; + 2# -> True; + 3# -> True; + 4# -> True; + 5# -> True + } + } + +isNotOneOfThese + = \ x -> + case x of { I# x1 -> + case x1 of { + __DEFAULT -> True; + 1# -> False; + 2# -> False; + 3# -> False; + 4# -> False; + 5# -> False + } + } + +isElemString + = \ x -> + case indexCharOffAddr# isElemString1 0# of ch { + __DEFAULT -> + case x of { C# x1 -> + case eqChar# x1 ch of { + __DEFAULT -> + joinrec { + go addr z + = case indexCharOffAddr# addr 0# of ch1 { + __DEFAULT -> + case eqChar# x1 ch1 of { + __DEFAULT -> jump go (plusAddr# addr 1#) z; + 1# -> True + }; + '\NUL'# -> z + }; } in + jump go (plusAddr# isElemString1 1#) False; + 1# -> True + } + }; + '\NUL'# -> False + } + +isNotElemString + = \ x -> + case indexCharOffAddr# isNotElemString1 0# of ch { + __DEFAULT -> + case x of { C# x1 -> + case eqChar# x1 ch of { + __DEFAULT -> + joinrec { + $sgo sc + = case indexCharOffAddr# sc 0# of ch1 { + __DEFAULT -> + case eqChar# x1 ch1 of { + __DEFAULT -> jump $sgo (plusAddr# sc 1#); + 1# -> False + }; + '\NUL'# -> True + }; } in + jump $sgo (plusAddr# isNotElemString1 1#); + 1# -> False + } + }; + '\NUL'# -> True + } + +isElemStringUtf + = \ x -> + unpackFoldrCStringUtf8# + isElemStringUtf1 + (\ y r -> + case x of { C# x1 -> + case y of { C# y1 -> + case eqChar# x1 y1 of { + __DEFAULT -> r; + 1# -> True + } + } + }) + False + +isNotElemStringUtf + = \ x -> + case unpackFoldrCStringUtf8# + isNotElemStringUtf1 + (\ y r -> + case x of { C# x1 -> + case y of { C# y1 -> + case eqChar# x1 y1 of { + __DEFAULT -> r; + 1# -> True + } + } + }) + False + of { + False -> True; + True -> False + } + ===================================== libraries/base/tests/perf/all.T ===================================== @@ -2,10 +2,25 @@ setTestOpts(js_skip) #-------------------------------------- -# Check specialization of elem via rules +# Check optimization of `elem` #-------------------------------------- -test('T17752', [only_ways(['normal'])] , makefile_test, ['T17752']) +elemCoreFilter = "sed -En '/^(is|fusion|noFusion)[A-Za-z]*($| )/,/^$/p'" + +def elemCoreTest(test_name, module_name, opt): + test(test_name, + [only_ways(['normal']), extra_files([module_name + '.hs'])], + multimod_compile_filter, + [module_name, + f'{opt} -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds', + elemCoreFilter]) + +elemCoreTest('T17752_O1', 'T17752', '-O1') +elemCoreTest('T17752_O2', 'T17752', '-O2') +elemCoreTest('ElemFusionUnknownList_O1', 'ElemFusionUnknownList', '-O1') +elemCoreTest('ElemFusionUnknownList_O2', 'ElemFusionUnknownList', '-O2') +elemCoreTest('ElemNoFusion_O1', 'ElemNoFusion', '-O1') +elemCoreTest('ElemNoFusion_O2', 'ElemNoFusion', '-O2') #-------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae3037e90ed3f2a8f3eb17087fe034f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae3037e90ed3f2a8f3eb17087fe034f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/26039] 78 commits: ghci: Mention active language edition in startup banner
by Rodrigo Mesquita (＠alt-romes) 01 Apr '26

01 Apr '26

Rodrigo Mesquita pushed to branch wip/romes/26039 at Glasgow Haskell Compiler / GHC Commits: e34cb6da by Adam Gundry at 2026-03-20T12:20:00-04:00 ghci: Mention active language edition in startup banner Per GHC proposal 632, this makes the GHCi startup banner include the active language edition, plus an indication of whether this was the default (as opposed to being explicitly selected via an option such as `-XGHC2024`). For example: ``` $ ghci GHCi, version 9.14.1: https://www.haskell.org/ghc/ :? for help Using default language edition: GHC2024 ghci> ``` Fixes #26037. - - - - - 52c3e6ba by sheaf at 2026-03-20T12:21:09-04:00 Improve incomplete record selector warnings This commit stops GHC from emitting spurious incomplete record selector warnings for bare selectors/projections such as .fld There are two places we currently emit incomplete record selector warnings: 1. In the desugarer, when we see a record selector or an occurrence of 'getField'. Here, we can use pattern matching information to ensure we don't give false positives. 2. In the typechecker, which might sometimes give false positives but can emit warnings in cases that the pattern match checker would otherwise miss. This is explained in Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc. Now, we obviously don't want to emit the same error twice, and generally we prefer (1), as those messages contain fewer false positives. So we suppress (2) when we are sure we are going to emit (1); the logic for doing so is in GHC.Tc.Instance.Class.warnIncompleteRecSel, and works by looking at the CtOrigin. Now, the issue was that this logic handled explicit record selectors as well as overloaded record field selectors such as "x.r" (which turns into a simple GetFieldOrigin CtOrigin), but it didn't properly handle record projectors like ".fld" or ".fld1.fld2" (which result in other CtOrigins such as 'RecordFieldProjectionOrigin'). To solve this problem, we re-use the 'isHasFieldOrigin' introduced in fbdc623a (slightly adjusted). On the way, we also had to update the desugarer with special handling for the 'ExpandedThingTc' case in 'ds_app', to make sure that 'ds_app_var' sees all the type arguments to 'getField' in order for it to indeed emit warnings like in (1). Fixes #26686 - - - - - 309d7e87 by Cheng Shao at 2026-03-20T12:21:53-04:00 rts: opportunistically grow the MutableByteArray# in-place in resizeMutableByteArray# Following !15234, this patch improves `resizeMutableByteArray#` memory efficiency by growing the `MutableByteArray#` in-place if possible, addressing an old todo comment here. Also adds a new test case `resizeMutableByteArrayInPlace` that stresses this behavior. - - - - - 7d4ef162 by Matthew Craven at 2026-03-20T12:22:47-04:00 Change representation of floating point literals This commit changes the representation of floating point literals throughough the compiler, in particular in Core and Cmm. The Rational type is deficient for this purpose, dealing poorly with NaN, +/-Infinity, and negative zero. Instead, the new module GHC.Types.Literal.Floating uses the host Float/Double type to represent NaNs, infinities and negative zero. It also contains a Rational constructor, for the benefit of -fexcess-precision. Other changes: - Remove Note [negative zero] and related code This also removes the restrictions on constant-folding of division by zero, and should make any problems with NaN/Infinity more obvious. - Use -0.0 as the additive identity for Core constant folding rules for floating-point addition, fixing #21227. - Manual worker-wrapper for GHC.Float.rationalToDouble. This is intended to prevent the compiler's WW on this function from interfering with constant-folding. This change means that we now avoid allocating a box for the result of a 'realToFrac' call in T10359. - Combine floatDecodeOp and doubleDecodeOp. This change also fixes a bug in doubleDecodeOp wherein it would incorrectly produce an Int# instead of an Int64# literal for the mantissa component with 64-bit targets. - Use Float/Double for assembly immediates, and update the X86 and PowerPC backends to properly handle special values such as NaN and infinity. - Allow 'rational_to' to handle zero denominators, fixing a TODO in GHC.Core.Opt.ConstantFold. Fixes #8364 #9811 #18897 #21227 Progress towards #26919 Metric Decrease: T10359 Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> ------------------------- Metric Decrease: T1969 T5321FD ------------------------- - - - - - 80e2dd4f by Zubin Duggal at 2026-03-20T12:23:33-04:00 compiler/ffi: Collapse void pointer chains in capi wrappers New gcc/clang treat -Wincompatible-pointer-types as an error by default. Since C only allows implicit conversion from void*, not void**, capi wrappers for functions taking e.g. abstract** would fail to compile when the Haskell type Ptr (Ptr Abstract) was naively translated to void**. Collapse nested void pointers to a single void* when the pointee type has no known C representation. Fixes #26852 - - - - - 1c50bd7b by Luite Stegeman at 2026-03-20T12:24:37-04:00 Move some functions related to pointer tagging to a separate module - - - - - bfd7aafd by Luite Stegeman at 2026-03-20T12:24:37-04:00 Branchless unpacking for enumeration types Change unpacking for enumeration types to go to Word8#/Word16#/Word# directly instead of going through an intermediate unboxed sum. This allows us to do a branchless conversion using DataToTag and TagToEnum. Fixes #26970 - - - - - 72b20fc0 by Luite Stegeman at 2026-03-20T12:25:30-04:00 bytecode: Carefully SLIDE off the end of a stack chunk The SLIDE bytecode instruction was not checking for stack chunk boundaries and could corrupt the stack underflow frame, leading to crashes. We add a check to use safe writes if we cross the chunk boundary and also handle stack underflow if Sp is advanced past the underflow frame. fix #27001 - - - - - 2e22b43c by Cheng Shao at 2026-03-20T12:26:14-04:00 ghci: serialize BCOByteArray buffer directly when possible This patch changes the `Binary` instances of `BCOByteArray` to directly serialize the underlying buffer when possible, while also taking into account the issue of host-dependent `Word` width. See added comments and amended `Note [BCOByteArray serialization]` for detailed explanation. Closes #27020. - - - - - 89d9ba37 by Sylvain Henry at 2026-03-20T12:27:34-04:00 JS: replace BigInt with Number arithmetic for 32/64-bit quot/rem (#23597) Replace BigInt-based implementations of quotWord32, remWord32, quotRemWord32, quotRem2Word32, quotWord64, remWord64, quotInt64, and remInt64 with pure Number (double/integer) arithmetic to avoid the overhead of BigInt promotion. - - - - - ae4ddd60 by Sylvain Henry at 2026-03-20T12:28:28-04:00 Core: add constant-folding rules for Addr# eq/ne (#18032) - - - - - 3e767f98 by Matthew Pickering at 2026-03-20T12:29:11-04:00 Use OsPath rather than FilePath in Downsweep cache This gets us one step closure to uniformly using `OsPath` in the compiler. - - - - - 2c57de29 by Cheng Shao at 2026-03-20T12:29:55-04:00 hadrian: fix ghc-in-ghci flavour stage0 shared libraries This patch fixes missing stage0 shared libraries in hadrian ghc-in-ghci flavour, which was accidentally dropped in 669d09f950a6e88b903d9fd8a7571531774d4d5d and resulted in a regression in HLS support on linux/macos. Fixes #27057. - - - - - 5b1be555 by Sylvain Henry at 2026-03-20T12:30:48-04:00 JS: install rts/Types.h header file (#27033) It was an omission, making HsFFI.h not usable with GHC using the JS backend. - - - - - b883f08f by Cheng Shao at 2026-03-20T12:31:33-04:00 hadrian: don't compile RTS with -Winline This patch removes `-Winline` from cflags when compiling the RTS, given that: 1. It generates a huge pile of spam and hurts developer experience 2. Whether inlining happens is highly dependent on toolchains, flavours, etc, and it's not really an issue to fix if inlining doesn't happen; it's a hint to the C compiler anyway. Fixes #27060. - - - - - 333387d6 by Cheng Shao at 2026-03-20T12:31:33-04:00 hadrian: compile libffi-clib with -Wno-deprecated-declarations This patch adds `-Wno-deprecated-declarations` to cflags of `libffi-clib`, given that it produces noise at compile-time that aren't really our issue to fix anyway, it's from vendored libffi source code. - - - - - 67c47771 by Rodrigo Mesquita at 2026-03-20T12:32:17-04:00 Expose decodeStackWithIpe from ghc-experimental This decoding is useful to the debugger and it wasn't originally exported as an oversight. - - - - - 18513365 by Matthew Pickering at 2026-03-21T04:43:26-04:00 Add support for custom external interpreter commands It can be useful for GHC API clients to implement their own external interpreter commands. For example, the debugger may want an efficient way to inspect the stacks of the running threads in the external interpreter. - - - - - 4636d906 by mangoiv at 2026-03-21T04:44:10-04:00 ci: remove obsolete fallback for old debian and ubuntu versions - - - - - 2e3a2805 by mangoiv at 2026-03-21T04:44:10-04:00 ci: drop ubuntu 18 and 20 Ubuntu 18 EOL: May 2023 Ubuntu 20 EOL: May 2025 We should probably not make another major release supporting these platforms. Also updates the generator script. Resolves #25876 - - - - - de54e264 by Cheng Shao at 2026-03-21T17:52:08+01:00 rts: fix -Wcompare-distinct-pointer-types errors This commit fixes `-Wcompare-distinct-pointer-types` errors in the RTS which should have been caught by the `validate` flavour but was warnings in CI due to the recent `+werror` regression. - - - - - b9bd73de by Cheng Shao at 2026-03-21T17:52:08+01:00 ghc-internal: fix unused imports This commit fixes unused imports in `ghc-internal` which should have been caught by the `validate` flavour but was warnings in CI due to the recent `+werror` regression. Fixes #26987 #27059. - - - - - da946a16 by Cheng Shao at 2026-03-21T17:03:51+00:00 ghci: fix unused imports This commit fixes unused imports in `ghci` which should have been caught by the `validate` flavour but was warnings in CI due to the recent `+werror` regression. Fixes #26987 #27059. - - - - - 955b1cf8 by Cheng Shao at 2026-03-21T17:03:51+00:00 compiler: fix unused imports in GHC.Tc.Types.Origin This commit fixes unused imports in `GHC.Tc.Types.Origin` which should have been caught by the `validate` flavour but was warnings in CI due to the recent `+werror` regression. Fixes #27059. - - - - - 3b1aeb50 by Cheng Shao at 2026-03-21T17:03:51+00:00 hadrian: fix missing +werror in validate flavour This patch fixes missing `+werror` in validate flavour, which was an oversight in bb3a2ba1eefadf0b2ef4f39b31337a23eec67f29. Fixes #27066. - - - - - 44f118f0 by Cheng Shao at 2026-03-22T04:54:01-04:00 ci: bump CACHE_REV and add the missing reminder This patch bumps `CACHE_REV` to address recent `[Cabal-7159]` CI errors due to stale cabal cache on some runners, and also adds a reminder to remind future maintainers. Fixes #27075. - - - - - 2a218737 by ARATA Mizuki at 2026-03-23T11:11:39-04:00 Add 128-bit SIMD support to AArch64 NCG Changes: - Add `Format` field to vector-capable instructions. These instructions will emit `vN.4s` (for example) as a operand. - Additional constructors for `Operand`: `OpVecLane` represents a vector lane and will be emitted as `vN.<width>[<index>]` (`vN.s[3]` for example). `OpScalarAsVec` represents a scalar, but printed as a vector lane like `vN.<width>[0]` (`vN.s[0]` for example). - Integer quot/rem are implemented in C, like x86. Closes #26536 Metric Increase: T3294 - - - - - 5d6e2be9 by ARATA Mizuki at 2026-03-23T11:11:39-04:00 AArch64 NCG: Improve code generation for floating-point and vector constants Some floating-point constants can be directly encoded using the FMOV instruction. Similarly, a class of vectors with same values can be encoded using FMOV, MOVI, or MVNI. - - - - - c6d262aa by Simon Jakobi at 2026-03-23T11:12:22-04:00 Add regression test for #13729 Closes #13729. - - - - - aa5dfe67 by Sylvain Henry at 2026-03-26T03:48:56-04:00 Check that shift values are valid In GHC's codebase in non-DEBUG builds we silently substitute shiftL/R with unsafeShiftL/R for performance reasons. However we were not checking that the shift value was valid for unsafeShiftL/R, leading to wrong computations, but only in non-DEBUG builds. This patch adds the necessary checks and reports an error when a wrong shift value is passed. - - - - - c8a7b588 by Sylvain Henry at 2026-03-26T03:48:56-04:00 Implement basic value range analysis (#25718) Perform basic value range analysis to try to determine at compile time the result of the application of some comparison primops (ltWord#, etc.). This subsumes the built-in rewrite rules used previously to check if one of the comparison argument was a bound (e.g. (x :: Word8) <= 255 is always True). Our analysis is more powerful and handles type conversions: e.g. word8ToWord x <= 255 is now detected as always True too. We also use value range analysis to filter unreachable alternatives in case-expressions. To support this, we had to allow case-expressions for primitive types to not have a DEFAULT alternative (as was assumed before and checked in Core lint). - - - - - a5ec467e by ARATA Mizuki at 2026-03-26T03:49:49-04:00 rts: Align stack to 64-byte boundary in StgRun on x86 When LLVM spills AVX/AVX-512 vector registers to the stack, it requires 32-byte (__m256) or 64-byte (__m512) alignment. If the stack is not sufficiently aligned, LLVM inserts a realignment prologue that reserves %rbp as a frame pointer, conflicting with GHC's use of %rbp as an STG callee-saved register and breaking the tail-call-based calling convention. Previously, GHC worked around this by lying to LLVM about the stack alignment and rewriting aligned vector loads/stores (VMOVDQA, VMOVAPS) to unaligned ones (VMOVDQU, VMOVUPS) in the LLVM Mangler. This had two problems: - It did not extend to AVX-512, which requires 64-byte alignment. (#26595) - When Haskell calls a C function that takes __m256/__m512 arguments on the stack, the callee requires genuine alignment, which could cause a segfault. (#26822) This patch genuinely aligns the stack to 64 bytes in StgRun by saving the original stack pointer before alignment and restoring it in StgReturn. We now unconditionally advertise 64-byte stack alignment to LLVM for all x86 targets, making rewriteAVX in the LLVM Mangler unnecessary. STG_RUN_STACK_FRAME_SIZE is increased from 48 to 56 bytes on non-Windows x86-64 to store the saved stack pointer. Closes #26595 and #26822 Co-Authored-By: Claude Opus 4.5 <noreply(a)anthropic.com> - - - - - 661da815 by Teo Camarasu at 2026-03-26T03:50:33-04:00 ghc-internal: Float Generics to near top of module graph We remove GHC.Internal.Generics from the critical path of the `ghc-internal` module graph. GHC.Internal.Generics used to be in the middle of the module graph, but now it is nearer the top (built later). This change thins out the module graph and allows us to get rid of the ByteOrder hs-boot file. We implement this by moving Generics instances from the module where the datatype is defined to the GHC.Internal.Generics module. This trades off increasing the compiled size of GHC.Internal.Generics with reducing the dependency footprint of datatype modules. Not all instances are moved to GHC.Internal.Generics. For instance, `GHC.Internal.Control.Monad.Fix` keeps its instance as it is one of the very last modules compiled in `ghc-internal` and so inverting the relationship here would risk adding GHC.Internal.Generics back onto the critical path. We also don't change modules that are re-exported from the `template-haskell` or `ghc-heap`. This is done to make it easy to eventually move `Generics` to `base` once something like #26657 is implemented. Resolves #26930 Metric Decrease: T21839c - - - - - 45428f88 by sheaf at 2026-03-26T03:51:31-04:00 Avoid infinite loop in deep subsumption This commit ensures we only unify after we recur in the deep subsumption code in the FunTy vs non-FunTy case of GHC.Tc.Utils.Unify.tc_sub_type_deep, to avoid falling into an infinite loop. See the new Wrinkle [Avoiding a loop in tc_sub_type_deep] in Note [FunTy vs non-FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify. Fixes #26823 Co-authored-by: simonpj <simon.peytonjones(a)gmail.com> - - - - - 2823b039 by Ian Duncan at 2026-03-26T03:52:21-04:00 AArch64: fix MOVK regUsageOfInstr to mark dst as both read and written MOVK (move with keep) modifies only a 16-bit slice of the destination register, so the destination is both read and written. The register allocator must know this to avoid clobbering live values. Update regUsageOfInstr to list the destination in both src and dst sets. No regression test: triggering the misallocation requires specific register pressure around a MOVK sequence, which is difficult to reliably provoke from Haskell source. - - - - - 57b7878d by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #12002 Closes #12002. - - - - - c8f9df2d by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #12046 Closes #12046. Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at> - - - - - 615d72ac by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #13180 Closes #13180. - - - - - 423eebcf by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #11141 Closes #11141. - - - - - 286849a4 by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #11505 Closes #11505. - - - - - 7db149d9 by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression perf test for #13820 Closes #13820. - - - - - e73c4adb by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #10381 Closes #10381. - - - - - 5ebcfb57 by Benjamin Maurer at 2026-03-26T03:54:02-04:00 Generate assembly on x86 for word2float (#22252) We used to emit C function call for MO_UF_Conv primitive. Now emits direct assembly instead. Co-Authored-By: Sylvain Henry <sylvain(a)haskus.fr> Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com> - - - - - 5b550754 by Matthew Pickering at 2026-03-26T03:54:51-04:00 rts: forward clone-stack messages after TSO migration MSG_CLONE_STACK assumed that the target TSO was still owned by the capability that received the message. This is not always true: the TSO can migrate before the inbox entry is handled. When that happened, handleCloneStackMessage could clone a live stack from the wrong capability and use the wrong capability for allocation and performTryPutMVar, leading to stack sanity failures such as checkStackFrame: weird activation record found on stack. Fix this by passing the current capability into handleCloneStackMessage, rechecking msg->tso->cap at handling time, and forwarding the message if the TSO has migrated. Once ownership matches, use the executing capability consistently for cloneStack, rts_apply, and performTryPutMVar. Fixes #27008 - - - - - ef0a1bd2 by mangoiv at 2026-03-26T03:55:34-04:00 release tracking: adopt release tracking ticket from #16816 - - - - - a7f40fd9 by mangoiv at 2026-03-26T03:55:34-04:00 release tracking: add a release tracking ticket Brings the information in the release tracking ticket up to date with https://gitlab.haskell.org/ghc/ghc-hq/-/blob/main/release-management.mkd Resolves #26691 - - - - - 161d3285 by Teo Camarasu at 2026-03-26T03:56:18-04:00 Revert "Set default eventlog-flush-interval to 5s" Flushing the eventlog forces a synchronisation of all the capabilities and there was a worry that this might lead to a performance cost for some highly parallel workloads. This reverts commit 66b96e2a591d8e3d60e74af3671344dfe4061cf2. - - - - - 36eed985 by Cheng Shao at 2026-03-26T03:57:03-04:00 ghc-boot: move GHC.Data.SmallArray to ghc-boot This commit moves `GHC.Data.SmallArray` from the `ghc` library to `ghc-boot`, so that it can be used by `ghci` as well: - The `Binary` (from `ghc`) instance of `SmallArray` is moved to `GHC.Utils.Binary` - Util functions `replicateSmallArrayIO`, `mapSmallArrayIO`, `mapSmallArrayM_`, `imapSmallArrayM_` , `smallArrayFromList` and `smallArrayToList` are added - The `Show` instance is added - The `Binary` (from `binary`) instance is added - - - - - fdf828ae by Cheng Shao at 2026-03-26T03:57:03-04:00 compiler: use `Binary` instance of `BCOByteArray` for bytecode objects This commit defines `Binary` (from `compiler`) instance of `BCOByteArray` which serializes the underlying buffer directly, and uses it directly in bytecode object serialization. Previously we reuse the `Binary` (from `binary`) instance, and this change allows us to avoid double-copying via an intermediate `ByteString` when using `put`/`get` in `binnary`. Also see added comment for explanation. - - - - - 3bf62d0a by Cheng Shao at 2026-03-26T03:57:03-04:00 ghci: use SmallArray directly in ResolvedBCO This patch makes ghci use `SmallArray` directly in `ResolvedBCO` when applicable, making the memory representation more compact and reducing marshaling overhead. Closes #27058. - - - - - 3d6492ce by Wen Kokke at 2026-03-26T03:57:53-04:00 Fix race condition between flushEventLog and start/endEventLogging. This commit changes `flushEventLog` to acquire/release the `state_change` mutex to prevent interleaving with `startEventLogging` and `endEventLogging`. In the current RTS, `flushEventLog` _does not_ acquire this mutex, which may lead to eventlog corruption on the following interleaving: - `startEventLogging` writes the new `EventLogWriter` to `event_log_writer`. - `flushEventLog` flushes some events to `event_log_writer`. - `startEventLogging` writes the eventlog header to `event_log_writer`. This causes the eventlog to be written out in an unreadable state, with one or more events preceding the eventlog header. This commit renames the old function to `flushEventLog_` and defines `flushEventLog` simply as: ```c void flushEventLog(Capability **cap USED_IF_THREADS) { ACQUIRE_LOCK(&state_change_mutex); flushEventLog_(cap); RELEASE_LOCK(&state_change_mutex); } ``` The old function is still needed internally within the compilation unit, where it is used in `endEventLogging` in a context where the `state_change` mutex has already been acquired. I've chosen to mark `flushEventLog_` as static and let other uses of `flushEventLog` within the RTS refer to the new version. There is one use in `hs_init_ghc` via `flushTrace`, where the new locking behaviour should be harmless, and one use in `handle_tick`, which I believe was likely vulnerable to the same race condition, so the new locking behaviour is desirable. I have not added a test. The behaviour is highly non-deterministic and requires a program that concurrently calls `flushEventLog` and `startEventLogging`/`endEventLogging`. I encountered the issue while developing `eventlog-socket` and within that context have verified that my patch likely addresses the issue: a test that used to fail within the first dozen or so runs now has been running on repeat for several hours. - - - - - 7b9a75f0 by Phil Hazelden at 2026-03-26T03:58:37-04:00 Fix build with werror on glibc 2.43. We've been defining `_XOPEN_SOURCE` and `_POSIX_C_SOURCE` to the same values as defined in glibc prior to 2.43. But in 2.43, glibc changes them to new values, which means we get a warning when redefining them. By `#undef`ing them first, we no longer get a warning. Closes #27076. - - - - - fe6e76c5 by Tobias Haslop at 2026-03-26T03:59:30-04:00 Fix broken Haddock link to Bifunctor class in description of Functor class - - - - - 404b71c1 by Luite Stegeman at 2026-03-27T04:40:49-04:00 Fix assert in Interpreter.c If we skip exactly the number of words on the stack we end up on the first word in the next chunk. - - - - - a85bd503 by Luite Stegeman at 2026-03-27T04:40:49-04:00 Support arbitrary size unboxed tuples in bytecode This stores the size (number of words on the stack) of the next expected tuple in the TSO, ctoi_spill_size field, eliminating the need of stg_ctoi_tN frames for each size. Note: On 32 bit platform there is still a bytecode tuple size limit of 255 words on the stack. Fixes #26946 - - - - - e2209031 by Luite Stegeman at 2026-03-27T04:40:49-04:00 Add specialized frames for small tuples Small tuples are now returned more efficiently to the interpreter. They use one less word of stack space and don't need manipulation of the TSO anymore. - - - - - b26bb2ea by VeryMilkyJoe at 2026-03-27T04:41:38-04:00 Remove backwards compatibility pattern synonym `ModLocation` Fixes #24932 - - - - - 66e5e324 by Vladislav Zavialov at 2026-03-27T04:42:25-04:00 Extend HsExpr with the StarIsType syntax (#26587, #26967) This patch allows kinds of the form `k -> *` and `* -> k` to occur in expression syntax, i.e. to be used as required type arguments. For example: {-# LANGUAGE RequiredTypeArguments, StarIsType #-} x1 = f (* -> * -> *) x2 = f (forall k. k -> *) x3 = f ((* -> *) -> Constraint) Summary of the changes: * Introduce the HsStar constructor of HsExpr and its extension field XStar. It is analogous to HsStarTy in HsType. * Refactor HsStarTy to store the unicode flag as TokStar, defined as type TokStar = EpUniToken "*" "★" -- similar to TokForall, TokRArrow, etc. The token is stored in the extension field and replaces the Bool field. * Extend the `infixexp2` nonterminal to parse `*` as a direct argument of `->`. This is more limited than the full StarIsType syntax, but has the nice property of not conflicting with the multiplication operator `a * b`. Test case: T26967 T26967_tyop - - - - - f8de456f by Sylvain Henry at 2026-03-27T04:43:22-04:00 STM: don't create a transaction in the rhs of catchRetry# (#26028) We don't need to create a transaction for the rhs of (catchRetry#) because contrary to the lhs we don't need to abort it on retry. Moreover it is particularly harmful if we have code such as (#26028): let cN = readTVar vN >> retry tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...)) atomically tree Because it will stack transactions for the rhss and the read-sets of all the transactions will be iteratively merged in O(n^2) after the execution of the most nested retry. This is the second attempt at implementing this. The first attempt triggered segfaults (#26291) and has been reverted. Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com> - - - - - fcf092dd by Luite Stegeman at 2026-03-27T04:44:17-04:00 Windows: remove StgAsyncIOResult and fix crash/leaks In stg_block_async{_void}, a stack slot was reserved for an StgAsyncIOResult. This slot would be filled by the IO manager upon completion of the async call. However, if the blocked thread was interrupted by an async exception, we would end up in an invalid state: - If the blocked computation was never re-entered, the StgAsyncIOResult would never be freed. - If the blocked computation was re-entered, the thread would find an unitialized stack slot for the StgAsyncIOResult, leading to a crash reading its fields, or freeing the pointer. We fix this by removing the StgAsyncIOResult altogether and writing the result directly to the stack. Fixes #26341 - - - - - 05094993 by Luite Stegeman at 2026-03-27T04:45:12-04:00 Don't refine DEFAULT alt for unary typeclasses A non-DEFAULT data alt for a unary typeclass dictionary would interfere with Unary Class Magic, leading to segfaults. fixes #27071 - - - - - 4ee260cf by sheaf at 2026-03-27T04:46:06-04:00 Fix several oversights in hsExprType This commit fixes several oversights in GHC.Hs.Syn.Type.hsExprType: - The 'RecordCon' case was returning the type of the constructor, instead of the constructor application. This is fixed by using 'splitFunTys'. - The 'ExplicitTuple' case failed to take into account tuple sections, and was also incorrectly handling 1-tuples (e.g. 'Solo') which can be constructed using Template Haskell. - The 'NegApp' case was returning the type of the negation operator, again failing to apply it to the argument. Fixed by using 'funResultTy'. - The 'HsProc' case was computing the result type of the arrow proc block, without taking into account the argument type. Fix that by adding a new field to 'CmdTopTc' that stores the arrow type, so that we can construct the correct result type `arr a b` for `proc (pat :: a) -> (cmd :: b)`. - The 'ArithSeq' and 'NegApp' cases were failing to take into account the result 'HsWrapper', which could e.g. silently drop casts. This is fixed by introducing 'syntaxExpr_wrappedFunResTy' which, on top of taking the result type, applies the result 'HsWrapper'. These fixes are validated by the new GHC API test T26910. Fixes #26910 - - - - - e97232ce by Hai at 2026-03-27T04:47:04-04:00 Parser.y: avoid looking at token with QualifiedDo This changes the behavior of 'hintQualifiedDo' so that the supplied token is not inspected when the QualifiedDo language extension bit is set. - - - - - 9831385b by Vladislav Zavialov at 2026-03-27T17:22:30-04:00 Infix holes in types (#11107) This patch introduces several improvements that follow naturally from refactoring HsOpTy to represent the operator as an HsType, aligning it with the approach taken by OpApp and HsExpr. User-facing changes: 1. Infix holes (t1 `_` t2) are now permitted in types, following the precedent set by term-level expressions. Test case: T11107 2. Error messages for illegal promotion ticks are now reported at more precise source locations. Test case: T17865 Internal changes: * The definition of HsOpTy now mirrors that of OpApp: | HsOpTy (XOpTy p) (LHsType p) (LHsType p) (LHsType p) | OpApp (XOpApp p) (LHsExpr p) (LHsExpr p) (LHsExpr p) This moves us one step closer to unifying HsType and HsExpr. * Ignoring locations, the old pattern match (HsOpTy x prom lhs op rhs) is now written as (HsOpTy x lhs (HsTyVar x' prom op) rhs) but we also handle (HsOpTy x lhs (HsWildCardTy x') rhs) Constructors other than HsTyVar and HsWildCardTy never appear in the operator position. * The various definitions across the compiler have been updated to work with the new representation, drawing inspiration from the term-level pipeline where appropriate. For example, ppr_infix_ty <=> ppr_infix_expr get_tyop <=> get_op lookupTypeFixityRn <=> lookupExprFixityRn (the latter is factored out from rnExpr) Test cases: T11107 T17865 - - - - - 5b6757d7 by mangoiv at 2026-03-27T17:23:19-04:00 ci: build i386 non-validate for deb12 This is a small fix that will unlock ghcup metadata to run, i386 debian 12 was missing as a job. - - - - - cf942119 by Cheng Shao at 2026-03-30T15:24:37-04:00 ghc-boot: remove unused SizedSeq instances and functions This commit removes unused `SizedSeq` instances and functions, only keeping the bits we need for hpc tick sequence for now. - - - - - 22c5b7cc by Cheng Shao at 2026-03-30T15:24:38-04:00 ghci: remove unused GHCi.BinaryArray This patch removes the unused `GHCi.BinaryArray` module from `ghci`. Closes #27108. - - - - - 77abb4ab by Cheng Shao at 2026-03-30T15:25:21-04:00 testsuite: mark T17912 as fragile on Windows T17912 is still fragile on Windows, it sometimes unexpectedly pass in CI. This especially strains our already scarce Windows CI runner resources. Mark it as fragile on Windows for the time being. - - - - - d741a6cc by Andreas Klebinger at 2026-03-31T04:39:33-04:00 Bump minimum shake version for hadrian. We also add the shake version we want to stack.yaml Fixes #26884 - - - - - 5e556f9e by Vladislav Zavialov at 2026-03-31T04:40:16-04:00 Status check for the HsType~HsExpr refactoring (#25121) Add a test case to track the status of a refactoring project within GHC whose goal is to arrive at the following declaration: type HsType = HsExpr The rationale for this is to increase code reuse between the term- and type-level code in the compiler front-end (AST, parser, renamer, type checker). The status report is saved to testsuite/tests/ghc-api/T25121_status.stdout and provides useful insights into what needs to happen to make progress on the ticket. - - - - - acffb1b1 by fendor at 2026-03-31T04:41:02-04:00 Extract Binary instances to `GHC.ByteCode.Binary` - - - - - e2ea8e25 by fendor at 2026-03-31T04:41:02-04:00 Add `seqNonEmpty` for evaluating `NonEmpty a` - - - - - 048b00b7 by fendor at 2026-03-31T04:41:02-04:00 Record `LinkableUsage` instead of `Linkable` in `LoaderState` Retaining a ByteCode `Linkable` after it has been loaded retains its `UnlinkedBCO`, keeping it alive for the remainder of the program. This starts accumulating a lot of `UnlinkedBCO` and memory over time. However, the `Linkable` is merely used to later record its usage in `mkObjectUsage`, which is used for recompilation checking. However, this is incorrect, as the interface file and bytecode objects could be in different states, e.g. the interface changes, but the bytecode library hasn't changed so we don't need to recompile and vice versa. By computing a `Fingerprint` for the `ModuleByteCode`, and recording it in the `LinkableUsage`, we know precisely whether the `ByteCode` object on disk is outdated. Thus, parts of this commit just makes sure that we efficiently compute a `Fingerprint` for `ModuleByteCode` and store it in the on-disk representation of `ModuleByteCode`. We change the `LoaderState` to retain `LinkableUsage`, which is smaller representation of a `Linkable`. This allows us to free the unneeded fields of `Linkable` after linking them. We declare the following memory invariants that this commit implements: * No `LinkablePart` should be retained from `LoaderState`. * `Linkable`s should be unloaded after they have been loaded. These invariants are unfortunately tricky to automatically uphold, so we are simply documenting our assumptions for now. We introduce the `linkable-space` test which makes sure that after loading, no `DotGBC` or `UnlinkedBCO` is retained. ------------------------- Metric Increase: MultiLayerModulesTH_OneShot ------------------------- We allocate a bit more, but the peak number of bytes doesn't change. While a bit unfortunate, accepting the metric increase. We add multiple new performance measurements where we were able to observe the desired memory invariants. Further, we add regression tests to validate that the recompilation checker behaves more correct than before. - - - - - 2d1c1997 by Simon Jakobi at 2026-03-31T04:41:46-04:00 Eliminate dictionary-passing in ListMap operations Mark the ListMap helpers 'INLINABLE' so importing modules can specialise the 'TrieMap (ListMap m)' methods and avoid recursive dictionary-passing. See Note [Making ListMap operations specialisable]. Fixes #27097 - - - - - ed2c6570 by Cheng Shao at 2026-03-31T04:42:33-04:00 testsuite: fix testdir cleanup logic on Windows testdir cleanup is unreliable on Windows (#13162) and despite existing hacks in the driver, new failure mode has occurred. This patch makes it print the warning and carry on when failed to clean up a testdir, instead of reporting a spurious framework failure. See added comment for detailed explanation. - - - - - d9388e29 by Simon Jakobi at 2026-03-31T13:14:59-04:00 Add regression test for #18177 Closes #18177. Assisted-by: Codex - - - - - 6a10045c by mangoiv at 2026-03-31T13:15:43-04:00 ci: allow metric decrease for two tests on i386 There has been a nightly failure on i386 due to a compiler runtime improvement on i386 debian 12. We allow that. Metric Decrease (test_env='i386-linux-deb12'): T12707 T8095 - - - - - 7fbb4fcb by Rodrigo Mesquita at 2026-04-01T12:16:33+00:00 Bump default language edition to GHC2024 As per the accepted ghc-proposal#632 Fixes #26039 - - - - - 533 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/flake.lock - .gitlab/generate-ci/gen_ci.hs - + .gitlab/issue_templates/release_tracking.md - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/ByteCode/Asm.hs - + compiler/GHC/ByteCode/Binary.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - + compiler/GHC/ByteCode/Recomp/Binary.hs - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/LA64/CodeGen.hs - compiler/GHC/CmmToAsm/LA64/Ppr.hs - compiler/GHC/CmmToAsm/LA64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - compiler/GHC/CmmToAsm/RV64/Regs.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Config.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/ConstantFold.hs - + compiler/GHC/Core/Opt/Range.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/AddImplicitBinds.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Types.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Linker/ByteCode.hs - compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - + compiler/GHC/Platform/Tag.hs - compiler/GHC/Prelude/Basic.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Fixity.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Utils.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/Literal.hs - + compiler/GHC/Types/Literal/Floating.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Unit/Home/ModInfo.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/Module/Location.hs - compiler/GHC/Unit/Module/Status.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Misc.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - docs/users_guide/9.16.1-notes.rst - docs/users_guide/exts/control.rst - docs/users_guide/exts/required_type_arguments.rst - docs/users_guide/utils.py - ghc/GHCi/Leak.hs - ghc/GHCi/UI.hs - ghc/Main.hs - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/src/Settings/Flavours/GhcInGhci.hs - hadrian/src/Settings/Flavours/Validate.hs - hadrian/src/Settings/Packages.hs - hadrian/stack.yaml - libraries/base/tests/IO/all.T - libraries/ghc-boot/GHC/Data/SizedSeq.hs - compiler/GHC/Data/SmallArray.hs → libraries/ghc-boot/GHC/Data/SmallArray.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/GHC/Stack/Decode/Experimental.hs - libraries/ghc-internal/src/GHC/Internal/Base.hs - libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs - − libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs-boot - libraries/ghc-internal/src/GHC/Internal/Char.hs - libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs - libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs - libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs - libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Version.hs - libraries/ghc-internal/src/GHC/Internal/Event/Control.hs - libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs - libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs - libraries/ghc-internal/src/GHC/Internal/Generics.hs - libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs - libraries/ghc-internal/src/GHC/Internal/IO/FD.hs - libraries/ghc-internal/src/GHC/Internal/Int.hs - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc - libraries/ghc-internal/src/GHC/Internal/Read.hs - libraries/ghc-internal/src/GHC/Internal/System/Environment.hs - libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs - libraries/ghc-internal/src/GHC/Internal/TopHandler.hs - libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs - − libraries/ghci/GHCi/BinaryArray.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/ResolvedBCO.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/GHCi/Server.hs - libraries/ghci/ghci.cabal.in - rts/Apply.cmm - rts/CloneStack.c - rts/CloneStack.h - rts/Continuation.c - rts/ContinuationOps.cmm - rts/HeapStackCheck.cmm - rts/IOManager.c - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/Printer.c - rts/RaiseAsync.c - rts/RtsFlags.c - rts/RtsSymbols.c - rts/STM.c - rts/STM.h - rts/Schedule.c - rts/StgCRun.c - rts/StgMiscClosures.cmm - rts/Threads.c - rts/Threads.h - rts/eventlog/EventLog.c - rts/include/rts/Bytecodes.h - rts/include/rts/Constants.h - rts/include/rts/PosixSource.h - rts/include/rts/storage/TSO.h - rts/include/stg/MiscClosures.h - rts/include/stg/Prim.h - rts/js/arith.js - rts/prim/vectorQuotRem.c - rts/rts.cabal - rts/win32/AsyncMIO.c - rts/win32/AsyncMIO.h - testsuite/driver/testlib.py - testsuite/tests/ado/ado004.hs - testsuite/tests/annotations/should_fail/annfail02.hs - testsuite/tests/annotations/should_fail/annfail02.stderr - testsuite/tests/array/should_run/arr020.hs - + testsuite/tests/bytecode/T27001.hs - + testsuite/tests/bytecode/T27001.stdout - + testsuite/tests/bytecode/TLinkable/BCOTemplate.hs - + testsuite/tests/bytecode/TLinkable/LinkableUsage01.stderr - + testsuite/tests/bytecode/TLinkable/LinkableUsage02.stderr - + testsuite/tests/bytecode/TLinkable/Makefile - + testsuite/tests/bytecode/TLinkable/all.T - + testsuite/tests/bytecode/TLinkable/genLinkables.sh - + testsuite/tests/bytecode/TLinkable/linkable-space.hs - + testsuite/tests/bytecode/TLinkable/linkable-space.stdout - testsuite/tests/bytecode/all.T - + testsuite/tests/bytecode/tuplestress/ByteCode.hs - + testsuite/tests/bytecode/tuplestress/Common.hs-incl - + testsuite/tests/bytecode/tuplestress/Obj.hs - + testsuite/tests/bytecode/tuplestress/TupleStress.hs - + testsuite/tests/bytecode/tuplestress/TupleStress.stdout - + testsuite/tests/bytecode/tuplestress/all.T - + testsuite/tests/codeGen/should_run/T21227.hs - + testsuite/tests/codeGen/should_run/T21227.stdout - + testsuite/tests/codeGen/should_run/T9811.hs - + testsuite/tests/codeGen/should_run/T9811.stdout - testsuite/tests/codeGen/should_run/Word2Float32.hs - testsuite/tests/codeGen/should_run/Word2Float32.stdout - testsuite/tests/codeGen/should_run/Word2Float64.hs - testsuite/tests/codeGen/should_run/Word2Float64.stdout - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/concurrent/should_run/T26341.hs - + testsuite/tests/concurrent/should_run/T26341.stdout - + testsuite/tests/concurrent/should_run/T26341a.hs - + testsuite/tests/concurrent/should_run/T26341a.stdout - + testsuite/tests/concurrent/should_run/T26341b.hs - + testsuite/tests/concurrent/should_run/T26341b.stdout - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/core-to-stg/T19700.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/deSugar/should_fail/DsStrictFail.hs - testsuite/tests/deriving/should_compile/T15798b.hs - testsuite/tests/deriving/should_compile/T15798c.hs - testsuite/tests/deriving/should_compile/T15798c.stderr - testsuite/tests/deriving/should_compile/T24955a.hs - testsuite/tests/deriving/should_compile/T24955a.stderr - testsuite/tests/deriving/should_compile/T24955b.hs - testsuite/tests/deriving/should_compile/T24955c.hs - testsuite/tests/deriving/should_fail/T10598_fail4.hs - testsuite/tests/deriving/should_fail/T10598_fail4.stderr - testsuite/tests/deriving/should_fail/T10598_fail5.hs - testsuite/tests/deriving/should_fail/T10598_fail5.stderr - testsuite/tests/dmdanal/sigs/T22241.hs - + testsuite/tests/driver/T13729/A/A.cabal - + testsuite/tests/driver/T13729/A/Setup.hs - + testsuite/tests/driver/T13729/A/TH.hs - + testsuite/tests/driver/T13729/A/Types1.hs - + testsuite/tests/driver/T13729/A/Types2.hs - + testsuite/tests/driver/T13729/B/B.cabal - + testsuite/tests/driver/T13729/B/Main.hs - + testsuite/tests/driver/T13729/B/Setup.hs - + testsuite/tests/driver/T13729/Makefile - + testsuite/tests/driver/T13729/Setup.hs - + testsuite/tests/driver/T13729/all.T - + testsuite/tests/driver/T18177.hs - testsuite/tests/driver/all.T - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout - + testsuite/tests/driver/recomp022/A1.hs - + testsuite/tests/driver/recomp022/A2.hs - + testsuite/tests/driver/recomp022/A3.hs - + testsuite/tests/driver/recomp022/B.hs - + testsuite/tests/driver/recomp022/C.hs - + testsuite/tests/driver/recomp022/Makefile - + testsuite/tests/driver/recomp022/all.T - + testsuite/tests/driver/recomp022/recomp022a.stdout - + testsuite/tests/driver/recomp022/recomp022b.stdout - + testsuite/tests/ffi/should_compile/T26852.h - + testsuite/tests/ffi/should_compile/T26852.hs - + testsuite/tests/ffi/should_compile/T26852.stderr - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/gadt/T20485.hs - + testsuite/tests/ghc-api/T25121_status.hs - + testsuite/tests/ghc-api/T25121_status.stdout - + testsuite/tests/ghc-api/T26910.hs - + testsuite/tests/ghc-api/T26910.stdout - + testsuite/tests/ghc-api/T26910_Input.hs - testsuite/tests/ghc-api/all.T - testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs - testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs - testsuite/tests/ghci.debugger/scripts/all.T - testsuite/tests/ghci.debugger/scripts/break012.hs - testsuite/tests/ghci.debugger/scripts/break012.stdout - + testsuite/tests/ghci/custom-external-interpreter-commands/Main.hs - + testsuite/tests/ghci/custom-external-interpreter-commands/all.T - + testsuite/tests/ghci/custom-external-interpreter-commands/custom-external-interpreter-commands.stdout - testsuite/tests/ghci/prog-mhu002/all.T - testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout - testsuite/tests/ghci/scripts/Makefile - testsuite/tests/ghci/scripts/T10963.stderr - testsuite/tests/ghci/scripts/ghci064.stdout - testsuite/tests/ghci/should_run/BinaryArray.hs - testsuite/tests/ghci/should_run/all.T - testsuite/tests/indexed-types/should_compile/T15322.hs - testsuite/tests/indexed-types/should_compile/T15322.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/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - + testsuite/tests/javascript/js-c-sources/T27033.hs - + testsuite/tests/javascript/js-c-sources/T27033.stdout - + testsuite/tests/javascript/js-c-sources/T27033_c.c - + testsuite/tests/javascript/js-c-sources/T27033_js.js - testsuite/tests/javascript/js-c-sources/all.T - + testsuite/tests/lib/stm/T26028.hs - + testsuite/tests/lib/stm/T26028.stdout - + testsuite/tests/lib/stm/T26291a.hs - + testsuite/tests/lib/stm/T26291a.stdout - + testsuite/tests/lib/stm/T26291b.hs - + testsuite/tests/lib/stm/T26291b.stdout - + testsuite/tests/lib/stm/all.T - testsuite/tests/linear/should_fail/T18888.hs - testsuite/tests/module/T20007.hs - testsuite/tests/module/T20007.stderr - testsuite/tests/module/mod90.hs - testsuite/tests/module/mod90.stderr - testsuite/tests/numeric/should_run/T7014.hs - + testsuite/tests/overloadedrecflds/should_compile/T26686.hs - + testsuite/tests/overloadedrecflds/should_compile/T26686.stderr - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.hs - testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.hs - testsuite/tests/overloadedrecflds/should_fail/all.T - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - + testsuite/tests/parser/should_compile/T12002.hs - + testsuite/tests/parser/should_compile/T12002.stderr - testsuite/tests/parser/should_compile/all.T - testsuite/tests/parser/should_fail/ParserNoLambdaCase.hs - testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr - testsuite/tests/parser/should_fail/T16270h.hs - testsuite/tests/parser/should_fail/T16270h.stderr - testsuite/tests/parser/should_fail/T17865.stderr - testsuite/tests/parser/should_fail/readFail001.hs - testsuite/tests/parser/should_fail/readFail001.stderr - testsuite/tests/partial-sigs/should_compile/SomethingShowable.hs - + testsuite/tests/partial-sigs/should_compile/T11107.hs - + testsuite/tests/partial-sigs/should_compile/T11107.stderr - testsuite/tests/partial-sigs/should_compile/all.T - + testsuite/tests/perf/compiler/T13820.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/plugins/late-plugin/LatePlugin.hs - testsuite/tests/polykinds/T7151.hs - testsuite/tests/polykinds/T7151.stderr - testsuite/tests/polykinds/T7433.hs - testsuite/tests/polykinds/T7433.stderr - testsuite/tests/programs/andy_cherry/test.T - + testsuite/tests/rebindable/T10381.hs - testsuite/tests/rebindable/all.T - testsuite/tests/rename/should_fail/T10668.hs - testsuite/tests/rename/should_fail/T10668.stderr - testsuite/tests/rename/should_fail/T12681.hs - testsuite/tests/rename/should_fail/T12681.stderr - testsuite/tests/rename/should_fail/T13568.hs - testsuite/tests/rename/should_fail/T13568.stderr - testsuite/tests/rename/should_fail/T13644.hs - testsuite/tests/rename/should_fail/T13644.stderr - testsuite/tests/rename/should_fail/T13847.hs - testsuite/tests/rename/should_fail/T13847.stderr - testsuite/tests/rename/should_fail/T14032c.hs - testsuite/tests/rename/should_fail/T19843l.hs - testsuite/tests/rename/should_fail/T19843l.stderr - testsuite/tests/rename/should_fail/T25901_imp_hq_fail_5.stderr - testsuite/tests/rename/should_fail/T25901_imp_sq_fail_2.stderr - testsuite/tests/rename/should_fail/T5385.hs - testsuite/tests/rename/should_fail/T5385.stderr - testsuite/tests/roles/should_fail/Roles5.hs - testsuite/tests/roles/should_fail/Roles5.stderr - testsuite/tests/rts/all.T - + testsuite/tests/rts/cloneThreadStackMigrating.hs - + testsuite/tests/rts/resizeMutableByteArrayInPlace.hs - testsuite/tests/showIface/DocsInHiFile.hs - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.hs - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/DocsInHiFileTHExternal.hs - testsuite/tests/showIface/HaddockIssue849.hs - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/HaddockOpts.hs - testsuite/tests/showIface/HaddockOpts.stdout - testsuite/tests/showIface/HaddockSpanIssueT24378.hs - testsuite/tests/showIface/HaddockSpanIssueT24378.stdout - testsuite/tests/showIface/MagicHashInHaddocks.hs - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/Makefile - testsuite/tests/showIface/NoExportList.hs - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/showIface/PragmaDocs.stdout - testsuite/tests/showIface/ReExports.stdout - + testsuite/tests/simd/should_run/FloatConstant.hs - + testsuite/tests/simd/should_run/FloatConstant.stdout - + testsuite/tests/simd/should_run/IntConstant.hs - + testsuite/tests/simd/should_run/IntConstant.stdout - + testsuite/tests/simd/should_run/StackAlignment32.hs - + testsuite/tests/simd/should_run/StackAlignment32.stdout - + testsuite/tests/simd/should_run/StackAlignment32_main.c - + testsuite/tests/simd/should_run/StackAlignment64.hs - + testsuite/tests/simd/should_run/StackAlignment64.stdout - + testsuite/tests/simd/should_run/StackAlignment64_main.c - testsuite/tests/simd/should_run/all.T - testsuite/tests/simd/should_run/int16x8_shuffle.hs - testsuite/tests/simd/should_run/int16x8_shuffle.stdout - testsuite/tests/simd/should_run/int16x8_shuffle_baseline.hs - testsuite/tests/simd/should_run/int16x8_shuffle_baseline.stdout - testsuite/tests/simd/should_run/int8x16_shuffle.hs - testsuite/tests/simd/should_run/int8x16_shuffle.stdout - testsuite/tests/simd/should_run/int8x16_shuffle_baseline.hs - testsuite/tests/simd/should_run/int8x16_shuffle_baseline.stdout - testsuite/tests/simd/should_run/simd013C.c - testsuite/tests/simplCore/T9646/test.T - + testsuite/tests/simplCore/should_compile/T18032.hs - + testsuite/tests/simplCore/should_compile/T18032.stderr - + testsuite/tests/simplCore/should_compile/T19166.hs - + testsuite/tests/simplCore/should_compile/T19166.stderr - testsuite/tests/simplCore/should_compile/T21960.hs - + testsuite/tests/simplCore/should_compile/T25718.hs - + testsuite/tests/simplCore/should_compile/T25718.stderr - + testsuite/tests/simplCore/should_compile/T25718a.hs - + testsuite/tests/simplCore/should_compile/T25718a.stderr - + testsuite/tests/simplCore/should_compile/T25718b.hs - + testsuite/tests/simplCore/should_compile/T25718b.stderr - + testsuite/tests/simplCore/should_compile/T25718c.hs - + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32 - + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64 - testsuite/tests/simplCore/should_compile/T26709.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/simplCore/should_run/T27071.hs - + testsuite/tests/simplCore/should_run/T27071.stdout - testsuite/tests/simplCore/should_run/all.T - testsuite/tests/simplStg/should_run/all.T - + testsuite/tests/simplStg/should_run/unpack_enum.hs - + testsuite/tests/simplStg/should_run/unpack_enum.stdout - testsuite/tests/th/TH_Promoted1Tuple.hs - testsuite/tests/th/TH_Roles1.hs - + testsuite/tests/typecheck/T13180/T13180.hs - + testsuite/tests/typecheck/T13180/T13180.hs-boot - + testsuite/tests/typecheck/T13180/T13180.stderr - + testsuite/tests/typecheck/T13180/T13180A.hs - + testsuite/tests/typecheck/T13180/all.T - testsuite/tests/typecheck/should_compile/MutRec.hs - testsuite/tests/typecheck/should_compile/T10770a.hs - + testsuite/tests/typecheck/should_compile/T11141.hs - + testsuite/tests/typecheck/should_compile/T11141.stderr - testsuite/tests/typecheck/should_compile/T11339.hs - testsuite/tests/typecheck/should_compile/T11397.hs - + testsuite/tests/typecheck/should_compile/T11505Bar.hs - + testsuite/tests/typecheck/should_compile/T11505Foo.hs - + testsuite/tests/typecheck/should_compile/T11505Foo.hs-boot - + testsuite/tests/typecheck/should_compile/T12046.hs - testsuite/tests/typecheck/should_compile/T13526.hs - testsuite/tests/typecheck/should_compile/T18467.hs - testsuite/tests/typecheck/should_compile/T18467.stderr - testsuite/tests/typecheck/should_compile/T26225.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/tc081.hs - testsuite/tests/typecheck/should_compile/tc141.hs - testsuite/tests/typecheck/should_fail/T23427.hs - + testsuite/tests/typecheck/should_fail/T26823.hs - + testsuite/tests/typecheck/should_fail/T26823.stderr - testsuite/tests/typecheck/should_fail/T6078.hs - testsuite/tests/typecheck/should_fail/T7453.hs - testsuite/tests/typecheck/should_fail/T7453.stderr - testsuite/tests/typecheck/should_fail/T8570.hs - testsuite/tests/typecheck/should_fail/T8570.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail083.hs - testsuite/tests/typecheck/should_fail/tcfail083.stderr - testsuite/tests/typecheck/should_fail/tcfail084.hs - testsuite/tests/typecheck/should_fail/tcfail084.stderr - testsuite/tests/typecheck/should_fail/tcfail094.hs - testsuite/tests/typecheck/should_fail/tcfail094.stderr - testsuite/tests/typecheck/should_run/T1735.hs - testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs - testsuite/tests/typecheck/should_run/T3731.hs - + testsuite/tests/vdq-rta/should_compile/T26967.hs - + testsuite/tests/vdq-rta/should_compile/T26967.stderr - + testsuite/tests/vdq-rta/should_compile/T26967_tyop.hs - + testsuite/tests/vdq-rta/should_compile/T26967_tyop.stderr - testsuite/tests/vdq-rta/should_compile/all.T - testsuite/tests/vdq-rta/should_fail/T24159_type_syntax_th_fail.script - testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs - testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr - testsuite/tests/warnings/should_fail/T24396c.hs - testsuite/tests/warnings/should_fail/T24396c.stderr - utils/check-exact/ExactPrint.hs - utils/deriveConstants/Main.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Interface/RenameType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9fb7c2cb95e3fed41edc57cd5dd9db… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9fb7c2cb95e3fed41edc57cd5dd9db… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/mangoiv/fix-bug-template
by Magnus (＠MangoIV) 01 Apr '26

01 Apr '26

Magnus pushed new branch wip/mangoiv/fix-bug-template at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mangoiv/fix-bug-template You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/fix-static-001-darwin] testsuite: filter stderr for static001 on darwin
by Magnus (＠MangoIV) 01 Apr '26

01 Apr '26

Magnus pushed to branch wip/mangoiv/fix-static-001-darwin at Glasgow Haskell Compiler / GHC Commits: 244ded63 by mangoiv at 2026-04-01T13:06:59+02:00 testsuite: filter stderr for static001 on darwin This reactivates the test on x86_64 darwin as this should have been done long ago and ignores warnings emitted by ranlib on newer version of the darwin toolchain since they are benign. (no symbols for stub libraries) Fixes #27116 - - - - - 2 changed files: - testsuite/driver/testlib.py - testsuite/tests/driver/all.T Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -3043,6 +3043,12 @@ def normalise_errmsg(s: str) -> str: # Old emcc warns when we export HEAP8 but new one requires it (see #26290) s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','') + # on newer versions of MacOS X, the shipped ranlib warns about object files with no symbols, + # however, these are completely benign stubs. + # See https://gitlab.haskell.org/ghc/ghc/-/issues/27116 + if opsys('darwin'): + modify_lines(s, lambda l: re.sub(r'.*ranlib:.*has no symbols', '', l)) + return s # normalise a .prof file, so that we can reasonably compare it against ===================================== testsuite/tests/driver/all.T ===================================== @@ -120,9 +120,7 @@ if config.os == 'darwin': else: only_darwin = skip -test('static001', [extra_files(['Static001.hs']), - only_darwin, - when(arch('x86_64'), expect_broken(8127))], +test('static001', [extra_files(['Static001.hs']), only_darwin], makefile_test, ['static001']) test('dynHelloWorld', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/244ded63574c96d574f05ac6ce7fc22… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/244ded63574c96d574f05ac6ce7fc22… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/27131] New rts Message to {set,unset} TSO flags
by Rodrigo Mesquita (＠alt-romes) 01 Apr '26

01 Apr '26

Rodrigo Mesquita pushed to branch wip/romes/27131 at Glasgow Haskell Compiler / GHC Commits: 35a63ae8 by Rodrigo Mesquita at 2026-04-01T12:03:26+01:00 New rts Message to {set,unset} TSO flags This commit introduces stg_MSG_SET_TSO_FLAG_info and stg_MSG_UNSET_TSO_FLAG_info, which allows setting flags of a TSO other than yourself. This is especially useful/necessary to set breakpoints and toggle breakpoints of different threads, which is needed to safely implement features like pausing, toggling step-out, toggling step-in per thread, etc. Fixes #27131 - - - - - 7 changed files: - rts/Interpreter.c - rts/Messages.c - rts/StgMiscClosures.cmm - rts/Threads.c - rts/Threads.h - rts/include/rts/storage/Closures.h - rts/include/stg/MiscClosures.h Changes: ===================================== rts/Interpreter.c ===================================== @@ -416,12 +416,22 @@ void rts_disableStopNextBreakpointAll(void) void rts_enableStopNextBreakpoint(StgTSO* tso) { - tso->flags |= TSO_STOP_NEXT_BREAKPOINT; +#if defined(THREADED_RTS) + Capability* cap = rts_unsafeGetMyCapability(); + setThreadFlag(cap, tso, TSO_STOP_NEXT_BREAKPOINT); +#else + tso->flags |= TSO_STOP_NEXT_BREAKPOINT; +#endif } void rts_disableStopNextBreakpoint(StgTSO* tso) { - tso->flags &= ~TSO_STOP_NEXT_BREAKPOINT; +#if defined(THREADED_RTS) + Capability* cap = rts_unsafeGetMyCapability(); + unsetThreadFlag(cap, tso, TSO_STOP_NEXT_BREAKPOINT); +#else + tso->flags &= ~TSO_STOP_NEXT_BREAKPOINT; +#endif } /* --------------------------------------------------------------------------- @@ -430,12 +440,22 @@ void rts_disableStopNextBreakpoint(StgTSO* tso) void rts_enableStopAfterReturn(StgTSO* tso) { +#if defined(THREADED_RTS) + Capability* cap = rts_unsafeGetMyCapability(); + setThreadFlag(cap, tso, TSO_STOP_AFTER_RETURN); +#else tso->flags |= TSO_STOP_AFTER_RETURN; +#endif } void rts_disableStopAfterReturn(StgTSO* tso) { +#if defined(THREADED_RTS) + Capability* cap = rts_unsafeGetMyCapability(); + unsetThreadFlag(cap, tso, TSO_STOP_AFTER_RETURN); +#else tso->flags &= ~TSO_STOP_AFTER_RETURN; +#endif } /* ===================================== rts/Messages.c ===================================== @@ -35,7 +35,9 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg) i != &stg_MSG_TRY_WAKEUP_info && i != &stg_IND_info && // can happen if a MSG_BLACKHOLE is revoked i != &stg_WHITEHOLE_info && - i != &stg_MSG_CLONE_STACK_info) { + i != &stg_MSG_CLONE_STACK_info && + i != &stg_MSG_SET_TSO_FLAG_info && + i != &stg_MSG_UNSET_TSO_FLAG_info) { barf("sendMessage: %p", i); } } @@ -137,6 +139,16 @@ loop: MessageCloneStack *cloneStackMessage = (MessageCloneStack*) m; handleCloneStackMessage(cap, cloneStackMessage); } + else if(i == &stg_MSG_SET_TSO_FLAG_info){ + MessageUpdTSOFlag *u = (MessageUpdTSOFlag*) m; + u->tso->flags |= u->flag; + return; + } + else if(i == &stg_MSG_UNSET_TSO_FLAG_info){ + MessageUpdTSOFlag *u = (MessageUpdTSOFlag*) m; + u->tso->flags &= ~u->flag; + return; + } else { barf("executeMessage: %p", i); ===================================== rts/StgMiscClosures.cmm ===================================== @@ -855,6 +855,12 @@ INFO_TABLE_CONSTR(stg_MSG_NULL,1,0,0,PRIM,"MSG_NULL","MSG_NULL") INFO_TABLE_CONSTR(stg_MSG_CLONE_STACK,3,0,0,PRIM,"MSG_CLONE_STACK","MSG_CLONE_STACK") { ccall pbarf("stg_MSG_CLONE_STACK object (%p) entered!", R1 "ptr") never returns; } +INFO_TABLE_CONSTR(stg_MSG_SET_TSO_FLAG,3,0,0,PRIM,"MSG_SET_TSO_FLAG","MSG_SET_TSO_FLAG") +{ foreign "C" barf("stg_MSG_SET_TSO_FLAG object (%p) entered!", R1) never returns; } + +INFO_TABLE_CONSTR(stg_MSG_UNSET_TSO_FLAG,3,0,0,PRIM,"MSG_UNSET_TSO_FLAG","MSG_UNSET_TSO_FLAG") +{ foreign "C" barf("stg_MSG_UNSET_TSO_FLAG object (%p) entered!", R1) never returns; } + /* ---------------------------------------------------------------------------- END_TSO_QUEUE ===================================== rts/Threads.c ===================================== @@ -376,6 +376,38 @@ migrateThread (Capability *from, StgTSO *tso, Capability *to) tryWakeupThread(from, tso); } +/* ---------------------------------------------------------------------------- + {set,unset}ThreadFlag + + sets or unsets a flag in a given TSO + ------------------------------------------------------------------------- */ + +#if defined(THREADED_RTS) +static void +updThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag, const StgInfoTable* info); + +void setThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag) +{ + updThreadFlag(from, tso, flag, &stg_MSG_SET_TSO_FLAG_info); +} + +void unsetThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag) +{ + updThreadFlag(from, tso, flag, &stg_MSG_UNSET_TSO_FLAG_info); +} + +static void +updThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag, const StgInfoTable* info) +{ + MessageUpdTSOFlag *msg; + msg = (MessageUpdTSOFlag *)allocate(from,sizeofW(MessageUpdTSOFlag)); + msg->tso = tso; + msg->flag = flag; + SET_HDR(msg, info, CCS_SYSTEM); + sendMessage(from, tso->cap, (Message*)msg); +} +#endif + /* ---------------------------------------------------------------------------- awakenBlockedQueue ===================================== rts/Threads.h ===================================== @@ -19,6 +19,11 @@ void checkBlockingQueues (Capability *cap, StgTSO *tso); void tryWakeupThread (Capability *cap, StgTSO *tso); void migrateThread (Capability *from, StgTSO *tso, Capability *to); +#if defined(THREADED_RTS) +void setThreadFlag (Capability *from, StgTSO *tso, StgWord32 flag); +void unsetThreadFlag (Capability *from, StgTSO *tso, StgWord32 flag); +#endif + // Wakes up a thread on a Capability (probably a different Capability // from the one held by the current Task). // ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -620,6 +620,12 @@ typedef struct MessageCloneStack_ { StgTSO *tso; } MessageCloneStack; +typedef struct MessageUpdTSOFlag_ { + StgHeader header; + Message *link; + StgTSO *tso; + StgWord32 flag; +} MessageUpdTSOFlag; /* ---------------------------------------------------------------------------- Compact Regions ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -152,6 +152,8 @@ RTS_ENTRY(stg_MSG_TRY_WAKEUP); RTS_ENTRY(stg_MSG_THROWTO); RTS_ENTRY(stg_MSG_BLACKHOLE); RTS_ENTRY(stg_MSG_CLONE_STACK); +RTS_ENTRY(stg_MSG_SET_TSO_FLAG); +RTS_ENTRY(stg_MSG_UNSET_TSO_FLAG); RTS_ENTRY(stg_MSG_NULL); RTS_ENTRY(stg_MVAR_TSO_QUEUE); RTS_ENTRY(stg_catch); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35a63ae8952688d04a519741a5e06e4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35a63ae8952688d04a519741a5e06e4… You're receiving this email because of your account on gitlab.haskell.org.

1 0