- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/ani/kill-SrcCodeOrigin] trying to remove SrcCodeOrigin. Cannot Derive Data instance for SrcCodeOrigin
by Apoorv Ingle (＠ani) 09 Feb '26

09 Feb '26

Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC Commits: ef338e58 by Apoorv Ingle at 2026-02-08T22:47:48-06:00 trying to remove SrcCodeOrigin. Cannot Derive Data instance for SrcCodeOrigin - - - - - 18 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/Instances.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Types/ErrCtxt.hs - compiler/GHC/Tc/Types/LclEnv.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs-boot - + compiler/GHC/Types/Error.hs-boot - + compiler/GHC/Unit/State.hs-boot - compiler/GHC/Utils/Logger.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -34,6 +34,7 @@ import GHC.Parser.Annotation -- others: import GHC.Tc.Types.Evidence +import GHC.Tc.Types.ErrCtxt import GHC.Types.Id.Info ( RecSelParent ) import GHC.Types.Name import GHC.Types.Name.Reader @@ -658,16 +659,8 @@ type instance XXExpr GhcTc = XXExprGhcTc * * ********************************************************************* -} --- | The different source constructs that we use to instantiate the "original" field --- in an `XXExprGhcRn original expansion` --- See Note [Handling overloaded and rebindable constructs] in `GHC.Rename.Expr` -data SrcCodeOrigin - = OrigExpr (HsExpr GhcRn) -- ^ The source, user written, expression - | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from - | OrigPat (ExprLStmt GhcRn) (Pat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints - data XXExprGhcRn - = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages + = ExpandedThingRn { xrn_orig :: ErrCtxtMsg -- The original source thing context to be used for error messages , xrn_expanded :: HsExpr GhcRn -- The compiler generated, expanded thing } @@ -679,21 +672,21 @@ data XXExprGhcRn -- and the two components of the expansion: original expression and -- expanded expressions. mkExpandedExpr - :: HsExpr GhcRn -- ^ source expression + :: HsExpr GhcRn -- ^ source expression context -> HsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' -mkExpandedExpr oExpr eExpr = XExpr (ExpandedThingRn { xrn_orig = OrigExpr oExpr +mkExpandedExpr oExpr eExpr = XExpr (ExpandedThingRn { xrn_orig = ExprCtxt oExpr , xrn_expanded = eExpr }) -- | Build an expression using the extension constructor `XExpr`, -- and the two components of the expansion: original do stmt and -- expanded expression mkExpandedStmt - :: ExprLStmt GhcRn -- ^ source statement - -> HsDoFlavour -- ^ source statement do flavour + :: ExprLStmt GhcRn -- ^ source statement context + -> HsDoFlavour -- ^ source statements do flavour -> HsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' -mkExpandedStmt oStmt flav eExpr = XExpr (ExpandedThingRn { xrn_orig = OrigStmt oStmt flav +mkExpandedStmt oStmt flav eExpr = XExpr (ExpandedThingRn { xrn_orig = StmtErrCtxt (HsDoStmt flav) oStmt , xrn_expanded = eExpr }) data XXExprGhcTc @@ -702,7 +695,7 @@ data XXExprGhcTc | ExpandedThingTc -- See Note [Rebindable syntax and XXExprGhcRn] -- See Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do` - { xtc_orig :: SrcCodeOrigin -- The original user written thing + { xtc_orig :: ErrCtxtMsg -- The original user written thing , xtc_expanded :: HsExpr GhcTc } -- The expanded typechecked expression | ConLikeTc @@ -736,10 +729,10 @@ mkExpandedExprTc :: HsExpr GhcRn -- ^ source expression -> HsExpr GhcTc -- ^ expanded typechecked expression -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn' -mkExpandedExprTc oExpr eExpr = mkExpandedTc (OrigExpr oExpr) eExpr +mkExpandedExprTc oExpr eExpr = mkExpandedTc (ExprCtxt oExpr) eExpr mkExpandedTc - :: SrcCodeOrigin -- ^ source, user written do statement/expression + :: ErrCtxtMsg -- ^ source, user written do statement/expression -> HsExpr GhcTc -- ^ expanded typechecked expression -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn' mkExpandedTc o e = XExpr (ExpandedThingTc o e) @@ -1060,24 +1053,32 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcRn -> ppr x GhcTc -> ppr x -instance Outputable SrcCodeOrigin where - ppr thing - = case thing of - OrigExpr x -> ppr_builder "<OrigExpr>:" x - OrigStmt x _ -> ppr_builder "<OrigStmt>:" x - OrigPat _ x -> ppr_builder "<OrigPat>:" x - where ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens (ppr x))) (ppr x) - instance Outputable XXExprGhcRn where - ppr (ExpandedThingRn o e) = ifPprDebug (braces $ vcat [ppr o, text ";;" , ppr e]) (ppr o) ppr (HsRecSelRn f) = pprPrefixOcc f + ppr (ExpandedThingRn o e) = ifPprDebug (braces $ vcat [pprCtxt o, text ";;" , ppr e]) (pprCtxt o) + where + ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens x)) x + pprCtxt :: ErrCtxtMsg -> SDoc + pprCtxt (ExprCtxt e) = ppr_builder "<OrigExpr>:" (ppr e) + pprCtxt (StmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt) + pprCtxt (StmtErrCtxtPat _ _ pat) = ppr_builder "<OrigPat>:" (ppr pat) + pprCtxt _ = empty instance Outputable XXExprGhcTc where ppr (WrapExpr co_fn e) = pprHsWrapper co_fn (\_parens -> pprExpr e) ppr (ExpandedThingTc o e) - = ifPprDebug (braces $ vcat [ppr o, ppr e]) (ppr o) + = ifPprDebug (braces $ vcat [pprCtxt o, ppr e]) (pprCtxt o) + + where + ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens x)) x + pprCtxt :: ErrCtxtMsg -> SDoc + pprCtxt (ExprCtxt e) = ppr_builder "<OrigExpr>:" (ppr e) + pprCtxt (StmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt) + pprCtxt (StmtErrCtxtPat _ _ pat) = ppr_builder "<OrigPat>:" (ppr pat) + pprCtxt _ = empty + -- e is the expanded expression, we print the original -- expression (HsExpr GhcRn), not the -- expanded typechecked one (HsExpr GhcTc), @@ -1125,8 +1126,8 @@ ppr_infix_expr_tc (HsTick {}) = Nothing ppr_infix_expr_tc (HsBinTick {}) = Nothing ppr_infix_expr_tc (HsRecSelTc f) = Just (pprInfixOcc f) -ppr_infix_hs_expansion :: SrcCodeOrigin -> Maybe SDoc -ppr_infix_hs_expansion (OrigExpr e) = ppr_infix_expr e +ppr_infix_hs_expansion :: ErrCtxtMsg -> Maybe SDoc +ppr_infix_hs_expansion (ExprCtxt e) = ppr_infix_expr e ppr_infix_hs_expansion _ = Nothing pprDebugParendExpr :: (OutputableBndrId p) @@ -1216,8 +1217,8 @@ hsExprNeedsParens prec = go go_x_rn (ExpandedThingRn thing _ ) = hsExpandedNeedsParens thing go_x_rn (HsRecSelRn{}) = False - hsExpandedNeedsParens :: SrcCodeOrigin -> Bool - hsExpandedNeedsParens (OrigExpr e) = hsExprNeedsParens prec e + hsExpandedNeedsParens :: ErrCtxtMsg -> Bool + hsExpandedNeedsParens (ExprCtxt e) = hsExprNeedsParens prec e hsExpandedNeedsParens _ = False -- | Parenthesize an expression without token information @@ -1268,8 +1269,8 @@ isAtomicHsExpr (XExpr x) go_x_rn (ExpandedThingRn thing _) = isAtomicExpandedThingRn thing go_x_rn (HsRecSelRn{}) = True - isAtomicExpandedThingRn :: SrcCodeOrigin -> Bool - isAtomicExpandedThingRn (OrigExpr e) = isAtomicHsExpr e + isAtomicExpandedThingRn :: ErrCtxtMsg -> Bool + isAtomicExpandedThingRn (ExprCtxt e) = isAtomicHsExpr e isAtomicExpandedThingRn _ = False isAtomicHsExpr _ = False ===================================== compiler/GHC/Hs/Expr.hs-boot ===================================== @@ -15,8 +15,11 @@ import Language.Haskell.Syntax.Expr , GRHSs , HsUntypedSplice , HsTypedSplice + , HsMatchContext + , HsStmtContext ) -import GHC.Hs.Extension ( OutputableBndrId, GhcPass ) +import Language.Haskell.Syntax.Extension (LIdP) +import GHC.Hs.Extension ( OutputableBndrId, GhcPass, GhcRn) import GHC.Types.Name ( Name ) import Data.Bool ( Bool ) import Data.Maybe ( Maybe ) @@ -48,3 +51,6 @@ data HsUntypedSpliceResult thing , utsplice_result :: thing } | HsUntypedSpliceNested SplicePointName + +type HsMatchContextRn = HsMatchContext (LIdP GhcRn) +type HsStmtContextRn = HsStmtContext (LIdP GhcRn) ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -36,6 +36,7 @@ import Language.Haskell.Syntax.Decls import Language.Haskell.Syntax.Decls.Overlap (OverlapMode(..)) import Language.Haskell.Syntax.Extension (Anno) import Language.Haskell.Syntax.Binds.InlinePragma (ActivationX(..), InlinePragma(..)) +import GHC.Tc.Types.ErrCtxt -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs----------------------------------------- @@ -619,7 +620,7 @@ deriving instance Eq (IE GhcTc) -- --------------------------------------------------------------------- -deriving instance Data SrcCodeOrigin +deriving instance Data ErrCtxtMsg deriving instance Data XXExprGhcRn deriving instance Data a => Data (WithUserRdr a) ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -2778,7 +2778,7 @@ isHasFieldOrigin = \case RecordUpdOrigin {} -> True RecordFieldProjectionOrigin {} -> True GetFieldOrigin {} -> True - ExpansionOrigin (OrigExpr e) + ExpansionOrigin (ExprCtxt e) | HsGetField{} <- e -> True | RecordUpd{} <- e -> True | HsProjection{} <- e -> True ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -68,11 +68,11 @@ import GHC.Core.FVs( orphNamesOfTypes ) import GHC.CoreToIface import GHC.Driver.Flags -import GHC.Driver.Backend +-- import GHC.Driver.Backend import GHC.Hs hiding (HoleError) import GHC.Hs.Decls.Overlap -import GHC.Tc.Errors.Types +-- import GHC.Tc.Errors.Types import GHC.Tc.Errors.Types.PromotionErr (pprTermLevelUseCtxt) import GHC.Tc.Errors.Hole.FitTypes import GHC.Tc.Types.BasicTypes @@ -109,7 +109,7 @@ import GHC.Iface.Errors.Types import GHC.Iface.Errors.Ppr import GHC.Iface.Syntax -import GHC.Unit.State +-- import GHC.Unit.State import GHC.Unit.Module import GHC.Data.Bag ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -909,7 +909,7 @@ tcInstFun do_ql inst_final ds_flag (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigm mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> CtOrigin mk_herald tc_fun arg = case fun_orig of - ExpansionOrigin (OrigStmt{}) -> ExpectedTySyntax DoStmtOrigin arg + ExpansionOrigin (StmtErrCtxt{}) -> ExpectedTySyntax DoStmtOrigin arg _ -> ExpectedFunTyArg (HsExprTcThing tc_fun) arg -- Is the argument supposed to instantiate a forall? @@ -1258,7 +1258,7 @@ expr_to_type earg = | otherwise = not_in_scope where occ = occName rdr not_in_scope = failWith $ TcRnNotInScope NotInScope rdr - go (L l (XExpr (ExpandedThingRn (OrigExpr orig) _))) = + go (L l (XExpr (ExpandedThingRn (ExprCtxt orig) _))) = -- Use the original, user-written expression (before expansion). -- Example. Say we have vfun :: forall a -> blah -- and the call vfun (Maybe [1,2,3]) ===================================== compiler/GHC/Tc/Gen/Do.hs ===================================== @@ -482,4 +482,6 @@ It stores the original statement (with location) and the expanded expression mkExpandedPatRn :: Pat GhcRn -> ExprLStmt GhcRn -> HsExpr GhcRn -> HsExpr GhcRn -mkExpandedPatRn pat stmt e = XExpr (ExpandedThingRn (OrigPat stmt pat) e) +mkExpandedPatRn oflav pat stmt e = XExpr $ ExpandedThingRn + { xrn_orig = StmtErrCtxtPat (HsDoStmt flav) stmt pat + , xrn_expand = e} ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -676,7 +676,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr ; (ds_expr, ds_res_ty, err_msg) <- expandRecordUpd record_expr possible_parents rbnds res_ty - ; addExpansionErrCtxt (OrigExpr expr) err_msg $ + ; addExpansionErrCtxt (ExprCtxt expr) err_msg $ do { -- Typecheck the expanded expression. expr' <- tcExpr ds_expr (Check ds_res_ty) -- NB: it's important to use ds_res_ty and not res_ty here. ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -1287,7 +1287,7 @@ warnIncompleteRecSel dflags sel_id ct_loc -- GHC.Tc.Gen.App.tcInstFun arranges that the CtOrigin of (r.x) is GetFieldOrigin, -- despite the expansion to (getField @"x" r) - isGetFieldOrigin (ExpansionOrigin (OrigExpr (HsGetField {}))) = True + isGetFieldOrigin (ExpansionOrigin (ExprCtxt (HsGetField {}))) = True isGetFieldOrigin _ = False lookupHasFieldLabel ===================================== compiler/GHC/Tc/Types/ErrCtxt.hs ===================================== @@ -1,28 +1,28 @@ {-# LANGUAGE UndecidableInstances #-} module GHC.Tc.Types.ErrCtxt - ( ErrCtxt (..), ErrCtxtMsg(..), ErrCtxtMsgM, CodeSrcFlag (..), srcCodeOriginErrCtxMsg + ( ErrCtxt (..), ErrCtxtMsg(..), CodeSrcFlag (..) , UserSigType(..), FunAppCtxtFunArg(..) , TyConInstFlavour(..) ) where import GHC.Prelude -import GHC.Hs.Expr +import {-# SOURCE #-} GHC.Hs.Expr (SplicePointName, HsMatchContextRn, HsStmtContextRn) +import {-# SOURCE #-} GHC.Hs.Expr () -- for outputable instances +import GHC.Hs.Type () -- for outputable instances import GHC.Hs.Extension import GHC.Parser.Annotation ( LocatedN, SrcSpanAnnA ) import GHC.Tc.Errors.Types.PromotionErr ( TermLevelUseCtxt ) -import GHC.Tc.Types.Origin ( CtOrigin, UserTypeCtxt ) -import GHC.Tc.Utils.TcType ( TcType, TcTyCon ) -import GHC.Tc.Zonk.Monad ( ZonkM ) +import {-# SOURCE #-} GHC.Tc.Types.Origin ( CtOrigin, UserTypeCtxt ) +import {-# SOURCE #-} GHC.Tc.Utils.TcType ( TcType, TcTyCon ) import GHC.Types.Basic ( TyConFlavour ) import GHC.Types.Name ( Name ) -import GHC.Types.SrcLoc ( SrcSpan, unLoc ) +import GHC.Types.SrcLoc ( SrcSpan ) import GHC.Types.Var ( Id, TyCoVar ) -import GHC.Types.Var.Env ( TidyEnv ) import GHC.Unit.Types ( Module, InstantiatedModule ) @@ -32,7 +32,7 @@ import GHC.Core.PatSyn ( PatSyn ) import GHC.Core.TyCon ( TyCon ) import GHC.Core.TyCo.Rep ( Type, ThetaType, PredType ) -import GHC.Unit.State ( UnitState ) +import {-# SOURCE #-} GHC.Unit.State ( UnitState ) -- Break the module graph cycle for accesing ErrCtxtMsg in GHC.Hs.Expr import GHC.Data.FastString ( FastString ) import GHC.Utils.Outputable ( Outputable(..) ) @@ -45,7 +45,7 @@ import qualified Data.List.NonEmpty as NE -------------------------------------------------------------------------------- -type ErrCtxtMsgM = TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg) +-- type ErrCtxtMsgM = TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg) -- | Additional context to include in an error message, e.g. -- "In the type signature ...", "In the ambiguity check for ...", etc. @@ -55,7 +55,7 @@ data ErrCtxt = MkErrCtxt -- LandmarkUserSrcCode <=> this is a landmark context; do not -- discard it when trimming for display - ErrCtxtMsgM + ErrCtxtMsg -- Monadic so that we have a chance -- to deal with bound type variables just before error -- message construction @@ -63,19 +63,20 @@ data ErrCtxt = MkErrCtxt data CodeSrcFlag = VanillaUserSrcCode | LandmarkUserSrcCode - | ExpansionCodeCtxt SrcCodeOrigin + | ExpansionCodeCtxt -------------------------------------------------------------------------------- -- Error message contexts -data UserSigType p - = UserLHsSigType !(LHsSigType p) - | UserLHsType !(LHsType p) +data UserSigType + = UserLHsSigType !(LHsSigType GhcRn) + | UserLHsType !(LHsType GhcRn) -instance OutputableBndrId p => Outputable (UserSigType (GhcPass p)) where +instance Outputable UserSigType where ppr (UserLHsSigType ty) = ppr ty ppr (UserLHsType ty) = ppr ty + data FunAppCtxtFunArg = FunAppCtxtExpr !(HsExpr GhcRn) !(HsExpr GhcRn) | FunAppCtxtTy !(LHsType GhcRn) !(LHsType GhcRn) @@ -104,7 +105,7 @@ data ErrCtxtMsg -- or a type signature, or... (see 'Sig'). | SigCtxt !(Sig GhcRn) -- | In a user-written type signature. - | UserSigCtxt !UserTypeCtxt !(UserSigType GhcRn) + | UserSigCtxt !UserTypeCtxt !UserSigType -- | In a record update. | RecordUpdCtxt !(NE.NonEmpty ConLike) ![Name] ![TyCoVar] -- | In a class method. @@ -175,10 +176,10 @@ data ErrCtxtMsg | VDQWarningCtxt !TcTyCon -- | In a statement. - | forall body. - ( Anno (StmtLR GhcRn GhcRn body) ~ SrcSpanAnnA - , Outputable body - ) => StmtErrCtxt !HsStmtContextRn !(StmtLR GhcRn GhcRn body) + | StmtErrCtxt !HsStmtContextRn !(ExprLStmt GhcRn) + + -- | In patten of the statement. (c.f. MonadFailErrors) + | StmtErrCtxtPat !HsStmtContextRn !(ExprLStmt GhcRn) (Pat GhcRn) -- | In an rebindable syntax expression. | SyntaxNameCtxt !(HsExpr GhcRn) !CtOrigin !TcType !SrcSpan @@ -228,9 +229,3 @@ data ErrCtxtMsg | MergeSignaturesCtxt !UnitState !ModuleName ![InstantiatedModule] -- | While checking that a module implements a Backpack signature. | CheckImplementsCtxt !UnitState !Module !InstantiatedModule - - -srcCodeOriginErrCtxMsg :: SrcCodeOrigin -> ErrCtxtMsg -srcCodeOriginErrCtxMsg (OrigExpr e) = ExprCtxt e -srcCodeOriginErrCtxMsg (OrigStmt s f) = StmtErrCtxt (HsDoStmt f) (unLoc s) -srcCodeOriginErrCtxMsg (OrigPat s _) = StmtErrCtxt (HsDoStmt (DoExpr Nothing)) (unLoc s) ===================================== compiler/GHC/Tc/Types/LclEnv.hs ===================================== @@ -213,7 +213,7 @@ setLclEnvSrcCodeOrigin ec = modifyLclCtxt (setLclCtxtSrcCodeOrigin ec) setLclCtxtSrcCodeOrigin :: ErrCtxt -> TcLclCtxt -> TcLclCtxt setLclCtxtSrcCodeOrigin ec lclCtxt | ecs@(MkErrCtxt (ExpansionCodeCtxt{}) _ : _) <- tcl_err_ctxt lclCtxt - , MkErrCtxt (ExpansionCodeCtxt OrigExpr{}) _ <- ec + , MkErrCtxt (ExpansionCodeCtxt ExprCtxt{}) _ <- ec = lclCtxt { tcl_err_ctxt = ec : ecs } | MkErrCtxt (ExpansionCodeCtxt{}) _ : ecs <- tcl_err_ctxt lclCtxt , MkErrCtxt (ExpansionCodeCtxt{}) _ <- ec ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -654,7 +654,7 @@ data CtOrigin | AmbiguityCheckOrigin UserTypeCtxt | ImplicitLiftOrigin HsImplicitLiftSplice - | ExpansionOrigin SrcCodeOrigin -- This is due to an expansion of the original thing given by SrcCodeOrigin + | ExpansionOrigin ErrCtxtMsg -- This is due to an expansion of the original thing given by the ErrCtxtMsg | ExpectedTySyntax !CtOrigin (HsExpr GhcRn) @@ -828,11 +828,11 @@ exprCtOrigin (HsHole _) = Shouldn'tHappenOrigin "hole expression" exprCtOrigin (HsForAll {}) = Shouldn'tHappenOrigin "forall telescope" -- See Note [Types in terms] exprCtOrigin (HsQual {}) = Shouldn'tHappenOrigin "constraint context" -- See Note [Types in terms] exprCtOrigin (HsFunArr {}) = Shouldn'tHappenOrigin "function arrow" -- See Note [Types in terms] -exprCtOrigin e@(ExplicitList {}) = ExpansionOrigin (OrigExpr e) -exprCtOrigin e@(HsIf {}) = ExpansionOrigin (OrigExpr e) -exprCtOrigin e@(HsProjection _ _) = ExpansionOrigin (OrigExpr e) -exprCtOrigin e@(RecordUpd{}) = ExpansionOrigin (OrigExpr e) -exprCtOrigin e@(HsGetField{}) = ExpansionOrigin (OrigExpr e) +exprCtOrigin e@(ExplicitList {}) = ExpansionOrigin (ExprCtxt e) +exprCtOrigin e@(HsIf {}) = ExpansionOrigin (ExprCtxt e) +exprCtOrigin e@(HsProjection _ _) = ExpansionOrigin (ExprCtxt e) +exprCtOrigin e@(RecordUpd{}) = ExpansionOrigin (ExprCtxt e) +exprCtOrigin e@(HsGetField{}) = ExpansionOrigin (ExprCtxt e) exprCtOrigin (XExpr (ExpandedThingRn o _)) = ExpansionOrigin o exprCtOrigin (XExpr (HsRecSelRn f)) = OccurrenceOfRecSel $ L (getLoc $ foLabel f) (foExt f) @@ -872,21 +872,21 @@ pprCtOrigin (ExpansionOrigin o) where what :: SDoc what = case o of - OrigStmt{} -> + StmtErrCtxt{} -> text "a do statement" - OrigPat _ p -> + StmtErrCtxtPat _ p -> text "a do statement" $$ text "with the failable pattern" <+> quotes (ppr p) - OrigExpr (HsGetField _ _ (L _ f)) -> + ExprCtxt (HsGetField _ _ (L _ f)) -> hsep [text "selecting the field", quotes (ppr f)] - OrigExpr (HsOverLabel _ l) -> + ExprCtxt (HsOverLabel _ l) -> hsep [text "the overloaded label" , quotes (char '#' <> ppr l)] - OrigExpr (RecordUpd{}) -> text "a record update" - OrigExpr (ExplicitList{}) -> text "an overloaded list" - OrigExpr (HsIf{}) -> text "an if-then-else expression" - OrigExpr (HsProjection _ p) -> text "the record selector" <+> + ExprCtxt (RecordUpd{}) -> text "a record update" + ExprCtxt (ExplicitList{}) -> text "an overloaded list" + ExprCtxt (HsIf{}) -> text "an if-then-else expression" + ExprCtxt (HsProjection _ p) -> text "the record selector" <+> quotes (ppr ((FieldLabelStrings $ fmap noLocA p))) - OrigExpr e -> text "the expression" <+> (ppr e) + ExprCtxt e -> text "the expression" <+> (ppr e) pprCtOrigin (GivenSCOrigin sk d blk) = vcat [ ctoHerald <+> pprSkolInfo sk @@ -1105,13 +1105,13 @@ ppr_br (InstanceSigOrigin {}) = text "a type signature in an instance" ppr_br (AmbiguityCheckOrigin {}) = text "a type ambiguity check" ppr_br (ImpedanceMatching {}) = text "combining required constraints" ppr_br (NonLinearPatternOrigin _ pat) = hsep [text "a non-linear pattern" <+> quotes (ppr pat)] -ppr_br (ExpansionOrigin (OrigExpr (HsOverLabel _ l))) = hsep [text "the overloaded label", quotes (char '#' <> ppr l)] -ppr_br (ExpansionOrigin (OrigExpr (RecordUpd{}))) = text "a record update" -ppr_br (ExpansionOrigin (OrigExpr (ExplicitList{}))) = text "an overloaded list" -ppr_br (ExpansionOrigin (OrigExpr (HsIf{}))) = text "an if-then-else expression" -ppr_br (ExpansionOrigin (OrigExpr e)) = text "an expression" <+> ppr e -ppr_br (ExpansionOrigin (OrigStmt{})) = text "a do statement" -ppr_br (ExpansionOrigin (OrigPat{})) = text "a do statement" +ppr_br (ExpansionOrigin (ExprCtxt (HsOverLabel _ l))) = hsep [text "the overloaded label", quotes (char '#' <> ppr l)] +ppr_br (ExpansionOrigin (ExprCtxt (RecordUpd{}))) = text "a record update" +ppr_br (ExpansionOrigin (ExprCtxt (ExplicitList{}))) = text "an overloaded list" +ppr_br (ExpansionOrigin (ExprCtxt (HsIf{}))) = text "an if-then-else expression" +ppr_br (ExpansionOrigin (ExprCtxt e)) = text "an expression" <+> ppr e +ppr_br (ExpansionOrigin (StmtErrCtxt{})) = text "a do statement" +ppr_br (ExpansionOrigin (StmtErrCtxtPat{})) = text "a do statement" ppr_br (ExpectedTySyntax o _) = ppr_br o ppr_br (ExpectedFunTySyntaxOp{}) = text "a rebindable syntax operator" ppr_br (ExpectedFunTyViewPat{}) = text "a view pattern" ===================================== compiler/GHC/Tc/Types/Origin.hs-boot ===================================== @@ -4,6 +4,8 @@ import GHC.Prelude.Basic ( Int, Maybe ) import GHC.Utils.Misc ( HasDebugCallStack ) import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type ) +data CtOrigin +data UserTypeCtxt data SkolemInfoAnon data SkolemInfo data FixedRuntimeRepContext ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1346,12 +1346,12 @@ add_expr_ctxt e thing_inside -- because it is mentioned in the error message itself ExprWithTySig _ (L _ e') _ - | XExpr (ExpandedThingRn o _) <- e' -> addExpansionErrCtxt o (ExprCtxt e) thing_inside + | XExpr (ExpandedThingRn o _) <- e' -> addExpansionErrCtxt o thing_inside -- There is a special case for expressions with signatures to avoid having too verbose -- error context. So here we flip the ErrCtxt state to expanded if the expression is expanded. -- c.f. RecordDotSyntaxFail9 - XExpr (ExpandedThingRn o _) -> addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) thing_inside + XExpr (ExpandedThingRn o _) -> addExpansionErrCtxt o thing_inside -- Flip error ctxt into expansion mode _ -> addErrCtxt (ExprCtxt e) thing_inside @@ -1372,9 +1372,9 @@ addErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a addErrCtxt msg = addErrCtxtM (\env -> return (env, msg)) -- See Note [ErrCtxtStack Manipulation] -addExpansionErrCtxt :: SrcCodeOrigin -> ErrCtxtMsg -> TcM a -> TcM a +addExpansionErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a {-# INLINE addExpansionErrCtxt #-} -- Note [Inlining addErrCtxt] -addExpansionErrCtxt o msg = addExpansionErrCtxtM o (\env -> return (env, msg)) +addExpansionErrCtxt msg = addExpansionErrCtxtM (\env -> return (env, msg)) -- | Add a message to the error context. This message may do tidying. -- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr @@ -1383,9 +1383,9 @@ addErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a addErrCtxtM ctxt = pushCtxt (MkErrCtxt VanillaUserSrcCode ctxt) -- See Note [ErrCtxtStack Manipulation] -addExpansionErrCtxtM :: SrcCodeOrigin -> (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a +addExpansionErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a {-# INLINE addExpansionErrCtxtM #-} -- Note [Inlining addErrCtxt] -addExpansionErrCtxtM o ctxt = pushCtxt (MkErrCtxt (ExpansionCodeCtxt o) ctxt) +addExpansionErrCtxtM ctxt = pushCtxt (MkErrCtxt ExpansionCodeCtxt ctxt) -- | Add a fixed landmark message to the error context. A landmark -- message is always sure to be reported, even if there is a lot of ===================================== compiler/GHC/Tc/Utils/TcType.hs-boot ===================================== @@ -5,6 +5,8 @@ import GHC.Prelude ( Bool ) import {-# SOURCE #-} GHC.Types.Var ( TcTyVar ) import {-# SOURCE #-} GHC.Tc.Types.Origin ( FixedRuntimeRepOrigin ) import GHC.Types.Name.Env ( NameEnv ) +import {-# SOURCE #-} GHC.Core.TyCon (TyCon) +import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type) data MetaDetails @@ -20,3 +22,6 @@ data ConcreteTvOrigin isConcreteTyVar :: TcTyVar -> Bool noConcreteTyVars :: ConcreteTyVars + +type TcTyCon = TyCon +type TcType = Type \ No newline at end of file ===================================== compiler/GHC/Types/Error.hs-boot ===================================== @@ -0,0 +1,24 @@ +module GHC.Types.Error where + +import GHC.Prelude (Maybe, Bool, IO) +import GHC.Utils.Outputable (SDoc) +import GHC.Types.SrcLoc (SrcSpan) + +data MessageClass + = MCOutput + | MCFatal + | MCInteractive + | MCDump + | MCInfo + | MCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode) + +data Severity + = SevIgnore + | SevWarning + | SevError + +data DiagnosticCode +data ResolvedDiagnosticReason + +mkLocMessageWarningGroups :: Bool -> MessageClass -> SrcSpan -> SDoc -> SDoc +getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc \ No newline at end of file ===================================== compiler/GHC/Unit/State.hs-boot ===================================== @@ -0,0 +1,7 @@ +module GHC.Unit.State where + +data UnitState +data ModuleSuggestion +data ModuleOrigin +data UnusableUnit +data UnitInfo \ No newline at end of file ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -82,7 +82,10 @@ where import GHC.Prelude import GHC.Driver.Flags -import GHC.Types.Error +import {-# SOURCE #-} GHC.Types.Error + ( MessageClass (..), Severity (..), ResolvedDiagnosticReason, DiagnosticCode + , mkLocMessageWarningGroups,getCaretDiagnostic) +import GHC.Types.Error () import GHC.Types.SrcLoc import qualified GHC.Utils.Ppr as Pretty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef338e58b86e668dffeab1e0053045b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef338e58b86e668dffeab1e0053045b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Add cabal.project file to generate-ci
by Marge Bot (＠marge-bot) 09 Feb '26

09 Feb '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d112b440 by Sven Tennie at 2026-02-07T10:47:56-05:00 Add cabal.project file to generate-ci This fixes the HLS setup for our CI code generation script (generate-ci). The project file simply makes `generate-ci` of the cabal file discoverable. - - - - - 5339f6f0 by Andreas Klebinger at 2026-02-07T10:48:40-05:00 CI: Don't collapse test results. This puts test output back into the primary test log instead of a subsection removing the need to expand a section to see test results. While the intention was good in practice the old behaviour mostly wastes time by requiring expansion of the section. Fixes #26882 - - - - - 0e1cd2e0 by Evan Piro at 2026-02-08T10:35:16-08:00 Linker.MacOS reduce dynflags import - - - - - 580be06d by Michael Alan Dorman at 2026-02-08T20:07:43-05:00 Remove `extra_src_files` variable from `testsuite/driver/testlib.py` While reading through the test harness code, I noticed this variable with a TODO attached that referenced #12223. Although that bug is closed, it strongly implied that this special-case variable that only affected a single test was expected to be removed at some point. I also looked at 3415bcaa0b1903b5e12dfaadb5b774718e406eab---where it was added---whose commit message suggested that it would have been desirable to remove it, but that there were special circumstances that meant it had to remain (though it doesn't elucidate what those special circumstances are). However, the special circumstances were mentioned as if the test was in a different location than is currently is, so I decided to try changing the test to use the standard `extra_files` mechanism, which works in local testing. This also seems like a reasonable time to remove the script that was originally used in the transition, since it doesn't really serve a purpose anymore. - - - - - 6 changed files: - .gitlab/ci.sh - + .gitlab/generate-ci/cabal.project - compiler/GHC/Linker/MacOS.hs - − testsuite/driver/kill_extra_files.py - testsuite/driver/testlib.py - testsuite/tests/process/all.T Changes: ===================================== .gitlab/ci.sh ===================================== @@ -655,7 +655,6 @@ function install_bindist() { } function test_hadrian() { - start_section test-hadrian "Test via Hadrian" check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -777,7 +776,6 @@ function test_hadrian() { info "STAGE2_TEST=$?" fi - end_section test-hadrian } function summarise_hi_files() { ===================================== .gitlab/generate-ci/cabal.project ===================================== @@ -0,0 +1 @@ +packages: . ===================================== compiler/GHC/Linker/MacOS.hs ===================================== @@ -11,8 +11,6 @@ import GHC.Platform import GHC.Linker.Config -import GHC.Driver.DynFlags - import GHC.Unit.Types import GHC.Unit.State import GHC.Unit.Env @@ -23,6 +21,7 @@ import GHC.Runtime.Interpreter import GHC.Utils.Exception import GHC.Utils.Logger +import GHC.Driver.Session import Data.List (isPrefixOf, nub, sort, intersperse, intercalate) import Data.Char ===================================== testsuite/driver/kill_extra_files.py deleted ===================================== @@ -1,101 +0,0 @@ -#!/usr/bin/env python3 -from typing import Dict, List, Set, NamedTuple - -import os -import subprocess -import ast - -import extra_files -extra_src_files = extra_files.extra_src_files # type: Dict[str, List[str]] - -found_tests = set() # type: Set[str] -fixed_tests = set() # type: Set[str] - -def extras(name: str) -> str: - return 'extra_files(%s)' % (extra_src_files[name],) - -def list_extras(name: str, col: int) -> str: - return extras(name) + ',\n' + ' ' * (col + 1) - -def find_all_T_files(basedir: bytes) -> List[bytes]: - result = [] # type: List[bytes] - for dirpath, dirnames, filenames in os.walk(basedir): - for f in filenames: - if f.endswith(b'.T'): - result.append(os.path.join(dirpath, f)) - return result - -# Delete del bytes from (line, col) and then insert the string ins there. -Fixup = NamedTuple('Fixup', [('line', int), - ('col', int), - ('delete', int), - ('insert', str)]) - -class TestVisitor(ast.NodeVisitor): - def __init__(self) -> None: - self.fixups = [] # type: List[Fixup] - - def visit_Call(self, node: ast.AST) -> None: - self.generic_visit(node) - assert isinstance(node, ast.Call) - - if isinstance(node.func, ast.Name) and node.func.id == 'test': - assert(len(node.args) == 4) - name_expr, setup, test_fn, args = node.args - if not(isinstance(name_expr, ast.Str)): - return - name = name_expr.s - if name in extra_src_files: - found_tests.add(name) - if isinstance(setup, ast.Name): - if setup.id == 'normal': - # Kill it - self.fixups.append(Fixup( - line=setup.lineno, col=setup.col_offset, - delete=len(setup.id), insert=extras(name))) - else: - # Make a lit - self.fixups.append(Fixup( - line=setup.lineno, col=setup.col_offset, - delete=0, - insert='[' + list_extras(name, setup.col_offset))) - self.fixups.append(Fixup( - line=setup.lineno, - col=setup.col_offset + len(setup.id), - delete=0, insert=']')) - fixed_tests.add(name) - elif isinstance(setup, ast.List): - # Insert into list at start - if not setup.elts: - ins = extras(name) # no need for comma, newline - # Don't try to delete the list because someone - # might have written "[ ]" for some reason - else: - ins = list_extras(name, setup.col_offset) - self.fixups.append(Fixup( - line=setup.lineno, col=setup.col_offset + 1, - delete=0, insert=ins)) - fixed_tests.add(name) - else: - assert False # we fixed them all manually already - -basedir = subprocess.check_output(['git', 'rev-parse', '--show-toplevel']) -basedir = basedir[0:-1] # delete trailing newline -print(basedir) -for f in find_all_T_files(basedir): - print(f) - text = open(f).read() - mod = ast.parse(text) - tv = TestVisitor() - tv.visit(mod) - - lines = text.split('\n') - if not tv.fixups: - # Don't rewrite files unnecessarily - # (libraries/Win32 has Windows line endings) - continue - for fixup in reversed(tv.fixups): - l = list(lines[fixup.line-1]) - l[fixup.col:fixup.col + fixup.delete] = fixup.insert - lines[fixup.line-1] = ''.join(l) - open(f, 'w').write('\n'.join(lines)) ===================================== testsuite/driver/testlib.py ===================================== @@ -31,7 +31,6 @@ import testutil from cpu_features import have_cpu_feature import perf_notes as Perf from perf_notes import MetricChange, PerfStat, StatsException, AlwaysAccept, RelativeMetricAcceptanceWindow -extra_src_files = {'T4198': ['exitminus1.c']} # TODO: See #12223 from my_typing import * @@ -1644,7 +1643,7 @@ async def test_common_work(name: TestName, opts, if f.startswith(name) and not f == name and not f.endswith(testdir_suffix) and not os.path.splitext(f)[1] in do_not_copy) - for filename in (opts.extra_files + extra_src_files.get(name, [])): + for filename in (opts.extra_files): if filename.startswith('/'): framework_fail(name, None, 'no absolute paths in extra_files please: ' + filename) ===================================== testsuite/tests/process/all.T ===================================== @@ -27,6 +27,7 @@ test('T3231', ['']) test('T4198', [pre_cmd('{compiler} exitminus1.c -no-hs-main -o exitminus1'), + extra_files(['exitminus1.c']), js_broken(22349), req_process], compile_and_run, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc6968179641973af5adf5589e71d1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc6968179641973af5adf5589e71d1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/hadrian-cross-stage3] Adjust jobs.yaml
by Sven Tennie (＠supersven) 08 Feb '26

08 Feb '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 77ec95ae by Sven Tennie at 2026-02-08T14:56:03+01:00 Adjust jobs.yaml - - - - - 1 changed file: - .gitlab/jobs.yaml Changes: ===================================== .gitlab/jobs.yaml ===================================== @@ -6795,7 +6795,7 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_3-validate", + "BIN_DIST_NAME": "stage3-ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-riscv64 -L /usr/riscv64-linux-gnu", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77ec95ae9e7e73313b4717ed2f0c44b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77ec95ae9e7e73313b4717ed2f0c44b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/hadrian-cross-stage3] 3 commits: Hack
by Sven Tennie (＠supersven) 08 Feb '26

08 Feb '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 7456b7c7 by Sven Tennie at 2026-02-07T08:10:14+01:00 Hack - - - - - 37a1598a by Sven Tennie at 2026-02-07T08:23:33+01:00 WIP: Validate script - - - - - 2fdd2d9a by Sven Tennie at 2026-02-07T12:18:43+01:00 Fix stage3 bindist creation - - - - - 3 changed files: - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - + validate-riscv-bindist.sh Changes: ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -122,8 +122,8 @@ installTo relocatable prefix = do runBuilderWithCmdOptions env (Make bindistFilesDir) ["install"] [] [] -buildBinDistDir :: FilePath -> BindistConfig -> Action () -buildBinDistDir root conf@BindistConfig{..} = do +buildBinDistDir :: FilePath -> FilePath -> BindistConfig -> Action () +buildBinDistDir dirPrefix root conf@BindistConfig{..} = do verbosity <- getVerbosity -- We 'need' all binaries and libraries @@ -153,7 +153,7 @@ buildBinDistDir root conf@BindistConfig{..} = do distDir <- Context.distDir (vanillaContext library_stage rts) let ghcBuildDir = root -/- stageString library_stage - bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty + bindistFilesDir = root -/- "bindist" -/- dirPrefix <> ghcVersionPretty ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform rtsIncludeDir = distDir -/- "include" @@ -223,8 +223,7 @@ buildBinDistDir root conf@BindistConfig{..} = do -- N.B. the ghc-pkg executable may be prefixed with a target triple -- (c.f. #20267). - -- Not going to work for cross - ghcPkgName <- programName (vanillaContext Stage1 ghcPkg) + ghcPkgName <- programName (vanillaContext executable_stage ghcPkg) cmd_ (bindistFilesDir -/- "bin" -/- ghcPkgName) ["recache", "--package-db", bindistFilesDir -/- "lib" -/- "package.conf.d" ] @@ -316,27 +315,27 @@ bindistRules = do phony "binary-dist-dir" $ do cfg <- implicitBindistConfig - buildBinDistDir root cfg + buildBinDistDir "" root cfg - phony "binary-dist-dir-cross" $ buildBinDistDir root crossBindist + phony "binary-dist-dir-cross" $ buildBinDistDir "" root crossBindist - phony "binary-dist-dir-stage3" $ buildBinDistDir root targetBindist + phony "binary-dist-dir-stage3" $ buildBinDistDir "stage3-" root targetBindist let buildBinDist compressor = do win_host <- isWinHost win_target <- isWinTarget Stage2 when (win_target && win_host) (error "normal binary-dist does not work for windows targets, use `reloc-binary-dist-*` target instead.") - buildBinDistX "binary-dist-dir" "bindist" compressor - buildBinDistReloc = buildBinDistX "reloc-binary-dist-dir" "reloc-bindist" + buildBinDistX "binary-dist-dir" "bindist" "" compressor + buildBinDistReloc = buildBinDistX "reloc-binary-dist-dir" "reloc-bindist" "" - buildBinDistX :: String -> FilePath -> Compressor -> Action () - buildBinDistX target bindist_folder compressor = do + buildBinDistX :: String -> FilePath -> FilePath -> Compressor -> Action () + buildBinDistX target bindist_folder dirPrefix compressor = do need [target] version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull - let ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform + let ghcVersionPretty = dirPrefix <> "ghc-" ++ version ++ "-" ++ targetPlatform -- Finally, we create the archive <root>/bindist/ghc-X.Y.Z-platform.tar.xz tarPath <- builderPath (Tar Create) @@ -352,12 +351,12 @@ bindistRules = do phony (name <> "-dist-xz") $ mk_bindist Xz -- TODO: Generate these targets as well - phony ("binary-dist-cross") $ buildBinDistX "binary-dist-dir-cross" "bindist" Xz - phony ("binary-dist-stage3") $ buildBinDistX "binary-dist-dir-stage3" "bindist" Xz + phony "binary-dist-cross" $ buildBinDistX "binary-dist-dir-cross" "bindist" "" Xz + phony "binary-dist-stage3" $ buildBinDistX "binary-dist-dir-stage3" "bindist" "stage3-" Xz -- Prepare binary distribution configure script -- (generated under <ghc root>/distrib/configure by 'autoreconf') - root -/- "bindist" -/- "ghc-*" -/- "configure" %> \configurePath -> do + root -/- "bindist" -/- "*ghc-*" -/- "configure" %> \configurePath -> do need ["distrib" -/- "configure.ac"] ghcRoot <- topDirectory copyFile (ghcRoot -/- "aclocal.m4") (ghcRoot -/- "distrib" -/- "aclocal.m4") @@ -372,7 +371,7 @@ bindistRules = do moveFile (ghcRoot -/- "distrib" -/- "configure") configurePath -- Generate the Makefile that enables the "make install" part - root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> do + root -/- "bindist" -/- "*ghc-*" -/- "Makefile" %> \makefilePath -> do top <- topDirectory copyFile (top -/- "hadrian" -/- "bindist" -/- "Makefile") makefilePath @@ -381,7 +380,7 @@ bindistRules = do -- (see the list of files needed in the 'binary-dist' rule above, before -- creating the archive). forM_ bindistInstallFiles $ \file -> - root -/- "bindist" -/- "ghc-*" -/- file %> \dest -> do + root -/- "bindist" -/- "*ghc-*" -/- file %> \dest -> do copyFile (fixup file) dest where @@ -466,7 +465,7 @@ pkgToWrappers stage pkg = do -- These are the packages which we want to expose to the user and hence -- there are wrappers installed in the bindist. | pkg `elem` [hpcBin, haddock, hp2ps, hsc2hs, ghc, ghcPkg] - -> (:[]) <$> (programName =<< programContext Stage1 pkg) + -> (:[]) <$> (programName =<< programContext stage pkg) | otherwise -> pure [] wrapper :: Stage -> FilePath -> Action String ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -417,9 +417,15 @@ bindistRules = do templateRule ("distrib" -/- "configure.ac") $ mconcat [ interpolateSetting "ConfiguredEmsdkVersion" EmsdkVersion , interpolateVar "CrossCompilePrefix" $ do - crossCompiling <- interp $ getFlag CrossCompiling - tpf <- setting TargetPlatformFull - pure $ if crossCompiling then tpf <> "-" else "" + -- For a bindist, the prefix is needed only if the distributed compiler + -- is a cross-compiler (i.e., host != target in the bindist). + -- For Stage3 bindist (isStage3Cross=True), both host and target are the + -- target platform, so no prefix. For cross-compiler bindist (Stage1), + -- host != target, so we add the prefix. + -- Note: This template is shared by all bindist types, evaluated in Stage2 context. + host <- ifM isStage3Cross (setting TargetPlatformFull) (setting HostPlatformFull) + target <- setting TargetPlatformFull + pure $ if host /= target then target <> "-" else "" , interpolateVar "LeadingUnderscore" $ yesNo <$> getTarget tgtSymbolsHaveLeadingUnderscore , interpolateSetting "LlvmMaxVersion" LlvmMaxVersion , interpolateSetting "LlvmMinVersion" LlvmMinVersion @@ -429,8 +435,8 @@ bindistRules = do , interpolateVar "TablesNextToCode" $ yesNo <$> getTarget tgtTablesNextToCode , interpolateVar "TargetHasLibm" $ yesNo <$> interp (staged (buildFlag TargetHasLibm)) , interpolateVar "TargetPlatform" $ getTarget targetPlatformTriple - , interpolateVar "BuildPlatform" $ interp $ queryBuild targetPlatformTriple - , interpolateVar "HostPlatform" $ interp $ queryHost targetPlatformTriple + , interpolateVar "BuildPlatform" $ ifM isStage3Cross (getTarget targetPlatformTriple) (interp $ queryBuild targetPlatformTriple) + , interpolateVar "HostPlatform" $ ifM isStage3Cross (getTarget targetPlatformTriple) (interp $ queryHost targetPlatformTriple) , interpolateVar "TargetWordBigEndian" $ getTarget isBigEndian , interpolateVar "TargetWordSize" $ getTarget wordSize , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised @@ -439,13 +445,19 @@ bindistRules = do , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP Stage2 , interpolateVar "TargetPlatformFull" (setting TargetPlatformFull) - , interpolateVar "BuildPlatformFull" (setting BuildPlatformFull) - , interpolateVar "HostPlatformFull" (setting HostPlatformFull) + , interpolateVar "BuildPlatformFull" $ ifM isStage3Cross (setting TargetPlatformFull) (setting BuildPlatformFull) + , interpolateVar "HostPlatformFull" $ ifM isStage3Cross (setting TargetPlatformFull) (setting HostPlatformFull) ] where interp = interpretInContext (semiEmptyTarget Stage2) getTarget = interp . queryTarget Stage2 + -- TODO: This is a hack. It should be covered by config files + isStage3Cross = do + crossCompiling <- interp $ getFlag CrossCompiling + stage <- interp getStage + pure $ if crossCompiling && stage >= Stage2 then True else False + -- | Given a 'String' replace characters '.' and '-' by underscores ('_') so that -- the resulting 'String' is a valid C preprocessor identifier. cppify :: String -> String ===================================== validate-riscv-bindist.sh ===================================== @@ -0,0 +1,184 @@ +#!/usr/bin/env bash +# Script to validate that only RISC-V binaries, libraries, and target strings +# are present in _build/bindist/stage3-* directories + +set -e + +RED='\033[0;31m' +GREEN='\033[0;32m' +YELLOW='\033[1;33m' +NC='\033[0m' # No Color + +ERRORS=0 +WARNINGS=0 + +echo "=== RISC-V Bindist Validation Script ===" +echo "" + +# Find all stage3-* directories +STAGE3_DIRS=$(find _build/bindist -maxdepth 1 -name "stage3-*" -type d 2>/dev/null || true) + +if [ -z "$STAGE3_DIRS" ]; then + echo -e "${YELLOW}Warning: No stage3-* directories found in _build/bindist/${NC}" + exit 1 +fi + +echo "Found stage3 directories:" +echo "$STAGE3_DIRS" +echo "" + +# Function to check if a file is a RISC-V binary/library +check_binary_arch() { + local file="$1" + + # Skip non-binary files + if ! file "$file" | grep -qE "ELF|archive"; then + return 0 + fi + + # Check architecture + local arch_info=$(file "$file") + + if echo "$arch_info" | grep -qE "RISC-V|riscv"; then + return 0 + else + echo -e "${RED}ERROR: Non-RISC-V binary/library found:${NC}" + echo " File: $file" + echo " Arch: $arch_info" + echo "" + return 1 + fi +} + +# Function to check target strings in text files +check_target_strings() { + local file="$1" + + # Skip if file is not readable or is a directory + if [ ! -f "$file" ] || [ ! -r "$file" ]; then + return 0 + fi + + # Skip binary files (ELF binaries and archives) + if file "$file" | grep -qE "ELF|archive"; then + return 0 + fi + + # Look for common non-RISC-V target patterns (case insensitive) + # Common architectures to check for: x86_64, aarch64, arm, i386, i686, powerpc, etc. + # Also check for build/host alias variables + local bad_patterns=( + "build_alias=.*x86_64" + "build_alias=.*aarch64" + "build_alias=.*i386" + "build_alias=.*i686" + "host_alias=.*x86_64" + "host_alias=.*aarch64" + "host_alias=.*i386" + "host_alias=.*i686" + "bootstrap_build=.*x86_64" + "bootstrap_build=.*aarch64" + "bootstrap_build=.*i386" + "bootstrap_build=.*i686" + "bootstrap_host=.*x86_64" + "bootstrap_host=.*aarch64" + "bootstrap_host=.*i386" + "bootstrap_host=.*i686" + ) + + local found_bad=0 + for pattern in "${bad_patterns[@]}"; do + if grep -qiE "$pattern" "$file" 2>/dev/null; then + if [ $found_bad -eq 0 ]; then + echo -e "${RED}ERROR: Non-RISC-V target string found in:${NC}" + echo " File: $file" + found_bad=1 + fi + echo " Pattern: $pattern" + # Show context (up to 3 lines) + grep -niE "$pattern" "$file" | head -3 | sed 's/^/ /' + fi + done + + if [ $found_bad -eq 1 ]; then + echo "" + return 1 + fi + + return 0 +} + +# Function to check for RISC-V references (informational) +check_riscv_presence() { + local file="$1" + + # Skip binary files for this check + if file "$file" | grep -qE "ELF|archive|executable"; then + return 0 + fi + + if [ ! -f "$file" ] || [ ! -r "$file" ]; then + return 0 + fi + + # Check if it's a text file + if ! file "$file" | grep -qE "text|ASCII|UTF-8|script"; then + return 0 + fi + + # Look for RISC-V patterns + if grep -qiE "riscv|risc-v" "$file" 2>/dev/null; then + return 0 + fi + + return 1 +} + +echo "=== Checking binaries and libraries for architecture ===" +echo "" + +for dir in $STAGE3_DIRS; do + echo "Scanning: $dir" + + # Find all ELF binaries and archives + while IFS= read -r -d '' file; do + if ! check_binary_arch "$file"; then + ((ERRORS++)) + fi + done < <(find "$dir" -type f -executable -print0 2>/dev/null) + + # Also check .a and .so files + while IFS= read -r -d '' file; do + if ! check_binary_arch "$file"; then + ((ERRORS++)) + fi + done < <(find "$dir" -type f $ -name "*.a" -o -name "*.so" -o -name "*.so.*" $ -print0 2>/dev/null) +done + +echo "" +echo "=== Checking text files for non-RISC-V target strings ===" +echo "" + +for dir in $STAGE3_DIRS; do + echo "Scanning: $dir" + + # Check common configuration and script files + while IFS= read -r -d '' file; do + if ! check_target_strings "$file"; then + ((ERRORS++)) + fi + done < <(find "$dir" -type f $ -name "*.conf" -o -name "*.config" -o -name "*.sh" -o -name "*.txt" -o -name "*.cabal" -o -name "*.mk" -o -name "Makefile" -o -name "configure" $ -print0 2>/dev/null) +done + +echo "" +echo "=== Summary ===" +echo "" + +if [ $ERRORS -eq 0 ]; then + echo -e "${GREEN}✓ All checks passed! Only RISC-V binaries/libraries and target strings found.${NC}" + exit 0 +else + echo -e "${RED}✗ Found $ERRORS error(s)${NC}" + echo -e "${RED}Non-RISC-V content detected in stage3 bindist directories!${NC}" + exit 1 +fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/251862dcf6e7ad8ace5a7626bd0d3c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/251862dcf6e7ad8ace5a7626bd0d3c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] CI: Don't collapse test results.
by Marge Bot (＠marge-bot) 07 Feb '26

07 Feb '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5339f6f0 by Andreas Klebinger at 2026-02-07T10:48:40-05:00 CI: Don't collapse test results. This puts test output back into the primary test log instead of a subsection removing the need to expand a section to see test results. While the intention was good in practice the old behaviour mostly wastes time by requiring expansion of the section. Fixes #26882 - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -655,7 +655,6 @@ function install_bindist() { } function test_hadrian() { - start_section test-hadrian "Test via Hadrian" check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -777,7 +776,6 @@ function test_hadrian() { info "STAGE2_TEST=$?" fi - end_section test-hadrian } function summarise_hi_files() { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5339f6f062f40b2509f75573880e875… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5339f6f062f40b2509f75573880e875… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Add cabal.project file to generate-ci
by Marge Bot (＠marge-bot) 07 Feb '26

07 Feb '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d112b440 by Sven Tennie at 2026-02-07T10:47:56-05:00 Add cabal.project file to generate-ci This fixes the HLS setup for our CI code generation script (generate-ci). The project file simply makes `generate-ci` of the cabal file discoverable. - - - - - 1 changed file: - + .gitlab/generate-ci/cabal.project Changes: ===================================== .gitlab/generate-ci/cabal.project ===================================== @@ -0,0 +1 @@ +packages: . View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d112b4407af651841367e5d326d98e6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d112b4407af651841367e5d326d98e6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: NCG/LA64: adjust register usage to avoid src-register being clobbered
by Marge Bot (＠marge-bot) 07 Feb '26

07 Feb '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2e39a340 by Peng Fan at 2026-02-07T03:42:01-05:00 NCG/LA64: adjust register usage to avoid src-register being clobbered - - - - - 9faf1b35 by Teo Camarasu at 2026-02-07T03:42:43-05:00 ghc-internal: Delete unnecessary GHC.Internal.Data.Ix This module merely re-exports GHC.Internal.Ix. It was copied from `base` when `ghc-internal` was split, but there is no reason to have this now. So, let's delete it. Resolves #26848 - - - - - badaf1da by Sven Tennie at 2026-02-07T06:17:36-05:00 Add cabal.project file to generate-ci This fixes the HLS setup for our CI code generation script (generate-ci). The project file simply makes `generate-ci` of the cabal file discoverable. - - - - - fc696817 by Andreas Klebinger at 2026-02-07T06:17:37-05:00 CI: Don't collapse test results. This puts test output back into the primary test log instead of a subsection removing the need to expand a section to see test results. While the intention was good in practice the old behaviour mostly wastes time by requiring expansion of the section. Fixes #26882 - - - - - 10 changed files: - .gitlab/ci.sh - + .gitlab/generate-ci/cabal.project - compiler/GHC/CmmToAsm/LA64/CodeGen.hs - libraries/base/src/Data/Ix.hs - libraries/ghc-internal/ghc-internal.cabal.in - − libraries/ghc-internal/src/GHC/Internal/Data/Ix.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== .gitlab/ci.sh ===================================== @@ -655,7 +655,6 @@ function install_bindist() { } function test_hadrian() { - start_section test-hadrian "Test via Hadrian" check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -777,7 +776,6 @@ function test_hadrian() { info "STAGE2_TEST=$?" fi - end_section test-hadrian } function summarise_hi_files() { ===================================== .gitlab/generate-ci/cabal.project ===================================== @@ -0,0 +1 @@ +packages: . ===================================== compiler/GHC/CmmToAsm/LA64/CodeGen.hs ===================================== @@ -1784,16 +1784,18 @@ genClz :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock genClz w dst src = do platform <- getPlatform (reg_x, _, code_x) <- getSomeReg src + tmp <- getNewRegNat II64 let dst_reg = getRegisterReg platform (CmmLocal dst) if w `elem` [W32, W64] then do return (code_x `snocOL` CLZ (OpReg w dst_reg) (OpReg w reg_x)) else if w `elem` [W8, W16] then do + -- Process uniformly according to one data length, W32. return (code_x `appOL` toOL [ - MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)), - SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt (31-shift))), - SLL (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (32-shift))), - OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x), + MOV (OpReg W64 tmp) (OpImm (ImmInt 1)), + SLL (OpReg W64 tmp) (OpReg W64 tmp) (OpImm (ImmInt (31-shift))), + SLL (OpReg W64 dst_reg) (OpReg W32 reg_x) (OpImm (ImmInt (32-shift))), + OR (OpReg W64 dst_reg) (OpReg W64 tmp) (OpReg W64 dst_reg), CLZ (OpReg W64 dst_reg) (OpReg W32 dst_reg) ] ) @@ -1806,16 +1808,17 @@ genCtz :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock genCtz w dst src = do platform <- getPlatform (reg_x, _, code_x) <- getSomeReg src + tmp <- getNewRegNat II64 let dst_reg = getRegisterReg platform (CmmLocal dst) if w `elem` [W32, W64] then do return (code_x `snocOL` CTZ (OpReg w dst_reg) (OpReg w reg_x)) else if w `elem` [W8, W16] then do return (code_x `appOL` toOL [ - MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)), - SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt shift)), - BSTRPICK II64 (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (shift-1))) (OpImm (ImmInt 0)), - OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x), + MOV (OpReg W64 tmp) (OpImm (ImmInt 1)), + SLL (OpReg W64 tmp) (OpReg W64 tmp) (OpImm (ImmInt shift)), + BSTRPICK II64 (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt (shift-1))) (OpImm (ImmInt 0)), + OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 tmp), CTZ (OpReg W64 dst_reg) (OpReg W64 dst_reg) ] ) ===================================== libraries/base/src/Data/Ix.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} -- | -- @@ -42,4 +42,4 @@ module Data.Ix -- <https://www.haskell.org/onlinereport/haskell2010/haskellch19.html>. ) where -import GHC.Internal.Data.Ix +import GHC.Internal.Ix ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -153,7 +153,6 @@ Library GHC.Internal.Data.Functor.Identity GHC.Internal.Data.Functor.Utils GHC.Internal.Data.IORef - GHC.Internal.Data.Ix GHC.Internal.Data.List GHC.Internal.Data.List.NonEmpty GHC.Internal.Data.Maybe ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Ix.hs deleted ===================================== @@ -1,64 +0,0 @@ -{-# LANGUAGE Trustworthy #-} - ------------------------------------------------------------------------------ --- | --- Module : GHC.Internal.Data.Ix --- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries(a)haskell.org --- Stability : stable --- Portability : portable --- --- The 'Ix' class is used to map a contiguous subrange of values in --- type onto integers. It is used primarily for array indexing --- (see the array package). 'Ix' uses row-major order. --- ------------------------------------------------------------------------------ - -module GHC.Internal.Data.Ix - ( - -- * The 'Ix' class - Ix - ( range - , index - , inRange - , rangeSize - ) - -- Ix instances: - -- - -- Ix Char - -- Ix Int - -- Ix Integer - -- Ix Bool - -- Ix Ordering - -- Ix () - -- (Ix a, Ix b) => Ix (a, b) - -- ... - - -- * Deriving Instances of 'Ix' - -- | Derived instance declarations for the class 'Ix' are only possible - -- for enumerations (i.e. datatypes having only nullary constructors) - -- and single-constructor datatypes, including arbitrarily large tuples, - -- whose constituent types are instances of 'Ix'. - -- - -- * For an enumeration, the nullary constructors are assumed to be - -- numbered left-to-right with the indices being 0 to n-1 inclusive. This - -- is the same numbering defined by the 'Enum' class. For example, given - -- the datatype: - -- - -- > data Colour = Red | Orange | Yellow | Green | Blue | Indigo | Violet - -- - -- we would have: - -- - -- > range (Yellow,Blue) == [Yellow,Green,Blue] - -- > index (Yellow,Blue) Green == 1 - -- > inRange (Yellow,Blue) Red == False - -- - -- * For single-constructor datatypes, the derived instance declarations - -- are as shown for tuples in chapter 19, section 2 of the Haskell 2010 report: - -- <https://www.haskell.org/onlinereport/haskell2010/haskellch19.html>. - - ) where - -import GHC.Internal.Ix ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -1286,7 +1286,7 @@ module Data.Int where data Int8 = ... module Data.Ix where - -- Safety: Safe + -- Safety: Trustworthy type Ix :: * -> Constraint class GHC.Internal.Classes.Ord a => Ix a where range :: (a, a) -> [a] ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -1286,7 +1286,7 @@ module Data.Int where data Int8 = ... module Data.Ix where - -- Safety: Safe + -- Safety: Trustworthy type Ix :: * -> Constraint class GHC.Internal.Classes.Ord a => Ix a where range :: (a, a) -> [a] ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -1286,7 +1286,7 @@ module Data.Int where data Int8 = ... module Data.Ix where - -- Safety: Safe + -- Safety: Trustworthy type Ix :: * -> Constraint class GHC.Internal.Classes.Ord a => Ix a where range :: (a, a) -> [a] ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -1286,7 +1286,7 @@ module Data.Int where data Int8 = ... module Data.Ix where - -- Safety: Safe + -- Safety: Trustworthy type Ix :: * -> Constraint class GHC.Internal.Classes.Ord a => Ix a where range :: (a, a) -> [a] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcf250997fce8696ccefe2cc8a671b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcf250997fce8696ccefe2cc8a671b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] ghc-internal: Delete unnecessary GHC.Internal.Data.Ix
by Marge Bot (＠marge-bot) 07 Feb '26

07 Feb '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9faf1b35 by Teo Camarasu at 2026-02-07T03:42:43-05:00 ghc-internal: Delete unnecessary GHC.Internal.Data.Ix This module merely re-exports GHC.Internal.Ix. It was copied from `base` when `ghc-internal` was split, but there is no reason to have this now. So, let's delete it. Resolves #26848 - - - - - 7 changed files: - libraries/base/src/Data/Ix.hs - libraries/ghc-internal/ghc-internal.cabal.in - − libraries/ghc-internal/src/GHC/Internal/Data/Ix.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== libraries/base/src/Data/Ix.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} -- | -- @@ -42,4 +42,4 @@ module Data.Ix -- <https://www.haskell.org/onlinereport/haskell2010/haskellch19.html>. ) where -import GHC.Internal.Data.Ix +import GHC.Internal.Ix ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -153,7 +153,6 @@ Library GHC.Internal.Data.Functor.Identity GHC.Internal.Data.Functor.Utils GHC.Internal.Data.IORef - GHC.Internal.Data.Ix GHC.Internal.Data.List GHC.Internal.Data.List.NonEmpty GHC.Internal.Data.Maybe ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Ix.hs deleted ===================================== @@ -1,64 +0,0 @@ -{-# LANGUAGE Trustworthy #-} - ------------------------------------------------------------------------------ --- | --- Module : GHC.Internal.Data.Ix --- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries(a)haskell.org --- Stability : stable --- Portability : portable --- --- The 'Ix' class is used to map a contiguous subrange of values in --- type onto integers. It is used primarily for array indexing --- (see the array package). 'Ix' uses row-major order. --- ------------------------------------------------------------------------------ - -module GHC.Internal.Data.Ix - ( - -- * The 'Ix' class - Ix - ( range - , index - , inRange - , rangeSize - ) - -- Ix instances: - -- - -- Ix Char - -- Ix Int - -- Ix Integer - -- Ix Bool - -- Ix Ordering - -- Ix () - -- (Ix a, Ix b) => Ix (a, b) - -- ... - - -- * Deriving Instances of 'Ix' - -- | Derived instance declarations for the class 'Ix' are only possible - -- for enumerations (i.e. datatypes having only nullary constructors) - -- and single-constructor datatypes, including arbitrarily large tuples, - -- whose constituent types are instances of 'Ix'. - -- - -- * For an enumeration, the nullary constructors are assumed to be - -- numbered left-to-right with the indices being 0 to n-1 inclusive. This - -- is the same numbering defined by the 'Enum' class. For example, given - -- the datatype: - -- - -- > data Colour = Red | Orange | Yellow | Green | Blue | Indigo | Violet - -- - -- we would have: - -- - -- > range (Yellow,Blue) == [Yellow,Green,Blue] - -- > index (Yellow,Blue) Green == 1 - -- > inRange (Yellow,Blue) Red == False - -- - -- * For single-constructor datatypes, the derived instance declarations - -- are as shown for tuples in chapter 19, section 2 of the Haskell 2010 report: - -- <https://www.haskell.org/onlinereport/haskell2010/haskellch19.html>. - - ) where - -import GHC.Internal.Ix ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -1286,7 +1286,7 @@ module Data.Int where data Int8 = ... module Data.Ix where - -- Safety: Safe + -- Safety: Trustworthy type Ix :: * -> Constraint class GHC.Internal.Classes.Ord a => Ix a where range :: (a, a) -> [a] ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -1286,7 +1286,7 @@ module Data.Int where data Int8 = ... module Data.Ix where - -- Safety: Safe + -- Safety: Trustworthy type Ix :: * -> Constraint class GHC.Internal.Classes.Ord a => Ix a where range :: (a, a) -> [a] ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -1286,7 +1286,7 @@ module Data.Int where data Int8 = ... module Data.Ix where - -- Safety: Safe + -- Safety: Trustworthy type Ix :: * -> Constraint class GHC.Internal.Classes.Ord a => Ix a where range :: (a, a) -> [a] ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -1286,7 +1286,7 @@ module Data.Int where data Int8 = ... module Data.Ix where - -- Safety: Safe + -- Safety: Trustworthy type Ix :: * -> Constraint class GHC.Internal.Classes.Ord a => Ix a where range :: (a, a) -> [a] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9faf1b3575652a5e379cc2f2c0a1266… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9faf1b3575652a5e379cc2f2c0a1266… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] NCG/LA64: adjust register usage to avoid src-register being clobbered
by Marge Bot (＠marge-bot) 07 Feb '26

07 Feb '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2e39a340 by Peng Fan at 2026-02-07T03:42:01-05:00 NCG/LA64: adjust register usage to avoid src-register being clobbered - - - - - 1 changed file: - compiler/GHC/CmmToAsm/LA64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/LA64/CodeGen.hs ===================================== @@ -1784,16 +1784,18 @@ genClz :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock genClz w dst src = do platform <- getPlatform (reg_x, _, code_x) <- getSomeReg src + tmp <- getNewRegNat II64 let dst_reg = getRegisterReg platform (CmmLocal dst) if w `elem` [W32, W64] then do return (code_x `snocOL` CLZ (OpReg w dst_reg) (OpReg w reg_x)) else if w `elem` [W8, W16] then do + -- Process uniformly according to one data length, W32. return (code_x `appOL` toOL [ - MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)), - SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt (31-shift))), - SLL (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (32-shift))), - OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x), + MOV (OpReg W64 tmp) (OpImm (ImmInt 1)), + SLL (OpReg W64 tmp) (OpReg W64 tmp) (OpImm (ImmInt (31-shift))), + SLL (OpReg W64 dst_reg) (OpReg W32 reg_x) (OpImm (ImmInt (32-shift))), + OR (OpReg W64 dst_reg) (OpReg W64 tmp) (OpReg W64 dst_reg), CLZ (OpReg W64 dst_reg) (OpReg W32 dst_reg) ] ) @@ -1806,16 +1808,17 @@ genCtz :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock genCtz w dst src = do platform <- getPlatform (reg_x, _, code_x) <- getSomeReg src + tmp <- getNewRegNat II64 let dst_reg = getRegisterReg platform (CmmLocal dst) if w `elem` [W32, W64] then do return (code_x `snocOL` CTZ (OpReg w dst_reg) (OpReg w reg_x)) else if w `elem` [W8, W16] then do return (code_x `appOL` toOL [ - MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)), - SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt shift)), - BSTRPICK II64 (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (shift-1))) (OpImm (ImmInt 0)), - OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x), + MOV (OpReg W64 tmp) (OpImm (ImmInt 1)), + SLL (OpReg W64 tmp) (OpReg W64 tmp) (OpImm (ImmInt shift)), + BSTRPICK II64 (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt (shift-1))) (OpImm (ImmInt 0)), + OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 tmp), CTZ (OpReg W64 dst_reg) (OpReg W64 dst_reg) ] ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e39a340868cb23508ad63471e1c4cc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e39a340868cb23508ad63471e1c4cc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/generate-ci_fix_hls_setup] Add cabal.project file to generate-ci
by Sven Tennie (＠supersven) 07 Feb '26

07 Feb '26

Sven Tennie pushed to branch wip/supersven/generate-ci_fix_hls_setup at Glasgow Haskell Compiler / GHC Commits: 756596a1 by Sven Tennie at 2026-02-07T09:11:20+01:00 Add cabal.project file to generate-ci This fixes the HLS setup for our CI code generation script (generate-ci). The project file simply makes `generate-ci` of the cabal file discoverable. - - - - - 1 changed file: - + .gitlab/generate-ci/cabal.project Changes: ===================================== .gitlab/generate-ci/cabal.project ===================================== @@ -0,0 +1 @@ +packages: . View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/756596a16906f34eb5c13abbcacfb38… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/756596a16906f34eb5c13abbcacfb38… You're receiving this email because of your account on gitlab.haskell.org.

1 0