- ghc-commits - Haskell.org

[Git][ghc/ghc][ghc-9.12] base: Fix changelog header
by Ben Gamari (＠bgamari) 13 May '25

13 May '25

Ben Gamari pushed to branch ghc-9.12 at Glasgow Haskell Compiler / GHC Commits: e2a6fc9b by Ben Gamari at 2025-05-13T11:25:27-04:00 base: Fix changelog header - - - - - 1 changed file: - libraries/base/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,6 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) -## 4.21.0.0 December 2024 +## 4.21.0.0 *December 2024* * Shipped with GHC 9.12.1 * Introduce `Data.Bounded` module exporting the `Bounded` typeclass (finishing [CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208)) * Deprecate export of `Bounded` class from `Data.Enum` ([CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2a6fc9b398b3220c9fedbbb0cd555d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2a6fc9b398b3220c9fedbbb0cd555d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][ghc-9.12] hadrian: fix bootstrap with 9.12.1
by Ben Gamari (＠bgamari) 13 May '25

13 May '25

Ben Gamari pushed to branch ghc-9.12 at Glasgow Haskell Compiler / GHC Commits: d67c8a9c by Cheng Shao at 2025-05-13T11:21:07-04:00 hadrian: fix bootstrap with 9.12.1 This patch bumps hadrian index-state to fix bootstrap with 9.12.1. (cherry picked from commit e16eae6548743870e77c2c93527bab1d24cff81c) - - - - - 2 changed files: - .gitlab/ci.sh - hadrian/cabal.project Changes: ===================================== .gitlab/ci.sh ===================================== @@ -8,7 +8,7 @@ set -Eeuo pipefail # Configuration: # N.B. You may want to also update the index-state in hadrian/cabal.project. -HACKAGE_INDEX_STATE="2024-10-30T22:56:00Z" +HACKAGE_INDEX_STATE="2025-01-27T17:45:32Z" MIN_HAPPY_VERSION="1.20" MIN_ALEX_VERSION="3.2.6" ===================================== hadrian/cabal.project ===================================== @@ -4,7 +4,7 @@ packages: ./ -- This essentially freezes the build plan for hadrian -- It would be wise to keep this up to date with the state set in .gitlab/ci.sh. -index-state: 2024-10-30T22:56:00Z +index-state: 2025-01-27T17:45:32Z -- unordered-containers-0.2.20-r1 requires template-haskell < 2.22 -- ghc-9.10 has template-haskell-2.22.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d67c8a9c09275e67086dd00c63afbb4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d67c8a9c09275e67086dd00c63afbb4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/improve-implicit-lifting-error] Improve error messages when implicit lifting fails
by Matthew Pickering (＠mpickering) 13 May '25

13 May '25

