- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/T27455] base: Don't drop exception context in SomeException(toException)
by sheaf (＠sheaf) 01 Aug '26

01 Aug '26

sheaf pushed to branch wip/T27455 at Glasgow Haskell Compiler / GHC Commits: a3a29d44 by Ben Gamari at 2026-08-01T19:35:22+02:00 base: Don't drop exception context in SomeException(toException) For reasons that are lost to time, the implementation of [CLC #200] that was merged inappropriately dropped `ExceptionContext` in the `toException` implementation given to `SomeException`. Fix this infelicity. [CLC #200]: https://github.com/haskell/core-libraries-committee/issues/200 - - - - - 4 changed files: - + changelog.d/T27455 - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs - testsuite/tests/ghc-e/should_run/ghc-e005.stderr Changes: ===================================== changelog.d/T27455 ===================================== @@ -0,0 +1,8 @@ +section: base +issues: #27455 +mrs: !16274 +synopsis: + Don't drop `ExceptionContext` in `SomeException(toException)` +description: + Previously the implementation of ``Exception(toException)`` given to `SomeException` would inappropriately drop the carried `ExceptionContext`. Now ``toException = id``, faithfully implementing the semantics proposed in :ref:`CLC Proposal #200 <https://github.com/haskell/core-libraries-committee/issues/200>`. + ===================================== libraries/base/changelog.md ===================================== @@ -33,6 +33,7 @@ * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387)) * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371)) + * The implementation of `toException` in `SomeException`'s `Exception` instance no longer drops exception context, in keeping with the behavior originally proposed in [CLC Proposal #200](https://github.com/haskell/core-libraries-committee/issues/200). * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397)) * Improve error message for `Data.Char.chr`. ([CLC Proposal #384](https://github.com/haskell/core-libraries-committee/issues/384)) ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Internal.Data.Maybe import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast) import qualified GHC.Internal.Data.Typeable as Typeable -- loop: GHC.Internal.Data.Typeable -> GHC.Internal.Err -> GHC.Internal.Exception -import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++)) +import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++), id) import GHC.Internal.Show import GHC.Internal.Types (Bool(..)) import GHC.Internal.Exception.Context @@ -208,7 +208,16 @@ Caught MismatchedParentheses -} class (Typeable e, Show e) => Exception e where - -- | @toException@ should produce a 'SomeException' with no attached 'ExceptionContext'. + -- | 'toException' converts an exception into the existential 'SomeException' + -- wrapper type. + -- + -- In doing so, 'toException' should not /add/ an 'ExceptionContext'. + -- + -- - In most cases, the exception does not store its own 'ExceptionContext'. + -- The default implementation of 'toException' (which does not store any + -- 'ExceptionContext') is suitable for these cases. + -- - In the rare case that the exception itself stores an 'ExceptionContext', + -- this context should be preserved by 'toException'. toException :: e -> SomeException fromException :: SomeException -> Maybe e @@ -231,13 +240,11 @@ class (Typeable e, Show e) => Exception e where -- | @since base-4.8.0.0 instance Exception Void --- | This drops any attached 'ExceptionContext'. +-- | NB: this instance preserves the attached 'ExceptionContext'. -- -- @since base-3.0 instance Exception SomeException where - toException (SomeException e) = - let ?exceptionContext = emptyExceptionContext - in SomeException e + toException = id fromException = Just backtraceDesired (SomeException e) = backtraceDesired e displayException (SomeException e) = displayException e ===================================== testsuite/tests/ghc-e/should_run/ghc-e005.stderr ===================================== @@ -4,3 +4,8 @@ foo HasCallStack backtrace: error, called at ghc-e005.hs:12:10 in main:Main + + +HasCallStack backtrace: + throwIO, called at ghc\GHCi\UI.hs:1655:31 in ghc-bin-10.1.20260629-inplace:GHCi.UI + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3a29d44862d0a423fd5277b9f69baf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3a29d44862d0a423fd5277b9f69baf… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/int-index/rta-patsyn] Discard type arguments in tcPatToExpr (#27440, #27583)
by Vladislav Zavialov (＠int-index) 01 Aug '26

01 Aug '26

