June 2025 - ghc-commits

[Git][ghc/ghc][wip/T26115] 2 commits: Discard outer casts
by Simon Peyton Jones (＠simonpj) 20 Jun '25

20 Jun '25

Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: 649ab08b by Simon Peyton Jones at 2025-06-20T15:28:28+01:00 Discard outer casts - - - - - f0dc94fc by Simon Peyton Jones at 2025-06-20T17:36:07+01:00 Nearly there - - - - - 8 changed files: - compiler/GHC/Core.hs - compiler/GHC/HsToCore/Binds.hs - + testsuite/tests/simplCore/should_compile/T26115.hs - + testsuite/tests/simplCore/should_compile/T26115.stderr - + testsuite/tests/simplCore/should_compile/T26116.hs - + testsuite/tests/simplCore/should_compile/T26116.stderr - + testsuite/tests/simplCore/should_compile/T26117.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -39,7 +39,7 @@ module GHC.Core ( isId, cmpAltCon, cmpAlt, ltAlt, -- ** Simple 'Expr' access functions and predicates - bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, + bindersOf, bindersOfBinds, rhssOfBind, rhssOfBinds, rhssOfAlts, foldBindersOfBindStrict, foldBindersOfBindsStrict, collectBinders, collectTyBinders, collectTyAndValBinders, collectNBinders, collectNValBinders_maybe, @@ -2154,6 +2154,11 @@ rhssOfBind :: Bind b -> [Expr b] rhssOfBind (NonRec _ rhs) = [rhs] rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs] +rhssOfBinds :: [Bind b] -> [Expr b] +rhssOfBinds [] = [] +rhssOfBinds (NonRec _ rhs : bs) = rhs : rhssOfBinds bs +rhssOfBinds (Rec pairs : bs) = map snd pairs ++ rhssOfBinds bs + rhssOfAlts :: [Alt b] -> [Expr b] rhssOfAlts alts = [e | Alt _ _ e <- alts] ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -66,11 +66,11 @@ import GHC.Builtin.Types ( naturalTy, typeSymbolKind, charTy ) import GHC.Tc.Types.Evidence import GHC.Types.Id -import GHC.Types.Id.Info (IdDetails(..)) +import GHC.Types.Id.Info import GHC.Types.Name import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Types.Var( EvVar ) +import GHC.Types.Var( EvVar, mkLocalVar ) import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Unique.Set( nonDetEltsUniqSet ) @@ -1141,7 +1141,7 @@ dsSpec poly_rhs (SpecPrag poly_id spec_co spec_inl) dsSpec poly_rhs (SpecPragE { spe_fn_nm = poly_nm , spe_fn_id = poly_id - , spe_inl = inl + , spe_inl = spec_inl , spe_bndrs = bndrs , spe_call = the_call }) -- SpecPragE case: See Note [Handling new-form SPECIALISE pragmas] in GHC.Tc.Gen.Sig @@ -1149,68 +1149,134 @@ dsSpec poly_rhs (SpecPragE { spe_fn_nm = poly_nm unsetWOptM Opt_WarnIdentities $ zapUnspecables $ dsLExpr the_call - ; dsSpec_help poly_nm poly_id poly_rhs inl bndrs ds_call } + ; dsSpec_help poly_nm poly_id poly_rhs spec_inl bndrs ds_call } dsSpec_help :: Name -> Id -> CoreExpr -- Function to specialise -> InlinePragma -> [Var] -> CoreExpr -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule)) -dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call - = do { - -- Simplify the (desugared) call; see wrinkle (SP1) - -- in Note [Desugaring new-form SPECIALISE pragmas] - ; dflags <- getDynFlags - ; let simpl_opts = initSimpleOpts dflags - core_call = simpleOptExprNoInline simpl_opts ds_call - - ; case decomposeCall poly_id core_call of { - Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call) - ; return Nothing } ; - +dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call + = do { mb_call_info <- decomposeCall poly_id ds_call + ; case mb_call_info of { + Nothing -> return Nothing ; Just (binds, rule_lhs_args) -> - do { let locals = mkVarSet orig_bndrs `extendVarSetList` bindersOfBinds binds + do { dflags <- getDynFlags + ; this_mod <- getModule + ; uniq <- newUnique + ; let locals = mkVarSet orig_bndrs `extendVarSetList` bindersOfBinds binds is_local :: Var -> Bool is_local v = v `elemVarSet` locals rule_bndrs = scopedSort (exprsSomeFreeVarsList is_local rule_lhs_args) - rn_binds = getRenamings orig_bndrs binds rule_bndrs + rn_binds = getRenamings orig_bndrs binds rule_bndrs - spec_binds = pickSpecBinds is_local (mkVarSet rule_bndrs) - (rn_binds ++ binds) + spec_binds = pickSpecBinds is_local (mkVarSet rule_bndrs) binds + -- Make spec_bndrs, the variables to pass to the specialised + -- function, by filtering out the rule_bndrs that aren't needed spec_binds_bndr_set = mkVarSet (bindersOfBinds spec_binds) + `minusVarSet` exprsFreeVars (rhssOfBinds rn_binds) spec_bndrs = filterOut (`elemVarSet` spec_binds_bndr_set) rule_bndrs - mk_spec_body fn_body = mkLets spec_binds $ + mk_spec_body fn_body = mkLets (rn_binds ++ spec_binds) $ mkApps fn_body rule_lhs_args -- ToDo: not mkCoreApps! That uses exprType on fun which -- fails in specUnfolding, sigh + poly_name = idName poly_id + spec_occ = mkSpecOcc (getOccName poly_name) + spec_name = mkInternalName uniq spec_occ (getSrcSpan poly_name) + id_inl = idInlinePragma poly_id + + simpl_opts = initSimpleOpts dflags + fn_unf = realIdUnfolding poly_id + spec_unf = specUnfolding simpl_opts spec_bndrs mk_spec_body rule_lhs_args fn_unf + spec_info = vanillaIdInfo + `setInlinePragInfo` specFunInlinePrag poly_id id_inl spec_inl + `setUnfoldingInfo` spec_unf + spec_id = mkLocalVar (idDetails poly_id) spec_name ManyTy spec_ty spec_info + -- Specialised binding is toplevel, hence Many. + + -- The RULE looks like + -- RULE "USPEC" forall rule_bndrs. f rule_lhs_args = $sf spec_bndrs + -- The specialised function looks like + -- $sf spec_bndrs = mk_spec_body <f's original rhs> + -- We also use mk_spec_body to specialise the methods in f's stable unfolding + -- NB: spec_bindrs is a subset of rule_bndrs + rule = mkSpecRule dflags this_mod False rule_act (text "USPEC") + poly_id rule_bndrs rule_lhs_args + (mkVarApps (Var spec_id) spec_bndrs) + + rule_ty = exprType (mkApps (Var poly_id) rule_lhs_args) + spec_ty = mkLamTypes spec_bndrs rule_ty + spec_rhs = mkLams spec_bndrs (mk_spec_body poly_rhs) + + result = (unitOL (spec_id, spec_rhs), rule) + -- NB: do *not* use makeCorePair on (spec_id,spec_rhs), because + -- makeCorePair overwrites the unfolding, which we have + -- just created using specUnfolding ; tracePm "dsSpec(new route)" $ vcat [ text "poly_id" <+> ppr poly_id , text "unfolding" <+> ppr (realIdUnfolding poly_id) , text "orig_bndrs" <+> pprCoreBinders orig_bndrs + , text "locals" <+> ppr locals + , text "fvs" <+> ppr (exprsSomeFreeVarsList is_local rule_lhs_args) , text "ds_call" <+> ppr ds_call - , text "core_call" <+> ppr core_call , text "binds" <+> ppr binds - , text "rule_bndrs" <+> ppr rule_bndrs , text "rule_lhs_args" <+> ppr rule_lhs_args + , text "rule_bndrs" <+> ppr rule_bndrs , text "spec_bndrs" <+> ppr spec_bndrs , text "rn_binds" <+> ppr rn_binds , text "spec_binds" <+> ppr spec_binds ] - ; finishSpecPrag poly_nm poly_rhs - rule_bndrs poly_id rule_lhs_args - spec_bndrs mk_spec_body inl } } } + ; dsWarnOrphanRule rule + + ; case checkUselessSpecPrag poly_id rule_lhs_args spec_bndrs + no_act_spec spec_inl rule_act of + Nothing -> return (Just result) + + Just reason -> do { diagnosticDs $ DsUselessSpecialisePragma poly_nm is_dfun reason + ; if uselessSpecialisePragmaKeepAnyway reason + then return (Just result) + else return Nothing } } } } + + where + -- See Note [Activation pragmas for SPECIALISE] + -- no_act_spec is True if the user didn't write an explicit + -- phase specification in the SPECIALISE pragma + id_inl = idInlinePragma poly_id + inl_prag_act = inlinePragmaActivation id_inl + spec_prag_act = inlinePragmaActivation spec_inl + no_act_spec = case inlinePragmaSpec spec_inl of + NoInline _ -> isNeverActive spec_prag_act + Opaque _ -> isNeverActive spec_prag_act + _ -> isAlwaysActive spec_prag_act + rule_act | no_act_spec = inl_prag_act -- Inherit + | otherwise = spec_prag_act -- Specified by user + + is_dfun = case idDetails poly_id of + DFunId {} -> True + _ -> False decomposeCall :: Id -> CoreExpr - -> Maybe ( [CoreBind] - , [CoreExpr] ) -- Args of the call -decomposeCall poly_id binds - = go [] binds + -> DsM (Maybe ([CoreBind], [CoreExpr] )) +-- Decompose the call into (let <binds> in f <args>) +decomposeCall poly_id ds_call + = do { -- Simplify the (desugared) call; see wrinkle (SP1) + -- in Note [Desugaring new-form SPECIALISE pragmas] + ; dflags <- getDynFlags + ; let simpl_opts = initSimpleOpts dflags + core_call = simpleOptExprNoInline simpl_opts ds_call + + ; case go [] core_call of { + Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call) + ; return Nothing } ; + Just result -> return (Just result) } } where - go acc (Let bind body) - = go (bind:acc) body + go :: [CoreBind] -> CoreExpr -> Maybe ([CoreBind],[CoreExpr]) + go acc (Let bind body) = go (bind:acc) body + go acc (Cast e _) = go acc e -- Discard outer casts + -- ToDo: document this go acc e | (Var fun, args) <- collectArgs e = assertPpr (fun == poly_id) (ppr fun $$ ppr poly_id) $ @@ -1218,6 +1284,40 @@ decomposeCall poly_id binds | otherwise = Nothing + -- Is this SPECIALISE pragma useless? +checkUselessSpecPrag :: Id -> [CoreExpr] + -> [Var] -> Bool -> InlinePragma -> Activation + -> Maybe UselessSpecialisePragmaReason +checkUselessSpecPrag poly_id rule_lhs_args + spec_bndrs no_act_spec spec_inl rule_act + | isJust (isClassOpId_maybe poly_id) + -- There is no point in trying to specialise a class op + -- Moreover, classops don't (currently) have an inl_sat arity set + -- (it would be Just 0) and that in turn makes makeCorePair bleat + = Just UselessSpecialiseForClassMethodSelector + + | no_act_spec, isNeverActive rule_act + -- Function is NOINLINE, and the specialisation inherits that + -- See Note [Activation pragmas for SPECIALISE] + = Just UselessSpecialiseForNoInlineFunction + + | all is_nop_arg rule_lhs_args, not (isInlinePragma spec_inl) + -- The specialisation does nothing. + -- But don't complain if it is SPECIALISE INLINE (#4444) + = Just UselessSpecialiseNoSpecialisation + + | otherwise + = Nothing + + where + is_nop_arg (Type {}) = True + is_nop_arg (Coercion {}) = True + is_nop_arg (Cast e _) = is_nop_arg e + is_nop_arg (Tick _ e) = is_nop_arg e + is_nop_arg (Var x) = x `elem` spec_bndrs + is_nop_arg _ = False + + getRenamings :: [Var] -> [CoreBind] -- orig_bndrs and bindings -> [Var] -- rule_bndrs -> [CoreBind] -- Binds some of the orig_bndrs to a rule_bndr @@ -1238,8 +1338,8 @@ getRenamings orig_bndrs binds rule_bndrs go (bind : binds) | NonRec b rhs <- bind , Just (v, mco) <- getCastedVar rhs - , Just e <- lookupVarEnv renamings v - = extendVarEnv renamings b (mkCastMCo e (mkSymMCo mco)) + , Just e <- lookupVarEnv renamings b + = extendVarEnv renamings v (mkCastMCo e (mkSymMCo mco)) | otherwise = renamings where @@ -1256,201 +1356,12 @@ pickSpecBinds is_local known_bndrs (bind:binds) where keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs) bad_var v = is_local v && not (v `elemVarSet` known_bndrs) -{- -grabSpecBinds :: (Var -> Bool) -> VarSet -> [CoreBind] - -> ([CoreBind], [CoreBind]) -grabSpecBinds is_local rule_bndrs rev_binds - = (reverse rename_binds, spec_binds) - where - (known_bndrs, (rename_binds, other_binds)) - = get_renamings rule_bndrs ([],[]) rev_binds - spec_binds = pick_spec_binds known_bndrs other_binds - - ------------------------ - get_renamings :: VarSet -- Variables bound by a successful match on the call - -> ([CoreBind],[CoreBind]) -- Accumulating parameter, in order - -> [CoreBind] -- Reversed, innermost first - -> ( VarSet - , ([CoreBind] -- Renamings, in order - , [CoreBind])) -- Other bindings, in order - get_renamings bndrs acc [] = (bndrs, acc) - - get_renamings bndrs (rn_binds, other_binds) (bind : binds) - | NonRec d r <- bind - , d `elemVarSet` bndrs - , Just (v, mco) <- getCastedVar r - , is_local v - , let flipped_bind = NonRec v (mkCastMCo (Var d) (mkSymMCo mco)) - = get_renamings (bndrs `extendVarSet` v) - (flipped_bind:rn_binds, other_binds) - binds - | otherwise - = get_renamings bndrs - (rn_binds, bind:other_binds) - binds - - ------------------------ - pick_spec_binds :: VarSet -> [CoreBind] -> [CoreBind] - pick_spec_binds _ [] = [] - pick_spec_binds known_bndrs (bind:binds) - | all keep_me (rhssOfBind bind) - , let known_bndrs' = known_bndrs `extendVarSetList` bindersOf bind - = bind : pick_spec_binds known_bndrs' binds - | otherwise - = pick_spec_binds known_bndrs binds - where - keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs) - bad_var v = is_local v && not (v `elemVarSet` known_bndrs) --} getCastedVar :: CoreExpr -> Maybe (Var, MCoercionR) getCastedVar (Var v) = Just (v, MRefl) getCastedVar (Cast (Var v) co) = Just (v, MCo co) getCastedVar _ = Nothing -{- - where - go :: VarSet -- Quantified variables, or dependencies thereof - -> [CoreBind] -- Reversed list of constant evidence bindings - -> CoreExpr - -> Maybe (IdSet, [CoreBind], [CoreExpr]) - go qevs acc (Cast e _) - = go qevs acc e - go qevs acc (Let bind e) - | not (all (isPredTy . varType) bndrs) - -- A normal 'let' is too complicated - -- But we definitely include quantified constraints - -- E.g. this is fine: let (d :: forall a. Eq a => Eq (f a) = d2) - = Nothing - - -- (a) (1) in Note [prepareSpecLHS] - | all (transfer_to_spec_rhs qevs) $ - rhssOfBind bind -- One of the `const_binds` - = go qevs (bind:acc) e - - -- (a) (2) in Note [prepareSpecLHS] - | otherwise - = go (qevs `extendVarSetList` bndrs) acc e - where - bndrs = bindersOf bind - - go qevs acc e - | (Var fun, args) <- collectArgs e - -- (a) (3) in Note [prepareSpecLHS] - = assertPpr (fun == poly_id) (ppr fun $$ ppr poly_id) $ - Just (qevs, reverse acc, args) - | otherwise - = Nothing - - transfer_to_spec_rhs qevs rhs - where - is_quant_id v = isId v && v `elemVarSet` qevs - -- See (a) (2) in Note [prepareSpecLHS] --} - -finishSpecPrag :: Name -> CoreExpr -- RHS to specialise - -> [Var] -> Id -> [CoreExpr] -- RULE LHS pattern - -> [Var] -> (CoreExpr -> CoreExpr) -> InlinePragma -- Specialised form - -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule)) -finishSpecPrag poly_nm poly_rhs rule_bndrs poly_id rule_lhs_args - spec_bndrs mk_spec_body spec_inl - | Just reason <- mb_useless - = do { diagnosticDs $ DsUselessSpecialisePragma poly_nm is_dfun reason - ; if uselessSpecialisePragmaKeepAnyway reason - then Just <$> finish_prag - else return Nothing } - - | otherwise - = Just <$> finish_prag - - where - -- The RULE looks like - -- RULE "USPEC" forall rule_bndrs. f rule_lhs_args = $sf spec_bndrs - -- The specialised function looks like - -- $sf spec_bndrs = mk_spec_body <f's original rhs> - -- We also use mk_spec_body to specialise the methods in f's stable unfolding - -- NB: spec_bindrs is a subset of rule_bndrs - finish_prag - = do { this_mod <- getModule - ; uniq <- newUnique - ; dflags <- getDynFlags - ; let poly_name = idName poly_id - spec_occ = mkSpecOcc (getOccName poly_name) - spec_name = mkInternalName uniq spec_occ (getSrcSpan poly_name) - - simpl_opts = initSimpleOpts dflags - fn_unf = realIdUnfolding poly_id - spec_unf = specUnfolding simpl_opts spec_bndrs mk_spec_body rule_lhs_args fn_unf - spec_id = mkLocalId spec_name ManyTy spec_ty - -- Specialised binding is toplevel, hence Many. - `setInlinePragma` specFunInlinePrag poly_id id_inl spec_inl - `setIdUnfolding` spec_unf - - rule = mkSpecRule dflags this_mod False rule_act (text "USPEC") - poly_id rule_bndrs rule_lhs_args - (mkVarApps (Var spec_id) spec_bndrs) - - rule_ty = exprType (mkApps (Var poly_id) rule_lhs_args) - spec_ty = mkLamTypes spec_bndrs rule_ty - spec_rhs = mkLams spec_bndrs (mk_spec_body poly_rhs) - - ; dsWarnOrphanRule rule - - ; tracePm "dsSpec" (vcat - [ text "fun:" <+> ppr poly_id - , text "spec_bndrs:" <+> ppr spec_bndrs - , text "rule_lhs_args:" <+> ppr rule_lhs_args ]) - ; return (unitOL (spec_id, spec_rhs), rule) } - -- NB: do *not* use makeCorePair on (spec_id,spec_rhs), because - -- makeCorePair overwrites the unfolding, which we have - -- just created using specUnfolding - - -- Is this SPECIALISE pragma useless? - mb_useless :: Maybe UselessSpecialisePragmaReason - mb_useless - | isJust (isClassOpId_maybe poly_id) - -- There is no point in trying to specialise a class op - -- Moreover, classops don't (currently) have an inl_sat arity set - -- (it would be Just 0) and that in turn makes makeCorePair bleat - = Just UselessSpecialiseForClassMethodSelector - - | no_act_spec, isNeverActive rule_act - -- Function is NOINLINE, and the specialisation inherits that - -- See Note [Activation pragmas for SPECIALISE] - = Just UselessSpecialiseForNoInlineFunction - - | all is_nop_arg rule_lhs_args, not (isInlinePragma spec_inl) - -- The specialisation does nothing. - -- But don't complain if it is SPECIALISE INLINE (#4444) - = Just UselessSpecialiseNoSpecialisation - - | otherwise - = Nothing - - -- See Note [Activation pragmas for SPECIALISE] - -- no_act_spec is True if the user didn't write an explicit - -- phase specification in the SPECIALISE pragma - id_inl = idInlinePragma poly_id - inl_prag_act = inlinePragmaActivation id_inl - spec_prag_act = inlinePragmaActivation spec_inl - no_act_spec = case inlinePragmaSpec spec_inl of - NoInline _ -> isNeverActive spec_prag_act - Opaque _ -> isNeverActive spec_prag_act - _ -> isAlwaysActive spec_prag_act - rule_act | no_act_spec = inl_prag_act -- Inherit - | otherwise = spec_prag_act -- Specified by user - - is_nop_arg (Type {}) = True - is_nop_arg (Coercion {}) = True - is_nop_arg (Cast e _) = is_nop_arg e - is_nop_arg (Tick _ e) = is_nop_arg e - is_nop_arg (Var x) = x `elem` spec_bndrs - is_nop_arg _ = False - - is_dfun = case idDetails poly_id of - DFunId {} -> True - _ -> False - specFunInlinePrag :: Id -> InlinePragma -> InlinePragma -> InlinePragma -- See Note [Activation pragmas for SPECIALISE] ===================================== testsuite/tests/simplCore/should_compile/T26115.hs ===================================== @@ -0,0 +1,10 @@ +module T26115 where + +class C a b where { op1, op2 :: a -> b -> Bool + ; op2 = op1 } + +instance C Bool b where { op1 _ _ = True } + +instance C p q => C [p] q where + op1 [x] y = op1 x y + {-# SPECIALISE instance C [Bool] b #-} ===================================== testsuite/tests/simplCore/should_compile/T26115.stderr ===================================== @@ -0,0 +1,6 @@ +[GblId[DFunId], + Unf=DFun: \ (@b_awW) -> +[GblId[DFunId], + Unf=DFun: \ (@b_aBU) -> +[GblId[DFunId], + Unf=DFun: \ (@p_awR) (@q_awS) (v_B1 :: C p_awR q_awS) -> ===================================== testsuite/tests/simplCore/should_compile/T26116.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE QuantifiedConstraints #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} + +module T26116 where + +data T a = MkT a + +instance Eq (T a) where + x == y = True + +class (forall b. Eq (T b)) => D a where { dop :: a -> a } + +class C f a where { op1,op2 :: f a -> Int } + +instance (Eq (f a), D a) => C f a where + op1 x | x==x = 3 + | otherwise = 4 + {-# SPECIALISE instance D a => C T a #-} ===================================== testsuite/tests/simplCore/should_compile/T26116.stderr ===================================== @@ -0,0 +1,12 @@ + +==================== Tidy Core rules ==================== +"USPEC $cop1 @T @_" + forall (@a) ($dD :: D a) ($dEq :: Eq (T a)). + $fCTYPEfa_$cop1 @T @a $dEq $dD + = \ _ [Occ=Dead] -> I# 3# +"USPEC $fCTYPEfa @T @_" + forall (@a) ($dD :: D a) ($dEq :: Eq (T a)). + $fCTYPEfa @T @a $dEq $dD + = $fCTYPEfa_$s$fCTYPEfa @a $dD + + ===================================== testsuite/tests/simplCore/should_compile/T26117.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE UndecidableInstances, TypeFamilies #-} + +module T26117 where + +type family F a +type instance F Int = Bool + +class Eq (F a) => D a b where { dop1, dop2 :: a -> b -> b } + +class C a b where { op1,op2 :: F a -> a -> b -> Int } + +instance (Eq (F a), D a b) => C a [b] where + op1 x _ _ | x==x = 3 + | otherwise = 4 + {-# SPECIALISE instance D Int b => C Int [b] #-} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -548,3 +548,6 @@ test('T25965', normal, compile, ['-O']) test('T25703', [grep_errmsg(r'SPEC')], compile, ['-O -fpolymorphic-specialisation -ddump-rule-firings']) test('T25703a', [grep_errmsg(r'SPEC')], compile, ['-O -fpolymorphic-specialisation -ddump-rule-firings']) +test('T26115', [grep_errmsg(r'DFun')], compile, ['-O -ddump-simpl']) +test('T26116', normal, compile, ['-O -ddump-rules']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d765a87164bdffd2a6494108b3fbcf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d765a87164bdffd2a6494108b3fbcf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T25282] bump lint-whitespace containers upper-bound
by Teo Camarasu (＠teo) 20 Jun '25

20 Jun '25

Teo Camarasu pushed to branch wip/T25282 at Glasgow Haskell Compiler / GHC Commits: 44c4682d by Teo Camarasu at 2025-06-20T16:29:25+01:00 bump lint-whitespace containers upper-bound - - - - - 1 changed file: - linters/lint-whitespace/lint-whitespace.cabal Changes: ===================================== linters/lint-whitespace/lint-whitespace.cabal ===================================== @@ -24,7 +24,7 @@ executable lint-whitespace process ^>= 1.6, containers - >= 0.6 && <0.8, + >= 0.6 && <0.9, base >= 4.14 && < 5, text View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44c4682da95e578d0024f1728517f53… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44c4682da95e578d0024f1728517f53… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T25282] 10 commits: MachRegs.h: Don't define NO_ARG_REGS when a XMM register is defined
by Teo Camarasu (＠teo) 20 Jun '25

20 Jun '25

Teo Camarasu pushed to branch wip/T25282 at Glasgow Haskell Compiler / GHC Commits: e64b3f16 by ARATA Mizuki at 2025-06-17T10:13:42+09:00 MachRegs.h: Don't define NO_ARG_REGS when a XMM register is defined On i386, MAX_REAL_VANILLA_REG is 1, but MAX_REAL_XMM_REG is 4. If we define NO_ARG_REGS on i386, programs that use SIMD vectors may segfault. Closes #25985 A couple of notes on the BROKEN_TESTS field: * This fixes the segfault from T25062_V16. * The failure from T22187_run was fixed in an earlier commit (see #25561), but BROKEN_TESTS was missed at that time. Now should be a good time to mark it fixed. - - - - - 3e7c6b4d by Matthew Pickering at 2025-06-18T15:34:04-04:00 Improve error messages when implicit lifting fails This patch concerns programs which automatically try to fix level errors by inserting `Lift`. For example: ``` foo x = [| x |] ~> foo x = [| $(lift x) |] ``` Before, there were two problems with the message. 1. (#26031), the location of the error was reported as the whole quotation. 2. (#26035), the message just mentions there is no Lift instance, but gives no indicate why the user program needed a Lift instance in the first place. This problem is especially bad when you disable `ImplicitStagePersistence`, so you just end up with a confusing "No instance for" message rather than an error message about levels This patch fixes both these issues. Firstly, `PendingRnSplice` differentiates between a user-written splice and an implicit lift. Then, the Lift instance is precisely requested with a specific origin in the typechecker. If the instance fails to be solved, the message is reported using the `TcRnBadlyLevelled` constructor (like a normal level error). Fixes #26031, #26035 - - - - - 44b8cee2 by Cheng Shao at 2025-06-18T15:34:46-04:00 testsuite: add T26120 marked as broken - - - - - 894a04f3 by Cheng Shao at 2025-06-18T15:34:46-04:00 compiler: fix GHC.SysTools.Ar archive member size writing logic This patch fixes a long-standing bug in `GHC.SysTools.Ar` that emits the wrong archive member size in each archive header. It should encode the exact length of the member payload, excluding any padding byte, otherwise malformed archive that extracts a broken object with an extra trailing byte could be created. Apart from the in-tree `T26120` test, I've also created an out-of-tree testsuite at https://github.com/TerrorJack/ghc-ar-quickcheck that contains QuickCheck roundtrip tests for `GHC.SysTools.Ar`. With this fix, simple roundtrip tests and `writeGNUAr`/GNU `ar` roundtrip test passes. There might be more bugs lurking in here, but this patch is still a critical bugfix already. Fixes #26120 #22586. Co-authored-by: Codex <codex(a)openai.com> - - - - - f677ab5f by Lauren Yim at 2025-06-18T15:35:37-04:00 fix some typos in the warnings page in the user guide - - - - - b968e1c1 by Rodrigo Mesquita at 2025-06-18T15:36:18-04:00 Add a frozen callstack to throwGhcException Fixes #25956 - - - - - a5e0c3a3 by fendor at 2025-06-18T15:36:59-04:00 Update using.rst to advertise full mhu support for GHCi - - - - - d3e60e97 by Ryan Scott at 2025-06-18T22:29:21-04:00 Deprecate -Wdata-kinds-tc, make DataKinds issues in typechecker become errors !11314 introduced the `-Wdata-kinds-tc` warning as part of a fix for #22141. This was a temporary stopgap measure to allow users who were accidentally relying on code which needed the `DataKinds` extension in order to typecheck without having to explicitly enable the extension. Now that some amount of time has passed, this patch deprecates `-Wdata-kinds-tc` and upgrades any `DataKinds`-related issues in the typechecker (which were previously warnings) into errors. - - - - - fd5b5177 by Ryan Hendrickson at 2025-06-18T22:30:06-04:00 haddock: Add redact-type-synonyms pragma `{-# OPTIONS_HADDOCK redact-type-synonyms #-}` pragma will hide the RHS of type synonyms, and display the result kind instead, if the RHS contains any unexported types. - - - - - a892ead1 by Teo Camarasu at 2025-06-20T14:43:09+01:00 Expose ghc-internal unit id through the settings file This in combination with the unit id of the compiler library allows cabal to know of the two unit ids that should not be reinstalled (in specific circumstances) as: - when using plugins, we want to link against exactly the compiler unit id - when using TemplateHaskell we want to link against exactly the package that contains the TemplateHaskell interfaces, which is `ghc-internal` See: <https://github.com/haskell/cabal/issues/10087> Resolves #25282 - - - - - 98 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/SysTools/Ar.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Utils/Panic.hs - compiler/Setup.hs - docs/users_guide/9.14.1-notes.rst - docs/users_guide/using-warnings.rst - docs/users_guide/using.rst - hadrian/src/Rules/Generate.hs - rts/include/stg/MachRegs.h - testsuite/tests/annotations/should_fail/annfail03.stderr - testsuite/tests/annotations/should_fail/annfail09.stderr - + testsuite/tests/ghc-api/T26120.hs - + testsuite/tests/ghc-api/T26120.stdout - testsuite/tests/ghc-api/all.T - testsuite/tests/quasiquotation/qq001/qq001.stderr - testsuite/tests/quasiquotation/qq002/qq002.stderr - testsuite/tests/quasiquotation/qq003/qq003.stderr - testsuite/tests/quasiquotation/qq004/qq004.stderr - + testsuite/tests/quotes/LiftErrMsg.hs - + testsuite/tests/quotes/LiftErrMsg.stderr - + testsuite/tests/quotes/LiftErrMsgDefer.hs - + testsuite/tests/quotes/LiftErrMsgDefer.stderr - + testsuite/tests/quotes/LiftErrMsgTyped.hs - + testsuite/tests/quotes/LiftErrMsgTyped.stderr - testsuite/tests/quotes/T10384.stderr - testsuite/tests/quotes/TH_localname.stderr - testsuite/tests/quotes/all.T - testsuite/tests/splice-imports/SI03.stderr - testsuite/tests/splice-imports/SI05.stderr - testsuite/tests/splice-imports/SI16.stderr - testsuite/tests/splice-imports/SI18.stderr - testsuite/tests/splice-imports/SI20.stderr - testsuite/tests/splice-imports/SI25.stderr - testsuite/tests/splice-imports/SI28.stderr - testsuite/tests/splice-imports/SI31.stderr - testsuite/tests/th/T16976z.stderr - testsuite/tests/th/T17820a.stderr - testsuite/tests/th/T17820b.stderr - testsuite/tests/th/T17820c.stderr - testsuite/tests/th/T17820d.stderr - testsuite/tests/th/T17820e.stderr - testsuite/tests/th/T23829_hasty.stderr - testsuite/tests/th/T23829_hasty_b.stderr - testsuite/tests/th/T5795.stderr - + testsuite/tests/typecheck/should_compile/T20873c.hs - − testsuite/tests/typecheck/should_compile/T22141a.stderr - − testsuite/tests/typecheck/should_compile/T22141b.stderr - − testsuite/tests/typecheck/should_compile/T22141c.stderr - − testsuite/tests/typecheck/should_compile/T22141d.stderr - − testsuite/tests/typecheck/should_compile/T22141e.stderr - testsuite/tests/typecheck/should_compile/all.T - − testsuite/tests/typecheck/should_fail/T20873c.hs - − testsuite/tests/typecheck/should_fail/T20873c.stderr - testsuite/tests/typecheck/should_compile/T22141a.hs → testsuite/tests/typecheck/should_fail/T22141a.hs - testsuite/tests/typecheck/should_fail/T22141a.stderr - testsuite/tests/typecheck/should_compile/T22141b.hs → testsuite/tests/typecheck/should_fail/T22141b.hs - testsuite/tests/typecheck/should_fail/T22141b.stderr - testsuite/tests/typecheck/should_compile/T22141c.hs → testsuite/tests/typecheck/should_fail/T22141c.hs - testsuite/tests/typecheck/should_fail/T22141c.stderr - testsuite/tests/typecheck/should_compile/T22141d.hs → testsuite/tests/typecheck/should_fail/T22141d.hs - testsuite/tests/typecheck/should_fail/T22141d.stderr - testsuite/tests/typecheck/should_compile/T22141e.hs → testsuite/tests/typecheck/should_fail/T22141e.hs - testsuite/tests/typecheck/should_fail/T22141e.stderr - testsuite/tests/typecheck/should_compile/T22141e_Aux.hs → testsuite/tests/typecheck/should_fail/T22141e_Aux.hs - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/vdq-rta/should_fail/T23739_fail_case.hs - testsuite/tests/vdq-rta/should_fail/T23739_fail_case.stderr - utils/haddock/CHANGES.md - utils/haddock/doc/cheatsheet/haddocks.md - utils/haddock/doc/markup.rst - 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.hs - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs - utils/haddock/haddock-api/src/Haddock/Types.hs - + utils/haddock/html-test/ref/RedactTypeSynonyms.html - + utils/haddock/html-test/src/RedactTypeSynonyms.hs - + utils/haddock/latex-test/ref/RedactTypeSynonyms/RedactTypeSynonyms.tex - + utils/haddock/latex-test/src/RedactTypeSynonyms/RedactTypeSynonyms.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cdf55d41c4a7547716f2f79696c779… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cdf55d41c4a7547716f2f79696c779… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T25282] Expose ghc-internal unit id through the settings file
by Teo Camarasu (＠teo) 20 Jun '25

20 Jun '25

Teo Camarasu pushed to branch wip/T25282 at Glasgow Haskell Compiler / GHC Commits: cdf55d41 by Teo Camarasu at 2025-06-20T14:31:58+01:00 Expose ghc-internal unit id through the settings file This in combination with the unit id of the compiler library allows cabal to know of the two unit ids that should not be reinstalled (in specific circumstances) as: - when using plugins, we want to link against exactly the compiler unit id - when using TemplateHaskell we want to link against exactly the package that contains the TemplateHaskell interfaces, which is `ghc-internal` See: <https://github.com/haskell/cabal/issues/10087> Resolves #25282 - - - - - 3 changed files: - compiler/GHC/Driver/Session.hs - compiler/Setup.hs - hadrian/src/Rules/Generate.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3459,6 +3459,7 @@ compilerInfo dflags ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), ("Project Unit Id", cProjectUnitId), + ("ghc-internal Unit Id", cGhcInternalUnitId), -- See Note [Special unit-ids] ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), @@ -3512,6 +3513,23 @@ compilerInfo dflags expandDirectories :: FilePath -> Maybe FilePath -> String -> String expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd +-- Note [Special unit-ids] +-- ~~~~~~~~~~~~~~~~~~~~~~~ +-- Certain units are special to the compiler: +-- - Wired-in identifiers reference a specific unit-id of `ghc-internal`. +-- - GHC plugins must be linked against a specific unit-id of `ghc`, +-- namely the same one as the compiler. +-- - When using Template Haskell, splices refer to the Template Haskell +-- interface defined in `ghc-internal`, and must be linked against the same +-- unit-id as the compiler. +-- +-- We therefore expose the unit-id of `ghc-internal` ("ghc-internal Unit Id") and +-- ghc ("Project Unit Id") through `ghc --info`. +-- +-- This allows build tools to act accordingly, eg, if a user wishes to build a +-- GHC plugin, `cabal-install` might force them to use the exact `ghc` unit +-- that the compiler was linked against. + {- ----------------------------------------------------------------------------- Note [DynFlags consistency] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/Setup.hs ===================================== @@ -22,6 +22,7 @@ import qualified Data.Map as Map import GHC.ResponseFile import System.Environment + main :: IO () main = defaultMainWithHooks ghcHooks where @@ -56,7 +57,7 @@ primopIncls = ] ghcAutogen :: Verbosity -> LocalBuildInfo -> IO () -ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap} +ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPackageIndex} = do -- Get compiler/ root directory from the cabal file let Just compilerRoot = takeDirectory <$> pkgDescrFile @@ -96,9 +97,16 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId _ -> error "Couldn't find unique cabal library when building ghc" + let cGhcInternalUnitId = case Map.lookup (mkPackageName "ghc-internal", LMainLibName) $ packageIdIndex installedPackageIndex of + Just versions + -- We assume there is exactly one copy of `ghc-internal` in our dependency closure + | [[packageInfo]] <- Map.values versions + -> unUnitId $ installedUnitId packageInfo + _ -> error "Couldn't find unique ghc-internal library when building ghc" + -- Write GHC.Settings.Config configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs" - configHs = generateConfigHs cProjectUnitId settings + configHs = generateConfigHs cProjectUnitId cGhcInternalUnitId settings createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath) rewriteFileEx verbosity configHsPath configHs @@ -110,8 +118,9 @@ getSetting settings kh kr = go settings kr Just v -> Right v generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key + -> String -- ^ ghc-internal's cabal-generated unit-id, which matches its package-id/key -> [(String,String)] -> String -generateConfigHs cProjectUnitId settings = either error id $ do +generateConfigHs cProjectUnitId cGhcInternalUnitId settings = either error id $ do let getSetting' = getSetting $ (("cStage","2"):) settings buildPlatform <- getSetting' "cBuildPlatformString" "Host platform" hostPlatform <- getSetting' "cHostPlatformString" "Target platform" @@ -127,6 +136,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do , " , cBooterVersion" , " , cStage" , " , cProjectUnitId" + , " , cGhcInternalUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -150,4 +160,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do , "" , "cProjectUnitId :: String" , "cProjectUnitId = " ++ show cProjectUnitId + , "" + , "cGhcInternalUnitId :: String" + , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId ] ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -601,6 +601,8 @@ generateConfigHs = do -- 'pkgUnitId' on 'compiler' (the ghc-library package) to create the -- unit-id in both situations. cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getStage + + cGhcInternalUnitId <- expr . (`pkgUnitId` ghcInternal) =<< getStage return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -610,6 +612,7 @@ generateConfigHs = do , " , cBooterVersion" , " , cStage" , " , cProjectUnitId" + , " , cGhcInternalUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -633,6 +636,9 @@ generateConfigHs = do , "" , "cProjectUnitId :: String" , "cProjectUnitId = " ++ show cProjectUnitId + , "" + , "cGhcInternalUnitId :: String" + , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId ] where stageString (Stage0 InTreeLibs) = "1" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdf55d41c4a7547716f2f79696c7793… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdf55d41c4a7547716f2f79696c7793… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T25282] Expose ghc-internal unit id through the settings file
by Teo Camarasu (＠teo) 20 Jun '25

20 Jun '25

Teo Camarasu pushed to branch wip/T25282 at Glasgow Haskell Compiler / GHC Commits: 1b88c0dc by Teo Camarasu at 2025-06-20T14:29:11+01:00 Expose ghc-internal unit id through the settings file This in combination with the unit id of the compiler library allows cabal to know of the two unit ids that should not be reinstalled (in specific circumstances) as: - when using plugins, we want to link against exactly the compiler unit id - when using TemplateHaskell we want to link against exactly the package that contains the TemplateHaskell interfaces, which is `ghc-internal` See: <https://github.com/haskell/cabal/issues/10087> Resolves #25282 - - - - - 3 changed files: - compiler/GHC/Driver/Session.hs - compiler/Setup.hs - hadrian/src/Rules/Generate.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3459,6 +3459,7 @@ compilerInfo dflags ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), ("Project Unit Id", cProjectUnitId), + ("ghc-internal Unit Id", cGhcInternalUnitId), -- See Note [Special unit-ids] ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), @@ -3512,6 +3513,23 @@ compilerInfo dflags expandDirectories :: FilePath -> Maybe FilePath -> String -> String expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd +-- Note [Special unit-ids] +-- ~~~~~~~~~~~~~~~~~~~~~~~ +-- Certain units are special to the compiler: +-- - Wired-in identifiers reference a specific unit-id of `ghc-internal`. +-- - GHC plugins must be linked against a specific unit-id of `ghc`, +-- namely the same one as the compiler. +-- - When using Template Haskell, splices refer to the Template Haskell +-- interface defined in `ghc-internal`, and must be linked against the same +-- unit-id as the compiler. +-- +-- We therefore expose the unit-id of `ghc-internal` ("ghc-internal Unit Id") and +-- ghc ("Project Unit Id") through `ghc --info`. +-- +-- This allows build tools to act accordingly, eg, if a user wishes to build a +-- GHC plugin, `cabal-install` might force them to use the exact `ghc` unit +-- that the compiler was linked against. + {- ----------------------------------------------------------------------------- Note [DynFlags consistency] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/Setup.hs ===================================== @@ -22,6 +22,9 @@ import qualified Data.Map as Map import GHC.ResponseFile import System.Environment +import Debug.Trace + + main :: IO () main = defaultMainWithHooks ghcHooks where @@ -56,7 +59,7 @@ primopIncls = ] ghcAutogen :: Verbosity -> LocalBuildInfo -> IO () -ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap} +ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPackageIndex} = do -- Get compiler/ root directory from the cabal file let Just compilerRoot = takeDirectory <$> pkgDescrFile @@ -96,9 +99,16 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId _ -> error "Couldn't find unique cabal library when building ghc" + let cGhcInternalUnitId = case Map.lookup (mkPackageName "ghc-internal", LMainLibName) $ packageIdIndex installedPackageIndex of + Just versions + -- We assume there is exactly one copy of `ghc-internal` in our dependency closure + | [[packageInfo]] <- Map.values versions + -> unUnitId $ installedUnitId packageInfo + _ -> error "Couldn't find unique ghc-internal library when building ghc" + -- Write GHC.Settings.Config configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs" - configHs = generateConfigHs cProjectUnitId settings + configHs = generateConfigHs cProjectUnitId cGhcInternalUnitId settings createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath) rewriteFileEx verbosity configHsPath configHs @@ -110,8 +120,9 @@ getSetting settings kh kr = go settings kr Just v -> Right v generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key + -> String -- ^ ghc-internal's cabal-generated unit-id, which matches its package-id/key -> [(String,String)] -> String -generateConfigHs cProjectUnitId settings = either error id $ do +generateConfigHs cProjectUnitId cGhcInternalUnitId settings = either error id $ do let getSetting' = getSetting $ (("cStage","2"):) settings buildPlatform <- getSetting' "cBuildPlatformString" "Host platform" hostPlatform <- getSetting' "cHostPlatformString" "Target platform" @@ -127,6 +138,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do , " , cBooterVersion" , " , cStage" , " , cProjectUnitId" + , " , cGhcInternalUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -150,4 +162,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do , "" , "cProjectUnitId :: String" , "cProjectUnitId = " ++ show cProjectUnitId + , "" + , "cGhcInternalUnitId :: String" + , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId ] ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -601,6 +601,8 @@ generateConfigHs = do -- 'pkgUnitId' on 'compiler' (the ghc-library package) to create the -- unit-id in both situations. cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getStage + + cGhcInternalUnitId <- expr . (`pkgUnitId` ghcInternal) =<< getStage return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -610,6 +612,7 @@ generateConfigHs = do , " , cBooterVersion" , " , cStage" , " , cProjectUnitId" + , " , cGhcInternalUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -633,6 +636,9 @@ generateConfigHs = do , "" , "cProjectUnitId :: String" , "cProjectUnitId = " ++ show cProjectUnitId + , "" + , "cGhcInternalUnitId :: String" + , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId ] where stageString (Stage0 InTreeLibs) = "1" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b88c0dc12f4882d4d676dfb97945bc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b88c0dc12f4882d4d676dfb97945bc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26115] Further iteration
by Simon Peyton Jones (＠simonpj) 20 Jun '25

20 Jun '25

Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: d765a871 by Simon Peyton Jones at 2025-06-20T13:07:04+01:00 Further iteration Needs documentation - - - - - 1 changed file: - compiler/GHC/HsToCore/Binds.hs Changes: ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -57,6 +57,7 @@ import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.Rules +import GHC.Core.Ppr( pprCoreBinders ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Builtin.Names @@ -1002,6 +1003,88 @@ when we would rather avoid passing both dictionaries, and instead generate: $sg @c d = let { d1 = $p1Ord d; d2 = d } in <g-rhs> @c @c d1 d2 For now, we accept this infelicity. + +Note [Desugaring new-form SPECIALISE pragmas] -- Take 2 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + f :: forall a b c d. (Ord a, Ord b, Eq c, Ix d) => ... + f = rhs + {-# SPECIALISE f @p @[p] @[Int] @(q,r) #-} + +The type-checker generates `the_call` which looks like + + spe_bndrs = (dx1 :: Ord p) (dx2::Ix q) (dx3::Ix r) + the_call = let d6 = dx1 + d2 = $fOrdList d6 + d3 = $fEqList $fEqInt + d7 = dx1 -- Solver may introduce + d1 = d7 -- these indirections + d4 = $fIxPair dx2 dx3 + in f @p @p @[Int] @(q,r) + (d1::Ord p) (d2::Ord [p]) (d3::Eq [Int]) (d4::Ix (q,r) + +We /could/ generate + RULE f d1 d2 d3 d4 e1..en = $sf d1 d2 d3 d4 + $sf d1 d2 d3 d4 = <rhs> d1 d2 d3 d4 + +But that would do no specialisation! What we want is this: + RULE f d1 _d2 _d3 d4 e1..en = $sf d1 d4 + $sf d1 d4 = let d7 = d1 -- Renaming + dx1 = d7 -- Renaming + d6 = dx1 + d2 = $fOrdList d6 + d3 = $fEqList $fEqInt + in rhs d1 d2 d3 d4 + +Notice that: + * We pass some, but not all, of the matched dictionaries to $sf + + * We get specialisations for d2 and d3, but not for d1, nor d4. + + * We had to introduce some renaming bindings at the top + to line things up + +The transformation goes in these steps +(S1) decomposeCall: decomopose `the_call` into + - `rev_binds`: the enclosing let-bindings (actually reversed) + - `rule_lhs_args`: the arguments of the call itself + We carefully arrange that the dictionary arguments of the actual + call, `rule_lhs_args` are all distinct dictionary variables, + not expressions. How? We use `simpleOptExprNoInline` to avoid + inlining the let-bindings. + +(S2) Compute `rule_bndrs`: the free vars of `rule_lhs_args`, which + will be the forall'd template variables of the RULE. In the example, + rule_bndrs = d1,d2,d3,d4 + +(S3) grabSpecBinds: transform `rev_binds` into `spec_binds`: the + bindings we will wrap around the call in the RHS of `$sf` + +(S4) Find `spec_bndrs`, the subset of `rule_bndrs` that we actually + need to pass to `$sf`, simply by filtering out those that are + bound by `spec_binds`. In the example + spec_bndrs = d1,d4 + + + Working inner +* Grab any bindings we can that will "shadow" the forall'd + rule-bndrs, giving specialised bindings for them. + * We keep a set of known_bndrs starting with {d1,..,dn} + * We keep a binding iff no free var is + (a) in orig_bndrs (i.e. not totally free) + (b) not in known_bndrs + * If we keep it, add its binder to known_bndrs; if not, don't + +To maximise what we can "grab", start by extracting /renamings/ of the +forall'd rule_bndrs, and bringing them to the top. A renaming is + rule_bndr = d +If we see this: + * Bring d=rule_bndr to the top + * Add d to the set of variables to look for on the right. + e.g. rule_bndrs = d1, d2 + Bindings { d7=d9; d1=d7 } + Bring to the top { d7=d1; d9=d7 } + -} ------------------------ @@ -1083,13 +1166,18 @@ dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call) ; return Nothing } ; - Just (rev_binds, rule_lhs_args) -> + Just (binds, rule_lhs_args) -> + + do { let locals = mkVarSet orig_bndrs `extendVarSetList` bindersOfBinds binds + is_local :: Var -> Bool + is_local v = v `elemVarSet` locals + + rule_bndrs = scopedSort (exprsSomeFreeVarsList is_local rule_lhs_args) + rn_binds = getRenamings orig_bndrs binds rule_bndrs + + spec_binds = pickSpecBinds is_local (mkVarSet rule_bndrs) + (rn_binds ++ binds) - do { let orig_bndr_set = mkVarSet orig_bndrs - locally_bound = orig_bndr_set `extendVarSetList` bindersOfBinds rev_binds - rule_bndrs = scopedSort (exprsSomeFreeVarsList (`elemVarSet` locally_bound) - rule_lhs_args) - spec_binds = grabSpecBinds orig_bndr_set (mkVarSet rule_bndrs) rev_binds spec_binds_bndr_set = mkVarSet (bindersOfBinds spec_binds) spec_bndrs = filterOut (`elemVarSet` spec_binds_bndr_set) rule_bndrs @@ -1101,13 +1189,14 @@ dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call ; tracePm "dsSpec(new route)" $ vcat [ text "poly_id" <+> ppr poly_id , text "unfolding" <+> ppr (realIdUnfolding poly_id) - , text "orig_bndrs" <+> ppr orig_bndrs + , text "orig_bndrs" <+> pprCoreBinders orig_bndrs , text "ds_call" <+> ppr ds_call , text "core_call" <+> ppr core_call - , text "rev_binds" <+> ppr rev_binds + , text "binds" <+> ppr binds , text "rule_bndrs" <+> ppr rule_bndrs , text "rule_lhs_args" <+> ppr rule_lhs_args , text "spec_bndrs" <+> ppr spec_bndrs + , text "rn_binds" <+> ppr rn_binds , text "spec_binds" <+> ppr spec_binds ] ; finishSpecPrag poly_nm poly_rhs @@ -1115,7 +1204,7 @@ dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call spec_bndrs mk_spec_body inl } } } decomposeCall :: Id -> CoreExpr - -> Maybe ( [CoreBind] -- Reversed bindings + -> Maybe ( [CoreBind] , [CoreExpr] ) -- Args of the call decomposeCall poly_id binds = go [] binds @@ -1125,42 +1214,78 @@ decomposeCall poly_id binds go acc e | (Var fun, args) <- collectArgs e = assertPpr (fun == poly_id) (ppr fun $$ ppr poly_id) $ - Just (acc, args) + Just (reverse acc, args) | otherwise = Nothing +getRenamings :: [Var] -> [CoreBind] -- orig_bndrs and bindings + -> [Var] -- rule_bndrs + -> [CoreBind] -- Binds some of the orig_bndrs to a rule_bndr +getRenamings orig_bndrs binds rule_bndrs + = [ NonRec b e | b <- orig_bndrs + , not (b `elem` rule_bndrs) + , Just e <- [lookupVarEnv final_renamings b] ] + where + init_renamings, final_renamings :: IdEnv CoreExpr + -- In this function, IdEnv maps a local variable to (v |> co), + -- where `v` is a rule_bndr + + init_renamings = mkVarEnv [ (v, Var v) | v <- rule_bndrs, isId v ] + final_renamings = go binds + + go :: [CoreBind] -> IdEnv CoreExpr + go [] = init_renamings + go (bind : binds) + | NonRec b rhs <- bind + , Just (v, mco) <- getCastedVar rhs + , Just e <- lookupVarEnv renamings v + = extendVarEnv renamings b (mkCastMCo e (mkSymMCo mco)) + | otherwise + = renamings + where + renamings = go binds -grabSpecBinds :: VarSet -> VarSet -> [CoreBind] -> [CoreBind] -grabSpecBinds orig_bndrs rule_bndrs rev_binds - = reverse rename_binds ++ spec_binds +pickSpecBinds :: (Var -> Bool) -> VarSet -> [CoreBind] -> [CoreBind] +pickSpecBinds _ _ [] = [] +pickSpecBinds is_local known_bndrs (bind:binds) + | all keep_me (rhssOfBind bind) + , let known_bndrs' = known_bndrs `extendVarSetList` bindersOf bind + = bind : pickSpecBinds is_local known_bndrs' binds + | otherwise + = pickSpecBinds is_local known_bndrs binds + where + keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs) + bad_var v = is_local v && not (v `elemVarSet` known_bndrs) +{- +grabSpecBinds :: (Var -> Bool) -> VarSet -> [CoreBind] + -> ([CoreBind], [CoreBind]) +grabSpecBinds is_local rule_bndrs rev_binds + = (reverse rename_binds, spec_binds) where (known_bndrs, (rename_binds, other_binds)) - = get_renamings orig_bndrs rule_bndrs ([],[]) rev_binds + = get_renamings rule_bndrs ([],[]) rev_binds spec_binds = pick_spec_binds known_bndrs other_binds ------------------------ - get_renamings :: VarSet -- Locally bound variables - -> VarSet -- Variables bound by a successful match on the call + get_renamings :: VarSet -- Variables bound by a successful match on the call -> ([CoreBind],[CoreBind]) -- Accumulating parameter, in order -> [CoreBind] -- Reversed, innermost first -> ( VarSet , ([CoreBind] -- Renamings, in order , [CoreBind])) -- Other bindings, in order - get_renamings _ bndrs acc [] = (bndrs, acc) + get_renamings bndrs acc [] = (bndrs, acc) - get_renamings locals bndrs (rn_binds, other_binds) (bind : binds) + get_renamings bndrs (rn_binds, other_binds) (bind : binds) | NonRec d r <- bind , d `elemVarSet` bndrs , Just (v, mco) <- getCastedVar r - , v `elemVarSet` locals + , is_local v , let flipped_bind = NonRec v (mkCastMCo (Var d) (mkSymMCo mco)) = get_renamings (bndrs `extendVarSet` v) - (locals `extendVarSet` d) (flipped_bind:rn_binds, other_binds) binds | otherwise = get_renamings bndrs - (locals `extendVarSetList` bindersOf bind) (rn_binds, bind:other_binds) binds @@ -1175,7 +1300,8 @@ grabSpecBinds orig_bndrs rule_bndrs rev_binds = pick_spec_binds known_bndrs binds where keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs) - bad_var v = v `elemVarSet` orig_bndrs && not (v `elemVarSet` known_bndrs) + bad_var v = is_local v && not (v `elemVarSet` known_bndrs) +-} getCastedVar :: CoreExpr -> Maybe (Var, MCoercionR) getCastedVar (Var v) = Just (v, MRefl) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d765a87164bdffd2a6494108b3fbcf1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d765a87164bdffd2a6494108b3fbcf1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/ghc-9.12.2-release+jumptable-fix] compiler: Fix CPP guards around ghc_unique_counter64
by Sven Tennie (＠supersven) 20 Jun '25

20 Jun '25

Sven Tennie pushed to branch wip/supersven/ghc-9.12.2-release+jumptable-fix at Glasgow Haskell Compiler / GHC Commits: 5a7cc5ff by Ben Gamari at 2025-06-19T12:33:17+00:00 compiler: Fix CPP guards around ghc_unique_counter64 The `ghc_unique_counter64` symbol was introduced in the RTS in the 64-bit unique refactor (!10568) which has been backported to %9.6.7 and %9.8.4. Update the CPP to reflect this. Fixes #25576. - - - - - 1 changed file: - compiler/cbits/genSym.c Changes: ===================================== compiler/cbits/genSym.c ===================================== @@ -9,7 +9,19 @@ // // The CPP is thus about the RTS version GHC is linked against, and not the // version of the GHC being built. -#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) + +#if MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) +// Unique64 patch was present in 9.10 and later +#define HAVE_UNIQUE64 1 +#elif !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) && MIN_VERSION_GLASGOW_HASKELL(9,8,4,0) +// Unique64 patch was backported to 9.8.4 +#define HAVE_UNIQUE64 1 +#elif !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) && MIN_VERSION_GLASGOW_HASKELL(9,6,7,0) +// Unique64 patch was backported to 9.6.7 +#define HAVE_UNIQUE64 1 +#endif + +#if !defined(HAVE_UNIQUE64) HsWord64 ghc_unique_counter64 = 0; #endif #if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a7cc5fffbc37ed420cc59a81c8f6d0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a7cc5fffbc37ed420cc59a81c8f6d0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/ghc-cpp] 139 commits: MachRegs.h: Don't define NO_ARG_REGS when a XMM register is defined
by Alan Zimmerman (＠alanz) 19 Jun '25

19 Jun '25

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: e64b3f16 by ARATA Mizuki at 2025-06-17T10:13:42+09:00 MachRegs.h: Don't define NO_ARG_REGS when a XMM register is defined On i386, MAX_REAL_VANILLA_REG is 1, but MAX_REAL_XMM_REG is 4. If we define NO_ARG_REGS on i386, programs that use SIMD vectors may segfault. Closes #25985 A couple of notes on the BROKEN_TESTS field: * This fixes the segfault from T25062_V16. * The failure from T22187_run was fixed in an earlier commit (see #25561), but BROKEN_TESTS was missed at that time. Now should be a good time to mark it fixed. - - - - - 3e7c6b4d by Matthew Pickering at 2025-06-18T15:34:04-04:00 Improve error messages when implicit lifting fails This patch concerns programs which automatically try to fix level errors by inserting `Lift`. For example: ``` foo x = [| x |] ~> foo x = [| $(lift x) |] ``` Before, there were two problems with the message. 1. (#26031), the location of the error was reported as the whole quotation. 2. (#26035), the message just mentions there is no Lift instance, but gives no indicate why the user program needed a Lift instance in the first place. This problem is especially bad when you disable `ImplicitStagePersistence`, so you just end up with a confusing "No instance for" message rather than an error message about levels This patch fixes both these issues. Firstly, `PendingRnSplice` differentiates between a user-written splice and an implicit lift. Then, the Lift instance is precisely requested with a specific origin in the typechecker. If the instance fails to be solved, the message is reported using the `TcRnBadlyLevelled` constructor (like a normal level error). Fixes #26031, #26035 - - - - - 44b8cee2 by Cheng Shao at 2025-06-18T15:34:46-04:00 testsuite: add T26120 marked as broken - - - - - 894a04f3 by Cheng Shao at 2025-06-18T15:34:46-04:00 compiler: fix GHC.SysTools.Ar archive member size writing logic This patch fixes a long-standing bug in `GHC.SysTools.Ar` that emits the wrong archive member size in each archive header. It should encode the exact length of the member payload, excluding any padding byte, otherwise malformed archive that extracts a broken object with an extra trailing byte could be created. Apart from the in-tree `T26120` test, I've also created an out-of-tree testsuite at https://github.com/TerrorJack/ghc-ar-quickcheck that contains QuickCheck roundtrip tests for `GHC.SysTools.Ar`. With this fix, simple roundtrip tests and `writeGNUAr`/GNU `ar` roundtrip test passes. There might be more bugs lurking in here, but this patch is still a critical bugfix already. Fixes #26120 #22586. Co-authored-by: Codex <codex(a)openai.com> - - - - - f677ab5f by Lauren Yim at 2025-06-18T15:35:37-04:00 fix some typos in the warnings page in the user guide - - - - - b968e1c1 by Rodrigo Mesquita at 2025-06-18T15:36:18-04:00 Add a frozen callstack to throwGhcException Fixes #25956 - - - - - a5e0c3a3 by fendor at 2025-06-18T15:36:59-04:00 Update using.rst to advertise full mhu support for GHCi - - - - - 889b8815 by Alan Zimmerman at 2025-06-18T21:22:34+01:00 GHC-CPP: first rough proof of concept Processes #define FOO #ifdef FOO x = 1 #endif Into [ITcppIgnored [L loc ITcppDefine] ,ITcppIgnored [L loc ITcppIfdef] ,ITvarid "x" ,ITequal ,ITinteger (IL {il_text = SourceText "1", il_neg = False, il_value = 1}) ,ITcppIgnored [L loc ITcppEndif] ,ITeof] In time, ITcppIgnored will be pushed into a comment - - - - - 4ebf2101 by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Tidy up before re-visiting the continuation mechanic - - - - - f0dd0257 by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Switch preprocessor to continuation passing style Proof of concept, needs tidying up - - - - - 604d1a13 by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Small cleanup - - - - - fb58338d by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Get rid of some cruft - - - - - 778123da by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Starting to integrate. Need to get the pragma recognised and set - - - - - 946016da by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Make cppTokens extend to end of line, and process CPP comments - - - - - c8b03ee1 by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Remove unused ITcppDefined - - - - - 1de0f0e3 by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Allow spaces between # and keyword for preprocessor directive - - - - - 088fcc53 by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Process CPP continuation lines They are emited as separate ITcppContinue tokens. Perhaps the processing should be more like a comment, and keep on going to the end. BUT, the last line needs to be slurped as a whole. - - - - - 9fe0f67a by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Accumulate CPP continuations, process when ready Can be simplified further, we only need one CPP token - - - - - bcb05807 by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Simplify Lexer interface. Only ITcpp We transfer directive lines through it, then parse them from scratch in the preprocessor. - - - - - 18cce45b by Alan Zimmerman at 2025-06-18T21:22:34+01:00 Deal with directive on last line, with no trailing \n - - - - - 01804178 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Start parsing and processing the directives - - - - - 9369dfeb by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Prepare for processing include files - - - - - 2c498ca4 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Move PpState into PreProcess And initParserState, initPragState too - - - - - 08dc4d62 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Process nested include files Also move PpState out of Lexer.x, so it is easy to evolve it in a ghci session, loading utils/check-cpp/Main.hs - - - - - 9b8af447 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Split into separate files - - - - - 462d0b45 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Starting on expression parser. But it hangs. Time for Text.Parsec.Expr - - - - - 9a0bb0ac by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Start integrating the ghc-cpp work From https://github.com/alanz/ghc-cpp - - - - - 3d703f19 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 WIP - - - - - 8c8ab9de by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Fixup after rebase - - - - - 292f6173 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 WIP - - - - - aa1d4f99 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Fixup after rebase, including all tests pass - - - - - 5b20ff87 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Change pragma usage to GHC_CPP from GhcCPP - - - - - 3d2e444d by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Some comments - - - - - 9bbf6ba8 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Reformat - - - - - f470c7b5 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Delete unused file - - - - - eff62de5 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Rename module Parse to ParsePP - - - - - e66be481 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Clarify naming in the parser - - - - - a0224ad1 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 WIP. Switching to alex/happy to be able to work in-tree Since Parsec is not available - - - - - 2cef2273 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Layering is now correct - GHC lexer, emits CPP tokens - accumulated in Preprocessor state - Lexed by CPP lexer, CPP command extracted, tokens concated with spaces (to get rid of token pasting via comments) - if directive lexed and parsed by CPP lexer/parser, and evaluated - - - - - 9878bce6 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 First example working Loading Example1.hs into ghci, getting the right results ``` {-# LANGUAGE GHC_CPP #-} module Example1 where y = 3 x = "hello" "bye now" foo = putStrLn x ``` - - - - - 411767d9 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Rebase, and all tests pass except whitespace for generated parser - - - - - 2a92b35c by Alan Zimmerman at 2025-06-18T21:22:35+01:00 More plumbing. Ready for testing tomorrow. - - - - - 53d2399c by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Proress. Renamed module State from Types And at first blush it seems to handle preprocessor scopes properly. - - - - - 5703c1a9 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Insert basic GHC version macros into parser __GLASGOW_HASKELL__ __GLASGOW_HASKELL_FULL_VERSION__ __GLASGOW_HASKELL_PATCHLEVEL1__ __GLASGOW_HASKELL_PATCHLEVEL2__ - - - - - 914c0931 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Re-sync check-cpp for easy ghci work - - - - - 3f227991 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Get rid of warnings - - - - - 5e878d93 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Rework macro processing, in check-cpp Macros kept at the top level, looked up via name, multiple arity versions per name can be stored - - - - - e7bdaaa4 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 WIP. Can crack arguments for #define Next step it to crack out args in an expansion - - - - - 373f9916 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 WIP on arg parsing. - - - - - d8d130c5 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Progress. Still screwing up nested parens. - - - - - 0080df4a by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Seems to work, but has redundant code - - - - - 686084ca by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Remove redundant code - - - - - b378b0e9 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Reformat - - - - - 9be9de1f by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Expand args, single pass Still need to repeat until fixpoint - - - - - 4fe1d38e by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Fixed point expansion - - - - - 2c868e15 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Sync the playground to compiler - - - - - 65e5a420 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Working on dumping the GHC_CPP result But We need to keep the BufSpan in a comment - - - - - 305ffb14 by Alan Zimmerman at 2025-06-18T21:22:35+01:00 Keep BufSpan in queued comments in GHC.Parser.Lexer - - - - - 54a1c9ff by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Getting close to being able to print the combined tokens showing what is in and what is out - - - - - e6924494 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 First implementation of dumpGhcCpp. Example output First dumps all macros in the state, then the source, showing which lines are in and which are out ------------------------------ - |#define FOO(A,B) A + B - |#define FOO(A,B,C) A + B + C - |#if FOO(1,FOO(3,4)) == 8 - |-- a comment |x = 1 - |#else - |x = 5 - |#endif - - - - - 6c893315 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Clean up a bit - - - - - 89e1cd84 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Add -ddump-ghc-cpp option and a test based on it - - - - - 13daa03f by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Restore Lexer.x rules, we need them for continuation lines - - - - - bc439ea3 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Lexer.x: trying to sort out the span for continuations - We need to match on \n at the end of the line - We cannot simply back up for it - - - - - 332ddab7 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Inserts predefined macros. But does not dump properly Because the cpp tokens have a trailing newline - - - - - 50f40f1f by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Remove unnecessary LExer rules We *need* the ones that explicitly match to the end of the line. - - - - - b5a9732b by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Generate correct span for ITcpp Dump now works, except we do not render trailing `\` for continuation lines. This is good enough for use in test output. - - - - - 6307a622 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Reduce duplication in lexer - - - - - ae9cb89a by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Tweaks - - - - - 74f31b10 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Insert min_version predefined macros into state The mechanism now works. Still need to flesh out the full set. - - - - - cd087f21 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Trying my alternative pragma syntax. It works, but dumpGhcCpp is broken, I suspect from the ITcpp token span update. - - - - - eaeefb34 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Pragma extraction now works, with both CPP and GHC_CPP For the following {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 913 {-# LANGUAGE GHC_CPP #-} #endif We will enable GHC_CPP only - - - - - fe4d273e by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Remove some tracing - - - - - 35f675b0 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Fix test exes for changes - - - - - d4500988 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 For GHC_CPP tests, normalise config-time-based macros - - - - - 2f99928b by Alan Zimmerman at 2025-06-18T21:22:36+01:00 WIP - - - - - 64bd6a23 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 WIP again. What is wrong? - - - - - 1f2a83b4 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Revert to dynflags for normal not pragma lexing - - - - - 2225db35 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Working on getting check-exact to work properly - - - - - 30aa16de by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Passes CppCommentPlacement test - - - - - 408b4722 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Starting on exact printing with GHC_CPP While overriding normal CPP - - - - - 420548f5 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Correctly store CPP ignored tokens as comments By populating the lexeme string in it, based on the bufpos - - - - - 4a1a04ef by Alan Zimmerman at 2025-06-18T21:22:36+01:00 WIP - - - - - 279e41d4 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Simplifying - - - - - 2f0d4d97 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Update the active state logic - - - - - 9ef48795 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Work the new logic into the mainline code - - - - - 80428aaa by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Process `defined` operator - - - - - f65a0d9d by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Manage lexer state while skipping tokens There is very intricate layout-related state used when lexing. If a CPP directive blanks out some tokens, store this state when the blanking starts, and restore it when they are no longer being blanked. - - - - - 2f12dffd by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Track the last token buffer index, for ITCppIgnored We need to attach the source being skipped in an ITCppIgnored token. We cannot simply use its BufSpan as an index into the underlying StringBuffer as it counts unicode chars, not bytes. So we update the lexer state to store the starting StringBuffer location for the last token, and use the already-stored length to extract the correct portion of the StringBuffer being parsed. - - - - - 0fff4ce8 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Process the ! operator in GHC_CPP expressions - - - - - 7245df41 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Predefine a constant when GHC_CPP is being used. - - - - - c32f169a by Alan Zimmerman at 2025-06-18T21:22:36+01:00 WIP - - - - - f79d8ae6 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Skip lines directly in the lexer when required - - - - - eacc502e by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Properly manage location when accepting tokens again - - - - - 46fc9d13 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Seems to be working now, for Example9 - - - - - 7189e97c by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Remove tracing - - - - - 99eafc55 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Fix parsing '*' in block comments Instead of replacing them with '-' - - - - - 2ccb3354 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Keep the trailing backslash in a ITcpp token - - - - - 96c0b70e by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Deal with only enabling one section of a group. A group is an instance of a conditional introduced by #if/#ifdef/#ifndef, and ending at the final #endif, including intermediate #elsif sections - - - - - 5270f370 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Replace remaining identifiers with 0 when evaluating As per the spec - - - - - e35ede33 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Snapshot before rebase - - - - - bc8081ae by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Skip non-processed lines starting with # - - - - - 37947b7e by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Export generateMacros so we can use it in ghc-exactprint - - - - - aec471b4 by Alan Zimmerman at 2025-06-18T21:22:36+01:00 Fix rebase - - - - - 5b166f2a by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Expose initParserStateWithMacrosString - - - - - 82accba8 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Fix buggy lexer cppSkip It was skipping all lines, not just ones prefixed by # - - - - - 015d27a7 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Fix evaluation of && to use the correct operator - - - - - fb7038b5 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Deal with closing #-} at the start of a line - - - - - 28047dc8 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Add the MIN_VERSION_GLASGOW_HASKELL predefined macro - - - - - cd298351 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Include MIN_VERSION_GLASGOW_HASKELL in GhcCpp01.stderr - - - - - 59fc66d0 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Use a strict map for macro defines - - - - - abc3d948 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Process TIdentifierLParen Which only matters at the start of #define - - - - - 4e145cd2 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Do not provide TIdentifierLParen paren twice - - - - - 6dd33444 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Handle whitespace between identifier and '(' for directive only - - - - - d83ddd88 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Expose some Lexer bitmap manipulation helpers - - - - - 2b4ae10c by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Deal with line pragmas as tokens Blows up for dumpGhcCpp though - - - - - 95ef50f2 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Allow strings delimited by a single quote too - - - - - d420e107 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Allow leading whitespace on cpp directives As per https://timsong-cpp.github.io/cppwp/n4140/cpp#1 - - - - - b36cc1ef by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Implement GHC_CPP undef - - - - - 81286cbd by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Sort out expansion of no-arg macros, in a context with args And make the expansion bottom out, in the case of recursion - - - - - 775b9e53 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Fix GhcCpp01 test The LINE pragma stuff works in ghc-exactprint when specifically setting flag to emit ITline_pragma tokens - - - - - d0e96edd by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Process comments in CPP directives - - - - - 23856d4d by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Correctly lex pragmas with finel #-} on a newline - - - - - 6bd11f3d by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Do not process CPP-style comments - - - - - d502ce75 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Allow cpp-style comments when GHC_CPP enabled - - - - - 3296c832 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Return other pragmas as cpp ignored when GHC_CPP active - - - - - a8f4a2a2 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Fix exactprinting default decl - - - - - 0bf34347 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Reorganise getOptionsFromFile for use in ghc-exactprint We want to be able to inject predefined macro definitions into the parser preprocessor state for when we do a hackage roundtrip. - - - - - f5697190 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Tweak testing - - - - - 72664c05 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Only allow unknown cpp pragmas with # in left margin - - - - - bb3524d9 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Require # against left margin for all GHC_CPP directives - - - - - 1657e0cd by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Fix CPP directives appearing in pragmas And add a test for error reporting for missing `#if` - - - - - 1be508ef by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Starting to report GHC_CPP errors using GHC machinery - - - - - 591b330e by Alan Zimmerman at 2025-06-18T21:22:37+01:00 More GHC_CPP diagnostic results - - - - - 7d9e12b1 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 WIP on converting error calls to GHC diagnostics in GHC_CPP - - - - - 5ed5378f by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Working on CPP diagnostic reporting - - - - - b64fea57 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Tweak some tests/lint warnings - - - - - 9d91ca3e by Alan Zimmerman at 2025-06-18T21:22:37+01:00 More error reporting in Macro - - - - - ad20e507 by Alan Zimmerman at 2025-06-18T21:22:37+01:00 Some cleanups - - - - - 136 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Parser.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.hs-boot - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - + compiler/GHC/Parser/PreProcess.hs - + compiler/GHC/Parser/PreProcess/Eval.hs - + compiler/GHC/Parser/PreProcess/Lexer.x - + compiler/GHC/Parser/PreProcess/Macro.hs - + compiler/GHC/Parser/PreProcess/ParsePP.hs - + compiler/GHC/Parser/PreProcess/Parser.y - + compiler/GHC/Parser/PreProcess/ParserM.hs - + compiler/GHC/Parser/PreProcess/State.hs - compiler/GHC/Parser/Utils.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/SysTools/Ar.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Panic.hs - compiler/ghc.cabal.in - docs/users_guide/debugging.rst - docs/users_guide/using-warnings.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - hadrian/src/Rules/SourceDist.hs - hadrian/stack.yaml.lock - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - rts/include/stg/MachRegs.h - testsuite/tests/annotations/should_fail/annfail03.stderr - testsuite/tests/annotations/should_fail/annfail09.stderr - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/T4437.hs - testsuite/tests/ghc-api/T11579.hs - + testsuite/tests/ghc-api/T26120.hs - + testsuite/tests/ghc-api/T26120.stdout - testsuite/tests/ghc-api/all.T - + testsuite/tests/ghc-cpp/GhcCpp01.hs - + testsuite/tests/ghc-cpp/GhcCpp01.stderr - + testsuite/tests/ghc-cpp/GhcCpp02.hs - + testsuite/tests/ghc-cpp/GhcCpp02.stderr - + testsuite/tests/ghc-cpp/all.T - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/printer/CppCommentPlacement.hs - testsuite/tests/quasiquotation/qq001/qq001.stderr - testsuite/tests/quasiquotation/qq002/qq002.stderr - testsuite/tests/quasiquotation/qq003/qq003.stderr - testsuite/tests/quasiquotation/qq004/qq004.stderr - + testsuite/tests/quotes/LiftErrMsg.hs - + testsuite/tests/quotes/LiftErrMsg.stderr - + testsuite/tests/quotes/LiftErrMsgDefer.hs - + testsuite/tests/quotes/LiftErrMsgDefer.stderr - + testsuite/tests/quotes/LiftErrMsgTyped.hs - + testsuite/tests/quotes/LiftErrMsgTyped.stderr - testsuite/tests/quotes/T10384.stderr - testsuite/tests/quotes/TH_localname.stderr - testsuite/tests/quotes/all.T - testsuite/tests/splice-imports/SI03.stderr - testsuite/tests/splice-imports/SI05.stderr - testsuite/tests/splice-imports/SI16.stderr - testsuite/tests/splice-imports/SI18.stderr - testsuite/tests/splice-imports/SI20.stderr - testsuite/tests/splice-imports/SI25.stderr - testsuite/tests/splice-imports/SI28.stderr - testsuite/tests/splice-imports/SI31.stderr - testsuite/tests/th/T16976z.stderr - testsuite/tests/th/T17820a.stderr - testsuite/tests/th/T17820b.stderr - testsuite/tests/th/T17820c.stderr - testsuite/tests/th/T17820d.stderr - testsuite/tests/th/T17820e.stderr - testsuite/tests/th/T23829_hasty.stderr - testsuite/tests/th/T23829_hasty_b.stderr - testsuite/tests/th/T5795.stderr - + utils/check-cpp/.ghci - + utils/check-cpp/.gitignore - + utils/check-cpp/Eval.hs - + utils/check-cpp/Example1.hs - + utils/check-cpp/Example10.hs - + utils/check-cpp/Example11.hs - + utils/check-cpp/Example12.hs - + utils/check-cpp/Example13.hs - + utils/check-cpp/Example2.hs - + utils/check-cpp/Example3.hs - + utils/check-cpp/Example4.hs - + utils/check-cpp/Example5.hs - + utils/check-cpp/Example6.hs - + utils/check-cpp/Example7.hs - + utils/check-cpp/Example8.hs - + utils/check-cpp/Example9.hs - + utils/check-cpp/Lexer.x - + utils/check-cpp/Macro.hs - + utils/check-cpp/Main.hs - + utils/check-cpp/ParsePP.hs - + utils/check-cpp/ParseSimulate.hs - + utils/check-cpp/Parser.y - + utils/check-cpp/ParserM.hs - + utils/check-cpp/PreProcess.hs - + utils/check-cpp/README.md - + utils/check-cpp/State.hs - + utils/check-cpp/run.sh - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Preprocess.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Parser.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c39a131a7440c04ce4f079dbaf4b9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c39a131a7440c04ce4f079dbaf4b9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/step-out-5] 2 commits: debugger: Implement step-out feature
by Rodrigo Mesquita (＠alt-romes) 19 Jun '25

19 Jun '25

Rodrigo Mesquita pushed to branch wip/romes/step-out-5 at Glasgow Haskell Compiler / GHC Commits: 20668d60 by Rodrigo Mesquita at 2025-06-19T13:12:21+01:00 debugger: Implement step-out feature Implements support for stepping-out of a function (aka breaking right after returning from a function) in the interactive debugger. It also introduces a GHCi command :stepout to step-out of a function being debugged in the interpreter. The feature is described as: Stop at the first breakpoint immediately after returning from the current function scope. Known limitations: because a function tail-call does not push a stack frame, if step-out is used inside of a function that was tail-called, execution will not be returned to its caller, but rather its caller's first non-tail caller. On the other hand, it means the debugger follows the more realistic execution of the program. In the following example: .. code-block:: none f = do a b <--- (1) set breakpoint then step in here c b = do ... d <--- (2) step-into this tail call d = do ... something <--- (3) step-out here ... Stepping-out will stop execution at the `c` invokation in `f`, rather than stopping at `b`. The key idea is simple: When step-out is enabled, traverse the runtime stack until a continuation BCO is found -- and enable the breakpoint heading that BCO explicitly using its tick-index. The details are specified in `Note [Debugger: Step-out]` in `rts/Interpreter.c`. Since PUSH_ALTS BCOs (representing case continuations) were never headed by a breakpoint (unlike the case alternatives they push), we introduced the BRK_ALTS instruction to allow the debugger to set a case continuation to stop at the breakpoint heading the alternative that is taken. This is further described in `Note [Debugger: BRK_ALTS]`. Fixes #26042 - - - - - 8f0a3a46 by Rodrigo Mesquita at 2025-06-19T13:12:21+01:00 debugger: Filter step-out stops by SrcSpan To implement step-out, the RTS looks for the first continuation frame on the stack and explicitly enables its entry breakpoint. However, some continuations will be contained in the function from which step-out was initiated (trivial example is a case expression). Similarly to steplocal, we will filter the breakpoints at which the RTS yields to the debugger based on the SrcSpan. When doing step-out, only stop if the breakpoint is /not/ contained in the function from which we initiated it. This is especially relevant in monadic statements such as IO which is compiled to a long chain of case expressions. See Note [Debugger: Filtering step-out stops] - - - - - 44 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Eval/Types.hs - compiler/GHC/StgToByteCode.hs - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc - libraries/ghc-heap/tests/parse_tso_flags.hs - libraries/ghci/GHCi/Debugger.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - rts/Disassembler.c - rts/Interpreter.c - rts/Interpreter.h - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - rts/include/rts/Bytecodes.h - rts/include/rts/Constants.h - rts/include/rts/storage/Closures.h - + testsuite/tests/ghci.debugger/scripts/T26042b.hs - + testsuite/tests/ghci.debugger/scripts/T26042b.script - + testsuite/tests/ghci.debugger/scripts/T26042b.stdout - + testsuite/tests/ghci.debugger/scripts/T26042c.hs - + testsuite/tests/ghci.debugger/scripts/T26042c.script - + testsuite/tests/ghci.debugger/scripts/T26042c.stdout - + testsuite/tests/ghci.debugger/scripts/T26042d.hs - + testsuite/tests/ghci.debugger/scripts/T26042d.script - + testsuite/tests/ghci.debugger/scripts/T26042d.stdout - + testsuite/tests/ghci.debugger/scripts/T26042e.hs - + testsuite/tests/ghci.debugger/scripts/T26042e.script - + testsuite/tests/ghci.debugger/scripts/T26042e.stdout - + testsuite/tests/ghci.debugger/scripts/T26042f.hs - + testsuite/tests/ghci.debugger/scripts/T26042f.script - + testsuite/tests/ghci.debugger/scripts/T26042f1.stderr - + testsuite/tests/ghci.debugger/scripts/T26042f1.stdout - + testsuite/tests/ghci.debugger/scripts/T26042f2.stdout - + testsuite/tests/ghci.debugger/scripts/T26042g.hs - + testsuite/tests/ghci.debugger/scripts/T26042g.script - + testsuite/tests/ghci.debugger/scripts/T26042g.stdout - testsuite/tests/ghci.debugger/scripts/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5df3c3fcec5b08ce8bd90ebed02be5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5df3c3fcec5b08ce8bd90ebed02be5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/step-out-5] debugger: Filter step-out stops by SrcSpan
by Rodrigo Mesquita (＠alt-romes) 19 Jun '25

19 Jun '25

Rodrigo Mesquita pushed to branch wip/romes/step-out-5 at Glasgow Haskell Compiler / GHC Commits: 5df3c3fc by Rodrigo Mesquita at 2025-06-19T12:59:26+01:00 debugger: Filter step-out stops by SrcSpan To implement step-out, the RTS looks for the first continuation frame on the stack and explicitly enables its entry breakpoint. However, some continuations will be contained in the function from which step-out was initiated (trivial example is a case expression). Similarly to steplocal, we will filter the breakpoints at which the RTS yields to the debugger based on the SrcSpan. When doing step-out, only stop if the breakpoint is /not/ contained in the function from which we initiated it. This is especially relevant in monadic statements such as IO which is compiled to a long chain of case expressions. See Note [Debugger: Filtering step-out stops] - - - - - 5 changed files: - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Eval/Types.hs - ghc/GHCi/UI.hs - rts/Interpreter.c - testsuite/tests/ghci.debugger/scripts/T26042d.stdout Changes: ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -355,14 +355,14 @@ handleRunStatus step expr bindings final_ids status history0 = do decl = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)? - b <- liftIO $ breakpointStatus interp (modBreaks_flags tick_brks) (ibi_tick_index ibi) + bactive <- liftIO $ breakpointStatus interp (modBreaks_flags tick_brks) (ibi_tick_index ibi) apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt -- This breakpoint is enabled or we mean to break here; -- we want to stop instead of just logging it. - if b || breakHere step span then do + if breakHere bactive step span then do -- This function only returns control to ghci with 'ExecBreak' when it is really meant to break. -- Specifically, for :steplocal or :stepmodule, don't return control -- and simply resume execution from here until we hit a breakpoint we do want to stop at. @@ -386,6 +386,7 @@ handleRunStatus step expr bindings final_ids status history0 = do setSession hsc_env2 return (ExecBreak names (Just ibi)) else do + -- resume with the same step type let eval_opts = initEvalOpts dflags (enableGhcStepMode step) status <- liftIO $ GHCi.resumeStmt interp eval_opts resume_ctxt_fhv history <- if not tracing then pure history0 else do @@ -451,7 +452,7 @@ resumeExec step mbCnt hist' = case mb_brkpt of Nothing -> pure prevHistoryLst Just bi - | breakHere step span -> do + | breakHere False step span -> do hist1 <- liftIO (mkHistory hsc_env apStack bi) return $ hist1 `consBL` fromListBL 50 hist | otherwise -> pure prevHistoryLst ===================================== compiler/GHC/Runtime/Eval/Types.hs ===================================== @@ -49,6 +49,11 @@ data SingleStep -- | :stepout | StepOut + { initiatedFrom :: Maybe SrcSpan + -- ^ Step-out locations are filtered to make sure we don't stop at a + -- continuation that is within the function from which step-out was + -- initiated. See Note [Debugger: Step-out] + } -- | :steplocal [expr] | LocalStep @@ -62,24 +67,73 @@ data SingleStep -- step at every breakpoint or after every return (see @'EvalStep'@). enableGhcStepMode :: SingleStep -> EvalStep enableGhcStepMode RunToCompletion = EvalStepNone -enableGhcStepMode StepOut = EvalStepOut +enableGhcStepMode StepOut{} = EvalStepOut -- for the remaining step modes we need to stop at every single breakpoint. enableGhcStepMode _ = EvalStepSingle --- | Given a 'SingleStep' mode and the SrcSpan of a breakpoint we hit, return --- @True@ if based on the step-mode alone we should stop at this breakpoint. +-- | Given a 'SingleStep' mode, whether the breakpoint was explicitly active, +-- and the SrcSpan of a breakpoint we hit, return @True@ if we should stop at +-- this breakpoint. -- -- In particular, this will always be @False@ for @'RunToCompletion'@ and -- @'RunAndLogSteps'@. We'd need further information e.g. about the user -- breakpoints to determine whether to break in those modes. -breakHere :: SingleStep -> SrcSpan -> Bool -breakHere step break_span = case step of - RunToCompletion -> False - RunAndLogSteps -> False - StepOut -> True - SingleStep -> True - LocalStep span -> break_span `isSubspanOf` span - ModuleStep span -> srcSpanFileName_maybe span == srcSpanFileName_maybe break_span +breakHere :: Bool -- ^ Was this breakpoint explicitly active (in the @BreakArray@s)? + -> SingleStep -- ^ What kind of stepping were we doing + -> SrcSpan -- ^ The span of the breakpoint we hit + -> Bool -- ^ Should we stop here then? +breakHere b RunToCompletion _ = b +breakHere b RunAndLogSteps _ = b +breakHere _ SingleStep _ = True +breakHere b step break_span = case step of + LocalStep start_span -> b || break_span `isSubspanOf` start_span + ModuleStep start_span -> b || srcSpanFileName_maybe start_span == srcSpanFileName_maybe break_span + StepOut Nothing -> True + StepOut (Just start) -> + -- See Note [Debugger: Filtering step-out stops] + not (break_span `isSubspanOf` start) + +{- +Note [Debugger: Filtering step-out stops] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Recall from Note [Debugger: Step-out] that the RTS explicitly enables the +breakpoint at the start of the first continuation frame on the stack, when +the step-out flag is set. + +Often, the continuation on top of the stack will be part of the same function +from which step-out was initiated. A trivial example is a case expression: + + f x = case <brk>g x of ... + +If we're stopped in <brk>, the continuation will be case alternatives rather +than in the function which called `f`. This is especially relevant for monadic +do-blocks which may end up being compiled to long chains of case expressions, +such as IO, and we don't want to stop at every line in the block while stepping out! + +To make sure we only stop at a continuation outside of the current function, we +compare the continuation breakpoint `SrcSpan` against the current one. If the +continuation breakpoint is within the current function, instead of stopping, we +re-trigger step-out and return the RTS interpreter right away. + +This behaviour is very similar to `:steplocal`, which is implemented by +yielding from the RTS at every breakpoint (using `:step`) but only really +stopping when the breakpoint's `SrcSpan` is contained in the current function. + +The function which determines if we should stop at the current breakpoint is +`breakHere`. For `StepOut`, `breakHere` will only return `True` if the +breakpoint is not contained in the function from which step-out was initiated. + +Notably, this means we will ignore breakpoints enabled by the user if they are +contained in the function we are stepping out of. + +If we had a way to distinguish whether a breakpoint was explicitly enabled (in +`BreakArrays`) by the user vs by step-out we could additionally break on +user-enabled breakpoints; however, it's not a straightforward and arguably it +may be uncommon for a user to use step-out to run until the next breakpoint in +the same function. Of course, if a breakpoint in any other function is hit +before returning to the continuation, we will still stop there (`breakHere` +will be `True` because the break point is not within the initiator function). +-} data ExecResult ===================================== ghc/GHCi/UI.hs ===================================== @@ -4165,7 +4165,14 @@ stepCmd arg = withSandboxOnly ":step" $ step arg step expression = runStmt expression GHC.SingleStep >> return () stepOutCmd :: GhciMonad m => String -> m () -stepOutCmd _ = withSandboxOnly ":stepout" $ doContinue GHC.StepOut +stepOutCmd _ = withSandboxOnly ":stepout" $ do + mb_span <- getCurrentBreakSpan + case mb_span of + Nothing -> doContinue (GHC.StepOut Nothing) + Just loc -> do + md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule + current_toplevel_decl <- flip enclosingTickSpan loc <$> getTickArray md + doContinue (GHC.StepOut (Just (RealSrcSpan current_toplevel_decl Strict.Nothing))) stepLocalCmd :: GhciMonad m => String -> m () stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg ===================================== rts/Interpreter.c ===================================== @@ -361,6 +361,11 @@ By simply enabling the breakpoint heading the continuation we can ensure that when it is returned to we will stop there without additional work -- it leverages the existing break point insertion process and stopping mechanisms. +See Note [Debugger: Filtering step-out stops] for details on how the +interpreter further filters the continuation we stop at to make sure we onky +break on a continuation outside of the function from which step-out was +initiated. + A limitation of this approach is that stepping-out of a function that was tail-called will skip its caller since no stack frame is pushed for a tail call (i.e. a tail call returns directly to its caller's first non-tail caller). ===================================== testsuite/tests/ghci.debugger/scripts/T26042d.stdout ===================================== @@ -10,8 +10,5 @@ _result :: ^^^^^^^^^^^^^^^^^ 7 putStrLn "hello3" hello2 -Stopped in Main.main, T26042d.hs:7:3-19 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - () #) = _ +hello3 +hello4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5df3c3fcec5b08ce8bd90ebed02be5d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5df3c3fcec5b08ce8bd90ebed02be5d… You're receiving this email because of your account on gitlab.haskell.org.

1 0