Matthew Pickering pushed to branch wip/improve-implicit-lifting-error at Glasgow Haskell Compiler / GHC Commits: fe034312 by Matthew Pickering at 2025-05-13T16:17:34+01: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 - - - - - 17 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Types/ThLevelIndex.hs - + testsuite/tests/quotes/LiftErrMsg.hs - + testsuite/tests/quotes/LiftErrMsg.stderr - + testsuite/tests/quotes/LiftErrMsgDefer.hs - + testsuite/tests/quotes/LiftErrMsgDefer.stderr - testsuite/tests/quotes/all.T - testsuite/tests/th/TH_Lift.stderr Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Types.Tickish (CoreTickish) import GHC.Types.Unique.Set (UniqSet) +import GHC.Types.ThLevelIndex import GHC.Core.ConLike ( conLikeName, ConLike ) import GHC.Unit.Module (ModuleName) import GHC.Utils.Misc @@ -78,7 +79,7 @@ import Data.Foldable ( toList ) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Void (Void) - +import qualified Data.Set as S {- ********************************************************************* * * Expressions proper @@ -2252,8 +2253,12 @@ data UntypedSpliceFlavour deriving Data -- | Pending Renamer Splice +-- There are two types of pending splices: +-- 1. A splice explicitly written by the user, e.g. `[| $(foo) |]` +-- 2. A cross-stage reference which we will attempt to fix by using Lift. data PendingRnSplice = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr GhcRn) + | PendingImplicitLift (S.Set ThLevelIndex) ThLevelIndex (Maybe GlobalRdrElt) (LIdOccP GhcRn) -- | Pending Type-checker Splice data PendingTcSplice @@ -2346,6 +2351,7 @@ thTyBrackets pp_body = text "[||" <+> pp_body <+> text "||]" instance Outputable PendingRnSplice where ppr (PendingRnSplice _ n e) = pprPendingSplice n e + ppr (PendingImplicitLift _bound _used _gre n) = text "implicit lift:" <+> ppr n instance Outputable PendingTcSplice where ppr (PendingTcSplice n e) = pprPendingSplice n e ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -2027,6 +2027,7 @@ instance ToHie (HsQuote GhcRn) where instance ToHie PendingRnSplice where toHie (PendingRnSplice _ _ e) = toHie e + toHie (PendingImplicitLift _bound _used _gre l) = toHie @(LHsExpr GhcRn) (L (l2l (getLoc l)) (HsVar noExtField l)) instance ToHie PendingTcSplice where toHie (PendingTcSplice _ e) = toHie e ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -328,7 +328,7 @@ rnExpr (HsVar _ (L l v)) -- matching GRE and add a name clash error -- (see lookupGlobalOccRn_overloaded, called by lookupExprOccRn). -> do { let sel_name = flSelector $ recFieldLabel fld_info - ; unless (isExact v || isOrig v) $ checkThLocalNameWithLift sel_name + ; unless (isExact v || isOrig v) $ checkThLocalNameWithLift (L (l2l l) (WithUserRdr v sel_name)) ; return (XExpr (HsRecSelRn (FieldOcc v (L l sel_name))), unitFV sel_name) } | nm == nilDataConName @@ -339,8 +339,9 @@ rnExpr (HsVar _ (L l v)) -> rnExpr (ExplicitList noAnn []) | otherwise - -> do { unless (isExact v || isOrig v) (checkThLocalNameWithLift nm) - ; return (HsVar noExtField (L (l2l l) (WithUserRdr v nm)), unitFV nm) } + -> do { let res_name = L (l2l l) (WithUserRdr v nm) + ; unless (isExact v || isOrig v) (checkThLocalNameWithLift res_name) + ; return (HsVar noExtField res_name, unitFV nm) } }}} ===================================== compiler/GHC/Rename/Splice.hs ===================================== @@ -51,7 +51,7 @@ import GHC.Data.FastString import GHC.Utils.Logger import GHC.Utils.Panic import GHC.Driver.Hooks -import GHC.Builtin.Names.TH ( decsQTyConName, expQTyConName, liftName +import GHC.Builtin.Names.TH ( decsQTyConName, expQTyConName , patQTyConName, quoteDecName, quoteExpName , quotePatName, quoteTypeName, typeQTyConName) @@ -184,7 +184,8 @@ rnUntypedBracket e br_body rn_utbracket :: HsQuote GhcPs -> RnM (HsQuote GhcRn, FreeVars) rn_utbracket (VarBr _ flg rdr_name) = do { name <- lookupOccRn (if flg then WL_Term else WL_Type) (unLoc rdr_name) - ; if flg then checkThLocalNameNoLift name else checkThLocalTyName name + ; let res_name = L (l2l (locA rdr_name)) (WithUserRdr (unLoc rdr_name) name) + ; if flg then checkThLocalNameNoLift res_name else checkThLocalTyName name ; check_namespace flg name ; return (VarBr noExtField flg (noLocA name), unitFV name) } @@ -423,9 +424,10 @@ rnUntypedSplice (HsUntypedSpliceExpr annCo expr) rnUntypedSplice (HsQuasiQuote ext quoter quote) = do { -- Rename the quoter; akin to the HsVar case of rnExpr ; quoter' <- lookupOccRn WL_TermVariable quoter + ; let res_name = noLocA (WithUserRdr quoter quoter') ; this_mod <- getModule ; when (nameIsLocalOrFrom this_mod quoter') $ - checkThLocalNameNoLift quoter' + checkThLocalNameNoLift res_name ; return (HsQuasiQuote ext quoter' quote, unitFV quoter') } @@ -932,17 +934,17 @@ checkThLocalTyName name -- | Check whether we are allowed to use a Name in this context (for TH purposes) -- In the case of a level incorrect program, attempt to fix it by using -- a Lift constraint. -checkThLocalNameWithLift :: Name -> RnM () +checkThLocalNameWithLift :: LIdOccP GhcRn -> RnM () checkThLocalNameWithLift = checkThLocalName True -- | Check whether we are allowed to use a Name in this context (for TH purposes) -- In the case of a level incorrect program, do not attempt to fix it by using -- a Lift constraint. -checkThLocalNameNoLift :: Name -> RnM () +checkThLocalNameNoLift :: LIdOccP GhcRn -> RnM () checkThLocalNameNoLift = checkThLocalName False -checkThLocalName :: Bool -> Name -> RnM () -checkThLocalName allow_lifting name +checkThLocalName :: Bool -> LIdOccP GhcRn -> RnM () +checkThLocalName allow_lifting name_var | isUnboundName name -- Do not report two errors for = return () -- $(not_in_scope args) @@ -964,7 +966,9 @@ checkThLocalName allow_lifting name ; dflags <- getDynFlags ; env <- getGlobalRdrEnv ; let mgre = lookupGRE_Name env name - ; checkCrossLevelLifting dflags (LevelCheckSplice name mgre) top_lvl is_local allow_lifting bind_lvl use_lvl use_lvl_idx name } } } + ; checkCrossLevelLifting dflags (LevelCheckSplice name mgre) top_lvl is_local allow_lifting bind_lvl use_lvl use_lvl_idx name_var } } } + where + name = getName name_var -------------------------------------- checkCrossLevelLifting :: DynFlags @@ -975,8 +979,8 @@ checkCrossLevelLifting :: DynFlags -> Set.Set ThLevelIndex -> ThLevel -> ThLevelIndex - -> Name -> TcM () -checkCrossLevelLifting dflags reason top_lvl is_local allow_lifting bind_lvl use_lvl use_lvl_idx name + -> LIdOccP GhcRn -> TcM () +checkCrossLevelLifting dflags reason top_lvl is_local allow_lifting bind_lvl use_lvl use_lvl_idx name_var -- 1. If name is in-scope, at the correct level. | use_lvl_idx `Set.member` bind_lvl = return () -- 2. Name is imported with -XImplicitStagePersistence @@ -993,52 +997,26 @@ checkCrossLevelLifting dflags reason top_lvl is_local allow_lifting bind_lvl use , any (use_lvl_idx >=) (Set.toList bind_lvl) , allow_lifting = do - dflags <- getDynFlags - check_cross_level_lifting dflags top_lvl name ps_var + let mgre = case reason of + LevelCheckSplice _ gre -> gre + _ -> Nothing + let pend_splice = PendingImplicitLift bind_lvl use_lvl_idx mgre name_var + -- Warning for implicit lift (#17804) + addDetailedDiagnostic (TcRnImplicitLift name) + + -- Update the pending splices + ps <- readMutVar ps_var + writeMutVar ps_var (pend_splice : ps) -- 5. For a typed bracket, these checks happen again later on (checkThLocalId) -- In the future we should do all the level checks here. | Brack _ RnPendingTyped <- use_lvl -- Lift for typed brackets is inserted later. , any (use_lvl_idx >=) (Set.toList bind_lvl) = return () -- Otherwise, we have a level error, report. - | otherwise = addErrTc (TcRnBadlyLevelled reason bind_lvl use_lvl_idx) - -check_cross_level_lifting :: DynFlags -> TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM () -check_cross_level_lifting dflags top_lvl name ps_var - | isTopLevel top_lvl - , xopt LangExt.ImplicitStagePersistence dflags - -- Top-level identifiers in this module, - -- (which have External Names) - -- are just like the imported case: - -- no need for the 'lifting' treatment - -- E.g. this is fine: - -- f x = x - -- g y = [| f 3 |] - = when (isExternalName name) (keepAlive name) - -- See Note [Keeping things alive for Template Haskell] + | otherwise = addErrTc (TcRnBadlyLevelled reason bind_lvl use_lvl_idx Nothing ErrorWithoutFlag) + where + name = getName name_var - | otherwise - = -- Nested identifiers, such as 'x' in - -- E.g. \x -> [| h x |] - -- We must behave as if the reference to x was - -- h $(lift x) - -- We use 'x' itself as the SplicePointName, used by - -- the desugarer to stitch it all back together. - -- If 'x' occurs many times we may get many identical - -- bindings of the same SplicePointName, but that doesn't - -- matter, although it's a mite untidy. - do { traceRn "checkCrossLevelLifting" (ppr name) - - -- Construct the (lift x) expression - ; let lift_expr = nlHsApp (nlHsVar liftName) (nlHsVar name) - pend_splice = PendingRnSplice UntypedExpSplice name lift_expr - - -- Warning for implicit lift (#17804) - ; addDetailedDiagnostic (TcRnImplicitLift name) - - -- Update the pending splices - ; ps <- readMutVar ps_var - ; writeMutVar ps_var (pend_splice : ps) } checkCrossLevelLiftingTy :: DynFlags -> TopLevelFlag -> Set.Set ThLevelIndex -> ThLevel -> ThLevelIndex -> Name -> TcM () checkCrossLevelLiftingTy dflags top_lvl bind_lvl _use_lvl use_lvl_idx name ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -610,6 +610,7 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics report1 = [ ("custom_error", is_user_type_error, True, mkUserTypeErrorReporter) -- (Handles TypeError and Unsatisfiable) + , ("implicit lifting", is_implicit_lifting, True, mkImplicitLiftingReporter) , given_eq_spec , ("insoluble2", utterly_wrong, True, mkGroupReporter mkEqErr) , ("skolem eq1", very_wrong, True, mkSkolReporter) @@ -671,6 +672,11 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics -- See also Note [Implementation of Unsatisfiable constraints], point (F). is_user_type_error item _ = containsUserTypeError (errorItemPred item) + is_implicit_lifting item _ = + case (errorItemOrigin item) of + ImplicitLiftOrigin {} -> True + _ -> False + is_homo_equality _ (EqPred _ ty1 ty2) = typeKind ty1 `tcEqType` typeKind ty2 is_homo_equality _ _ @@ -1082,7 +1088,7 @@ mkUserTypeErrorReporter :: Reporter mkUserTypeErrorReporter ctxt = mapM_ $ \item -> do { let err = important ctxt $ mkUserTypeError item ; maybeReportError ctxt (item :| []) err - ; addDeferredBinding err item } + ; addSolverDeferredBinding err item } mkUserTypeError :: ErrorItem -> TcSolverReportMsg mkUserTypeError item @@ -1095,6 +1101,21 @@ mkUserTypeError item where pty = errorItemPred item +mkImplicitLiftingReporter :: Reporter +mkImplicitLiftingReporter ctxt + = mapM_ $ \item -> do { let err = mkImplicitLiftingError item + ; msg <- mkErrorReport (ctLocEnv (errorItemCtLoc item)) err (Just ctxt) [] [] + ; reportDiagnostic msg + ; addDeferredBinding ctxt [] [] err item + } + + where + mkImplicitLiftingError :: ErrorItem -> TcRnMessage + mkImplicitLiftingError item = + case errorItemOrigin item of + ImplicitLiftOrigin bound used gre name -> TcRnBadlyLevelled (LevelCheckSplice name gre) bound used (Just item) (cec_defer_type_errors ctxt) + _ -> pprPanic "mkImplicitLiftingError" (ppr item) + mkGivenErrorReporter :: Reporter -- See Note [Given errors] mkGivenErrorReporter ctxt (item:|_) @@ -1192,7 +1213,7 @@ reportGroup mk_err ctxt items ; maybeReportError ctxt items err -- But see Note [Always warn with -fdefer-type-errors] ; traceTc "reportGroup" (ppr items) - ; mapM_ (addDeferredBinding err) items } + ; mapM_ (addSolverDeferredBinding err) items } -- Add deferred bindings for all -- Redundant if we are going to abort compilation, -- but that's hard to know for sure, and if we don't @@ -1225,15 +1246,23 @@ maybeReportError ctxt items@(item1:|_) (SolverReport { sr_important_msg = import msg <- mkErrorReport (ctLocEnv (errorItemCtLoc item1)) diag (Just ctxt) supp hints reportDiagnostic msg -addDeferredBinding :: SolverReport -> ErrorItem -> TcM () +addSolverDeferredBinding :: SolverReport -> ErrorItem -> TcM () +addSolverDeferredBinding err item = + let ctxt = reportContext . sr_important_msg $ err + supp = sr_supplementary err + hints = sr_hints err + important = sr_important_msg err + in addDeferredBinding ctxt supp hints (TcRnSolverReport important ErrorWithoutFlag) item + + +addDeferredBinding :: SolverReportErrCtxt -> [SupplementaryInfo] -> [GhcHint] -> TcRnMessage -> ErrorItem -> TcM () -- See Note [Deferring coercion errors to runtime] -addDeferredBinding err (EI { ei_evdest = Just dest - , ei_pred = item_ty - , ei_loc = loc }) +addDeferredBinding ctxt supp hints msg (EI { ei_evdest = Just dest + , ei_pred = item_ty + , ei_loc = loc }) -- if evdest is Just, then the constraint was from a wanted - | let ctxt = reportContext . sr_important_msg $ err - , deferringAnyBindings ctxt - = do { err_tm <- mkErrorTerm loc item_ty err + | deferringAnyBindings ctxt + = do { err_tm <- mkErrorTerm loc item_ty ctxt msg supp hints ; let ev_binds_var = cec_binds ctxt ; case dest of @@ -1244,15 +1273,24 @@ addDeferredBinding err (EI { ei_evdest = Just dest let co_var = coHoleCoVar hole ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var EvNonCanonical err_tm ; fillCoercionHole hole (mkCoVarCo co_var) } } -addDeferredBinding _ _ = return () -- Do not set any evidence for Given +addDeferredBinding _ _ _ _ _ = return () -- Do not set any evidence for Given + +mkSolverErrorTerm :: CtLoc -> Type -- of the error term + -> SolverReport -> TcM EvTerm +mkSolverErrorTerm ct_loc ty err + = mkErrorTerm ct_loc ty (reportContext . sr_important_msg $ err) + (TcRnSolverReport (sr_important_msg err) ErrorWithoutFlag) + (sr_supplementary err) + (sr_hints err) mkErrorTerm :: CtLoc -> Type -- of the error term - -> SolverReport -> TcM EvTerm -mkErrorTerm ct_loc ty (SolverReport { sr_important_msg = important, sr_supplementary = supp, sr_hints = hints }) + -> SolverReportErrCtxt -> TcRnMessage + -> [SupplementaryInfo] -> [GhcHint] -> TcM EvTerm +mkErrorTerm ct_loc ty ctxt msg supp hints = do { msg <- mkErrorReport (ctLocEnv ct_loc) - (TcRnSolverReport important ErrorWithoutFlag) - (Just $ reportContext important) + msg + (Just $ ctxt) supp hints -- This will be reported at runtime, so we always want "error:" in the report, never "warning:" @@ -1526,7 +1564,7 @@ maybeAddDeferredBindings hole report = do -- not for holes in partial type signatures -- cf. addDeferredBinding when (deferringAnyBindings ctxt) $ do - err_tm <- mkErrorTerm (hole_loc hole) ref_ty report + err_tm <- mkSolverErrorTerm (hole_loc hole) ref_ty report -- NB: ref_ty, not hole_ty. hole_ty might be rewritten. -- See Note [Holes in expressions] in GHC.Hs.Expr writeMutVar ref err_tm ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -105,6 +105,7 @@ import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Fixity (defaultFixity) +import GHC.Types.ThLevelIndex (pprThBindLevel) import GHC.Iface.Errors.Types import GHC.Iface.Errors.Ppr @@ -1517,23 +1518,8 @@ instance Diagnostic TcRnMessage where hsep [ text "Unknown type variable" <> plural errorVars , text "on the RHS of injectivity condition:" , interpp'SP errorVars ] - TcRnBadlyLevelled reason bind_lvls use_lvl - -> - mkSimpleDecorated $ - vcat $ - [ fsep [ text "Level error:", pprLevelCheckReason reason - , text "is bound at" <+> pprThBindLevel bind_lvls - , text "but used at level" <+> ppr use_lvl] - ] ++ - [ fsep [ text "Hint: quoting" <+> thBrackets (ppUnless (isValName n) "t") (ppr n) - , text "or an enclosing expression" - , text "would allow the quotation to be used at an earlier level" - ] - | LevelCheckSplice n _ <- [reason] - ] ++ - [ "From imports" <+> (ppr (gre_imp gre)) - | LevelCheckSplice _ (Just gre) <- [reason] - , not (isEmptyBag (gre_imp gre)) ] + TcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt _reason + -> pprTcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt TcRnBadlyLevelledType name bind_lvls use_lvl -> mkSimpleDecorated $ text "Badly levelled type:" <+> ppr name <+> @@ -2490,8 +2476,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnknownTyVarsOnRhsOfInjCond{} -> ErrorWithoutFlag - TcRnBadlyLevelled{} - -> ErrorWithoutFlag + TcRnBadlyLevelled _ _ _ _ reason + -> reason TcRnBadlyLevelledType{} -> WarningWithFlag Opt_WarnBadlyLevelledTypes TcRnTyThingUsedWrong{} @@ -3389,6 +3375,22 @@ instance Diagnostic TcRnMessage where diagnosticCode = constructorCode @GHC +pprTcRnBadlyLevelled :: LevelCheckReason -> Set.Set ThLevelIndex -> ThLevelIndex -> Maybe ErrorItem -> DecoratedSDoc +pprTcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt = mkDecorated $ + [ fsep [ text "Level error:", pprLevelCheckReason reason + , text "is bound at" <+> pprThBindLevel bind_lvls + , text "but used at level" <+> ppr use_lvl] + ] ++ + [hang (text "Could not be resolved by implicit lifting due to the following error:") 2 + (text "No instance for:" <+> quotes (ppr (errorItemPred item))) + | Just item <- [lift_attempt] + ] ++ + [ vcat (text "Available from the imports:" : ppr_imports (gre_imp gre)) + | LevelCheckSplice _ (Just gre) <- [reason] + , not (isEmptyBag (gre_imp gre)) ] + where + ppr_imports :: Bag ImportSpec -> [SDoc] + ppr_imports = map ((bullet <+>) . ppr ) . bagToList note :: SDoc -> SDoc note note = "Note" <> colon <+> note <> dot @@ -4537,8 +4539,7 @@ pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra) : pp_givens useful_givens) supplementary = case mb_extra of - Nothing - -> Left [] + Nothing -> Right empty Just (CND_Extra level ty1 ty2) -> mk_supplementary_ea_msg ctxt level ty1 ty2 orig ct_loc = errorItemCtLoc item @@ -7491,6 +7492,3 @@ pprErrCtxtMsg = \case text "in" <+> quotes (ppr req_uid) <> dot -------------------------------------------------------------------------------- - -pprThBindLevel :: Set.Set ThLevelIndex -> SDoc -pprThBindLevel levels_set = text "level" <> pluralSet levels_set <+> pprUnquotedSet levels_set \ No newline at end of file ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -3497,6 +3497,8 @@ data TcRnMessage where :: !LevelCheckReason -- ^ The binding -> !(Set.Set ThLevelIndex) -- ^ The binding levels -> !ThLevelIndex -- ^ The level at which the binding is used. + -> !(Maybe ErrorItem) -- ^ The attempt we made to implicitly lift the binding. + -> DiagnosticReason -- ^ Whether to defer this error or fail -> TcRnMessage {-| TcRnBadlyLevelledWarn is a warning that occurs when a TH type binding is ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -54,6 +54,7 @@ import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType import GHC.Tc.Gen.Expr +import GHC.Tc.Gen.Head import GHC.Tc.Utils.Unify import GHC.Tc.Utils.Env import GHC.Tc.Types.Origin @@ -720,8 +721,8 @@ tcUntypedBracket rn_expr brack ps res_ty -- Match the expected type with the type of all the internal -- splices. They might have further constrained types and if they do -- we want to reflect that in the overall type of the bracket. - ; ps' <- case quoteWrapperTyVarTy <$> brack_info of - Just m_var -> mapM (tcPendingSplice m_var) ps + ; ps' <- case brack_info of + Just q -> mapM (tcPendingSplice q) ps Nothing -> assert (null ps) $ return [] -- Notice that we don't attempt to typecheck the body @@ -781,11 +782,11 @@ brackTy b = --------------- -- | Typechecking a pending splice from a untyped bracket -tcPendingSplice :: TcType -- Metavariable for the expected overall type of the +tcPendingSplice :: QuoteWrapper -- Metavariable for the expected overall type of the -- quotation. -> PendingRnSplice -> TcM PendingTcSplice -tcPendingSplice m_var (PendingRnSplice flavour splice_name expr) +tcPendingSplice (QuoteWrapper _ m_var) (PendingRnSplice flavour splice_name expr) -- See Note [Typechecking Overloaded Quotes] = do { meta_ty <- tcMetaTy meta_ty_name -- Expected type of splice, e.g. m Exp @@ -799,6 +800,26 @@ tcPendingSplice m_var (PendingRnSplice flavour splice_name expr) UntypedPatSplice -> patTyConName UntypedTypeSplice -> typeTyConName UntypedDeclSplice -> decsTyConName + -- Identifiers that are lifted implicitly, such as 'x' in + -- E.g. \x -> [| h x |] + -- We must behave as if the reference to x was + -- h $(lift x) + -- We use 'x' itself as the SplicePointName, used by + -- the desugarer to stitch it all back together. + -- If 'x' occurs many times we may get many identical + -- bindings of the same SplicePointName, but that doesn't + -- matter, although it's a mite untidy. +tcPendingSplice q (PendingImplicitLift bound used gre id_name) + = do { (id_expr, id_ty) <- tcInferId id_name + -- lift :: Quote m' => a -> m' Exp + ; lift <- setSrcSpan (getLocA id_name) $ + newMethodFromName (ImplicitLiftOrigin bound used gre (getName id_name)) + GHC.Builtin.Names.TH.liftName + [getRuntimeRep id_ty, id_ty] + ; let res = nlHsApp (mkLHsWrap (applyQuoteWrapper q) (noLocA lift)) (noLocA id_expr) + + ; return (PendingTcSplice (getName id_name) res) } + --------------- -- Takes a m and tau and returns the type m (TExp tau) ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1652,7 +1652,7 @@ checkCrossLevelClsInst dflags reason bind_lvls use_lvl_idx is_local -- With ImplicitStagePersistence, using later than bound is fine | xopt LangExt.ImplicitStagePersistence dflags , any (use_lvl_idx >=) bind_lvls = return () - | otherwise = TcM.addErrTc (TcRnBadlyLevelled reason bind_lvls use_lvl_idx) + | otherwise = TcM.addErrTc (TcRnBadlyLevelled reason bind_lvls use_lvl_idx Nothing ErrorWithoutFlag) ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -80,11 +80,13 @@ import GHC.Utils.Monad import GHC.Utils.Misc( HasDebugCallStack ) import GHC.Types.Unique import GHC.Types.Unique.Supply +import GHC.Types.ThLevelIndex import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import qualified Data.Kind as Hs import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.Set as S {- ********************************************************************* * * @@ -647,6 +649,7 @@ data CtOrigin Type -- the instance-sig type Type -- the instantiated type of the method | AmbiguityCheckOrigin UserTypeCtxt + | ImplicitLiftOrigin (S.Set ThLevelIndex) ThLevelIndex (Maybe GlobalRdrElt) Name data NonLinearPatternReason = LazyPatternReason @@ -944,6 +947,7 @@ pprCtO (UsageEnvironmentOf x) = hsep [text "multiplicity of", quotes (ppr x)] pprCtO (OmittedFieldOrigin Nothing) = text "an omitted anonymous field" pprCtO (OmittedFieldOrigin (Just fl)) = hsep [text "omitted field" <+> quotes (ppr fl)] pprCtO BracketOrigin = text "a quotation bracket" +pprCtO (ImplicitLiftOrigin _ _ _ n) = text "an implicit lift of" <+> quotes (ppr n) -- These ones are handled by pprCtOrigin, but we nevertheless sometimes -- get here via callStackOriginFS, when doing ambiguity checks @@ -978,7 +982,6 @@ pprNonLinearPatternReason PatternSynonymReason = parens (text "pattern synonyms pprNonLinearPatternReason ViewPatternReason = parens (text "view patterns aren't linear") pprNonLinearPatternReason OtherPatternReason = empty - {- ********************************************************************* * * CallStacks and CtOrigin ===================================== compiler/GHC/Types/ThLevelIndex.hs ===================================== @@ -3,9 +3,10 @@ module GHC.Types.ThLevelIndex where import GHC.Prelude import GHC.Utils.Outputable import GHC.Types.Basic ( ImportLevel(..) ) - +import Data.Data (Data) +import qualified Data.Set as Set -- | The integer which represents the level -newtype ThLevelIndex = ThLevelIndex Int deriving (Eq, Ord) +newtype ThLevelIndex = ThLevelIndex Int deriving (Eq, Ord, Data) -- NB: see Note [Template Haskell levels] in GHC.Tc.Gen.Splice -- Incremented when going inside a bracket, -- decremented when going inside a splice @@ -32,4 +33,7 @@ quoteLevelIndex = incThLevelIndex topLevelIndex thLevelIndexFromImportLevel :: ImportLevel -> ThLevelIndex thLevelIndexFromImportLevel NormalLevel = topLevelIndex thLevelIndexFromImportLevel SpliceLevel = spliceLevelIndex -thLevelIndexFromImportLevel QuoteLevel = quoteLevelIndex \ No newline at end of file +thLevelIndexFromImportLevel QuoteLevel = quoteLevelIndex + +pprThBindLevel :: Set.Set ThLevelIndex -> SDoc +pprThBindLevel levels_set = text "level" <> pluralSet levels_set <+> pprUnquotedSet levels_set \ No newline at end of file ===================================== testsuite/tests/quotes/LiftErrMsg.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE NoImplicitStagePersistence #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +module LiftErrMsg where + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +data B = B + +local_b :: [B] +local_b = [B] + +test :: Q Exp +test = [| id |] + +test2 :: Q Exp +test2 = [| (id, id) |] + +test3 :: Q Exp +test3 = [| local_b |] + +test4 :: a -> Q Exp +test4 x = [| x |] + +test5 :: Lift a => a -> Q Exp +test5 x = [| x |] + ===================================== testsuite/tests/quotes/LiftErrMsg.stderr ===================================== @@ -0,0 +1,38 @@ +LiftErrMsg.hs:14:11: error: [GHC-28914] + • Level error: ‘id’ is bound at level 0 but used at level 1 + • Could not be resolved by implicit lifting due to the following error: + No instance for: ‘Lift (forall a. a -> a)’ + • Available from the imports: + • imported from ‘Prelude’ at LiftErrMsg.hs:3:8-17 + • In the expression: + [| id |] + pending(rn) [implicit lift: id] + In an equation for ‘test’: + test + = [| id |] + pending(rn) [implicit lift: id] + +LiftErrMsg.hs:20:12: error: [GHC-28914] + • Level error: ‘local_b’ is bound at level 0 but used at level 1 + • Could not be resolved by implicit lifting due to the following error: + No instance for: ‘Lift B’ + • In the expression: + [| local_b |] + pending(rn) [implicit lift: local_b] + In an equation for ‘test3’: + test3 + = [| local_b |] + pending(rn) [implicit lift: local_b] + +LiftErrMsg.hs:23:14: error: [GHC-28914] + • Level error: ‘x’ is bound at level 0 but used at level 1 + • Could not be resolved by implicit lifting due to the following error: + No instance for: ‘Lift a’ + • In the expression: + [| x |] + pending(rn) [implicit lift: x] + In an equation for ‘test4’: + test4 x + = [| x |] + pending(rn) [implicit lift: x] + ===================================== testsuite/tests/quotes/LiftErrMsgDefer.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE NoImplicitStagePersistence #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +module Main where + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +data B = B + +local_b :: [B] +local_b = [B] + +test1 :: Q Exp +test1 = [| id |] + +test2 :: Q Exp +test2 = [| (id, id) |] + +test3 :: Q Exp +test3 = [| local_b |] + +main = do + runQ test1 + runQ test2 + runQ test3 + return () ===================================== testsuite/tests/quotes/LiftErrMsgDefer.stderr ===================================== @@ -0,0 +1,22 @@ +LiftErrMsgDefer: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.TypeError: + +LiftErrMsgDefer.hs:14:12: warning: [GHC-28914] [-Wdeferred-type-errors (in -Wdefault)] + • Level error: ‘id’ is bound at level 0 but used at level 1 + • Could not be resolved by implicit lifting due to the following error: + No instance for: ‘Lift (forall a. a -> a)’ + • Available from the imports: + • imported from ‘Prelude’ at LiftErrMsgDefer.hs:3:8-11 + • In the expression: + [| id |] + pending(rn) [implicit lift: id] + In an equation for ‘test1’: + test1 + = [| id |] + pending(rn) [implicit lift: id] +(deferred type error) + +HasCallStack backtrace: + collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception + toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception + throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base + ===================================== testsuite/tests/quotes/all.T ===================================== @@ -43,3 +43,5 @@ test('T20893', normal, compile_and_run, ['']) test('T21619', normal, compile, ['']) test('T20472_quotes', normal, compile, ['']) test('T24750', normal, compile_and_run, ['']) +test('LiftErrMsg', normal, compile_fail, ['']) +test('LiftErrMsgDefer', [exit_code(1)], compile_and_run, ['-fdefer-type-errors']) ===================================== testsuite/tests/th/TH_Lift.stderr ===================================== @@ -1,161 +1,161 @@ TH_Lift.hs:18:6-39: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Integer) ======> 5 TH_Lift.hs:21:6-35: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Int) ======> 5 TH_Lift.hs:24:7-37: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Int8) ======> 5 TH_Lift.hs:27:7-38: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Int16) ======> 5 TH_Lift.hs:30:7-38: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Int32) ======> 5 TH_Lift.hs:33:7-38: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Int64) ======> 5 TH_Lift.hs:36:6-36: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Word) ======> 5 TH_Lift.hs:39:6-37: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Word8) ======> 5 TH_Lift.hs:42:6-38: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Word16) ======> 5 TH_Lift.hs:45:6-38: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Word32) ======> 5 TH_Lift.hs:48:6-38: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Word64) ======> 5 TH_Lift.hs:51:7-40: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 :: Natural) ======> 5 TH_Lift.hs:54:6-44: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (5 % 3 :: Rational) ======> 1.6666666666666667 TH_Lift.hs:57:7-39: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (pi :: Float) ======> 3.1415927410125732 TH_Lift.hs:60:7-40: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (pi :: Double) ======> 3.141592653589793 TH_Lift.hs:63:6-28: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) 'x' ======> 'x' TH_Lift.hs:66:6-29: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) True ======> True TH_Lift.hs:69:6-35: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (Just 'x') ======> Just 'x' TH_Lift.hs:72:6-58: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (Right False :: Either Char Bool) ======> Right False TH_Lift.hs:75:6-29: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) "hi!" ======> "hi!" TH_Lift.hs:78:6-27: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) () ======> () TH_Lift.hs:81:6-46: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) (True, 'x', 4 :: Int) ======> (,,) True 'x' 4 TH_Lift.hs:84:6-41: Splicing expression (\ x -> [| x |] - pending(rn) [<x, lift x>]) + pending(rn) [implicit lift: x]) ('a' :| "bcde") ======> (:|) 'a' "bcde" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe034312f9c4715836cd2b17985b5d3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe034312f9c4715836cd2b17985b5d3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][ghc-9.12] 2 commits: template-haskell: fix haddocks
by Ben Gamari (＠bgamari) 13 May '25

13 May '25

Ben Gamari pushed to branch ghc-9.12 at Glasgow Haskell Compiler / GHC Commits: a2b43e25 by Teo Camarasu at 2025-05-13T10:55:38-04:00 template-haskell: fix haddocks It seems that we need a direct dependency on ghc-internal, otherwise Haddock cannot find our haddocks The bug seems to be caused by Hadrian because if I rebuild with cabal-install (without this extra dependency) then I get accurate Haddocks. Resolves #25705 (cherry picked from commit c3b5b216667d946f096116486b835fe717b2e63a) - - - - - c4535f96 by Teo Camarasu at 2025-05-13T10:58:45-04:00 template-haskell: Add explicit exports lists to all remaining modules - - - - - 4 changed files: - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - libraries/template-haskell/Language/Haskell/TH/PprLib.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/template-haskell.cabal.in Changes: ===================================== libraries/template-haskell/Language/Haskell/TH/Ppr.hs ===================================== @@ -1,9 +1,91 @@ {-# LANGUAGE Safe #-} --- | contains a prettyprinter for the --- Template Haskell datatypes -module Language.Haskell.TH.Ppr - ( module GHC.Internal.TH.Ppr ) - where +{- | contains a prettyprinter for the +Template Haskell datatypes +-} +module Language.Haskell.TH.Ppr ( + appPrec, + bar, + bytesToString, + commaSep, + commaSepApplied, + commaSepWith, + fromTANormal, + funPrec, + hashParens, + isStarT, + isSymOcc, + nestDepth, + noPrec, + opPrec, + parensIf, + pprBangType, + pprBndrVis, + pprBody, + pprClause, + pprCtxWith, + pprCxt, + pprExp, + pprFields, + pprFixity, + pprForall, + pprForall', + pprForallVis, + pprFunArgType, + pprGadtRHS, + pprGuarded, + pprInfixExp, + pprInfixT, + pprLit, + pprMatchPat, + pprMaybeExp, + pprNamespaceSpecifier, + pprParendType, + pprParendTypeArg, + pprPat, + pprPatSynSig, + pprPatSynType, + pprPrefixOcc, + pprRecFields, + pprStrictType, + pprString, + pprTyApp, + pprTyLit, + pprType, + pprVarBangType, + pprVarStrictType, + ppr_bndrs, + ppr_ctx_preds_with, + ppr_cxt_preds, + ppr_data, + ppr_dec, + ppr_deriv_clause, + ppr_deriv_strategy, + ppr_newtype, + ppr_overlap, + ppr_sig, + ppr_tf_head, + ppr_tySyn, + ppr_type_data, + ppr_typedef, + pprint, + qualPrec, + quoteParens, + semiSep, + semiSepWith, + sepWith, + showtextl, + sigPrec, + split, + unboxedSumBars, + unopPrec, + where_clause, + ForallVisFlag (..), + Ppr (..), + PprFlag (..), + Precedence, + TypeArg (..), +) +where import GHC.Internal.TH.Ppr ===================================== libraries/template-haskell/Language/Haskell/TH/PprLib.hs ===================================== @@ -1,8 +1,56 @@ {-# LANGUAGE Safe #-} -- | Monadic front-end to Text.PrettyPrint -module Language.Haskell.TH.PprLib - ( module GHC.Internal.TH.PprLib ) - where +module Language.Haskell.TH.PprLib ( + ($$), + ($+$), + (<+>), + (<>), + arrow, + braces, + brackets, + cat, + char, + colon, + comma, + dcolon, + double, + doubleQuotes, + empty, + equals, + fcat, + float, + fsep, + hang, + hcat, + hsep, + int, + integer, + isEmpty, + lbrace, + lbrack, + lparen, + nest, + parens, + pprName, + pprName', + ptext, + punctuate, + quotes, + rational, + rbrace, + rbrack, + rparen, + semi, + sep, + space, + text, + to_HPJ_Doc, + vcat, + Doc, + PprM, +) +where import GHC.Internal.TH.PprLib +import Prelude () ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -2,13 +2,196 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE Trustworthy #-} -module Language.Haskell.TH.Syntax - ( module GHC.Internal.TH.Syntax - , makeRelativeToProject - , module GHC.Internal.TH.Lift - , addrToByteArrayName - , addrToByteArray - ) +{-# LANGUAGE UnboxedTuples #-} + +module Language.Haskell.TH.Syntax ( + Quote (..), + Exp (..), + Match (..), + Clause (..), + Q (..), + Pat (..), + Stmt (..), + Con (..), + Type (..), + Dec (..), + BangType, + VarBangType, + FieldExp, + FieldPat, + Name (..), + FunDep (..), + Pred, + RuleBndr (..), + TySynEqn (..), + InjectivityAnn (..), + Kind, + Overlap (..), + DerivClause (..), + DerivStrategy (..), + Code (..), + ModName (..), + addCorePlugin, + addDependentFile, + addForeignFile, + addForeignFilePath, + addForeignSource, + addModFinalizer, + addTempFile, + addTopDecls, + badIO, + bindCode, + bindCode_, + cmpEq, + compareBytes, + counter, + defaultFixity, + eqBytes, + extsEnabled, + getDoc, + getPackageRoot, + getQ, + get_cons_names, + hoistCode, + isExtEnabled, + isInstance, + joinCode, + liftCode, + location, + lookupName, + lookupTypeName, + lookupValueName, + manyName, + maxPrecedence, + memcmp, + mkNameG, + mkNameU, + mkOccName, + mkPkgName, + mk_tup_name, + mkName, + mkNameG_v, + mkNameG_d, + mkNameG_tc, + mkNameL, + mkNameS, + unTypeCode, + mkModName, + unsafeCodeCoerce, + mkNameQ, + mkNameG_fld, + modString, + nameBase, + nameModule, + namePackage, + nameSpace, + newDeclarationGroup, + newNameIO, + occString, + oneName, + pkgString, + putDoc, + putQ, + recover, + reify, + reifyAnnotations, + reifyConStrictness, + reifyFixity, + reifyInstances, + reifyModule, + reifyRoles, + reifyType, + report, + reportError, + reportWarning, + runIO, + sequenceQ, + runQ, + showName, + showName', + thenCmp, + tupleDataName, + tupleTypeName, + unTypeQ, + unboxedSumDataName, + unboxedSumTypeName, + unboxedTupleDataName, + unboxedTupleTypeName, + unsafeTExpCoerce, + ForeignSrcLang (..), + Extension (..), + AnnLookup (..), + AnnTarget (..), + Arity, + Bang (..), + BndrVis (..), + Body (..), + Bytes (..), + Callconv (..), + CharPos, + Cxt, + DecidedStrictness (..), + DocLoc (..), + FamilyResultSig (..), + Fixity (..), + FixityDirection (..), + Foreign (..), + Guard (..), + Info (..), + Inline (..), + InstanceDec, + Lit (..), + Loc (..), + Module (..), + ModuleInfo (..), + NameFlavour (..), + NameIs (..), + NameSpace (..), + NamespaceSpecifier (..), + OccName (..), + ParentName, + PatSynArgs (..), + PatSynDir (..), + PatSynType, + Phases (..), + PkgName (..), + Pragma (..), + Quasi (..), + Range (..), + Role (..), + RuleMatch (..), + Safety (..), + SourceStrictness (..), + SourceUnpackedness (..), + Specificity (..), + Strict, + StrictType, + SumAlt, + SumArity, + TExp (..), + TyLit (..), + TyVarBndr (..), + TypeFamilyHead (..), + Uniq, + Unlifted, + VarStrictType, + makeRelativeToProject, + liftString, + Lift (..), + dataToExpQ, + dataToPatQ, + dataToQa, + falseName, + justName, + leftName, + liftData, + nonemptyName, + nothingName, + rightName, + trueName, + addrToByteArrayName, + addrToByteArray, +) where import GHC.Internal.TH.Syntax @@ -18,7 +201,7 @@ import Data.Array.Byte import GHC.Exts import GHC.ST --- This module completely re-exports 'GHC.Internal.TH.Syntax', +-- This module completely re-exports 'GHC.Boot.TH.Syntax', -- and exports additionally functions that depend on filepath. -- | The input is a filepath, which if relative is offset by the package root. ===================================== libraries/template-haskell/template-haskell.cabal.in ===================================== @@ -53,6 +53,10 @@ Library build-depends: base >= 4.11 && < 4.22, + -- We don't directly depend on any of the modules from `ghc-internal` + -- But we need to depend on it to work around a hadrian bug. + -- See: https://gitlab.haskell.org/ghc/ghc/-/issues/25705 + ghc-internal == @ProjectVersionForLib@.*, ghc-boot-th == @ProjectVersionMunged@ other-modules: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b30f25591e78d42837eff475bbe25f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b30f25591e78d42837eff475bbe25f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T25821
by Ben Gamari (＠bgamari) 13 May '25

13 May '25

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

1 0

[Git][ghc/ghc][wip/libffi-3.4.8] 11 commits: llvmGen: Fix built-in variable predicate
by Cheng Shao (＠TerrorJack) 13 May '25

13 May '25

Cheng Shao pushed to branch wip/libffi-3.4.8 at Glasgow Haskell Compiler / GHC Commits: 6e67fa08 by Ben Gamari at 2025-05-08T06:21:21-04:00 llvmGen: Fix built-in variable predicate Previously the predicate to identify LLVM builtin global variables was checking for `$llvm` rather than `@llvm` as it should. - - - - - a9d0a22c by Ben Gamari at 2025-05-08T06:21:22-04:00 llvmGen: Fix linkage of built-in arrays LLVM now insists that built-in arrays use Appending linkage, not Internal. Fixes #25769. - - - - - 9c6d2b1b by sheaf at 2025-05-08T06:22:11-04:00 Use mkTrAppChecked in ds_ev_typeable This change avoids violating the invariant of mkTrApp according to which the argument should not be a fully saturated function type. This ensures we don't return false negatives for type equality involving function types. Fixes #25998 - - - - - 75cadf81 by Ryan Hendrickson at 2025-05-08T06:22:55-04:00 haddock: Preserve indentation in multiline examples Intended for use with :{ :}, but doesn't look for those characters. Any consecutive lines with birdtracks will only have initial whitespace stripped up to the column of the first line. - - - - - fee9b351 by Cheng Shao at 2025-05-08T06:23:36-04:00 ci: re-enable chrome for wasm ghci browser tests Currently only firefox is enabled for wasm ghci browser tests, for some reason testing with chrome works on my machine but gets stuck on gitlab instance runners. This patch re-enables testing with chrome by passing `--no-sandbox`, since chrome sandboxing doesn't work in containers without `--cap-add=SYS_ADMIN`. - - - - - 282df905 by Vladislav Zavialov at 2025-05-09T03:18:25-04:00 Take subordinate 'type' specifiers into account This patch fixes multiple bugs (#22581, #25983, #25984, #25991) in name resolution of subordinate import lists. Bug #22581 ---------- In subordinate import lists, the use of the `type` namespace specifier used to be ignored. For example, this import statement was incorrectly accepted: import Prelude (Bool(type True)) Now it results in an error message: <interactive>:2:17: error: [GHC-51433] In the import of ‘Prelude’: a data type called ‘Bool’ is exported, but its subordinate item ‘True’ is not in the type namespace. Bug #25983 ---------- In subordinate import lists within a `hiding` clause, non-existent items led to a poor warning message with -Wdodgy-imports. Consider: import Prelude hiding (Bool(X)) The warning message for this import statement used to misreport the cause of the problem: <interactive>:3:24: warning: [GHC-56449] [-Wdodgy-imports] In the import of ‘Prelude’: an item called ‘Bool’ is exported, but it is a type. Now the warning message is correct: <interactive>:2:24: warning: [GHC-10237] [-Wdodgy-imports] In the import of ‘Prelude’: a data type called ‘Bool’ is exported, but it does not export any constructors or record fields called ‘X’. Bug #25984 ---------- In subordinate import lists within a `hiding` clause, non-existent items resulted in the entire import declaration being discarded. For example, this program was incorrectly accepted: import Prelude hiding (Bool(True,X)) t = True Now it results in an error message: <interactive>:2:5: error: [GHC-88464] Data constructor not in scope: True Bug #25991 ---------- In subordinate import lists, it was not possible to refer to a class method if there was an associated type of the same name: module M_helper where class C a b where type a # b (#) :: a -> b -> () module M where import M_helper (C((#))) This import declaration failed with: M.hs:2:28: error: [GHC-10237] In the import of ‘M_helper’: an item called ‘C’ is exported, but it does not export any children (constructors, class methods or field names) called ‘#’. Now it is accepted. Summary ------- The changes required to fix these bugs are almost entirely confined to GHC.Rename.Names. Other than that, there is a new error constructor BadImportNonTypeSubordinates with error code [GHC-51433]. Test cases: T22581a T22581b T22581c T22581d T25983a T25983b T25983c T25983d T25983e T25983f T25983g T25984a T25984b T25991a T25991b1 T25991b2 - - - - - 51b0ce8f by Simon Peyton Jones at 2025-05-09T03:19:07-04:00 Slighty improve `dropMisleading` Fix #26105, by upgrading the (horrible, hacky) `dropMisleading` function. This fix makes things a bit better but does not cure the underlying problem. - - - - - 7b2d1e6d by Simon Peyton Jones at 2025-05-11T03:24:47-04:00 Refine `noGivenNewtypeReprEqs` to account for quantified constraints This little MR fixes #26020. We are on the edge of completeness for newtype equalities (that doesn't change) but this MR makes GHC a bit more consistent -- and fixes the bug reported. - - - - - eaa8093b by Cheng Shao at 2025-05-11T03:25:28-04:00 wasm: mark freeJSVal as INLINE This patch marks `freeJSVal` as `INLINE` for the wasm backend. I noticed that the `freeJSVal` invocations are not inlined when inspecting STG/Cmm dumps of downstream libraries that use release build of the wasm backend. The performance benefit of inlining here is very modest, but so is the cost anyway; if you are using `freeJSVal` at all then you care about every potential chance to improve performance :) - - - - - eac196df by Cheng Shao at 2025-05-11T03:25:28-04:00 wasm: add zero length fast path for fromJSString This patch adds a zero length fast path for `fromJSString`; when marshaling a zero-length `JSString` we don't need to allocate an empty `ByteArray#` at all. - - - - - c4a38199 by Cheng Shao at 2025-05-13T14:04:11+00:00 libffi: update to 3.4.8 Bumps libffi submodule. - - - - - 73 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Names.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.14.1-notes.rst - docs/users_guide/exts/explicit_namespaces.rst - libffi-tarballs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs - testsuite/tests/driver/RecompExports/RecompExports1.stderr - testsuite/tests/driver/RecompExports/RecompExports4.stderr - testsuite/tests/module/T21826.stderr - testsuite/tests/module/mod81.stderr - testsuite/tests/module/mod91.stderr - + testsuite/tests/rename/should_compile/T22581c.hs - + testsuite/tests/rename/should_compile/T22581c_helper.hs - + testsuite/tests/rename/should_compile/T22581d.script - + testsuite/tests/rename/should_compile/T22581d.stdout - + testsuite/tests/rename/should_compile/T25983a.hs - + testsuite/tests/rename/should_compile/T25983a.stderr - + testsuite/tests/rename/should_compile/T25983b.hs - + testsuite/tests/rename/should_compile/T25983b.stderr - + testsuite/tests/rename/should_compile/T25983c.hs - + testsuite/tests/rename/should_compile/T25983c.stderr - + testsuite/tests/rename/should_compile/T25983d.hs - + testsuite/tests/rename/should_compile/T25983d.stderr - + testsuite/tests/rename/should_compile/T25983e.hs - + testsuite/tests/rename/should_compile/T25983e.stderr - + testsuite/tests/rename/should_compile/T25983f.hs - + testsuite/tests/rename/should_compile/T25983f.stderr - + testsuite/tests/rename/should_compile/T25983g.hs - + testsuite/tests/rename/should_compile/T25983g.stderr - + testsuite/tests/rename/should_compile/T25984a.hs - + testsuite/tests/rename/should_compile/T25984a.stderr - + testsuite/tests/rename/should_compile/T25984a_helper.hs - + testsuite/tests/rename/should_compile/T25991a.hs - + testsuite/tests/rename/should_compile/T25991a_helper.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T22581a.hs - + testsuite/tests/rename/should_fail/T22581a.stderr - + testsuite/tests/rename/should_fail/T22581a_helper.hs - + testsuite/tests/rename/should_fail/T22581b.hs - + testsuite/tests/rename/should_fail/T22581b.stderr - + testsuite/tests/rename/should_fail/T22581b_helper.hs - + testsuite/tests/rename/should_fail/T25984b.hs - + testsuite/tests/rename/should_fail/T25984b.stderr - + testsuite/tests/rename/should_fail/T25991b1.hs - + testsuite/tests/rename/should_fail/T25991b1.stderr - + testsuite/tests/rename/should_fail/T25991b2.hs - + testsuite/tests/rename/should_fail/T25991b2.stderr - + testsuite/tests/rename/should_fail/T25991b_helper.hs - testsuite/tests/rename/should_fail/T9006.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/typecheck/should_compile/T26020.hs - + testsuite/tests/typecheck/should_compile/T26020a.hs - + testsuite/tests/typecheck/should_compile/T26020a_help.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T26015.hs - + testsuite/tests/typecheck/should_fail/T26015.stderr - + testsuite/tests/typecheck/should_run/T25998.hs - + testsuite/tests/typecheck/should_run/T25998.stdout - testsuite/tests/typecheck/should_run/all.T - utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs - utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55badbf1d3efda1e3ef4a82dfbe907… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55badbf1d3efda1e3ef4a82dfbe907… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/improve-implicit-lifting-error
by Matthew Pickering (＠mpickering) 13 May '25

13 May '25

Matthew Pickering pushed new branch wip/improve-implicit-lifting-error at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/improve-implicit-lifting-error You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/torsten.schmits/worker-debug
by Torsten Schmits (＠torsten.schmits) 13 May '25

13 May '25

Torsten Schmits pushed new branch wip/torsten.schmits/worker-debug at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/torsten.schmits/worker-debug You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add LoongArch NCG support
by Marge Bot (＠marge-bot) 13 May '25

13 May '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b0e5eeeb by Peng Fan at 2025-05-13T00:18:09-04:00 Add LoongArch NCG support Not supported before. - - - - - d2f9e797 by Lin Runze at 2025-05-13T00:18:09-04:00 ci: Add LoongArch64 cross-compile CI for testing - - - - - 038090e2 by Sylvain Henry at 2025-05-13T00:18:29-04:00 Deprecate GHC.JS.Prim.Internal.Build (#23432) Deprecated as per CLC proposal 329 (https://github.com/haskell/core-libraries-committee/issues/329) - - - - - 6da327cf by Matthew Pickering at 2025-05-13T00:18:29-04:00 Remove leftover trace - - - - - 98c125c4 by Cheng Shao at 2025-05-13T00:18:30-04:00 Revert "ci: re-enable chrome for wasm ghci browser tests" This reverts commit fee9b351fa5a35d5778d1252789eacaaf5663ae8. Unfortunately the chrome test jobs may still timeout on certain runners (e.g. OpenCape) for unknown reasons. - - - - - 33 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Constants.hs - + compiler/GHC/CmmToAsm/LA64.hs - + compiler/GHC/CmmToAsm/LA64/CodeGen.hs - + compiler/GHC/CmmToAsm/LA64/Cond.hs - + compiler/GHC/CmmToAsm/LA64/Instr.hs - + compiler/GHC/CmmToAsm/LA64/Ppr.hs - + compiler/GHC/CmmToAsm/LA64/RegInfo.hs - + compiler/GHC/CmmToAsm/LA64/Regs.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - + compiler/GHC/CmmToAsm/Reg/Linear/LA64.hs - compiler/GHC/CmmToAsm/Reg/Target.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Platform/LoongArch64.hs → compiler/GHC/Platform/LA64.hs - compiler/GHC/Platform/Regs.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/ghc.cabal.in - hadrian/bindist/config.mk.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/changelog.md - libraries/base/src/GHC/JS/Prim/Internal/Build.hs - testsuite/tests/rts/all.T - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7b8ba42b3adab8c964c41884bfbce… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7b8ba42b3adab8c964c41884bfbce… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23109a] Better mkDupableCont for StrictArg
by Simon Peyton Jones (＠simonpj) 12 May '25

12 May '25

Simon Peyton Jones pushed to branch wip/T23109a at Glasgow Haskell Compiler / GHC Commits: 034fb397 by Simon Peyton Jones at 2025-05-12T21:32:00-04:00 Better mkDupableCont for StrictArg Treat it more like Select. - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -57,7 +57,7 @@ import GHC.Types.Var ( isTyCoVar ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey, seqHashKey ) -import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) +import GHC.Data.Maybe ( isJust, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable @@ -2121,7 +2121,7 @@ wrapJoinCont env cont thing_inside trimJoinCont :: Id -- Used only in error message -> JoinPointHood -> SimplCont -> SimplCont --- Drop outer context from join point invocation (jump) +-- Discard outer context from join point invocation (jump) -- See Note [Join points and case-of-case] trimJoinCont _ NotJoinPoint cont @@ -2165,7 +2165,9 @@ evaluation context E): As is evident from the example, there are two components to this behavior: 1. When entering the RHS of a join point, copy the context inside. + 2. When a join point is invoked, discard the outer context. + See `trimJoinCont` We need to be very careful here to remain consistent---neither part is optional! @@ -3909,13 +3911,49 @@ mkDupableContWithDmds env _ ; mkDupableStrictBind env bndr' join_body res_ty } mkDupableContWithDmds env _ - (StrictArg { sc_fun = fun, sc_cont = cont - , sc_fun_ty = fun_ty }) + (StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty }) + -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable + | isJust (isDataConId_maybe (ai_fun fun)) + -- isDataConId: see point (DJ4) of Note [Duplicating join points] + = -- Use Plan B of Note [Duplicating StrictArg] + -- K[ f a b <> ] --> join j x = K[ f a b x ] + -- j <> + do { let rhs_ty = contResultType cont + (m,arg_ty,_) = splitFunTy fun_ty + ; arg_bndr <- newId (fsLit "arg") m arg_ty + ; let env' = env `addNewInScopeIds` [arg_bndr] + ; (floats, join_rhs) <- rebuildCall env' (addValArgTo fun (Var arg_bndr) fun_ty) cont + ; mkDupableStrictBind env' arg_bndr (wrapFloats floats join_rhs) rhs_ty } + + | otherwise + = -- Use Plan C of Note [Duplicating StrictArg] + -- K[ f a b <> ] --> join j x = K[ x ] + -- K1[ f a b <> ] + -- where K1 = j <> + do { let rhs_ty = contResultType cont + (m,_,res_ty) = splitFunTy fun_ty + ; (floats, cont') <- + if contIsTrivial cont + then return (emptyFloats env, cont) + else do { arg_bndr <- newId (fsLit "arg") m res_ty + ; let env' = env `addNewInScopeIds` [arg_bndr] + ; rhs' <- simplExprC env' (Var arg_bndr) cont + ; mkDupableStrictBind env' arg_bndr rhs' rhs_ty } + + ; (floats_s, args') <- mapAndUnzipM (makeTrivialArg env) (ai_args fun) + + ; return ( foldl' addLetFloats floats floats_s + , StrictArg { sc_fun = fun { ai_args = args' } + , sc_cont = cont', sc_dup = OkToDup, sc_fun_ty = fun_ty }) } + +{- -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable | isNothing (isDataConId_maybe (ai_fun fun)) -- isDataConId: see point (DJ4) of Note [Duplicating join points] , thumbsUpPlanA cont = -- Use Plan A of Note [Duplicating StrictArg] + -- K[ f a b <> ] --> let xa = a; xb = b + -- K[ f xa xb <> ] -- pprTrace "Using plan A" (ppr (ai_fun fun) $$ text "args" <+> ppr (ai_args fun) $$ text "cont" <+> ppr cont) $ do { let _ :| dmds = expectNonEmpty $ ai_dmds fun ; (floats1, cont') <- mkDupableContWithDmds env dmds cont @@ -3951,6 +3989,7 @@ mkDupableContWithDmds env _ thumbsUpPlanA (ApplyToVal { sc_cont = k }) = thumbsUpPlanA k thumbsUpPlanA (ApplyToTy { sc_cont = k }) = thumbsUpPlanA k -} +-} mkDupableContWithDmds env dmds (ApplyToTy { sc_cont = cont, sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) @@ -4037,7 +4076,10 @@ mkDupableContWithDmds env _ mkDupableStrictBind :: SimplEnv -> OutId -> OutExpr -> OutType -> SimplM (SimplFloats, SimplCont) -mkDupableStrictBind env arg_bndr join_rhs res_ty +-- mkDupableStrictBind env arg body rhs_ty +-- generates join-floats join j arg = body +-- cont StrictArg (jump j <>) : Stop +mkDupableStrictBind env arg_bndr join_rhs join_rhs_ty | uncondInlineJoin [arg_bndr] join_rhs -- See point (DJ2) of Note [Duplicating join points] = return (emptyFloats env @@ -4047,9 +4089,9 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , sc_from = FromLet -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_dup = OkToDup - , sc_cont = mkBoringStop res_ty } ) + , sc_cont = mkBoringStop join_rhs_ty } ) | otherwise - = do { join_bndr <- newJoinId [arg_bndr] res_ty + = do { join_bndr <- newJoinId [arg_bndr] join_rhs_ty ; let arg_info = ArgInfo { ai_fun = join_bndr , ai_rules = [], ai_args = [] , ai_encl = False, ai_dmds = repeat topDmd @@ -4061,7 +4103,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , StrictArg { sc_dup = OkToDup , sc_fun = arg_info , sc_fun_ty = idType join_bndr - , sc_cont = mkBoringStop res_ty + , sc_cont = mkBoringStop join_rhs_ty } ) } mkDupableAlt :: SimplEnv -> OutId View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/034fb39782c58e0561cf251cd440998… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/034fb39782c58e0561cf251cd440998… You're receiving this email because of your account on gitlab.haskell.org.

1 0