Vladislav Zavialov pushed to branch wip/int-index/rta-patsyn at Glasgow Haskell Compiler / GHC Commits: 7640370d by Vladislav Zavialov at 2026-08-01T20:27:02+03:00 Discard type arguments in tcPatToExpr (#27440, #27583) The builder expression of an implicitly bidirectional pattern synonym must not mention types written in the RHS: * Invisible type arguments led to a panic (#27440) * Required type arguments failed with out-of-scope variables (#27583) Both are now discarded, following the precedent established by pattern signatures (#9867). Discarding type arguments takes some care: a type pattern cannot be told from a value pattern by syntax alone, as the `type` keyword may be omitted. Consider: data T a b c where MkT :: forall a. forall b c -> a -> T a b c pattern P :: x -> T x y z pattern P x = MkT @a (type b) c x In P's right-hand side, `@a` and `type b` are clearly type arguments, but what about `c` and `x`? We can only tell by matching the patterns against MkT's type. So tcPatToExpr now runs in TcM and matches the arguments against the constructor's TyVarBinders using zipPatsBndrs, which is made public for this purpose. The resulting builder is $bP x = MkT (type _) (type _) x. See Note [Discarding types in the builder expression]. Test cases: T27440a T27440b T27440c T27440d T27440e T27583a T27583b T27583c T27583d T27583e T27583f Assisted-by: Claude Opus 5 - - - - - 22 changed files: - + changelog.d/T27440 - + changelog.d/T27583 - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - + testsuite/tests/patsyn/should_compile/T27440a.hs - + testsuite/tests/patsyn/should_compile/T27440b.hs - + testsuite/tests/patsyn/should_compile/T27440c.hs - testsuite/tests/patsyn/should_compile/all.T - + testsuite/tests/patsyn/should_fail/T27440d.hs - + testsuite/tests/patsyn/should_fail/T27440d.stderr - testsuite/tests/patsyn/should_fail/all.T - + testsuite/tests/vdq-rta/should_compile/T27583a.hs - + testsuite/tests/vdq-rta/should_compile/T27583b.hs - + testsuite/tests/vdq-rta/should_compile/T27583c.hs - + testsuite/tests/vdq-rta/should_compile/T27583d.hs - + testsuite/tests/vdq-rta/should_compile/T27583e.hs - testsuite/tests/vdq-rta/should_compile/all.T - + testsuite/tests/vdq-rta/should_fail/T27440e.hs - + testsuite/tests/vdq-rta/should_fail/T27440e.stderr - + testsuite/tests/vdq-rta/should_fail/T27583f.hs - + testsuite/tests/vdq-rta/should_fail/T27583f.stderr - testsuite/tests/vdq-rta/should_fail/all.T Changes: ===================================== changelog.d/T27440 ===================================== @@ -0,0 +1,8 @@ +section: compiler +issues: #27440 +mrs: !16434 +synopsis: + Fix a panic on ``@ty`` in a pattern synonym RHS +description: + An invisible type argument (``@ty``) in the right-hand side of an implicitly + bidirectional pattern synonym no longer causes a panic. ===================================== changelog.d/T27583 ===================================== @@ -0,0 +1,9 @@ +section: compiler +issues: #27583 +mrs: !16434 +synopsis: + Fix spurious out-of-scope errors from ``type ty`` in a pattern synonym RHS +description: + A required type argument with an explicit namespace specifier (``type ty``) + in the right-hand side of an implicitly bidirectional pattern synonym no + longer reports variables bound by the pattern as out of scope. ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Tc.Gen.Pat , tcCheckPat, tcCheckPat_O, tcInferPat , tcMatchPats , addDataConStupidTheta + , zipPatsBndrs ) where @@ -1727,7 +1728,7 @@ split_con_ty_args :: LexicalFixity -- How to wrap value arguments , [(HsTyPat GhcRn, TyVar)] -- Existentials , HsConPatDetails GhcRn ) -- Value arguments split_con_ty_args fixity con_like arg_pats = do - (bndr_ty_arg_prs, value_args) <- zip_pats_bndrs arg_pats (conLikeUserTyVarBinders con_like) + (bndr_ty_arg_prs, value_args) <- zipPatsBndrs arg_pats (conLikeUserTyVarBinders con_like) return $ if null ex_tvs -- Short cut common case then (bndr_ty_arg_prs, [], mk_details fixity value_args) else let (ex_prs, univ_prs) = partition is_existential bndr_ty_arg_prs @@ -1743,24 +1744,30 @@ split_con_ty_args fixity con_like arg_pats = do -- InfixCon becomes PrefixCon if there are fewer than 2 value arguments. -- Test case: T25127_infix -zip_pats_bndrs :: [LPat GhcRn] -> [TyVarBinder] -> TcM ([(HsTyPat GhcRn, TyVar)], [LPat GhcRn]) -zip_pats_bndrs (L loc pat : pats) (Bndr tv vis : tvbs) +-- | Line the arguments of a 'ConPat' up against the 'TyVarBinder's of its +-- 'ConLike', returning the type arguments with the binders they instantiate, +-- and the remaining value arguments. +-- +-- Precondition: 'check_con_pat_arity' has passed for these arguments, so that +-- we never run out of patterns while a required binder remains. +zipPatsBndrs :: [LPat GhcRn] -> [TyVarBinder] -> TcM ([(HsTyPat GhcRn, TyVar)], [LPat GhcRn]) +zipPatsBndrs (L loc pat : pats) (Bndr tv vis : tvbs) | isVisibleForAllTyFlag vis = do { tp <- setSrcSpanA loc $ pat_to_type_pat pat - ; (prs, pats') <- zip_pats_bndrs pats tvbs + ; (prs, pats') <- zipPatsBndrs pats tvbs ; return ((tp, tv) : prs, pats') } | InvisPat pat_spec tp <- pat , Invisible spec <- vis , pat_spec == spec - = do { (prs, pats') <- zip_pats_bndrs pats tvbs + = do { (prs, pats') <- zipPatsBndrs pats tvbs ; return ((tp, tv):prs, pats') } -zip_pats_bndrs pats (Bndr _ vis : tvbs) - -- zip_pats_bndrs [] (Bndr _ Required : tvbs) +zipPatsBndrs pats (Bndr _ vis : tvbs) + -- zipPatsBndrs [] (Bndr _ Required : tvbs) -- is ruled out by the arity check in splitConTyArgs, -- so we can assume (isInvisibleForAllTyFlag vis) = do { massert (isInvisibleForAllTyFlag vis) - ; zip_pats_bndrs pats tvbs } -zip_pats_bndrs pats [] = return ([], pats) + ; zipPatsBndrs pats tvbs } +zipPatsBndrs pats [] = return ([], pats) tcConTyArgs :: Subst -> PatEnv -> [(HsTyPat GhcRn, TyVar)] -> TcM a -> TcM a ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -940,11 +940,9 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) | isUnidirectional dir = return [] - | Left why <- mb_match_group -- Can't invert the pattern - = setSrcSpan (getLocA lpat) $ failWithTc $ TcRnPatSynInvalidRhs ps_name lpat args why - - | Right match_group <- mb_match_group -- Bidirectional - = do { patsyn <- tcLookupPatSyn ps_name + | otherwise -- Bidirectional + = do { match_group <- get_match_group + ; patsyn <- tcLookupPatSyn ps_name ; case patSynBuilder patsyn of { Nothing -> return [] ; -- This case happens if we found a type error in the @@ -985,10 +983,10 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) ; return builder_binds } } } where - mb_match_group + get_match_group = case dir of - ExplicitBidirectional explicit_mg -> Right explicit_mg - ImplicitBidirectional -> fmap mk_mg (tcPatToExpr args lpat) + ExplicitBidirectional explicit_mg -> return explicit_mg + ImplicitBidirectional -> mk_mg <$> tcPatToExpr ps_name args lpat Unidirectional -> panic "tcPatSynBuilderBind" mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) @@ -1032,44 +1030,53 @@ add_void need_dummy_arg ty | need_dummy_arg = mkVisFunTyMany unboxedUnitTy ty | otherwise = ty -tcPatToExpr :: [LocatedN Name] -> LPat GhcRn - -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) +tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn -> TcM (LHsExpr GhcRn) -- Given a /pattern/, return an /expression/ that builds a value -- that matches the pattern. E.g. if the pattern is (Just [x]), -- the expression is (Just [x]). They look the same, but the -- input uses constructors from HsPat and the output uses constructors -- from HsExpr. -- --- Returns (Left r) if the pattern is not invertible, for reason r. +-- Fails with TcRnPatSynInvalidRhs if the pattern is not invertible. -- See Note [Builder for a bidirectional pattern synonym] -tcPatToExpr args pat = go pat +tcPatToExpr ps_name args pat = go pat where lhsVars = mkNameSet (map unLoc args) + invalidRhs :: PatSynInvalidRhsReason -> TcM a + invalidRhs why = setSrcSpan (getLocA pat) $ + failWithTc $ TcRnPatSynInvalidRhs ps_name pat args why + -- Make a prefix con for prefix and infix patterns for simplicity mkPrefixConExpr :: LocatedN (WithUserRdr Name) -> [LPat GhcRn] - -> Either PatSynInvalidRhsReason (HsExpr GhcRn) - mkPrefixConExpr lcon@(L loc _) pats - = do { exprs <- mapM go pats + -> TcM (HsExpr GhcRn) + mkPrefixConExpr lcon@(L loc con_name) pats + = do { con_like <- tcLookupConLike con_name + ; let tvbs = conLikeUserTyVarBinders con_like + ; (_ty_pats, val_pats) <- zipPatsBndrs pats tvbs + -- Type arguments _ty_pats are discarded, just like the SigPat's type. + -- See Note [Discarding types in the builder expression] + ; let ty_exprs = [wildCardTyArg | tvb <- tvbs, isVisibleForAllTyBinder tvb] + -- Placeholders (type _) for the discarded required type arguments. + ; val_exprs <- mapM go val_pats ; let con = L (l2l loc) (HsVar noExtField lcon) - ; return (unLoc $ mkHsApps con exprs) - } + ; return (unLoc $ mkHsApps con (ty_exprs ++ val_exprs)) } mkRecordConExpr :: LocatedN (WithUserRdr Name) -> HsRecFields GhcRn (LPat GhcRn) - -> Either PatSynInvalidRhsReason (HsExpr GhcRn) + -> TcM (HsExpr GhcRn) mkRecordConExpr con (HsRecFields x fields dd) = do { exprFields <- mapM go' fields ; return (RecordCon noExtField con (HsRecFields x exprFields dd)) } - go' :: LHsRecField GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn)) + go' :: LHsRecField GhcRn (LPat GhcRn) -> TcM (LHsRecField GhcRn (LHsExpr GhcRn)) go' (L l rf) = L l <$> traverse go rf - go :: LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) + go :: LPat GhcRn -> TcM (LHsExpr GhcRn) go (L loc p) = L loc <$> go1 p - go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn) + go1 :: Pat GhcRn -> TcM (HsExpr GhcRn) go1 (ConPat NoExtField con info) = case info of PrefixCon _ ps -> mkPrefixConExpr con ps @@ -1077,13 +1084,13 @@ tcPatToExpr args pat = go pat RecCon _ fields -> mkRecordConExpr con fields go1 (SigPat _ pat _) = go1 (unLoc pat) - -- See Note [Type signatures and the builder expression] + -- See Note [Discarding types in the builder expression] go1 (VarPat _ (L l var)) | var `elemNameSet` lhsVars = return $ mkHsVar (L l var) | otherwise - = Left (PatSynUnboundVar var) + = invalidRhs (PatSynUnboundVar var) go1 (ParPat _ pat) = fmap (HsPar noExtField) (go pat) go1 (ListPat _ pats) = do { exprs <- mapM go pats @@ -1104,10 +1111,7 @@ tcPatToExpr args pat = go pat | otherwise = return $ HsOverLit noExtField n go1 (SplicePat (HsUntypedSpliceTop _ pat) _) = go1 pat go1 (SplicePat (HsUntypedSpliceNested _) _) = panic "tcPatToExpr: invalid nested splice" - go1 (EmbTyPat _ tp) = return $ HsEmbTy noExtField (hstp_to_hswc tp) - where hstp_to_hswc :: HsTyPat GhcRn -> LHsWcType GhcRn - hstp_to_hswc (HsTP { hstp_ext = HsTPRn { hstp_nwcs = wcs }, hstp_body = hs_ty }) - = HsWC { hswc_ext = wcs, hswc_body = hs_ty } + go1 (EmbTyPat _ _tp) = panic "tcPatToExpr: invalid type pattern" go1 (InvisPat _ _tp) = panic "tcPatToExpr: invalid invisible pattern" go1 (XPat (HsPatExpanded _ pat))= go1 pat @@ -1131,7 +1135,13 @@ tcPatToExpr args pat = go pat go1 p@(NPlusKPat {}) = notInvertible p go1 p@(OrPat {}) = notInvertible p - notInvertible p = Left (PatSynNotInvertible p) + notInvertible p = invalidRhs (PatSynNotInvertible p) + +-- See Note [Discarding types in the builder expression] +wildCardTyArg :: LHsExpr GhcRn +wildCardTyArg = wrapGenSpan e + where e = HsEmbTy noExtField (mkEmptyWildCardBndrs (noLocA t)) + t = HsWildCardTy (HoleVar (noLocA unnamedHoleRdrName)) {- Note [Builder for a bidirectional pattern synonym] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1203,9 +1213,17 @@ one could write a nonsensical function like or g (K (Just True) False) = ... -Note [Type signatures and the builder expression] +Note [Discarding types in the builder expression] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The RHS of an implicitly bidirectional pattern synonym may mention types in +three ways: a pattern signature (p :: ty), an invisible type argument (@ty), +and a required type argument (type ty). Required type arguments may be obscured +by the omission of the `type` keyword. + +A type may /bind/ variables when it occurs in a pattern, and those binders have +no counterpart in the builder's scope, so tcPatToExpr must not carry them over. Consider + pattern L x = Left x :: Either [a] [b] In tc{Infer/Check}PatSynDecl we will check that the pattern has the @@ -1223,6 +1241,43 @@ latter; #9867.) No, the job of the signature is done, so when converting the pattern to an expression (for the builder RHS) we simply discard the signature. +The same reasoning applies to the other two forms, but the way we discard +them differs. Which form an argument takes is not apparent from the pattern +alone: in + + pattern P x = MkT a x + +'a' looks like an ordinary variable pattern, and only the TyVarBinders in +MkT's type say that it stands in a required type argument position. We get +those binders from the typechecked ConLike, via conLikeUserTyVarBinders, so +mkPrefixConExpr must look the constructor up before it can walk the arguments. +It then lines them up against the binders with zipPatsBndrs, exactly as +tcConPat does for the pattern itself, and treats them accordingly: + +* Invisible type arguments (@ty) are dropped from the argument list + altogether. Given + + pattern Q x = MkT @a x + + the builder is $bQ x = MkT x. Dropping is safe because the argument + instantiates either a universal, which the expected type of the builder + already pins down, or an existential, which cannot take a concrete type + in a pattern anyway. Improper handling of type arguments led to #27440. + +* Required type arguments cannot be dropped, as that would change the syntactic + arity of the application. Instead, we replace them with placeholders (type _), + the equivalent of @_ for invisible type arguments. Given + + pattern R x = MkT (type a) x + pattern P x = MkT a x + + the builders are $bR x = MkT (type _) x and $bP x = MkT (type _) x, and the + wildcard is solved from the expected type. Retaining the type would mention a + binder that is not in scope in the builder (#27583). + +In all three cases the pattern has already been checked by the time the +builder is built, so no information is lost by forgetting these types. + Note [Record PatSyn Desugaring] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It is important that prov_theta comes before req_theta as this ordering is used ===================================== testsuite/tests/patsyn/should_compile/T27440a.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, PatternSynonyms, TypeAbstractions #-} +module T27440a where + +import Data.Kind (Type) + +newtype Lit = Lit { litName :: String } + +type LitOfValue :: Bool -> Type +newtype LitOfValue v = LitOfValue { underlyingLit :: Lit } + +pattern FalseLit :: Lit -> LitOfValue False +pattern FalseLit a = LitOfValue @False a ===================================== testsuite/tests/patsyn/should_compile/T27440b.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms, TypeAbstractions #-} +module T27440b where + +data T a = MkT a + +pattern P :: a -> T a +pattern P x = MkT @a x ===================================== testsuite/tests/patsyn/should_compile/T27440c.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE ExistentialQuantification, PatternSynonyms, TypeAbstractions #-} +module T27440c where + +data S = forall a. Show a => MkS a + +pattern P :: () => Show a => a -> S +pattern P x = MkS @a x ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -90,3 +90,7 @@ test('T23038', normal, compile_fail, ['']) test('T22328', normal, compile, ['']) test('T26331', normal, compile, ['']) test('T26331a', normal, compile, ['']) + +test('T27440a', normal, compile, ['']) +test('T27440b', normal, compile, ['']) +test('T27440c', normal, compile, ['']) ===================================== testsuite/tests/patsyn/should_fail/T27440d.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE ExistentialQuantification, PatternSynonyms, TypeAbstractions #-} +module T27440d where + +data S = forall a. Show a => MkS a + +pattern P :: Show a => a -> S +pattern P x = MkS @a x ===================================== testsuite/tests/patsyn/should_fail/T27440d.stderr ===================================== @@ -0,0 +1,12 @@ +T27440d.hs:7:22: error: [GHC-25897] + • Couldn't match expected type ‘a’ with actual type ‘a1’ + ‘a1’ is a rigid type variable bound by + a pattern with constructor: MkS :: forall a. Show a => a -> S, + in a pattern synonym declaration + at T27440d.hs:7:15-22 + ‘a’ is a rigid type variable bound by + the signature for pattern synonym ‘P’ + at T27440d.hs:6:14-29 + • In the declaration for pattern synonym ‘P’ + • Relevant bindings include x :: a1 (bound at T27440d.hs:7:22) + ===================================== testsuite/tests/patsyn/should_fail/all.T ===================================== @@ -55,3 +55,5 @@ test('patsyn_where_fail1', normal, compile_fail, ['']) test('patsyn_where_fail2', normal, compile_fail, ['']) test('patsyn_where_fail3', normal, compile_fail, ['']) test('patsyn_where_fail4', normal, compile_fail, ['']) + +test('T27440d', normal, compile_fail, ['']) ===================================== testsuite/tests/vdq-rta/should_compile/T27583a.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583a where + +data T a where + MkT :: forall a -> T a + +pattern P :: T a +pattern P = MkT (type a) ===================================== testsuite/tests/vdq-rta/should_compile/T27583b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583b where + +data T a where + MkT :: forall a -> T a + +pattern P :: T a +pattern P = MkT a ===================================== testsuite/tests/vdq-rta/should_compile/T27583c.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583c where + +data T a where + MkT :: forall a -> T a + +pattern P :: T Int +pattern P = MkT (type Int) ===================================== testsuite/tests/vdq-rta/should_compile/T27583d.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583d where + +data T a where + MkT :: forall a -> a -> T a + +-- A required type argument is checked against the signature, with or without +-- the 'type' herald. The variable/wildcard patterns x, _, (type x), (type _) +-- can't mismatch the signature. Concrete types are in T27583e and T27583f. + +pattern P1 :: Int -> T Int +pattern P1 n = MkT x n + +pattern P2 :: Int -> T Int +pattern P2 n = MkT (type x) n + +pattern P3 :: Int -> T Int +pattern P3 n = MkT _ n + +pattern P4 :: Int -> T Int +pattern P4 n = MkT (type _) n ===================================== testsuite/tests/vdq-rta/should_compile/T27583e.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583e where + +data T a where + MkT :: forall a -> a -> T a + +-- A required type argument is checked against the signature, with or without +-- the 'type' herald. Here the type written in that position agrees with the +-- signature. T27583f is the same four patterns with a type that does not. + +pattern P1 :: Int -> T Int +pattern P1 n = MkT Int n + +pattern P2 :: Int -> T Int +pattern P2 n = MkT (type Int) n + +pattern P3 :: Maybe Int -> T (Maybe Int) +pattern P3 n = MkT (Maybe Int) n + +pattern P4 :: Maybe Int -> T (Maybe Int) +pattern P4 n = MkT (type (Maybe Int)) n ===================================== testsuite/tests/vdq-rta/should_compile/all.T ===================================== @@ -39,3 +39,9 @@ test('T23738_th', req_th, compile, ['']) test('T24159_viewpat', normal, compile, ['']) test('T24159_type_syntax', normal, compile, ['']) test('T24159_th_type_syntax', req_th, compile, ['']) + +test('T27583a', normal, compile, ['']) +test('T27583b', normal, compile, ['']) +test('T27583c', normal, compile, ['']) +test('T27583d', normal, compile, ['']) +test('T27583e', normal, compile, ['']) ===================================== testsuite/tests/vdq-rta/should_fail/T27440e.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms, TypeAbstractions #-} +module T27440e where + +data T a where + MkT :: forall a -> T a + +pattern P :: a -> T a +pattern P x = MkT @a x ===================================== testsuite/tests/vdq-rta/should_fail/T27440e.stderr ===================================== @@ -0,0 +1,5 @@ +T27440e.hs:8:19: error: [GHC-88754] + • Ill-formed type pattern: @a + • In the pattern: MkT @a x + In the declaration for pattern synonym ‘P’ + ===================================== testsuite/tests/vdq-rta/should_fail/T27583f.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583f where + +data T a where + MkT :: forall a -> a -> T a + +-- A required type argument is checked against the signature, with or without +-- the 'type' herald. Here the type written in that position does not agree +-- with the signature. T27583e is the same four patterns with a type that does. + +pattern P1 :: Int -> T Int +pattern P1 n = MkT Bool n + +pattern P2 :: Int -> T Int +pattern P2 n = MkT (type Bool) n + +pattern P3 :: Maybe Int -> T (Maybe Int) +pattern P3 n = MkT (Maybe Bool) n + +pattern P4 :: Maybe Int -> T (Maybe Int) +pattern P4 n = MkT (type (Maybe Bool)) n ===================================== testsuite/tests/vdq-rta/should_fail/T27583f.stderr ===================================== @@ -0,0 +1,24 @@ +T27583f.hs:12:16: error: [GHC-83865] + • Couldn't match expected type ‘Int’ with actual type ‘Bool’ + • In the pattern: MkT Bool n + In the declaration for pattern synonym ‘P1’ + +T27583f.hs:15:16: error: [GHC-83865] + • Couldn't match expected type ‘Int’ with actual type ‘Bool’ + • In the pattern: MkT (type Bool) n + In the declaration for pattern synonym ‘P2’ + +T27583f.hs:18:16: error: [GHC-83865] + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Maybe Int + Actual: Maybe Bool + • In the pattern: MkT (Maybe Bool) n + In the declaration for pattern synonym ‘P3’ + +T27583f.hs:21:16: error: [GHC-83865] + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Maybe Int + Actual: Maybe Bool + • In the pattern: MkT (type (Maybe Bool)) n + In the declaration for pattern synonym ‘P4’ + ===================================== testsuite/tests/vdq-rta/should_fail/all.T ===================================== @@ -32,3 +32,6 @@ test('T24159_type_syntax_tc_fail', normal, compile_fail, ['']) test('T24159_type_syntax_th_fail', normal, ghci_script, ['T24159_type_syntax_th_fail.script']) test('T25127_fail_th_quote', normal, compile_fail, ['']) test('T25127_fail_arity', normal, compile_fail, ['']) + +test('T27440e', normal, compile_fail, ['']) +test('T27583f', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7640370df7320ad7f67df05f8a6a7f0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7640370df7320ad7f67df05f8a6a7f0… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/int-index/t20902
by Vladislav Zavialov (＠int-index) 01 Aug '26

01 Aug '26

Vladislav Zavialov pushed new branch wip/int-index/t20902 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/t20902 You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: EPA: Remove LocatedP from OverlapMode
by Marge Bot (＠marge-bot) 01 Aug '26

01 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 85b10c00 by Alan Zimmerman at 2026-07-31T22:09:47+01:00 EPA: Remove LocatedP from OverlapMode We have type LocatedP = GenLocated SrcSpanAnnP type SrcSpanAnnP = EpAnn AnnPragma As the first step in removing this in favour of LocatedA which only captures location, comments and trailing annotations, we remove it from OverlapMode We do this by moving the AnnPragma into the TTG extension point instead. - - - - - 2cbe06b7 by Viktor Dukhovni at 2026-08-01T09:36:58-04:00 Fix note typo - - - - - 11 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Decls/Overlap.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - libraries/ghc-internal/src/GHC/Internal/Ix.hs - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Types.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1158,20 +1158,25 @@ ppDerivStrategy mb = Nothing -> empty Just (L _ ds) -> ppr ds -ppOverlapPragma :: Maybe (LocatedP (OverlapMode (GhcPass p))) -> SDoc +ppOverlapPragma :: forall p. IsPass p => Maybe (LocatedA (OverlapMode (GhcPass p))) -> SDoc ppOverlapPragma mb = case mb of Nothing -> empty - Just (L _ (NoOverlap s)) -> maybe_stext s "{-# NO_OVERLAP #-}" - Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}" - Just (L _ (Overlapping s)) -> maybe_stext s "{-# OVERLAPPING #-}" - Just (L _ (Overlaps s)) -> maybe_stext s "{-# OVERLAPS #-}" - Just (L _ (Incoherent s)) -> maybe_stext s "{-# INCOHERENT #-}" - Just (L _ (NonCanonical s)) -> maybe_stext s "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet + Just (L _ (NoOverlap s)) -> maybe_stext (stext s) "{-# NO_OVERLAP #-}" + Just (L _ (Overlappable s)) -> maybe_stext (stext s) "{-# OVERLAPPABLE #-}" + Just (L _ (Overlapping s)) -> maybe_stext (stext s) "{-# OVERLAPPING #-}" + Just (L _ (Overlaps s)) -> maybe_stext (stext s) "{-# OVERLAPS #-}" + Just (L _ (Incoherent s)) -> maybe_stext (stext s) "{-# INCOHERENT #-}" + Just (L _ (NonCanonical s)) -> maybe_stext (stext s) "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet where maybe_stext NoSourceText alt = text alt maybe_stext (SourceText src) _ = ftext src <+> text "#-}" + stext :: XOverlapMode (GhcPass p) -> SourceText + stext s = case (ghcPass @p, s) of + (GhcPs, (s,_)) -> s + (GhcRn, (s,_)) -> s + (GhcTc, s) -> s instance (OutputableBndrId p) => Outputable (InstDecl (GhcPass p)) where ppr (ClsInstD { cid_inst = decl }) = ppr decl @@ -1593,7 +1598,7 @@ type instance Anno (ClsInstDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (InstDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (DocDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (DerivDecl (GhcPass p)) = SrcSpanAnnA -type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnP +type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnA type instance Anno (DerivStrategy (GhcPass p)) = EpAnnCO type instance Anno (DefaultDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (ForeignDecl (GhcPass p)) = SrcSpanAnnA ===================================== compiler/GHC/Hs/Decls/Overlap.hs ===================================== @@ -26,6 +26,8 @@ import GHC.Prelude import GHC.Hs.Extension +import GHC.Parser.Annotation ( AnnPragma ) + import Language.Haskell.Syntax.Decls.Overlap import Language.Haskell.Syntax.Extension @@ -65,7 +67,9 @@ instance NFData OverlapFlag where instance Outputable OverlapFlag where ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag) -type instance XOverlapMode (GhcPass _) = SourceText +type instance XOverlapMode GhcPs = (SourceText, AnnPragma) +type instance XOverlapMode GhcRn = (SourceText, AnnPragma) +type instance XOverlapMode GhcTc = SourceText type instance XXOverlapMode (GhcPass _) = DataConCantHappen ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1752,7 +1752,7 @@ instance ToHie (RScoped (LocatedAn NoEpAnns (DerivStrategy GhcRn))) where NewtypeStrategy _ -> [] ViaStrategy s -> [ toHie (TS (ResolvedScopes [sc]) s) ] -instance ToHie (LocatedP (OverlapMode GhcRn)) where +instance ToHie (LocatedA (OverlapMode GhcRn)) where toHie (L span _) = locOnly (locA span) instance ToHie (LocatedA (ConDecl GhcRn)) where ===================================== compiler/GHC/Parser.y ===================================== @@ -1471,15 +1471,15 @@ inst_decl :: { LInstDecl GhcPs } (fmap reverse $7) (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc NoEpTok)}} -overlap_pragma :: { Maybe (LocatedP (OverlapMode GhcPs)) } - : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# OVERLAPS' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# INCOHERENT' '#-}' {% fmap Just $ amsr (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } +overlap_pragma :: { Maybe (LocatedA (OverlapMode GhcPs)) } + : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# OVERLAPS' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# INCOHERENT' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } | {- empty -} { Nothing } deriv_strategy_no_via :: { LDerivStrategy GhcPs } ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -11,7 +11,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | Handles @deriving@ clauses on @data@ declarations. -module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..) ) where +module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..), tcOverlapMode ) where import GHC.Prelude @@ -776,12 +776,12 @@ deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mo tcOverlapMode :: OverlapMode GhcRn -> OverlapMode GhcTc tcOverlapMode = \case - NoOverlap s -> NoOverlap s - Overlappable s -> Overlappable s - Overlapping s -> Overlapping s - Overlaps s -> Overlaps s - Incoherent s -> Incoherent s - NonCanonical s -> NonCanonical s + NoOverlap s -> NoOverlap (fst s) + Overlappable s -> Overlappable (fst s) + Overlapping s -> Overlapping (fst s) + Overlaps s -> Overlaps (fst s) + Incoherent s -> Incoherent (fst s) + NonCanonical s -> NonCanonical (fst s) -- Typecheck the type in a standalone deriving declaration. -- ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -558,7 +558,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty -- Dfun location is that of instance *header* ; let warn = fmap unLoc lwarn - ; ispec <- newClsInst (fmap unLoc overlap_mode) dfun_name + ; ispec <- newClsInst (fmap (tcOverlapMode . unLoc) overlap_mode) dfun_name tyvars theta clas inst_tys warn ; let inst_binds = InstBindings ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Rename.Utils( mkRnSyntaxExpr ) import GHC.Types.Id.Make( mkDictFunId ) import GHC.Types.Arity ( Arity, VisArity ) import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Types.SourceText import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env import GHC.Types.Id @@ -912,7 +911,7 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity ************************************************************************ -} -getOverlapFlag :: Maybe (OverlapMode (GhcPass p)) -- User pragma if any +getOverlapFlag :: Maybe (OverlapMode GhcTc) -- User pragma if any -> TcM OverlapFlag -- Construct the OverlapFlag from the global module flags, -- but if the overlap_mode argument is (Just m), @@ -936,9 +935,9 @@ getOverlapFlag overlap_mode_prag overlap_mode | Just m <- overlap_mode_prag = m - | incoherent_ok = Incoherent NoSourceText - | overlap_ok = Overlaps NoSourceText - | otherwise = NoOverlap NoSourceText + | incoherent_ok = Incoherent noAnn + | overlap_ok = Overlaps noAnn + | otherwise = NoOverlap noAnn -- final_overlap_mode: the `-fspecialise-incoherents` flag controls the -- meaning of the `Incoherent` overlap mode: as either an Incoherent overlap @@ -964,7 +963,7 @@ tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. tcGetInsts = fmap tcg_insts getGblEnv -newClsInst :: Maybe (OverlapMode (GhcPass p)) -- User pragma +newClsInst :: Maybe (OverlapMode GhcTc) -- User pragma -> Name -> [TyVar] -> ThetaType -> Class -> [Type] -> Maybe (WarningTxt GhcRn) -> TcM ClsInst newClsInst overlap_mode dfun_name tvs theta clas tys warn ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -356,10 +356,10 @@ cvtDec (InstanceD o ctxt ty decs) where overlap pragma = case pragma of - TH.Overlaps -> Hs.Overlaps (SourceText $ fsLit "{-# OVERLAPS") - TH.Overlappable -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE") - TH.Overlapping -> Hs.Overlapping (SourceText $ fsLit "{-# OVERLAPPING") - TH.Incoherent -> Hs.Incoherent (SourceText $ fsLit "{-# INCOHERENT") + TH.Overlaps -> Hs.Overlaps (SourceText $ fsLit "{-# OVERLAPS", noAnn) + TH.Overlappable -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE", noAnn) + TH.Overlapping -> Hs.Overlapping (SourceText $ fsLit "{-# OVERLAPPING", noAnn) + TH.Incoherent -> Hs.Incoherent (SourceText $ fsLit "{-# INCOHERENT", noAnn) ===================================== libraries/ghc-internal/src/GHC/Internal/Ix.hs ===================================== @@ -142,7 +142,7 @@ For 1-d, 2-d, and 3-d arrays of Int we have specialised instances to avoid this. Note [Out-of-bounds error messages] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The default method for 'index' generates hoplelessIndexError, because +The default method for 'index' generates 'hopelessIndexError', because Ix doesn't have Show as a superclass. For particular base types we can do better, so we override the default method for index. ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2246,40 +2246,40 @@ instance ExactPrint (TyFamInstDecl GhcPs) where -- --------------------------------------------------------------------- -instance Typeable p => ExactPrint (LocatedP (OverlapMode (GhcPass p))) where - getAnnotationEntry = entryFromLocatedA - setAnnotationAnchor = setAnchorAn +instance ExactPrint (OverlapMode GhcPs) where + getAnnotationEntry _ = NoEntryVal + setAnnotationAnchor a _ _ _ = a -- NOTE: NoOverlap is only used in the typechecker - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NoOverlap src)) = do + exact (NoOverlap (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# NO_OVERLAP" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (NoOverlap src)) + return (NoOverlap (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlappable src)) = do + exact (Overlappable (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPPABLE" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlappable src)) + return (Overlappable (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlapping src)) = do + exact (Overlapping (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPPING" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlapping src)) + return (Overlapping (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlaps src)) = do + exact (Overlaps (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPS" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlaps src)) + return (Overlaps (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Incoherent src)) = do + exact (Incoherent (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# INCOHERENT" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src)) + return (Incoherent (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NonCanonical src)) = do + exact (NonCanonical (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# INCOHERENT" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src)) + return (Incoherent (src, AnnPragma o' c' s l1 l2 t m)) -- --------------------------------------------------------------------- ===================================== utils/haddock/haddock-api/src/Haddock/Types.hs ===================================== @@ -836,7 +836,7 @@ type instance Anno (FamilyResultSig DocNameI) = EpAnn NoEpAnns type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA type instance Anno (HsSigType DocNameI) = SrcSpanAnnA type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnBF -type instance Anno (OverlapMode DocNameI) = EpAnn AnnPragma +type instance Anno (OverlapMode DocNameI) = SrcSpanAnnA type instance Anno (CType DocNameI) = EpAnn AnnPragma type instance Anno (Header DocNameI) = EpAnn AnnPragma type instance Anno (HsModifierOf (LocatedA (HsType DocNameI)) DocNameI) = SrcSpanAnnA View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d8785ca41703a9c45b68162c60c05… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d8785ca41703a9c45b68162c60c05… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T27455] base: Don't drop exception context in SomeException(toException)
by sheaf (＠sheaf) 01 Aug '26

01 Aug '26

sheaf pushed to branch wip/T27455 at Glasgow Haskell Compiler / GHC Commits: 3cefa7d9 by Ben Gamari at 2026-08-01T15:28:55+02:00 base: Don't drop exception context in SomeException(toException) For reasons that are lost to time, the implementation of [CLC #200] that was merged inappropriately dropped `ExceptionContext` in the `toException` implementation given to `SomeException`. Fix this infelicity. [CLC #200]: https://github.com/haskell/core-libraries-committee/issues/200 - - - - - 5 changed files: - + changelog.d/T27455 - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs - testsuite/tests/ghc-e/should_fail/T18441fail7.stderr - testsuite/tests/ghc-e/should_run/ghc-e005.stderr Changes: ===================================== changelog.d/T27455 ===================================== @@ -0,0 +1,8 @@ +section: base +issues: #27455 +mrs: !16274 +synopsis: + Don't drop `ExceptionContext` in `SomeException(toException)` +description: + Previously the implementation of ``Exception(toException)`` given to `SomeException` would inappropriately drop the carried `ExceptionContext`. Now ``toException = id``, faithfully implementing the semantics proposed in :ref:`CLC Proposal #200 <https://github.com/haskell/core-libraries-committee/issues/200>`. + ===================================== libraries/base/changelog.md ===================================== @@ -33,6 +33,7 @@ * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387)) * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371)) + * The implementation of `toException` in `SomeException`'s `Exception` instance no longer drops exception context, in keeping with the behavior originally proposed in [CLC Proposal #200](https://github.com/haskell/core-libraries-committee/issues/200). * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397)) * Improve error message for `Data.Char.chr`. ([CLC Proposal #384](https://github.com/haskell/core-libraries-committee/issues/384)) ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Internal.Data.Maybe import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast) import qualified GHC.Internal.Data.Typeable as Typeable -- loop: GHC.Internal.Data.Typeable -> GHC.Internal.Err -> GHC.Internal.Exception -import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++)) +import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++), id) import GHC.Internal.Show import GHC.Internal.Types (Bool(..)) import GHC.Internal.Exception.Context @@ -208,7 +208,16 @@ Caught MismatchedParentheses -} class (Typeable e, Show e) => Exception e where - -- | @toException@ should produce a 'SomeException' with no attached 'ExceptionContext'. + -- | 'toException' converts an exception into the existential 'SomeException' + -- wrapper type. + -- + -- In doing so, 'toException' should not /add/ an 'ExceptionContext'. + -- + -- - In most cases, the exception does not store its own 'ExceptionContext'. + -- The default implementation of 'toException' (which does not store any + -- 'ExceptionContext') is suitable for these cases. + -- - In the rare case that the exception itself stores an 'ExceptionContext', + -- this context should be preserved by 'toException'. toException :: e -> SomeException fromException :: SomeException -> Maybe e @@ -231,13 +240,11 @@ class (Typeable e, Show e) => Exception e where -- | @since base-4.8.0.0 instance Exception Void --- | This drops any attached 'ExceptionContext'. +-- | NB: this instance preserves the attached 'ExceptionContext'. -- -- @since base-3.0 instance Exception SomeException where - toException (SomeException e) = - let ?exceptionContext = emptyExceptionContext - in SomeException e + toException = id fromException = Just backtraceDesired (SomeException e) = backtraceDesired e displayException (SomeException e) = displayException e ===================================== testsuite/tests/ghc-e/should_fail/T18441fail7.stderr ===================================== @@ -1,10 +1,16 @@ -<interactive>: Uncaught exception ghc-9.13-inplace:GHC.Utils.Panic.GhcException: +<interactive>: Uncaught exception ghc-10.1-inplace:GHC.Utils.Panic.GhcException: IO error: "Abcde" does not exist -While handling IO error: "Abcde" does not exist +While handling ghc-10.1-inplace:GHC.Utils.Panic.GhcException: + | + | IO error: "Abcde" does not exist + | + | HasCallStack backtrace: + | throw, called at compiler/GHC/Utils/Panic.hs:180:21 in ghc-10.1-inplace:GHC.Utils.Panic + | throwGhcException, called at ghc/GHCi/UI.hs:2851:21 in ghc-bin-10.1.20260801-inplace:GHCi.UI HasCallStack backtrace: - throwIO, called at compiler/GHC/Utils/Error.hs:512:19 in ghc-9.13-inplace:GHC.Utils.Error + throwIO, called at compiler/GHC/Utils/Error.hs:513:19 in ghc-10.1-inplace:GHC.Utils.Error 1 ===================================== testsuite/tests/ghc-e/should_run/ghc-e005.stderr ===================================== @@ -4,3 +4,8 @@ foo HasCallStack backtrace: error, called at ghc-e005.hs:12:10 in main:Main + + +HasCallStack backtrace: + throwIO, called at ghc\GHCi\UI.hs:1655:31 in ghc-bin-10.1.20260629-inplace:GHCi.UI + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3cefa7d9c21913266af95d0def8a8ce… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3cefa7d9c21913266af95d0def8a8ce… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/libffi-tarballs-3.7.1
by Cheng Shao (＠TerrorJack) 01 Aug '26

01 Aug '26

Cheng Shao pushed new branch wip/libffi-tarballs-3.7.1 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/libffi-tarballs-3.7.1 You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: GHC Guide: Improve docs on response files
by Marge Bot (＠marge-bot) 01 Aug '26

01 Aug '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3ec9e2b9 by Mike Pilgrem at 2026-07-31T08:21:33-04:00 GHC Guide: Improve docs on response files - - - - - e5b2a1f7 by sheaf at 2026-07-31T08:22:23-04:00 Disable Core Lint for TcPlugin_RewritePerf This is a compiler performance test, but the test source hard-coded -dcore-lint, defeating the measurement. ------------------------- Metric Decrease: TcPlugin_RewritePerf ------------------------- - - - - - 720736e1 by Ben Gamari at 2026-08-01T07:15:36-04:00 base: Don't drop exception context in SomeException(toException) For reasons that are lost to time, the implementation of [CLC #200] that was merged inappropriately dropped `ExceptionContext` in the `toException` implementation given to `SomeException`. Fix this infelicity. [CLC #200]: https://github.com/haskell/core-libraries-committee/issues/200 - - - - - 3d8785ca by Alan Zimmerman at 2026-08-01T07:15:36-04:00 EPA: Remove LocatedP from OverlapMode We have type LocatedP = GenLocated SrcSpanAnnP type SrcSpanAnnP = EpAnn AnnPragma As the first step in removing this in favour of LocatedA which only captures location, comments and trailing annotations, we remove it from OverlapMode We do this by moving the AnnPragma into the TTG extension point instead. - - - - - 17 changed files: - + changelog.d/T27455 - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Decls/Overlap.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - docs/users_guide/using.rst - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs - testsuite/tests/ghc-e/should_run/ghc-e005.stderr - testsuite/tests/tcplugins/TcPlugin_RewritePerf.hs - testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Types.hs Changes: ===================================== changelog.d/T27455 ===================================== @@ -0,0 +1,8 @@ +section: base +issues: #27455 +mrs: !16274 +synopsis: + Don't drop `ExceptionContext` in `SomeException(toException)` +description: + Previously the implementation of ``Exception(toException)`` given to `SomeException` would inappropriately drop the carried `ExceptionContext`. Now ``toException = id``, faithfully implementing the semantics proposed in :ref:`CLC Proposal #200 <https://github.com/haskell/core-libraries-committee/issues/200>`. + ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1158,20 +1158,25 @@ ppDerivStrategy mb = Nothing -> empty Just (L _ ds) -> ppr ds -ppOverlapPragma :: Maybe (LocatedP (OverlapMode (GhcPass p))) -> SDoc +ppOverlapPragma :: forall p. IsPass p => Maybe (LocatedA (OverlapMode (GhcPass p))) -> SDoc ppOverlapPragma mb = case mb of Nothing -> empty - Just (L _ (NoOverlap s)) -> maybe_stext s "{-# NO_OVERLAP #-}" - Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}" - Just (L _ (Overlapping s)) -> maybe_stext s "{-# OVERLAPPING #-}" - Just (L _ (Overlaps s)) -> maybe_stext s "{-# OVERLAPS #-}" - Just (L _ (Incoherent s)) -> maybe_stext s "{-# INCOHERENT #-}" - Just (L _ (NonCanonical s)) -> maybe_stext s "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet + Just (L _ (NoOverlap s)) -> maybe_stext (stext s) "{-# NO_OVERLAP #-}" + Just (L _ (Overlappable s)) -> maybe_stext (stext s) "{-# OVERLAPPABLE #-}" + Just (L _ (Overlapping s)) -> maybe_stext (stext s) "{-# OVERLAPPING #-}" + Just (L _ (Overlaps s)) -> maybe_stext (stext s) "{-# OVERLAPS #-}" + Just (L _ (Incoherent s)) -> maybe_stext (stext s) "{-# INCOHERENT #-}" + Just (L _ (NonCanonical s)) -> maybe_stext (stext s) "{-# INCOHERENT #-}" -- No surface syntax for NONCANONICAL yet where maybe_stext NoSourceText alt = text alt maybe_stext (SourceText src) _ = ftext src <+> text "#-}" + stext :: XOverlapMode (GhcPass p) -> SourceText + stext s = case (ghcPass @p, s) of + (GhcPs, (s,_)) -> s + (GhcRn, (s,_)) -> s + (GhcTc, s) -> s instance (OutputableBndrId p) => Outputable (InstDecl (GhcPass p)) where ppr (ClsInstD { cid_inst = decl }) = ppr decl @@ -1593,7 +1598,7 @@ type instance Anno (ClsInstDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (InstDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (DocDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (DerivDecl (GhcPass p)) = SrcSpanAnnA -type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnP +type instance Anno (OverlapMode (GhcPass p)) = SrcSpanAnnA type instance Anno (DerivStrategy (GhcPass p)) = EpAnnCO type instance Anno (DefaultDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (ForeignDecl (GhcPass p)) = SrcSpanAnnA ===================================== compiler/GHC/Hs/Decls/Overlap.hs ===================================== @@ -26,6 +26,8 @@ import GHC.Prelude import GHC.Hs.Extension +import GHC.Parser.Annotation ( AnnPragma ) + import Language.Haskell.Syntax.Decls.Overlap import Language.Haskell.Syntax.Extension @@ -65,7 +67,9 @@ instance NFData OverlapFlag where instance Outputable OverlapFlag where ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag) -type instance XOverlapMode (GhcPass _) = SourceText +type instance XOverlapMode GhcPs = (SourceText, AnnPragma) +type instance XOverlapMode GhcRn = (SourceText, AnnPragma) +type instance XOverlapMode GhcTc = SourceText type instance XXOverlapMode (GhcPass _) = DataConCantHappen ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1752,7 +1752,7 @@ instance ToHie (RScoped (LocatedAn NoEpAnns (DerivStrategy GhcRn))) where NewtypeStrategy _ -> [] ViaStrategy s -> [ toHie (TS (ResolvedScopes [sc]) s) ] -instance ToHie (LocatedP (OverlapMode GhcRn)) where +instance ToHie (LocatedA (OverlapMode GhcRn)) where toHie (L span _) = locOnly (locA span) instance ToHie (LocatedA (ConDecl GhcRn)) where ===================================== compiler/GHC/Parser.y ===================================== @@ -1471,15 +1471,15 @@ inst_decl :: { LInstDecl GhcPs } (fmap reverse $7) (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc NoEpTok)}} -overlap_pragma :: { Maybe (LocatedP (OverlapMode GhcPs)) } - : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# OVERLAPS' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } - | '{-# INCOHERENT' '#-}' {% fmap Just $ amsr (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1))) - (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) } +overlap_pragma :: { Maybe (LocatedA (OverlapMode GhcPs)) } + : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# OVERLAPS' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } + | '{-# INCOHERENT' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1, + AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn))) } | {- empty -} { Nothing } deriv_strategy_no_via :: { LDerivStrategy GhcPs } ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -11,7 +11,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | Handles @deriving@ clauses on @data@ declarations. -module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..) ) where +module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..), tcOverlapMode ) where import GHC.Prelude @@ -776,12 +776,12 @@ deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mo tcOverlapMode :: OverlapMode GhcRn -> OverlapMode GhcTc tcOverlapMode = \case - NoOverlap s -> NoOverlap s - Overlappable s -> Overlappable s - Overlapping s -> Overlapping s - Overlaps s -> Overlaps s - Incoherent s -> Incoherent s - NonCanonical s -> NonCanonical s + NoOverlap s -> NoOverlap (fst s) + Overlappable s -> Overlappable (fst s) + Overlapping s -> Overlapping (fst s) + Overlaps s -> Overlaps (fst s) + Incoherent s -> Incoherent (fst s) + NonCanonical s -> NonCanonical (fst s) -- Typecheck the type in a standalone deriving declaration. -- ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -558,7 +558,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty -- Dfun location is that of instance *header* ; let warn = fmap unLoc lwarn - ; ispec <- newClsInst (fmap unLoc overlap_mode) dfun_name + ; ispec <- newClsInst (fmap (tcOverlapMode . unLoc) overlap_mode) dfun_name tyvars theta clas inst_tys warn ; let inst_binds = InstBindings ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Rename.Utils( mkRnSyntaxExpr ) import GHC.Types.Id.Make( mkDictFunId ) import GHC.Types.Arity ( Arity, VisArity ) import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Types.SourceText import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env import GHC.Types.Id @@ -912,7 +911,7 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity ************************************************************************ -} -getOverlapFlag :: Maybe (OverlapMode (GhcPass p)) -- User pragma if any +getOverlapFlag :: Maybe (OverlapMode GhcTc) -- User pragma if any -> TcM OverlapFlag -- Construct the OverlapFlag from the global module flags, -- but if the overlap_mode argument is (Just m), @@ -936,9 +935,9 @@ getOverlapFlag overlap_mode_prag overlap_mode | Just m <- overlap_mode_prag = m - | incoherent_ok = Incoherent NoSourceText - | overlap_ok = Overlaps NoSourceText - | otherwise = NoOverlap NoSourceText + | incoherent_ok = Incoherent noAnn + | overlap_ok = Overlaps noAnn + | otherwise = NoOverlap noAnn -- final_overlap_mode: the `-fspecialise-incoherents` flag controls the -- meaning of the `Incoherent` overlap mode: as either an Incoherent overlap @@ -964,7 +963,7 @@ tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. tcGetInsts = fmap tcg_insts getGblEnv -newClsInst :: Maybe (OverlapMode (GhcPass p)) -- User pragma +newClsInst :: Maybe (OverlapMode GhcTc) -- User pragma -> Name -> [TyVar] -> ThetaType -> Class -> [Type] -> Maybe (WarningTxt GhcRn) -> TcM ClsInst newClsInst overlap_mode dfun_name tvs theta clas tys warn ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -356,10 +356,10 @@ cvtDec (InstanceD o ctxt ty decs) where overlap pragma = case pragma of - TH.Overlaps -> Hs.Overlaps (SourceText $ fsLit "{-# OVERLAPS") - TH.Overlappable -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE") - TH.Overlapping -> Hs.Overlapping (SourceText $ fsLit "{-# OVERLAPPING") - TH.Incoherent -> Hs.Incoherent (SourceText $ fsLit "{-# INCOHERENT") + TH.Overlaps -> Hs.Overlaps (SourceText $ fsLit "{-# OVERLAPS", noAnn) + TH.Overlappable -> Hs.Overlappable (SourceText $ fsLit "{-# OVERLAPPABLE", noAnn) + TH.Overlapping -> Hs.Overlapping (SourceText $ fsLit "{-# OVERLAPPING", noAnn) + TH.Incoherent -> Hs.Incoherent (SourceText $ fsLit "{-# INCOHERENT", noAnn) ===================================== docs/users_guide/using.rst ===================================== @@ -58,9 +58,10 @@ Windows. Options overview ---------------- -GHC's behaviour is controlled by options, which for historical reasons -are also sometimes referred to as command-line flags or arguments. -Options can be specified in three ways: +GHC's behaviour is controlled by options. Options can be specified in four ways: +(1) directly on the command line; (2) via files (response files); (3) in source +files, using a pragma; and (4) when using GHCi, from within GHCi. + Command-line arguments ~~~~~~~~~~~~~~~~~~~~~~ @@ -76,7 +77,8 @@ An invocation of GHC takes the following form: ghc [argument...] -Command-line arguments are either options or file names. +Command-line arguments are either options, file names or response file arguments +(see further below). Command-line options begin with ``-``. They may *not* be grouped: ``-vO`` is different from ``-v -O``. Options need not precede filenames: @@ -111,16 +113,47 @@ to the files ``Foo.hs`` and ``Bar.hs``. Command-line arguments in response files ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In addition to passing arguments via the command-line, arguments can be passed -via GNU-style response files. For instance, +GHC's use of response files is similar to that of GCC. A response file argument +is ``@`` followed immediately by the absolute or relative path identifying the +response file. + +.. note:: + + In PowerShell, ``@`` is used to identify a splatting variable. Consequently, + GHC response file arguments must be enclosed in quotation marks on the + command line to avoid parsing errors. + +A response file argument is equivalent to the command-line arguments in the +response file in the order that they appear in the file. A response file can +include a response file argument. + +In a response file: + +* any unescaped whitespace is assumed to separate command-line arguments and is + otherwise ignored; +* a backslash character (``\``) always escapes the following character; and +* matching pairs of unescaped single quote (``'``) or double quote (``"``) + characters escape blocks of characters. + +For example, .. code-block:: bash - $ cat response-file + $ cat response-file1 -O1 + @response-file2 + + $ cat response-file2 Hello.hs -o Hello - $ ghc @response-file + + $ ghc @response-file1 + +is equivalent to, + +.. code-block:: bash + + $ ghc -O1 Hello.hs -o Hello .. _source-file-options: ===================================== libraries/base/changelog.md ===================================== @@ -38,6 +38,7 @@ * Show `ExceptionContext` in `displayExceptionAnnotation` implementation of `WhileHandling` ([GHC #27456](https://gitlab.haskell.org/ghc/ghc/-/issues/27456)) * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387)) * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371)) + * The implementation of `toException` in `SomeException`'s `Exception` instance no longer drops exception context, in keeping with the behavior originally proposed in [CLC Proposal #200](https://github.com/haskell/core-libraries-committee/issues/200). * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397)) * Improve error message for `Data.Char.chr`. ([CLC Proposal #384](https://github.com/haskell/core-libraries-committee/issues/384)) ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Internal.Data.Maybe import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast) import qualified GHC.Internal.Data.Typeable as Typeable -- loop: GHC.Internal.Data.Typeable -> GHC.Internal.Err -> GHC.Internal.Exception -import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++)) +import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++), id) import GHC.Internal.Show import GHC.Internal.Types (Bool(..)) import GHC.Internal.Exception.Context @@ -208,7 +208,16 @@ Caught MismatchedParentheses -} class (Typeable e, Show e) => Exception e where - -- | @toException@ should produce a 'SomeException' with no attached 'ExceptionContext'. + -- | 'toException' converts an exception into the existential 'SomeException' + -- wrapper type. + -- + -- In doing so, 'toException' should not /add/ an 'ExceptionContext'. + -- + -- - In most cases, the exception does not store its own 'ExceptionContext'. + -- The default implementation of 'toException' (which does not store any + -- 'ExceptionContext') is suitable for these cases. + -- - In the rare case that the exception itself stores an 'ExceptionContext', + -- this context should be preserved by 'toException'. toException :: e -> SomeException fromException :: SomeException -> Maybe e @@ -231,13 +240,11 @@ class (Typeable e, Show e) => Exception e where -- | @since base-4.8.0.0 instance Exception Void --- | This drops any attached 'ExceptionContext'. +-- | NB: this instance preserves the attached 'ExceptionContext'. -- -- @since base-3.0 instance Exception SomeException where - toException (SomeException e) = - let ?exceptionContext = emptyExceptionContext - in SomeException e + toException = id fromException = Just backtraceDesired (SomeException e) = backtraceDesired e displayException (SomeException e) = displayException e ===================================== testsuite/tests/ghc-e/should_run/ghc-e005.stderr ===================================== @@ -4,3 +4,8 @@ foo HasCallStack backtrace: error, called at ghc-e005.hs:12:10 in main:Main + + +HasCallStack backtrace: + throwIO, called at ghc\GHCi\UI.hs:1655:31 in ghc-bin-10.1.20260629-inplace:GHCi.UI + ===================================== testsuite/tests/tcplugins/TcPlugin_RewritePerf.hs ===================================== @@ -2,7 +2,6 @@ -- Testing performance of type-checking rewriting plugins. -- Test based on T9872b. -{-# OPTIONS_GHC -dcore-lint #-} {-# OPTIONS_GHC -freduction-depth=400 #-} {-# OPTIONS_GHC -fplugin RewritePerfPlugin #-} ===================================== testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr ===================================== @@ -1,8 +1,7 @@ [1 of 4] Compiling RewritePerfDefs ( RewritePerfDefs.hs, RewritePerfDefs.o ) [2 of 4] Compiling RewritePerfPlugin ( RewritePerfPlugin.hs, RewritePerfPlugin.o ) [3 of 4] Compiling Main ( TcPlugin_RewritePerf.hs, TcPlugin_RewritePerf.o ) - -TcPlugin_RewritePerf.hs:25:8: error: [GHC-39999] +TcPlugin_RewritePerf.hs:24:8: error: [GHC-39999] • No instance for ‘Show (Proxy [['Cube G B W R B G, 'Cube W G B W R R, 'Cube R W R B G R, @@ -25,3 +24,4 @@ TcPlugin_RewritePerf.hs:25:8: error: [GHC-39999] • In the expression: print (Proxy :: Proxy (Solutions Cubes)) In an equation for ‘main’: main = print (Proxy :: Proxy (Solutions Cubes)) + ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2246,40 +2246,40 @@ instance ExactPrint (TyFamInstDecl GhcPs) where -- --------------------------------------------------------------------- -instance Typeable p => ExactPrint (LocatedP (OverlapMode (GhcPass p))) where - getAnnotationEntry = entryFromLocatedA - setAnnotationAnchor = setAnchorAn +instance ExactPrint (OverlapMode GhcPs) where + getAnnotationEntry _ = NoEntryVal + setAnnotationAnchor a _ _ _ = a -- NOTE: NoOverlap is only used in the typechecker - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NoOverlap src)) = do + exact (NoOverlap (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# NO_OVERLAP" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (NoOverlap src)) + return (NoOverlap (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlappable src)) = do + exact (Overlappable (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPPABLE" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlappable src)) + return (Overlappable (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlapping src)) = do + exact (Overlapping (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPPING" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlapping src)) + return (Overlapping (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Overlaps src)) = do + exact (Overlaps (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# OVERLAPS" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Overlaps src)) + return (Overlaps (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (Incoherent src)) = do + exact (Incoherent (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# INCOHERENT" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src)) + return (Incoherent (src, AnnPragma o' c' s l1 l2 t m)) - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (NonCanonical src)) = do + exact (NonCanonical (src, AnnPragma o c s l1 l2 t m)) = do o' <- markAnnOpen'' o src "{-# INCOHERENT" c' <- markEpToken c - return (L (EpAnn l (AnnPragma o' c' s l1 l2 t m) cs) (Incoherent src)) + return (Incoherent (src, AnnPragma o' c' s l1 l2 t m)) -- --------------------------------------------------------------------- ===================================== utils/haddock/haddock-api/src/Haddock/Types.hs ===================================== @@ -836,7 +836,7 @@ type instance Anno (FamilyResultSig DocNameI) = EpAnn NoEpAnns type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA type instance Anno (HsSigType DocNameI) = SrcSpanAnnA type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnBF -type instance Anno (OverlapMode DocNameI) = EpAnn AnnPragma +type instance Anno (OverlapMode DocNameI) = SrcSpanAnnA type instance Anno (CType DocNameI) = EpAnn AnnPragma type instance Anno (Header DocNameI) = EpAnn AnnPragma type instance Anno (HsModifierOf (LocatedA (HsType DocNameI)) DocNameI) = SrcSpanAnnA View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca740ff7acf0a27b3d6367a1602a8d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca740ff7acf0a27b3d6367a1602a8d… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/andreask/opt-stg-lint] stgLint: Use a single reader env for read only arguments.
by Andreas Klebinger (＠AndreasK) 01 Aug '26

01 Aug '26

Andreas Klebinger pushed to branch wip/andreask/opt-stg-lint at Glasgow Haskell Compiler / GHC Commits: ba1b3ef7 by Andreas Klebinger at 2026-08-01T08:06:17+00:00 stgLint: Use a single reader env for read only arguments. - - - - - 1 changed file: - compiler/GHC/Stg/Lint.hs Changes: ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -434,11 +434,15 @@ The Lint monad ************************************************************************ -} +data LintReaderEnv = LintReaderEnv + { le_mod :: !Module + , le_flags :: !LintFlags + , le_diag_opts :: !DiagOpts -- Diagnostic options + , le_ppr_opts :: !StgPprOpts -- Pretty-printing options + } + newtype LintM a = LintM' - { unLintM :: Module - -> LintFlags - -> DiagOpts -- Diagnostic options - -> StgPprOpts -- Pretty-printing options + { unLintM :: LintReaderEnv -> [LintLocInfo] -- Locations -> IdSet -- Local vars in scope -> Bag SDoc -- Error messages so far @@ -446,16 +450,13 @@ newtype LintM a = LintM' } instance Functor LintM where fmap f (LintM m) = - LintM $ \mod lf diag_opts opts loc scope errs -> - case m mod lf diag_opts opts loc scope errs of + LintM $ \env loc scope errs -> + case m env loc scope errs of (a, errs') -> (f a, errs') -- See Note [The one-shot state monad trick] in GHC.Utils.Monad {-# COMPLETE LintM #-} -pattern LintM :: (Module - -> LintFlags - -> DiagOpts - -> StgPprOpts +pattern LintM :: (LintReaderEnv -> [LintLocInfo] -> IdSet -> Bag SDoc @@ -463,13 +464,10 @@ pattern LintM :: (Module -> LintM a pattern LintM m <- LintM' m where - LintM m = LintM' $ oneShot (\mod -> oneShot - (\lf -> oneShot - (\diag_opts -> oneShot - (\opts -> oneShot + LintM m = LintM' $ oneShot (\env -> oneShot (\loc -> oneShot (\scope -> oneShot - (\errs -> m mod lf diag_opts opts loc scope errs))))))) + (\errs -> m env loc scope errs)))) data LintFlags = LintFlags { lf_unarised :: !Bool , lf_platform :: !Platform @@ -500,14 +498,16 @@ pp_binders bs initL :: Platform -> DiagOpts -> Module -> Bool -> StgPprOpts -> IdSet -> LintM a -> Maybe SDoc initL platform diag_opts this_mod unarised opts locals (LintM m) = do - let (_, errs) = m this_mod (LintFlags unarised platform) diag_opts opts [] locals emptyBag + let !flags = LintFlags unarised platform + !env = LintReaderEnv this_mod flags diag_opts opts + (_, errs) = m env [] locals emptyBag if isEmptyBag errs then Nothing else Just (vcat (punctuate blankLine (bagToList errs))) instance Applicative LintM where - pure a = LintM $ \_mod _lf _df _opts _loc _scope errs -> (a, errs) + pure a = LintM $ \_env _loc _scope errs -> (a, errs) (<*>) = ap (*>) = thenL_ @@ -516,14 +516,14 @@ instance Monad LintM where (>>) = (*>) thenL :: LintM a -> (a -> LintM b) -> LintM b -thenL m k = LintM $ \mod lf diag_opts opts loc scope errs - -> case unLintM m mod lf diag_opts opts loc scope errs of - (r, errs') -> unLintM (k r) mod lf diag_opts opts loc scope errs' +thenL m k = LintM $ \env loc scope errs + -> case unLintM m env loc scope errs of + (r, errs') -> unLintM (k r) env loc scope errs' thenL_ :: LintM a -> LintM b -> LintM b -thenL_ m k = LintM $ \mod lf diag_opts opts loc scope errs - -> case unLintM m mod lf diag_opts opts loc scope errs of - (_, errs') -> unLintM k mod lf diag_opts opts loc scope errs' +thenL_ m k = LintM $ \env loc scope errs + -> case unLintM m env loc scope errs of + (_, errs') -> unLintM k env loc scope errs' checkL :: Bool -> SDoc -> LintM () checkL True _ = return () @@ -552,7 +552,8 @@ checkPostUnariseId id id_ty = idType id addErrL :: SDoc -> LintM () -addErrL msg = LintM $ \_mod _lf df _opts loc _scope errs -> ((), addErr df errs msg loc) +addErrL msg = LintM $ \LintReaderEnv{le_diag_opts = df} loc _scope errs + -> ((), addErr df errs msg loc) addErr :: DiagOpts -> Bag SDoc -> SDoc -> [LintLocInfo] -> Bag SDoc addErr diag_opts errs_so_far msg locs @@ -564,23 +565,23 @@ addErr diag_opts errs_so_far msg locs mk_msg [] = msg addLoc :: LintLocInfo -> LintM a -> LintM a -addLoc extra_loc m = LintM $ \mod lf diag_opts opts loc scope errs - -> unLintM m mod lf diag_opts opts (extra_loc:loc) scope errs +addLoc extra_loc m = LintM $ \env loc scope errs + -> unLintM m env (extra_loc:loc) scope errs addInScopeVars :: [Id] -> LintM a -> LintM a -addInScopeVars ids m = LintM $ \mod lf diag_opts opts loc scope errs +addInScopeVars ids m = LintM $ \env loc scope errs -> let new_set = mkVarSet ids - in unLintM m mod lf diag_opts opts loc (scope `unionVarSet` new_set) errs + in unLintM m env loc (scope `unionVarSet` new_set) errs getLintFlags :: LintM LintFlags -getLintFlags = LintM $ \_mod lf _df _opts _loc _scope errs -> (lf, errs) +getLintFlags = LintM $ \LintReaderEnv{le_flags = lf} _loc _scope errs -> (lf, errs) getStgPprOpts :: LintM StgPprOpts -getStgPprOpts = LintM $ \_mod _lf _df opts _loc _scope errs -> (opts, errs) +getStgPprOpts = LintM $ \LintReaderEnv{le_ppr_opts = opts} _loc _scope errs -> (opts, errs) checkInScope :: Id -> LintM () -checkInScope id = LintM $ \mod _lf diag_opts _opts loc scope errs +checkInScope id = LintM $ \LintReaderEnv{le_mod = mod, le_diag_opts = diag_opts} loc scope errs -> if nameIsLocalOrFrom mod (idName id) && not (id `elemVarSet` scope) then ((), addErr diag_opts errs (hsep [ppr id, dcolon, ppr (idType id), text "is out of scope"]) loc) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba1b3ef760ede1373bd606fb9fd1c72… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba1b3ef760ede1373bd606fb9fd1c72… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/andreask/opt-stg-lint] stgLint: Use a single reader env for read only arguments.
by Andreas Klebinger (＠AndreasK) 01 Aug '26

01 Aug '26

Andreas Klebinger pushed to branch wip/andreask/opt-stg-lint at Glasgow Haskell Compiler / GHC Commits: 83792939 by Andreas Klebinger at 2026-08-01T08:03:21+00:00 stgLint: Use a single reader env for read only arguments. - - - - - 1 changed file: - compiler/GHC/Stg/Lint.hs Changes: ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -434,11 +434,15 @@ The Lint monad ************************************************************************ -} +data LintReaderEnv = LintReaderEnv + { le_mod :: !Module + , le_flags :: !LintFlags + , le_diag_opts :: !DiagOpts -- Diagnostic options + , le_ppr_opts :: !StgPprOpts -- Pretty-printing options + } + newtype LintM a = LintM' - { unLintM :: Module - -> LintFlags - -> DiagOpts -- Diagnostic options - -> StgPprOpts -- Pretty-printing options + { unLintM :: LintReaderEnv -> [LintLocInfo] -- Locations -> IdSet -- Local vars in scope -> Bag SDoc -- Error messages so far @@ -446,16 +450,13 @@ newtype LintM a = LintM' } instance Functor LintM where fmap f (LintM m) = - LintM $ \mod lf diag_opts opts loc scope errs -> - case m mod lf diag_opts opts loc scope errs of + LintM $ \env loc scope errs -> + case m env loc scope errs of (a, errs') -> (f a, errs') -- See Note [The one-shot state monad trick] in GHC.Utils.Monad {-# COMPLETE LintM #-} -pattern LintM :: (Module - -> LintFlags - -> DiagOpts - -> StgPprOpts +pattern LintM :: (LintReaderEnv -> [LintLocInfo] -> IdSet -> Bag SDoc @@ -463,13 +464,10 @@ pattern LintM :: (Module -> LintM a pattern LintM m <- LintM' m where - LintM m = LintM' $ oneShot (\mod -> oneShot - (\lf -> oneShot - (\diag_opts -> oneShot - (\opts -> oneShot + LintM m = LintM' $ oneShot (\env -> oneShot (\loc -> oneShot (\scope -> oneShot - (\errs -> m mod lf diag_opts opts loc scope errs))))))) + (\errs -> m env loc scope errs)))) data LintFlags = LintFlags { lf_unarised :: !Bool , lf_platform :: !Platform @@ -500,14 +498,16 @@ pp_binders bs initL :: Platform -> DiagOpts -> Module -> Bool -> StgPprOpts -> IdSet -> LintM a -> Maybe SDoc initL platform diag_opts this_mod unarised opts locals (LintM m) = do - let (_, errs) = m this_mod (LintFlags unarised platform) diag_opts opts [] locals emptyBag + let !flags = LintFlags unarised platform + !env = LintReaderEnv this_mod flags diag_opts opts + (_, errs) = m env [] locals emptyBag if isEmptyBag errs then Nothing else Just (vcat (punctuate blankLine (bagToList errs))) instance Applicative LintM where - pure a = LintM $ \_mod _lf _df _opts _loc _scope errs -> (a, errs) + pure a = LintM $ \_env _loc _scope errs -> (a, errs) (<*>) = ap (*>) = thenL_ @@ -516,14 +516,14 @@ instance Monad LintM where (>>) = (*>) thenL :: LintM a -> (a -> LintM b) -> LintM b -thenL m k = LintM $ \mod lf diag_opts opts loc scope errs - -> case unLintM m mod lf diag_opts opts loc scope errs of - (r, errs') -> unLintM (k r) mod lf diag_opts opts loc scope errs' +thenL m k = LintM $ \env loc scope errs + -> case unLintM m env loc scope errs of + (r, errs') -> unLintM (k r) env loc scope errs' thenL_ :: LintM a -> LintM b -> LintM b -thenL_ m k = LintM $ \mod lf diag_opts opts loc scope errs - -> case unLintM m mod lf diag_opts opts loc scope errs of - (_, errs') -> unLintM k mod lf diag_opts opts loc scope errs' +thenL_ m k = LintM $ \env loc scope errs + -> case unLintM m env loc scope errs of + (_, errs') -> unLintM k env loc scope errs' checkL :: Bool -> SDoc -> LintM () checkL True _ = return () @@ -552,7 +552,7 @@ checkPostUnariseId id id_ty = idType id addErrL :: SDoc -> LintM () -addErrL msg = LintM $ \_mod _lf df _opts loc _scope errs -> ((), addErr df errs msg loc) +addErrL msg = LintM $ \env loc _scope errs -> ((), addErr (le_diag_opts env) errs msg loc) addErr :: DiagOpts -> Bag SDoc -> SDoc -> [LintLocInfo] -> Bag SDoc addErr diag_opts errs_so_far msg locs @@ -564,25 +564,25 @@ addErr diag_opts errs_so_far msg locs mk_msg [] = msg addLoc :: LintLocInfo -> LintM a -> LintM a -addLoc extra_loc m = LintM $ \mod lf diag_opts opts loc scope errs - -> unLintM m mod lf diag_opts opts (extra_loc:loc) scope errs +addLoc extra_loc m = LintM $ \env loc scope errs + -> unLintM m env (extra_loc:loc) scope errs addInScopeVars :: [Id] -> LintM a -> LintM a -addInScopeVars ids m = LintM $ \mod lf diag_opts opts loc scope errs +addInScopeVars ids m = LintM $ \env loc scope errs -> let new_set = mkVarSet ids - in unLintM m mod lf diag_opts opts loc (scope `unionVarSet` new_set) errs + in unLintM m env loc (scope `unionVarSet` new_set) errs getLintFlags :: LintM LintFlags -getLintFlags = LintM $ \_mod lf _df _opts _loc _scope errs -> (lf, errs) +getLintFlags = LintM $ \env _loc _scope errs -> (le_flags env, errs) getStgPprOpts :: LintM StgPprOpts -getStgPprOpts = LintM $ \_mod _lf _df opts _loc _scope errs -> (opts, errs) +getStgPprOpts = LintM $ \env _loc _scope errs -> (le_ppr_opts env, errs) checkInScope :: Id -> LintM () -checkInScope id = LintM $ \mod _lf diag_opts _opts loc scope errs - -> if nameIsLocalOrFrom mod (idName id) && not (id `elemVarSet` scope) then - ((), addErr diag_opts errs (hsep [ppr id, dcolon, ppr (idType id), +checkInScope id = LintM $ \env loc scope errs + -> if nameIsLocalOrFrom (le_mod env) (idName id) && not (id `elemVarSet` scope) then + ((), addErr (le_diag_opts env) errs (hsep [ppr id, dcolon, ppr (idType id), text "is out of scope"]) loc) else ((), errs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83792939185c4a1ce5f1dda3d1118df… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83792939185c4a1ce5f1dda3d1118df… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/int-index/rta-patsyn] Discard type arguments in tcPatToExpr (#27440, #27583)
by Vladislav Zavialov (＠int-index) 01 Aug '26

01 Aug '26

Vladislav Zavialov pushed to branch wip/int-index/rta-patsyn at Glasgow Haskell Compiler / GHC Commits: e9a9ed67 by Vladislav Zavialov at 2026-08-01T07:14:10+03:00 Discard type arguments in tcPatToExpr (#27440, #27583) The builder expression of an implicitly bidirectional pattern synonym must not mention types written in the RHS. Invisible type arguments led to a panic (#27440) and required type arguments produced a builder with out-of-scope variables (#27583). Both are now discarded, just as pattern signatures have long been (#9867). See Note [Discarding types in the builder expression]. Test cases: T27440a T27440b T27440c T27440d T27440e T27583a T27583b T27583c T27583d T27583e T27583f Assisted-by: Claude Opus 5 - - - - - 22 changed files: - + changelog.d/T27440 - + changelog.d/T27583 - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - + testsuite/tests/patsyn/should_compile/T27440a.hs - + testsuite/tests/patsyn/should_compile/T27440b.hs - + testsuite/tests/patsyn/should_compile/T27440c.hs - testsuite/tests/patsyn/should_compile/all.T - + testsuite/tests/patsyn/should_fail/T27440d.hs - + testsuite/tests/patsyn/should_fail/T27440d.stderr - testsuite/tests/patsyn/should_fail/all.T - + testsuite/tests/vdq-rta/should_compile/T27583a.hs - + testsuite/tests/vdq-rta/should_compile/T27583b.hs - + testsuite/tests/vdq-rta/should_compile/T27583c.hs - + testsuite/tests/vdq-rta/should_compile/T27583d.hs - + testsuite/tests/vdq-rta/should_compile/T27583e.hs - testsuite/tests/vdq-rta/should_compile/all.T - + testsuite/tests/vdq-rta/should_fail/T27440e.hs - + testsuite/tests/vdq-rta/should_fail/T27440e.stderr - + testsuite/tests/vdq-rta/should_fail/T27583f.hs - + testsuite/tests/vdq-rta/should_fail/T27583f.stderr - testsuite/tests/vdq-rta/should_fail/all.T Changes: ===================================== changelog.d/T27440 ===================================== @@ -0,0 +1,10 @@ +section: compiler +issues: #27440 +mrs: !16434 +synopsis: + Fix a panic on ``@ty`` in a pattern synonym RHS +description: + An invisible type argument (``@ty``) in the right-hand side of an implicitly + bidirectional pattern synonym no longer causes a panic. The type is ignored + when the right-hand side is converted to an expression, just as a pattern + signature has long been (#9867). ===================================== changelog.d/T27583 ===================================== @@ -0,0 +1,10 @@ +section: compiler +issues: #27583 +mrs: !16434 +synopsis: + Fix spurious out-of-scope errors from ``type ty`` in a pattern synonym RHS +description: + A required type argument (``type ty``) in the right-hand side of an implicitly + bidirectional pattern synonym no longer reports variables bound by the pattern + as out of scope. The type is ignored when the right-hand side is converted to + an expression, and GHC infers it from the context instead. ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Tc.Gen.Pat , tcCheckPat, tcCheckPat_O, tcInferPat , tcMatchPats , addDataConStupidTheta + , zipPatsBndrs ) where @@ -1727,7 +1728,7 @@ split_con_ty_args :: LexicalFixity -- How to wrap value arguments , [(HsTyPat GhcRn, TyVar)] -- Existentials , HsConPatDetails GhcRn ) -- Value arguments split_con_ty_args fixity con_like arg_pats = do - (bndr_ty_arg_prs, value_args) <- zip_pats_bndrs arg_pats (conLikeUserTyVarBinders con_like) + (bndr_ty_arg_prs, value_args) <- zipPatsBndrs arg_pats (conLikeUserTyVarBinders con_like) return $ if null ex_tvs -- Short cut common case then (bndr_ty_arg_prs, [], mk_details fixity value_args) else let (ex_prs, univ_prs) = partition is_existential bndr_ty_arg_prs @@ -1743,24 +1744,30 @@ split_con_ty_args fixity con_like arg_pats = do -- InfixCon becomes PrefixCon if there are fewer than 2 value arguments. -- Test case: T25127_infix -zip_pats_bndrs :: [LPat GhcRn] -> [TyVarBinder] -> TcM ([(HsTyPat GhcRn, TyVar)], [LPat GhcRn]) -zip_pats_bndrs (L loc pat : pats) (Bndr tv vis : tvbs) +-- | Line the arguments of a 'ConPat' up against the 'TyVarBinder's of its +-- 'ConLike', returning the type arguments with the binders they instantiate, +-- and the remaining value arguments. +-- +-- Precondition: 'check_con_pat_arity' has passed for these arguments, so that +-- we never run out of patterns while a required binder remains. +zipPatsBndrs :: [LPat GhcRn] -> [TyVarBinder] -> TcM ([(HsTyPat GhcRn, TyVar)], [LPat GhcRn]) +zipPatsBndrs (L loc pat : pats) (Bndr tv vis : tvbs) | isVisibleForAllTyFlag vis = do { tp <- setSrcSpanA loc $ pat_to_type_pat pat - ; (prs, pats') <- zip_pats_bndrs pats tvbs + ; (prs, pats') <- zipPatsBndrs pats tvbs ; return ((tp, tv) : prs, pats') } | InvisPat pat_spec tp <- pat , Invisible spec <- vis , pat_spec == spec - = do { (prs, pats') <- zip_pats_bndrs pats tvbs + = do { (prs, pats') <- zipPatsBndrs pats tvbs ; return ((tp, tv):prs, pats') } -zip_pats_bndrs pats (Bndr _ vis : tvbs) - -- zip_pats_bndrs [] (Bndr _ Required : tvbs) +zipPatsBndrs pats (Bndr _ vis : tvbs) + -- zipPatsBndrs [] (Bndr _ Required : tvbs) -- is ruled out by the arity check in splitConTyArgs, -- so we can assume (isInvisibleForAllTyFlag vis) = do { massert (isInvisibleForAllTyFlag vis) - ; zip_pats_bndrs pats tvbs } -zip_pats_bndrs pats [] = return ([], pats) + ; zipPatsBndrs pats tvbs } +zipPatsBndrs pats [] = return ([], pats) tcConTyArgs :: Subst -> PatEnv -> [(HsTyPat GhcRn, TyVar)] -> TcM a -> TcM a ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -940,11 +940,9 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) | isUnidirectional dir = return [] - | Left why <- mb_match_group -- Can't invert the pattern - = setSrcSpan (getLocA lpat) $ failWithTc $ TcRnPatSynInvalidRhs ps_name lpat args why - - | Right match_group <- mb_match_group -- Bidirectional - = do { patsyn <- tcLookupPatSyn ps_name + | otherwise -- Bidirectional + = do { match_group <- get_match_group + ; patsyn <- tcLookupPatSyn ps_name ; case patSynBuilder patsyn of { Nothing -> return [] ; -- This case happens if we found a type error in the @@ -985,10 +983,10 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) ; return builder_binds } } } where - mb_match_group + get_match_group = case dir of - ExplicitBidirectional explicit_mg -> Right explicit_mg - ImplicitBidirectional -> fmap mk_mg (tcPatToExpr args lpat) + ExplicitBidirectional explicit_mg -> return explicit_mg + ImplicitBidirectional -> mk_mg <$> tcPatToExpr ps_name args lpat Unidirectional -> panic "tcPatSynBuilderBind" mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) @@ -1032,44 +1030,53 @@ add_void need_dummy_arg ty | need_dummy_arg = mkVisFunTyMany unboxedUnitTy ty | otherwise = ty -tcPatToExpr :: [LocatedN Name] -> LPat GhcRn - -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) +tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn -> TcM (LHsExpr GhcRn) -- Given a /pattern/, return an /expression/ that builds a value -- that matches the pattern. E.g. if the pattern is (Just [x]), -- the expression is (Just [x]). They look the same, but the -- input uses constructors from HsPat and the output uses constructors -- from HsExpr. -- --- Returns (Left r) if the pattern is not invertible, for reason r. +-- Fails with TcRnPatSynInvalidRhs if the pattern is not invertible. -- See Note [Builder for a bidirectional pattern synonym] -tcPatToExpr args pat = go pat +tcPatToExpr ps_name args pat = go pat where lhsVars = mkNameSet (map unLoc args) + invalidRhs :: PatSynInvalidRhsReason -> TcM a + invalidRhs why = setSrcSpan (getLocA pat) $ + failWithTc $ TcRnPatSynInvalidRhs ps_name pat args why + -- Make a prefix con for prefix and infix patterns for simplicity mkPrefixConExpr :: LocatedN (WithUserRdr Name) -> [LPat GhcRn] - -> Either PatSynInvalidRhsReason (HsExpr GhcRn) - mkPrefixConExpr lcon@(L loc _) pats - = do { exprs <- mapM go pats + -> TcM (HsExpr GhcRn) + mkPrefixConExpr lcon@(L loc con_name) pats + = do { con_like <- tcLookupConLike con_name + ; let tvbs = conLikeUserTyVarBinders con_like + ; (_ty_pats, val_pats) <- zipPatsBndrs pats tvbs + -- Type arguments _ty_pats are discarded, just like the SigPat's type. + -- See Note [Discarding types in the builder expression] + ; let ty_exprs = [wildCardTyArg | tvb <- tvbs, isVisibleForAllTyBinder tvb] + -- Placeholders (type _) for the discarded required type arguments. + ; val_exprs <- mapM go val_pats ; let con = L (l2l loc) (HsVar noExtField lcon) - ; return (unLoc $ mkHsApps con exprs) - } + ; return (unLoc $ mkHsApps con (ty_exprs ++ val_exprs)) } mkRecordConExpr :: LocatedN (WithUserRdr Name) -> HsRecFields GhcRn (LPat GhcRn) - -> Either PatSynInvalidRhsReason (HsExpr GhcRn) + -> TcM (HsExpr GhcRn) mkRecordConExpr con (HsRecFields x fields dd) = do { exprFields <- mapM go' fields ; return (RecordCon noExtField con (HsRecFields x exprFields dd)) } - go' :: LHsRecField GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn)) + go' :: LHsRecField GhcRn (LPat GhcRn) -> TcM (LHsRecField GhcRn (LHsExpr GhcRn)) go' (L l rf) = L l <$> traverse go rf - go :: LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) + go :: LPat GhcRn -> TcM (LHsExpr GhcRn) go (L loc p) = L loc <$> go1 p - go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn) + go1 :: Pat GhcRn -> TcM (HsExpr GhcRn) go1 (ConPat NoExtField con info) = case info of PrefixCon _ ps -> mkPrefixConExpr con ps @@ -1077,13 +1084,13 @@ tcPatToExpr args pat = go pat RecCon _ fields -> mkRecordConExpr con fields go1 (SigPat _ pat _) = go1 (unLoc pat) - -- See Note [Type signatures and the builder expression] + -- See Note [Discarding types in the builder expression] go1 (VarPat _ (L l var)) | var `elemNameSet` lhsVars = return $ mkHsVar (L l var) | otherwise - = Left (PatSynUnboundVar var) + = invalidRhs (PatSynUnboundVar var) go1 (ParPat _ pat) = fmap (HsPar noExtField) (go pat) go1 (ListPat _ pats) = do { exprs <- mapM go pats @@ -1104,10 +1111,7 @@ tcPatToExpr args pat = go pat | otherwise = return $ HsOverLit noExtField n go1 (SplicePat (HsUntypedSpliceTop _ pat) _) = go1 pat go1 (SplicePat (HsUntypedSpliceNested _) _) = panic "tcPatToExpr: invalid nested splice" - go1 (EmbTyPat _ tp) = return $ HsEmbTy noExtField (hstp_to_hswc tp) - where hstp_to_hswc :: HsTyPat GhcRn -> LHsWcType GhcRn - hstp_to_hswc (HsTP { hstp_ext = HsTPRn { hstp_nwcs = wcs }, hstp_body = hs_ty }) - = HsWC { hswc_ext = wcs, hswc_body = hs_ty } + go1 (EmbTyPat _ _tp) = panic "tcPatToExpr: invalid type pattern" go1 (InvisPat _ _tp) = panic "tcPatToExpr: invalid invisible pattern" go1 (XPat (HsPatExpanded _ pat))= go1 pat @@ -1131,7 +1135,13 @@ tcPatToExpr args pat = go pat go1 p@(NPlusKPat {}) = notInvertible p go1 p@(OrPat {}) = notInvertible p - notInvertible p = Left (PatSynNotInvertible p) + notInvertible p = invalidRhs (PatSynNotInvertible p) + +-- See Note [Discarding types in the builder expression] +wildCardTyArg :: LHsExpr GhcRn +wildCardTyArg = wrapGenSpan e + where e = HsEmbTy noExtField (mkEmptyWildCardBndrs (noLocA t)) + t = HsWildCardTy (HoleVar (noLocA unnamedHoleRdrName)) {- Note [Builder for a bidirectional pattern synonym] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1203,9 +1213,17 @@ one could write a nonsensical function like or g (K (Just True) False) = ... -Note [Type signatures and the builder expression] +Note [Discarding types in the builder expression] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The RHS of an implicitly bidirectional pattern synonym may mention types in +three ways: a pattern signature (p :: ty), an invisible type argument (@ty), +and a required type argument (type ty). Required type arguments may be obscured +by the omission of the `type` keyword. + +A type may /bind/ variables when it occurs in a pattern, and those binders have +no counterpart in the builder's scope, so tcPatToExpr must not carry them over. Consider + pattern L x = Left x :: Either [a] [b] In tc{Infer/Check}PatSynDecl we will check that the pattern has the @@ -1223,6 +1241,43 @@ latter; #9867.) No, the job of the signature is done, so when converting the pattern to an expression (for the builder RHS) we simply discard the signature. +The same reasoning applies to the other two forms, but the way we discard +them differs. Which form an argument takes is not apparent from the pattern +alone: in + + pattern P x = MkT a x + +'a' looks like an ordinary variable pattern, and only the TyVarBinders in +MkT's type say that it stands in a required type argument position. We get +those binders from the typechecked ConLike, via conLikeUserTyVarBinders, so +mkPrefixConExpr must look the constructor up before it can walk the arguments. +It then lines them up against the binders with zipPatsBndrs, exactly as +tcConPat does for the pattern itself, and treats them accordingly: + +* Invisible type arguments (@ty) are dropped from the argument list + altogether. Given + + pattern Q x = MkT @a x + + the builder is $bQ x = MkT x. Dropping is safe because the argument + instantiates either a universal, which the expected type of the builder + already pins down, or an existential, which cannot take a concrete type + in a pattern anyway. Improper handling of type arguments led to #27440. + +* Required type arguments cannot be dropped, as that would change the syntactic + arity of the application. Instead, we replace them with placeholders (type _), + the equivalent of @_ for invisible type arguments. Given + + pattern R x = MkT (type a) x + pattern P x = MkT a x + + the builders are $bR x = MkT (type _) x and $bP x = MkT (type _) x, and the + wildcard is solved from the expected type. Retaining the type would mention a + binder that is not in scope in the builder (#27583). + +In all three cases the pattern has already been checked by the time the +builder is built, so no information is lost by forgetting these types. + Note [Record PatSyn Desugaring] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It is important that prov_theta comes before req_theta as this ordering is used ===================================== testsuite/tests/patsyn/should_compile/T27440a.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, PatternSynonyms, TypeAbstractions #-} +module T27440a where + +import Data.Kind (Type) + +newtype Lit = Lit { litName :: String } + +type LitOfValue :: Bool -> Type +newtype LitOfValue v = LitOfValue { underlyingLit :: Lit } + +pattern FalseLit :: Lit -> LitOfValue False +pattern FalseLit a = LitOfValue @False a ===================================== testsuite/tests/patsyn/should_compile/T27440b.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms, TypeAbstractions #-} +module T27440b where + +data T a = MkT a + +pattern P :: a -> T a +pattern P x = MkT @a x ===================================== testsuite/tests/patsyn/should_compile/T27440c.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE ExistentialQuantification, PatternSynonyms, TypeAbstractions #-} +module T27440c where + +data S = forall a. Show a => MkS a + +pattern P :: () => Show a => a -> S +pattern P x = MkS @a x ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -90,3 +90,7 @@ test('T23038', normal, compile_fail, ['']) test('T22328', normal, compile, ['']) test('T26331', normal, compile, ['']) test('T26331a', normal, compile, ['']) + +test('T27440a', normal, compile, ['']) +test('T27440b', normal, compile, ['']) +test('T27440c', normal, compile, ['']) ===================================== testsuite/tests/patsyn/should_fail/T27440d.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE ExistentialQuantification, PatternSynonyms, TypeAbstractions #-} +module T27440d where + +data S = forall a. Show a => MkS a + +pattern P :: Show a => a -> S +pattern P x = MkS @a x ===================================== testsuite/tests/patsyn/should_fail/T27440d.stderr ===================================== @@ -0,0 +1,12 @@ +T27440d.hs:7:22: error: [GHC-25897] + • Couldn't match expected type ‘a’ with actual type ‘a1’ + ‘a1’ is a rigid type variable bound by + a pattern with constructor: MkS :: forall a. Show a => a -> S, + in a pattern synonym declaration + at T27440d.hs:7:15-22 + ‘a’ is a rigid type variable bound by + the signature for pattern synonym ‘P’ + at T27440d.hs:6:14-29 + • In the declaration for pattern synonym ‘P’ + • Relevant bindings include x :: a1 (bound at T27440d.hs:7:22) + ===================================== testsuite/tests/patsyn/should_fail/all.T ===================================== @@ -55,3 +55,5 @@ test('patsyn_where_fail1', normal, compile_fail, ['']) test('patsyn_where_fail2', normal, compile_fail, ['']) test('patsyn_where_fail3', normal, compile_fail, ['']) test('patsyn_where_fail4', normal, compile_fail, ['']) + +test('T27440d', normal, compile_fail, ['']) ===================================== testsuite/tests/vdq-rta/should_compile/T27583a.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583a where + +data T a where + MkT :: forall a -> T a + +pattern P :: T a +pattern P = MkT (type a) ===================================== testsuite/tests/vdq-rta/should_compile/T27583b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583b where + +data T a where + MkT :: forall a -> T a + +pattern P :: T a +pattern P = MkT a ===================================== testsuite/tests/vdq-rta/should_compile/T27583c.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583c where + +data T a where + MkT :: forall a -> T a + +pattern P :: T Int +pattern P = MkT (type Int) ===================================== testsuite/tests/vdq-rta/should_compile/T27583d.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583d where + +data T a where + MkT :: forall a -> a -> T a + +-- A required type argument is checked against the signature, with or without +-- the 'type' herald. The variable/wildcard patterns x, _, (type x), (type _) +-- can't mismatch the signature. Concrete types are in T27583e and T27583f. + +pattern P1 :: Int -> T Int +pattern P1 n = MkT x n + +pattern P2 :: Int -> T Int +pattern P2 n = MkT (type x) n + +pattern P3 :: Int -> T Int +pattern P3 n = MkT _ n + +pattern P4 :: Int -> T Int +pattern P4 n = MkT (type _) n ===================================== testsuite/tests/vdq-rta/should_compile/T27583e.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583e where + +data T a where + MkT :: forall a -> a -> T a + +-- A required type argument is checked against the signature, with or without +-- the 'type' herald. Here the type written in that position agrees with the +-- signature. T27583f is the same four patterns with a type that does not. + +pattern P1 :: Int -> T Int +pattern P1 n = MkT Int n + +pattern P2 :: Int -> T Int +pattern P2 n = MkT (type Int) n + +pattern P3 :: Maybe Int -> T (Maybe Int) +pattern P3 n = MkT (Maybe Int) n + +pattern P4 :: Maybe Int -> T (Maybe Int) +pattern P4 n = MkT (type (Maybe Int)) n ===================================== testsuite/tests/vdq-rta/should_compile/all.T ===================================== @@ -39,3 +39,9 @@ test('T23738_th', req_th, compile, ['']) test('T24159_viewpat', normal, compile, ['']) test('T24159_type_syntax', normal, compile, ['']) test('T24159_th_type_syntax', req_th, compile, ['']) + +test('T27583a', normal, compile, ['']) +test('T27583b', normal, compile, ['']) +test('T27583c', normal, compile, ['']) +test('T27583d', normal, compile, ['']) +test('T27583e', normal, compile, ['']) ===================================== testsuite/tests/vdq-rta/should_fail/T27440e.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms, TypeAbstractions #-} +module T27440e where + +data T a where + MkT :: forall a -> T a + +pattern P :: a -> T a +pattern P x = MkT @a x ===================================== testsuite/tests/vdq-rta/should_fail/T27440e.stderr ===================================== @@ -0,0 +1,5 @@ +T27440e.hs:8:19: error: [GHC-88754] + • Ill-formed type pattern: @a + • In the pattern: MkT @a x + In the declaration for pattern synonym ‘P’ + ===================================== testsuite/tests/vdq-rta/should_fail/T27583f.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-} +module T27583f where + +data T a where + MkT :: forall a -> a -> T a + +-- A required type argument is checked against the signature, with or without +-- the 'type' herald. Here the type written in that position does not agree +-- with the signature. T27583e is the same four patterns with a type that does. + +pattern P1 :: Int -> T Int +pattern P1 n = MkT Bool n + +pattern P2 :: Int -> T Int +pattern P2 n = MkT (type Bool) n + +pattern P3 :: Maybe Int -> T (Maybe Int) +pattern P3 n = MkT (Maybe Bool) n + +pattern P4 :: Maybe Int -> T (Maybe Int) +pattern P4 n = MkT (type (Maybe Bool)) n ===================================== testsuite/tests/vdq-rta/should_fail/T27583f.stderr ===================================== @@ -0,0 +1,24 @@ +T27583f.hs:12:16: error: [GHC-83865] + • Couldn't match expected type ‘Int’ with actual type ‘Bool’ + • In the pattern: MkT Bool n + In the declaration for pattern synonym ‘P1’ + +T27583f.hs:15:16: error: [GHC-83865] + • Couldn't match expected type ‘Int’ with actual type ‘Bool’ + • In the pattern: MkT (type Bool) n + In the declaration for pattern synonym ‘P2’ + +T27583f.hs:18:16: error: [GHC-83865] + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Maybe Int + Actual: Maybe Bool + • In the pattern: MkT (Maybe Bool) n + In the declaration for pattern synonym ‘P3’ + +T27583f.hs:21:16: error: [GHC-83865] + • Couldn't match type ‘Bool’ with ‘Int’ + Expected: Maybe Int + Actual: Maybe Bool + • In the pattern: MkT (type (Maybe Bool)) n + In the declaration for pattern synonym ‘P4’ + ===================================== testsuite/tests/vdq-rta/should_fail/all.T ===================================== @@ -32,3 +32,6 @@ test('T24159_type_syntax_tc_fail', normal, compile_fail, ['']) test('T24159_type_syntax_th_fail', normal, ghci_script, ['T24159_type_syntax_th_fail.script']) test('T25127_fail_th_quote', normal, compile_fail, ['']) test('T25127_fail_arity', normal, compile_fail, ['']) + +test('T27440e', normal, compile_fail, ['']) +test('T27583f', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9a9ed673af18fdd3772c8ebe2761be… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9a9ed673af18fdd3772c8ebe2761be… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0