[Git][ghc/ghc][wip/spj-apporv-Oct24] add Note to explain the tcExprSigma, QuickLook and Deepsubsumption flag impl
by Apoorv Ingle (＠ani) 31 Mar '26
by Apoorv Ingle (＠ani) 31 Mar '26
31 Mar '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
abc37a34 by Apoorv Ingle at 2026-03-30T21:29:37-05:00
add Note to explain the tcExprSigma, QuickLook and Deepsubsumption flag impl
- - - - -
6 changed files:
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/App.hs-boot
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Utils/Unify.hs
Changes:
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -171,14 +171,90 @@ Note [Instantiation variables are short lived]
* *
********************************************************************* -}
+{- Note [splitHsApps, XExpr and tcExprSigma]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+This implementation is WIP and is subject to change once MR!15811 is figured out
+
+To simplify the implementation of `splitHsApps`, we do not look through
+XExpr's, however, we still need to deal with cases such as:
+
+ (XExpr (ExpandedThingRn f1 (f `HsApp` e1))) `HsApp` e2 `HsApp` e3
+
+Otherwise stuff like overloaded labels (#19154) won't work.
+
+How do we do it?
+
+`splitHsApps` peals off the arguments until it hits an XExpr
+From above example,
+
+ splitHsApps ((XExpr (ExpandedThingRn f1 (f `HsApp` e1))) `HsApp` e2 `HsApp` e3)
+ = { head = XExpr (ExpandedThingRn f1 (f `HsApp` e1))
+ , args = [e3, e2] -- NB: arguments are in the reverse order
+ }
+
+Now, we infer the type of head using tcInferAppHead/tcInferAppHead_maybe.
+Which calls `tcExprSigma` on the XExpr. It performs a mini-`tcApp`
+where it uses the CtOrigin obtained from f1, splits the application chain: f `HsApp` e1.
+and finally returns an uninstantiated sigma type and a typechecked expression
+
+It is crucial for tcExprSigma to return an uninstantiated type so that visible type
+applications with rebindable syntax works fine. Eg. T19167
+
+
+ fromListN :: Int -> [elt] -> (forall list. (IsList list, elt ~ Item list) => list)
+ fromListN n l = Predule.fromListN n l
+
+ shouldBeANonEmpty = ['x', 'y', 'z'] @(NonEmpty Char)
+
+here the RHS of `shouldBeNonEmpty` is expanded to
+ (XExpr (ExpandedThingRn (['x', 'y', 'z']) (fromListN 3 ['x', 'y', 'z']) `HsTypeApp` (NonEmpty Char)
+
+Now, if we were to instantiate the head of the expression, we will
+fail to typecheck the expression as the type `NonEmpty Char`.
+
+
+Wrinkle [DeepSubsumption Flag and Multiplicity]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Consider the expression:
+
+ (1 :) $ [2, 3]
+
+Here, the head of the expression is ($) and it is applied to two arguments
+ Arg1 = (1 :)
+ Arg2 = [2, 3]
+
+Arg1 is an expanded expression as it is a left section wrapped with parenthesis
+
+ Arg1 = HsPar (XExpr (ExpandedThingRn (HSE (1 :) ((:) 1))))
+
+As `($)` is the head of the application chain, we perform QuickLook on the arguments
+in `tcInstFun`. See Note [Quick Look for particular Ids] and Note [tcApp: typechecking applications].
+
+Thus, Arg1 will be transformed into
+
+ EValArgQL { eaql_tc_head = XExpr (ExpandedThingRn (HSE { hs_ctxt = 1 : , hs_expr = ((:) 1))))
+ , eaql_arg_ty = [alpha] %1 -> [beta]
+ , eqql_args = [EPar] }
+
+Now, in `tcValArg` Arg1 is expected to have type [Int] -> [Int],
+and according to Note [Typechecking data constructors], we ought to be able to
+coerce the type [alpha] %1 -> [beta] into type [Int] -> [Int] in `checkResultTy`
+because the "actual" head of Arg1 is (:), thus we need to traverse eaql_tc_head.
+
+The hope is that future refactoring simplifies this delicate and complicated process.
+
+-}
-- Very similar to tcApp, but returns a sigma (uninstantiated) type
-- CAUTION: Any changes to tcApp should be reflected here
-- cf. T19167. the head is an expanded expression applied to a type
-- Caution: Currently we assume that the expression is compiler generated/expanded
-- Because that is what T19167 test case expects.
-- This function should go away after MR!15778 lands
-tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
-tcExprSigma inst fun_orig rn_expr
+-- See Note [splitHsApps, XExpr and tcExprSigma]
+tcExprSigma :: CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
+tcExprSigma fun_orig rn_expr
= do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr
; do_ql <- wantQuickLook rn_fun
; (tc_fun, fun_sigma) <- tcInferAppHead fun
@@ -186,7 +262,7 @@ tcExprSigma inst fun_orig rn_expr
; traceTc "tcExprSigma" (vcat [ text "rn_expr:" <+> ppr rn_expr
, text "tc_fun" <+> ppr tc_fun
, text "inGeneratedCode:" <+> ppr inGenCode])
- ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (fun_orig, rn_fun, fun_lspan)
+ ; (inst_args, app_res_sigma) <- tcInstFun do_ql False (fun_orig, rn_fun, fun_lspan)
tc_fun fun_sigma rn_args
; tc_args <- tcValArgs do_ql (rn_fun, fun_lspan) inst_args
; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args
=====================================
compiler/GHC/Tc/Gen/App.hs-boot
=====================================
@@ -7,6 +7,4 @@ import GHC.Tc.Utils.TcType ( TcSigmaType )
import GHC.Hs.Extension ( GhcRn, GhcTc )
-import GHC.Prelude (Bool)
-
-tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
+tcExprSigma :: CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -383,7 +383,7 @@ The `fail`-block wrapping is done by `GHC.Tc.Gen.Do.mk_failable_expr`.
* _Wrinkle 2_: The call to `fail` will give rise to a `MonadFail` constraint. What `CtOrigin` do we
attach to that constraint? When the `MonadFail` constraint can't be solved, it'll show up in error
messages and it needs to be a good location. Ideally, it should identify the
- pattern `p`. Hence, we wrap the `fail` alternative expression with a `ExpandedPat`
+ pattern `p`. Hence, we wrap the `fail` alternative expression with a `ExpandedPatRn`
that tags the fail expression with the failable pattern. (See testcase MonadFailErrors.hs)
Part 2. Generate warnings for discarded body statement results
@@ -412,7 +412,7 @@ Part 3. Blaming Offending Source Code and Generating Appropriate Error Messages
To ensure we correctly track source of the offending user written source code,
in this case the `do`-statement, we need to keep track of
which source statement's expansion the typechecker is currently typechecking.
-For this purpose we use the `XXExprGhcRn.ExpansionRn`.
+For this purpose we use the `XXExprGhcRn.ExpandedThingRn`.
It stores the original statement (with location) and the expanded expression
A. Expanding Body Statements
@@ -453,7 +453,7 @@ It stores the original statement (with location) and the expanded expression
This popping is implicitly done when we push the error context message for the next statment.
See `LclEnv.setLclCtxtHsCtxt`
- Sans the popping business for error context stack,
+ Sans the implicit overwriting business for error context stack,
if there were to be a type error in `e2`, we would get a spurious and confusing error message
which mentions "In the stmt of a do block e1" along with the message
"In the stmt of a do block e2".
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -144,7 +144,7 @@ takes apart either an HsApp, or an infix OpApp, returning
innermost un-expanded head as the "error head".
* A list of HsExprArg, the arguments
-* We do not look through expanded expressions (except PopErrCtxt.)
+* We do not look through expanded expressions (`XExpr`s)
-}
data TcPass = TcpRn -- Arguments decomposed
@@ -349,29 +349,6 @@ That makes it possible to typecheck something like
where
f :: forall a. t1 -> forall b. t2 -> t3
-Note [Looking through ExpandedThingRn]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When creating an application chain in splitHsApps, we must deal with
- ExpandedThingRn f1 (f `HsApp` e1) `HsApp` e2 `HsApp` e3
-
-as a single application chain `f e1 e2 e3`. Otherwise stuff like overloaded
-labels (#19154) won't work.
-
-It's easy to achieve this: `splitHsApps` unwraps `ExpandedThingRn`.
-
-In order to be able to more accurately reconstruct the original `SrcSpan`s
-from the renamer in `rebuildHsApps`, we also have to track the `SrcSpan`
-of the current application in `VAExpansion` when unwrapping `ExpandedThingRn`
-in `splitHsApps`, just as we track it in a non-expanded expression.
-
-Previously, `rebuildHsApps` substituted the location of the original
-expression as given by `splitHsApps` for this. As a result, the application
-head in expanded expressions, e.g. the call to `fromListN`, would either
-have `noSrcSpan` set as its location post-typecheck, or get the location
-of the original expression, depending on whether the `XExpr` given to
-`splitHsApps` is in the outermost layer. The span it got in the renamer
-would always be discarded, causing #23120.
-
Note [Looking through Template Haskell splices in splitHsApps]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When typechecking an application, we must look through untyped TH splices in
@@ -467,7 +444,7 @@ tcInferAppHead_maybe fun = case fun of
-> Just <$> tcInferRecSelId f
XExpr (ExpandedThingRn (HSE o (L loc e)))
-> setSrcSpan (locA loc) $ Just <$>
- do { (e', ty) <- tcExprSigma False (hsCtxtCtOrigin o) e
+ do { (e', ty) <- tcExprSigma (hsCtxtCtOrigin o) e
; return (mkExpandedTc o (L loc e'), ty) }
-- We do not want to instantiate the type of the head as there may be
-- visible type applications in the argument.
=====================================
compiler/GHC/Tc/Types/LclEnv.hs
=====================================
@@ -173,6 +173,7 @@ setLclEnvHsCtxt ec = modifyLclCtxt (setLclCtxtHsCtxt ec)
setLclCtxtHsCtxt :: HsCtxt -> TcLclCtxt -> TcLclCtxt
setLclCtxtHsCtxt ec lclCtxt
-- Never stack 2 do statement error messages on top of each other
+ -- See Part 3 A of Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`
| StmtErrCtxt{} : ecs <- tcl_err_ctxt lclCtxt
, StmtErrCtxt{} <- ec
= lclCtxt { tcl_err_ctxt = ec : ecs }
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -2078,6 +2078,9 @@ getDeepSubsumptionFlag_DataConHead app_head =
-> go app_head
}
where
+ -- Why do we look through ExpandedThingTc and HsApps?
+ -- See Wrinkle [DeepSubsumption Flag and Multiplicity] in
+ -- Note [splitHsApps, XExpr and tcExprSigma]
go :: HsExpr GhcTc -> DeepSubsumptionFlag
go (XExpr (ConLikeTc (RealDataCon {}))) = Deep TopSub
go (XExpr (ExpandedThingTc (HSE _ (L _ f)))) = go f
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/abc37a34a51014ff68b06c3986a6711…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/abc37a34a51014ff68b06c3986a6711…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-apporv-Oct24] pattern matches for GeneratedSrcSpan do not use underscores
by Apoorv Ingle (＠ani) 31 Mar '26
by Apoorv Ingle (＠ani) 31 Mar '26
31 Mar '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
36652baf by Apoorv Ingle at 2026-03-30T19:17:43-05:00
pattern matches for GeneratedSrcSpan do not use underscores
- - - - -
12 changed files:
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Utils/Logger.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
Changes:
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -507,7 +507,9 @@ getSrcSpanDs = do { env <- getLclEnv
putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
putSrcSpanDs (RealSrcSpan real_span _) thing_inside
= updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside
-putSrcSpanDs _ thing_inside
+putSrcSpanDs UnhelpfulSpan{} thing_inside
+ = thing_inside
+putSrcSpanDs GeneratedSrcSpan{} thing_inside
= thing_inside
putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -121,8 +121,9 @@ addTicksToBinds logger cfg
, inScope = emptyVarSet
, blackList = Set.fromList $
mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of
- RealSrcSpan l _ -> Just l
- _ -> Nothing)
+ RealSrcSpan l _ -> Just l
+ GeneratedSrcSpan{} -> Nothing
+ UnhelpfulSpan{} -> Nothing)
tyCons
, density = mkDensity tickish $ ticks_profAuto cfg
, this_mod = mod
@@ -1192,7 +1193,8 @@ getFileName = fileName `liftM` getEnv
isGoodSrcSpan' :: SrcSpan -> Bool
isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos
-isGoodSrcSpan' _ = False
+isGoodSrcSpan' UnhelpfulSpan{} = False
+isGoodSrcSpan' GeneratedSrcSpan{} = False
isGoodTickSrcSpan :: SrcSpan -> TM Bool
isGoodTickSrcSpan pos = do
@@ -1218,11 +1220,13 @@ bindLocals from (TM m) = TM $ \env st ->
withBlackListed :: SrcSpan -> TM a -> TM a
withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) })
-withBlackListed _ = id
+withBlackListed GeneratedSrcSpan{} = id
+withBlackListed UnhelpfulSpan{} = id
isBlackListed :: SrcSpan -> TM Bool
isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st)
-isBlackListed _ = return False
+isBlackListed GeneratedSrcSpan{} = return False
+isBlackListed UnhelpfulSpan{} = return False
-- the tick application inherits the source position of its
-- expression argument to support nested box allocations
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -426,7 +426,8 @@ getRealSpanA la = getRealSpan (locA la)
getRealSpan :: SrcSpan -> Maybe Span
getRealSpan (RealSrcSpan sp _) = Just sp
getRealSpan (GeneratedSrcSpan (OrigSpan sp)) = Just sp
-getRealSpan _ = Nothing
+getRealSpan (GeneratedSrcSpan{}) = Nothing
+getRealSpan (UnhelpfulSpan{}) = Nothing
grhss_span :: (IsPass p, Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns)
=> GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
=====================================
compiler/GHC/Iface/Ext/Utils.hs
=====================================
@@ -314,7 +314,8 @@ getNameScopeAndBinding
getNameScopeAndBinding n asts = case nameSrcSpan n of
RealSrcSpan sp _ -> go sp
GeneratedSrcSpan (OrigSpan sp) -> go sp
- _ -> Nothing
+ GeneratedSrcSpan{} -> Nothing
+ UnhelpfulSpan{} -> Nothing
where
go sp = do -- @Maybe
ast <- M.lookup (HiePath (srcSpanFile sp)) asts
@@ -542,9 +543,10 @@ locOnlyE _ = pure []
mkScope :: (HasLoc a) => a -> Scope
mkScope a = case getHasLoc a of
- (RealSrcSpan sp _) -> LocalScope sp
- (GeneratedSrcSpan (OrigSpan sp)) -> LocalScope sp
- _ -> NoScope
+ RealSrcSpan sp _ -> LocalScope sp
+ GeneratedSrcSpan (OrigSpan sp) -> LocalScope sp
+ GeneratedSrcSpan{} -> NoScope
+ UnhelpfulSpan{} -> NoScope
combineScopes :: Scope -> Scope -> Scope
combineScopes ModuleScope _ = ModuleScope
@@ -576,7 +578,8 @@ makeNode x spn = do
pure $ case spn of
RealSrcSpan span _ -> mk_node span org
GeneratedSrcSpan (OrigSpan span) -> mk_node span org
- _ -> []
+ GeneratedSrcSpan{} -> []
+ UnhelpfulSpan{} -> []
where
cons = mkFastString . show . toConstr $ x
typ = mkFastString . show . typeRepTyCon . typeOf $ x
@@ -603,7 +606,8 @@ makeTypeNode x spn etyp = do
pure $ case spn of
RealSrcSpan span _ -> mk_node span org
GeneratedSrcSpan (OrigSpan span) -> mk_node span org
- _ -> []
+ GeneratedSrcSpan{} -> []
+ UnhelpfulSpan{} -> []
where
cons = mkFastString . show . toConstr $ x
typ = mkFastString . show . typeRepTyCon . typeOf $ x
=====================================
compiler/GHC/Parser/HaddockLex.x
=====================================
@@ -185,11 +185,12 @@ validateIdentWith identParser mloc str0 =
realSrcLc = case mloc of
RealSrcSpan loc _ -> realSrcSpanStart loc
GeneratedSrcSpan{} -> mkRealSrcLoc nilFS 0 0
- UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0
+ UnhelpfulSpan{} -> mkRealSrcLoc nilFS 0 0
pstate = initParserState pflags buffer realSrcLc
in case unP identParser pstate of
POk _ name -> Just $ case mloc of
RealSrcSpan _ _ -> reLoc name
- _ -> L mloc (unLoc name) -- Preserve the original reason
+ GeneratedSrcSpan{} -> L mloc (unLoc name) -- Preserve the original reason
+ UnhelpfulSpan{} -> L mloc (unLoc name) -- Preserve the original reason
_ -> Nothing
}
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -705,7 +705,9 @@ wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
wrapGenSpan' :: (HasAnnotation an) => SrcSpan -> a -> GenLocated an a
wrapGenSpan' s x = case s of
RealSrcSpan s _ -> L (noAnnSrcSpan $ GeneratedSrcSpan (OrigSpan s)) x
- _ -> wrapGenSpan x
+ GeneratedSrcSpan{} -> wrapGenSpan x
+ UnhelpfulSpan{} -> wrapGenSpan x
+
wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a
-- Wrap something in a "noSrcSpan"
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1481,8 +1481,8 @@ instance TH.Quasi TcM where
; l <- getSrcSpanM
; r <- case l of
RealSrcSpan s _ -> return s
- GeneratedSrcSpan l -> pprPanic "qLocation: generatedSrcSpan"
- (pprGeneratedSrcSpanDetails l)
+ GeneratedSrcSpan{} -> pprPanic "qLocation: generatedSrcSpan"
+ (pprGeneratedSrcSpanDetails)
UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location"
(ppr l)
; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -424,7 +424,7 @@ pprSimilarName mb_tried_ns (SimilarRdrName rdr_name _gre_info how_in_scope)
LocallyBoundAt loc ->
case loc of
UnhelpfulSpan l -> parens (ppr l)
- GeneratedSrcSpan ss -> parens (pprGeneratedSrcSpanDetails ss)
+ GeneratedSrcSpan{} -> parens (pprGeneratedSrcSpanDetails)
RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
ImportedBy is ->
parens (text "imported from" <+> ppr (moduleName $ is_mod is))
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -49,9 +49,9 @@ module GHC.Types.SrcLoc (
pprUserRealSpan, pprUnhelpfulSpanReason,
pprUserSpan,
unhelpfulSpanFS,
+ generatedSrcSpanDetailsFS,
srcSpanToRealSrcSpan,
pprGeneratedSrcSpanDetails,
- generatedSrcSpanDetailsFS,
-- ** Unsafely deconstructing SrcSpan
-- These are dubious exports, because they crash on some inputs
@@ -642,13 +642,13 @@ srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c
-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanStart :: SrcSpan -> SrcLoc
srcSpanStart (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
-srcSpanStart (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
+srcSpanStart (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
srcSpanStart (RealSrcSpan s b) = RealSrcLoc (realSrcSpanStart s) (fmap bufSpanStart b)
-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanEnd :: SrcSpan -> SrcLoc
srcSpanEnd (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
-srcSpanEnd (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
+srcSpanEnd (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b)
realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
@@ -738,15 +738,15 @@ unhelpfulSpanFS r = case r of
pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc
pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r)
-generatedSrcSpanDetailsFS :: GeneratedSrcSpanDetails -> FastString
-generatedSrcSpanDetailsFS _ = fsLit "<generated>"
+generatedSrcSpanDetailsFS :: FastString
+generatedSrcSpanDetailsFS = fsLit "<generated>"
-pprGeneratedSrcSpanDetails :: GeneratedSrcSpanDetails -> SDoc
-pprGeneratedSrcSpanDetails d = ftext (generatedSrcSpanDetailsFS d)
+pprGeneratedSrcSpanDetails :: SDoc
+pprGeneratedSrcSpanDetails = ftext generatedSrcSpanDetailsFS
pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan _ (UnhelpfulSpan r) = pprUnhelpfulSpanReason r
-pprUserSpan _ (GeneratedSrcSpan d) = pprGeneratedSrcSpanDetails d
+pprUserSpan _ (GeneratedSrcSpan{}) = pprGeneratedSrcSpanDetails
pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
=====================================
compiler/GHC/Utils/Logger.hs
=====================================
@@ -401,7 +401,8 @@ jsonLogActionWithHandle out logflags msg_class srcSpan msg
, ("endCol", json $ srcSpanEndCol rss)
]
where file = unpackFS $ srcSpanFile rss
- _ -> JSNull
+ GeneratedSrcSpan{} -> JSNull
+ UnhelpfulSpan{} -> JSNull
-- | The default 'LogAction' prints to 'stdout' and 'stderr'.
--
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -2710,7 +2710,7 @@ parseSpanArg s = do
-- while simply unpacking 'UnhelpfulSpan's
showSrcSpan :: SrcSpan -> String
showSrcSpan (UnhelpfulSpan s) = unpackFS (unhelpfulSpanFS s)
-showSrcSpan (GeneratedSrcSpan d) = unpackFS (generatedSrcSpanDetailsFS d)
+showSrcSpan (GeneratedSrcSpan{}) = unpackFS (generatedSrcSpanDetailsFS)
showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn
-- | Variant of 'showSrcSpan' for 'RealSrcSpan's
=====================================
ghc/GHCi/UI/Info.hs
=====================================
@@ -393,7 +393,8 @@ processAllTypeCheckedModule tcm
toSpanInfo :: (Maybe Id,SrcSpan,Type) -> Maybe SpanInfo
toSpanInfo (n,RealSrcSpan spn _,typ)
= Just $ spanInfoFromRealSrcSpan spn (Just typ) n
- toSpanInfo _ = Nothing
+ toSpanInfo (_, GeneratedSrcSpan{}, _) = Nothing
+ toSpanInfo (_, UnhelpfulSpan{}, _) = Nothing
-- helper stolen from @syb@ package
type GenericQ r = forall a. Data a => a -> r
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36652baf25e67a342aaee26c53ab075…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36652baf25e67a342aaee26c53ab075…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-apporv-Oct24] pattern matches for GeneratedSrcSpan do not use underscores
by Apoorv Ingle (＠ani) 31 Mar '26
by Apoorv Ingle (＠ani) 31 Mar '26
31 Mar '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
fe528a96 by Apoorv Ingle at 2026-03-30T19:01:40-05:00
pattern matches for GeneratedSrcSpan do not use underscores
- - - - -
12 changed files:
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Utils/Logger.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
Changes:
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -507,7 +507,9 @@ getSrcSpanDs = do { env <- getLclEnv
putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
putSrcSpanDs (RealSrcSpan real_span _) thing_inside
= updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside
-putSrcSpanDs _ thing_inside
+putSrcSpanDs UnhelpfulSpan{} thing_inside
+ = thing_inside
+putSrcSpanDs GeneratedSrcSpan{} thing_inside
= thing_inside
putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -121,8 +121,9 @@ addTicksToBinds logger cfg
, inScope = emptyVarSet
, blackList = Set.fromList $
mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of
- RealSrcSpan l _ -> Just l
- _ -> Nothing)
+ RealSrcSpan l _ -> Just l
+ GeneratedSrcSpan{} -> Nothing
+ UnhelpfulSpan{} -> Nothing)
tyCons
, density = mkDensity tickish $ ticks_profAuto cfg
, this_mod = mod
@@ -1192,7 +1193,8 @@ getFileName = fileName `liftM` getEnv
isGoodSrcSpan' :: SrcSpan -> Bool
isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos
-isGoodSrcSpan' _ = False
+isGoodSrcSpan' UnhelpfulSpan{} = False
+isGoodSrcSpan' GeneratedSrcSpan{} = False
isGoodTickSrcSpan :: SrcSpan -> TM Bool
isGoodTickSrcSpan pos = do
@@ -1218,11 +1220,13 @@ bindLocals from (TM m) = TM $ \env st ->
withBlackListed :: SrcSpan -> TM a -> TM a
withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) })
-withBlackListed _ = id
+withBlackListed GeneratedSrcSpan{} = id
+withBlackListed UnhelpfulSpan{} = id
isBlackListed :: SrcSpan -> TM Bool
isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st)
-isBlackListed _ = return False
+isBlackListed GeneratedSrcSpan{} = return False
+isBlackListed UnhelpfulSpan{} = return False
-- the tick application inherits the source position of its
-- expression argument to support nested box allocations
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -426,7 +426,8 @@ getRealSpanA la = getRealSpan (locA la)
getRealSpan :: SrcSpan -> Maybe Span
getRealSpan (RealSrcSpan sp _) = Just sp
getRealSpan (GeneratedSrcSpan (OrigSpan sp)) = Just sp
-getRealSpan _ = Nothing
+getRealSpan (GeneratedSrcSpan{}) = Nothing
+getRealSpan (UnhelpfulSpan{}) = Nothing
grhss_span :: (IsPass p, Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns)
=> GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
=====================================
compiler/GHC/Iface/Ext/Utils.hs
=====================================
@@ -314,7 +314,8 @@ getNameScopeAndBinding
getNameScopeAndBinding n asts = case nameSrcSpan n of
RealSrcSpan sp _ -> go sp
GeneratedSrcSpan (OrigSpan sp) -> go sp
- _ -> Nothing
+ GeneratedSrcSpan{} -> Nothing
+ UnhelpfulSpan{} -> Nothing
where
go sp = do -- @Maybe
ast <- M.lookup (HiePath (srcSpanFile sp)) asts
@@ -542,9 +543,10 @@ locOnlyE _ = pure []
mkScope :: (HasLoc a) => a -> Scope
mkScope a = case getHasLoc a of
- (RealSrcSpan sp _) -> LocalScope sp
- (GeneratedSrcSpan (OrigSpan sp)) -> LocalScope sp
- _ -> NoScope
+ RealSrcSpan sp _ -> LocalScope sp
+ GeneratedSrcSpan (OrigSpan sp) -> LocalScope sp
+ GeneratedSrcSpan{} -> NoScope
+ UnhelpfulSpan{} -> NoScope
combineScopes :: Scope -> Scope -> Scope
combineScopes ModuleScope _ = ModuleScope
@@ -576,7 +578,8 @@ makeNode x spn = do
pure $ case spn of
RealSrcSpan span _ -> mk_node span org
GeneratedSrcSpan (OrigSpan span) -> mk_node span org
- _ -> []
+ GeneratedSrcSpan{} -> []
+ UnhelpfulSpan{} -> []
where
cons = mkFastString . show . toConstr $ x
typ = mkFastString . show . typeRepTyCon . typeOf $ x
@@ -603,7 +606,8 @@ makeTypeNode x spn etyp = do
pure $ case spn of
RealSrcSpan span _ -> mk_node span org
GeneratedSrcSpan (OrigSpan span) -> mk_node span org
- _ -> []
+ GeneratedSrcSpan{} -> []
+ UnhelpfulSpan{} -> []
where
cons = mkFastString . show . toConstr $ x
typ = mkFastString . show . typeRepTyCon . typeOf $ x
=====================================
compiler/GHC/Parser/HaddockLex.x
=====================================
@@ -185,11 +185,12 @@ validateIdentWith identParser mloc str0 =
realSrcLc = case mloc of
RealSrcSpan loc _ -> realSrcSpanStart loc
GeneratedSrcSpan{} -> mkRealSrcLoc nilFS 0 0
- UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0
+ UnhelpfulSpan{} -> mkRealSrcLoc nilFS 0 0
pstate = initParserState pflags buffer realSrcLc
in case unP identParser pstate of
POk _ name -> Just $ case mloc of
RealSrcSpan _ _ -> reLoc name
- _ -> L mloc (unLoc name) -- Preserve the original reason
+ GeneratedSrcSpan{} -> L mloc (unLoc name) -- Preserve the original reason
+ UnhelpfulSpan{} -> L mloc (unLoc name) -- Preserve the original reason
_ -> Nothing
}
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -705,7 +705,9 @@ wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
wrapGenSpan' :: (HasAnnotation an) => SrcSpan -> a -> GenLocated an a
wrapGenSpan' s x = case s of
RealSrcSpan s _ -> L (noAnnSrcSpan $ GeneratedSrcSpan (OrigSpan s)) x
- _ -> wrapGenSpan x
+ GeneratedSrcSpan{} -> wrapGenSpan x
+ UnhelpfulSpan{} -> wrapGenSpan x
+
wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a
-- Wrap something in a "noSrcSpan"
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1481,8 +1481,8 @@ instance TH.Quasi TcM where
; l <- getSrcSpanM
; r <- case l of
RealSrcSpan s _ -> return s
- GeneratedSrcSpan l -> pprPanic "qLocation: generatedSrcSpan"
- (pprGeneratedSrcSpanDetails l)
+ GeneratedSrcSpan{} -> pprPanic "qLocation: generatedSrcSpan"
+ (pprGeneratedSrcSpanDetails)
UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location"
(ppr l)
; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -424,7 +424,7 @@ pprSimilarName mb_tried_ns (SimilarRdrName rdr_name _gre_info how_in_scope)
LocallyBoundAt loc ->
case loc of
UnhelpfulSpan l -> parens (ppr l)
- GeneratedSrcSpan ss -> parens (pprGeneratedSrcSpanDetails ss)
+ GeneratedSrcSpan{} -> parens (pprGeneratedSrcSpanDetails)
RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
ImportedBy is ->
parens (text "imported from" <+> ppr (moduleName $ is_mod is))
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -49,9 +49,9 @@ module GHC.Types.SrcLoc (
pprUserRealSpan, pprUnhelpfulSpanReason,
pprUserSpan,
unhelpfulSpanFS,
+ generatedSrcSpanDetailsFS,
srcSpanToRealSrcSpan,
pprGeneratedSrcSpanDetails,
- generatedSrcSpanDetailsFS,
-- ** Unsafely deconstructing SrcSpan
-- These are dubious exports, because they crash on some inputs
@@ -642,13 +642,13 @@ srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c
-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanStart :: SrcSpan -> SrcLoc
srcSpanStart (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
-srcSpanStart (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
+srcSpanStart (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
srcSpanStart (RealSrcSpan s b) = RealSrcLoc (realSrcSpanStart s) (fmap bufSpanStart b)
-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanEnd :: SrcSpan -> SrcLoc
srcSpanEnd (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
-srcSpanEnd (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
+srcSpanEnd (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b)
realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
@@ -738,15 +738,15 @@ unhelpfulSpanFS r = case r of
pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc
pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r)
-generatedSrcSpanDetailsFS :: GeneratedSrcSpanDetails -> FastString
-generatedSrcSpanDetailsFS _ = fsLit "<generated>"
+generatedSrcSpanDetailsFS :: FastString
+generatedSrcSpanDetailsFS = fsLit "<generated>"
-pprGeneratedSrcSpanDetails :: GeneratedSrcSpanDetails -> SDoc
-pprGeneratedSrcSpanDetails d = ftext (generatedSrcSpanDetailsFS d)
+pprGeneratedSrcSpanDetails :: SDoc
+pprGeneratedSrcSpanDetails = ftext generatedSrcSpanDetailsFS
pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan _ (UnhelpfulSpan r) = pprUnhelpfulSpanReason r
-pprUserSpan _ (GeneratedSrcSpan d) = pprGeneratedSrcSpanDetails d
+pprUserSpan _ (GeneratedSrcSpan{}) = pprGeneratedSrcSpanDetails
pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
=====================================
compiler/GHC/Utils/Logger.hs
=====================================
@@ -401,7 +401,8 @@ jsonLogActionWithHandle out logflags msg_class srcSpan msg
, ("endCol", json $ srcSpanEndCol rss)
]
where file = unpackFS $ srcSpanFile rss
- _ -> JSNull
+ GeneratedSrcSpan{} -> JSNull
+ UnhelpfulSpan{} -> JSNull
-- | The default 'LogAction' prints to 'stdout' and 'stderr'.
--
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -2710,7 +2710,7 @@ parseSpanArg s = do
-- while simply unpacking 'UnhelpfulSpan's
showSrcSpan :: SrcSpan -> String
showSrcSpan (UnhelpfulSpan s) = unpackFS (unhelpfulSpanFS s)
-showSrcSpan (GeneratedSrcSpan d) = unpackFS (generatedSrcSpanDetailsFS d)
+showSrcSpan (GeneratedSrcSpan{}) = unpackFS (generatedSrcSpanDetailsFS)
showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn
-- | Variant of 'showSrcSpan' for 'RealSrcSpan's
=====================================
ghc/GHCi/UI/Info.hs
=====================================
@@ -393,7 +393,8 @@ processAllTypeCheckedModule tcm
toSpanInfo :: (Maybe Id,SrcSpan,Type) -> Maybe SpanInfo
toSpanInfo (n,RealSrcSpan spn _,typ)
= Just $ spanInfoFromRealSrcSpan spn (Just typ) n
- toSpanInfo _ = Nothing
+ toSpanInfo GeneratedSrcSpan{} = Nothing
+ toSpanInfo UnhelpfulSpan{} = Nothing
-- helper stolen from @syb@ package
type GenericQ r = forall a. Data a => a -> r
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe528a964d519234741e2f1235bdd6f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe528a964d519234741e2f1235bdd6f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-apporv-Oct24] pattern matches for GeneratedSrcSpan do not use underscores
by Apoorv Ingle (＠ani) 31 Mar '26
by Apoorv Ingle (＠ani) 31 Mar '26
31 Mar '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
5b583171 by Apoorv Ingle at 2026-03-30T18:57:20-05:00
pattern matches for GeneratedSrcSpan do not use underscores
- - - - -
10 changed files:
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/SrcLoc.hs
- ghc/GHCi/UI.hs
Changes:
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -507,7 +507,9 @@ getSrcSpanDs = do { env <- getLclEnv
putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
putSrcSpanDs (RealSrcSpan real_span _) thing_inside
= updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside
-putSrcSpanDs _ thing_inside
+putSrcSpanDs UnhelpfulSpan{} thing_inside
+ = thing_inside
+putSrcSpanDs GeneratedSrcSpan{} thing_inside
= thing_inside
putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -121,8 +121,9 @@ addTicksToBinds logger cfg
, inScope = emptyVarSet
, blackList = Set.fromList $
mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of
- RealSrcSpan l _ -> Just l
- _ -> Nothing)
+ RealSrcSpan l _ -> Just l
+ GeneratedSrcSpan{} -> Nothing
+ UnhelpfulSpan{} -> Nothing)
tyCons
, density = mkDensity tickish $ ticks_profAuto cfg
, this_mod = mod
@@ -1192,7 +1193,8 @@ getFileName = fileName `liftM` getEnv
isGoodSrcSpan' :: SrcSpan -> Bool
isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos
-isGoodSrcSpan' _ = False
+isGoodSrcSpan' UnhelpfulSpan{} = False
+isGoodSrcSpan' GeneratedSrcSpan{} = False
isGoodTickSrcSpan :: SrcSpan -> TM Bool
isGoodTickSrcSpan pos = do
@@ -1218,11 +1220,13 @@ bindLocals from (TM m) = TM $ \env st ->
withBlackListed :: SrcSpan -> TM a -> TM a
withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) })
-withBlackListed _ = id
+withBlackListed GeneratedSrcSpan{} = id
+withBlackListed UnhelpfulSpan{} = id
isBlackListed :: SrcSpan -> TM Bool
isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st)
-isBlackListed _ = return False
+isBlackListed GeneratedSrcSpan{} = return False
+isBlackListed UnhelpfulSpan{} = return False
-- the tick application inherits the source position of its
-- expression argument to support nested box allocations
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -426,7 +426,8 @@ getRealSpanA la = getRealSpan (locA la)
getRealSpan :: SrcSpan -> Maybe Span
getRealSpan (RealSrcSpan sp _) = Just sp
getRealSpan (GeneratedSrcSpan (OrigSpan sp)) = Just sp
-getRealSpan _ = Nothing
+getRealSpan (GeneratedSrcSpan{}) = Nothing
+getRealSpan (UnhelpfulSpan{}) = Nothing
grhss_span :: (IsPass p, Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns)
=> GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
=====================================
compiler/GHC/Iface/Ext/Utils.hs
=====================================
@@ -314,7 +314,8 @@ getNameScopeAndBinding
getNameScopeAndBinding n asts = case nameSrcSpan n of
RealSrcSpan sp _ -> go sp
GeneratedSrcSpan (OrigSpan sp) -> go sp
- _ -> Nothing
+ GeneratedSrcSpan{} -> Nothing
+ UnhelpfulSpan{} -> Nothing
where
go sp = do -- @Maybe
ast <- M.lookup (HiePath (srcSpanFile sp)) asts
@@ -542,9 +543,10 @@ locOnlyE _ = pure []
mkScope :: (HasLoc a) => a -> Scope
mkScope a = case getHasLoc a of
- (RealSrcSpan sp _) -> LocalScope sp
- (GeneratedSrcSpan (OrigSpan sp)) -> LocalScope sp
- _ -> NoScope
+ RealSrcSpan sp _ -> LocalScope sp
+ GeneratedSrcSpan (OrigSpan sp) -> LocalScope sp
+ GeneratedSrcSpan{} -> NoScope
+ UnhelpfulSpan{} -> NoScope
combineScopes :: Scope -> Scope -> Scope
combineScopes ModuleScope _ = ModuleScope
@@ -576,7 +578,8 @@ makeNode x spn = do
pure $ case spn of
RealSrcSpan span _ -> mk_node span org
GeneratedSrcSpan (OrigSpan span) -> mk_node span org
- _ -> []
+ GeneratedSrcSpan{} -> []
+ UnhelpfulSpan{} -> []
where
cons = mkFastString . show . toConstr $ x
typ = mkFastString . show . typeRepTyCon . typeOf $ x
@@ -603,7 +606,8 @@ makeTypeNode x spn etyp = do
pure $ case spn of
RealSrcSpan span _ -> mk_node span org
GeneratedSrcSpan (OrigSpan span) -> mk_node span org
- _ -> []
+ GeneratedSrcSpan{} -> []
+ UnhelpfulSpan{} -> []
where
cons = mkFastString . show . toConstr $ x
typ = mkFastString . show . typeRepTyCon . typeOf $ x
=====================================
compiler/GHC/Parser/HaddockLex.x
=====================================
@@ -185,11 +185,12 @@ validateIdentWith identParser mloc str0 =
realSrcLc = case mloc of
RealSrcSpan loc _ -> realSrcSpanStart loc
GeneratedSrcSpan{} -> mkRealSrcLoc nilFS 0 0
- UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0
+ UnhelpfulSpan{} -> mkRealSrcLoc nilFS 0 0
pstate = initParserState pflags buffer realSrcLc
in case unP identParser pstate of
POk _ name -> Just $ case mloc of
RealSrcSpan _ _ -> reLoc name
- _ -> L mloc (unLoc name) -- Preserve the original reason
+ GeneratedSrcSpan{} -> L mloc (unLoc name) -- Preserve the original reason
+ UnhelpfulSpan{} -> L mloc (unLoc name) -- Preserve the original reason
_ -> Nothing
}
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -705,7 +705,9 @@ wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
wrapGenSpan' :: (HasAnnotation an) => SrcSpan -> a -> GenLocated an a
wrapGenSpan' s x = case s of
RealSrcSpan s _ -> L (noAnnSrcSpan $ GeneratedSrcSpan (OrigSpan s)) x
- _ -> wrapGenSpan x
+ GeneratedSrcSpan{} -> wrapGenSpan x
+ UnhelpfulSpan{} -> wrapGenSpan x
+
wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a
-- Wrap something in a "noSrcSpan"
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1481,8 +1481,8 @@ instance TH.Quasi TcM where
; l <- getSrcSpanM
; r <- case l of
RealSrcSpan s _ -> return s
- GeneratedSrcSpan l -> pprPanic "qLocation: generatedSrcSpan"
- (pprGeneratedSrcSpanDetails l)
+ GeneratedSrcSpan{} -> pprPanic "qLocation: generatedSrcSpan"
+ (pprGeneratedSrcSpanDetails)
UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location"
(ppr l)
; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -424,7 +424,7 @@ pprSimilarName mb_tried_ns (SimilarRdrName rdr_name _gre_info how_in_scope)
LocallyBoundAt loc ->
case loc of
UnhelpfulSpan l -> parens (ppr l)
- GeneratedSrcSpan ss -> parens (pprGeneratedSrcSpanDetails ss)
+ GeneratedSrcSpan{} -> parens (pprGeneratedSrcSpanDetails)
RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
ImportedBy is ->
parens (text "imported from" <+> ppr (moduleName $ is_mod is))
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -49,9 +49,9 @@ module GHC.Types.SrcLoc (
pprUserRealSpan, pprUnhelpfulSpanReason,
pprUserSpan,
unhelpfulSpanFS,
+ generatedSrcSpanDetailsFS,
srcSpanToRealSrcSpan,
pprGeneratedSrcSpanDetails,
- generatedSrcSpanDetailsFS,
-- ** Unsafely deconstructing SrcSpan
-- These are dubious exports, because they crash on some inputs
@@ -642,13 +642,13 @@ srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c
-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanStart :: SrcSpan -> SrcLoc
srcSpanStart (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
-srcSpanStart (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
+srcSpanStart (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
srcSpanStart (RealSrcSpan s b) = RealSrcLoc (realSrcSpanStart s) (fmap bufSpanStart b)
-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanEnd :: SrcSpan -> SrcLoc
srcSpanEnd (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
-srcSpanEnd (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
+srcSpanEnd (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b)
realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
@@ -738,15 +738,15 @@ unhelpfulSpanFS r = case r of
pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc
pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r)
-generatedSrcSpanDetailsFS :: GeneratedSrcSpanDetails -> FastString
-generatedSrcSpanDetailsFS _ = fsLit "<generated>"
+generatedSrcSpanDetailsFS :: FastString
+generatedSrcSpanDetailsFS = fsLit "<generated>"
-pprGeneratedSrcSpanDetails :: GeneratedSrcSpanDetails -> SDoc
-pprGeneratedSrcSpanDetails d = ftext (generatedSrcSpanDetailsFS d)
+pprGeneratedSrcSpanDetails :: SDoc
+pprGeneratedSrcSpanDetails = ftext generatedSrcSpanDetailsFS
pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan _ (UnhelpfulSpan r) = pprUnhelpfulSpanReason r
-pprUserSpan _ (GeneratedSrcSpan d) = pprGeneratedSrcSpanDetails d
+pprUserSpan _ (GeneratedSrcSpan{}) = pprGeneratedSrcSpanDetails
pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -2710,7 +2710,7 @@ parseSpanArg s = do
-- while simply unpacking 'UnhelpfulSpan's
showSrcSpan :: SrcSpan -> String
showSrcSpan (UnhelpfulSpan s) = unpackFS (unhelpfulSpanFS s)
-showSrcSpan (GeneratedSrcSpan d) = unpackFS (generatedSrcSpanDetailsFS d)
+showSrcSpan (GeneratedSrcSpan{}) = unpackFS (generatedSrcSpanDetailsFS)
showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn
-- | Variant of 'showSrcSpan' for 'RealSrcSpan's
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b5831712279a6f2a07dbadadd0eb3f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b5831712279a6f2a07dbadadd0eb3f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-apporv-Oct24] pattern matches for GeneratedSrcSpan do not use underscores
by Apoorv Ingle (＠ani) 31 Mar '26
by Apoorv Ingle (＠ani) 31 Mar '26
31 Mar '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
cdbd45e4 by Apoorv Ingle at 2026-03-30T18:34:13-05:00
pattern matches for GeneratedSrcSpan do not use underscores
- - - - -
9 changed files:
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/SrcLoc.hs
Changes:
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -507,7 +507,9 @@ getSrcSpanDs = do { env <- getLclEnv
putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
putSrcSpanDs (RealSrcSpan real_span _) thing_inside
= updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside
-putSrcSpanDs _ thing_inside
+putSrcSpanDs UnhelpfulSpan{} thing_inside
+ = thing_inside
+putSrcSpanDs GeneratedSrcSpan{} thing_inside
= thing_inside
putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -121,8 +121,9 @@ addTicksToBinds logger cfg
, inScope = emptyVarSet
, blackList = Set.fromList $
mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of
- RealSrcSpan l _ -> Just l
- _ -> Nothing)
+ RealSrcSpan l _ -> Just l
+ GeneratedSrcSpan{} -> Nothing
+ UnhelpfulSpan{} -> Nothing)
tyCons
, density = mkDensity tickish $ ticks_profAuto cfg
, this_mod = mod
@@ -1192,7 +1193,8 @@ getFileName = fileName `liftM` getEnv
isGoodSrcSpan' :: SrcSpan -> Bool
isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos
-isGoodSrcSpan' _ = False
+isGoodSrcSpan' UnhelpfulSpan{} = False
+isGoodSrcSpan' GeneratedSrcSpan{} = False
isGoodTickSrcSpan :: SrcSpan -> TM Bool
isGoodTickSrcSpan pos = do
@@ -1218,11 +1220,13 @@ bindLocals from (TM m) = TM $ \env st ->
withBlackListed :: SrcSpan -> TM a -> TM a
withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) })
-withBlackListed _ = id
+withBlackListed GeneratedSrcSpan{} = id
+withBlackListed UnhelpfulSpan{} = id
isBlackListed :: SrcSpan -> TM Bool
isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st)
-isBlackListed _ = return False
+isBlackListed GeneratedSrcSpan{} = return False
+isBlackListed UnhelpfulSpan{} = return False
-- the tick application inherits the source position of its
-- expression argument to support nested box allocations
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -426,7 +426,8 @@ getRealSpanA la = getRealSpan (locA la)
getRealSpan :: SrcSpan -> Maybe Span
getRealSpan (RealSrcSpan sp _) = Just sp
getRealSpan (GeneratedSrcSpan (OrigSpan sp)) = Just sp
-getRealSpan _ = Nothing
+getRealSpan (GeneratedSrcSpan{}) = Nothing
+getRealSpan (UnhelpfulSpan{}) = Nothing
grhss_span :: (IsPass p, Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns)
=> GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
=====================================
compiler/GHC/Iface/Ext/Utils.hs
=====================================
@@ -314,7 +314,8 @@ getNameScopeAndBinding
getNameScopeAndBinding n asts = case nameSrcSpan n of
RealSrcSpan sp _ -> go sp
GeneratedSrcSpan (OrigSpan sp) -> go sp
- _ -> Nothing
+ GeneratedSrcSpan{} -> Nothing
+ UnhelpfulSpan{} -> Nothing
where
go sp = do -- @Maybe
ast <- M.lookup (HiePath (srcSpanFile sp)) asts
@@ -542,9 +543,10 @@ locOnlyE _ = pure []
mkScope :: (HasLoc a) => a -> Scope
mkScope a = case getHasLoc a of
- (RealSrcSpan sp _) -> LocalScope sp
- (GeneratedSrcSpan (OrigSpan sp)) -> LocalScope sp
- _ -> NoScope
+ RealSrcSpan sp _ -> LocalScope sp
+ GeneratedSrcSpan (OrigSpan sp) -> LocalScope sp
+ GeneratedSrcSpan{} -> NoScope
+ UnhelpfulSpan{} -> NoScope
combineScopes :: Scope -> Scope -> Scope
combineScopes ModuleScope _ = ModuleScope
@@ -576,7 +578,8 @@ makeNode x spn = do
pure $ case spn of
RealSrcSpan span _ -> mk_node span org
GeneratedSrcSpan (OrigSpan span) -> mk_node span org
- _ -> []
+ GeneratedSrcSpan{} -> []
+ UnhelpfulSpan{} -> []
where
cons = mkFastString . show . toConstr $ x
typ = mkFastString . show . typeRepTyCon . typeOf $ x
@@ -603,7 +606,8 @@ makeTypeNode x spn etyp = do
pure $ case spn of
RealSrcSpan span _ -> mk_node span org
GeneratedSrcSpan (OrigSpan span) -> mk_node span org
- _ -> []
+ GeneratedSrcSpan{} -> []
+ UnhelpfulSpan{} -> []
where
cons = mkFastString . show . toConstr $ x
typ = mkFastString . show . typeRepTyCon . typeOf $ x
=====================================
compiler/GHC/Parser/HaddockLex.x
=====================================
@@ -185,11 +185,12 @@ validateIdentWith identParser mloc str0 =
realSrcLc = case mloc of
RealSrcSpan loc _ -> realSrcSpanStart loc
GeneratedSrcSpan{} -> mkRealSrcLoc nilFS 0 0
- UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0
+ UnhelpfulSpan{} -> mkRealSrcLoc nilFS 0 0
pstate = initParserState pflags buffer realSrcLc
in case unP identParser pstate of
POk _ name -> Just $ case mloc of
RealSrcSpan _ _ -> reLoc name
- _ -> L mloc (unLoc name) -- Preserve the original reason
+ GeneratedSrcSpan{} -> L mloc (unLoc name) -- Preserve the original reason
+ UnhelpfulSpan{} -> L mloc (unLoc name) -- Preserve the original reason
_ -> Nothing
}
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -705,7 +705,9 @@ wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
wrapGenSpan' :: (HasAnnotation an) => SrcSpan -> a -> GenLocated an a
wrapGenSpan' s x = case s of
RealSrcSpan s _ -> L (noAnnSrcSpan $ GeneratedSrcSpan (OrigSpan s)) x
- _ -> wrapGenSpan x
+ GeneratedSrcSpan{} -> wrapGenSpan x
+ UnhelpfulSpan{} -> wrapGenSpan x
+
wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a
-- Wrap something in a "noSrcSpan"
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1481,8 +1481,8 @@ instance TH.Quasi TcM where
; l <- getSrcSpanM
; r <- case l of
RealSrcSpan s _ -> return s
- GeneratedSrcSpan l -> pprPanic "qLocation: generatedSrcSpan"
- (pprGeneratedSrcSpanDetails l)
+ GeneratedSrcSpan{} -> pprPanic "qLocation: generatedSrcSpan"
+ (pprGeneratedSrcSpanDetails)
UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location"
(ppr l)
; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -424,7 +424,7 @@ pprSimilarName mb_tried_ns (SimilarRdrName rdr_name _gre_info how_in_scope)
LocallyBoundAt loc ->
case loc of
UnhelpfulSpan l -> parens (ppr l)
- GeneratedSrcSpan ss -> parens (pprGeneratedSrcSpanDetails ss)
+ GeneratedSrcSpan{} -> parens (pprGeneratedSrcSpanDetails)
RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
ImportedBy is ->
parens (text "imported from" <+> ppr (moduleName $ is_mod is))
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -51,7 +51,6 @@ module GHC.Types.SrcLoc (
unhelpfulSpanFS,
srcSpanToRealSrcSpan,
pprGeneratedSrcSpanDetails,
- generatedSrcSpanDetailsFS,
-- ** Unsafely deconstructing SrcSpan
-- These are dubious exports, because they crash on some inputs
@@ -642,13 +641,13 @@ srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c
-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanStart :: SrcSpan -> SrcLoc
srcSpanStart (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
-srcSpanStart (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
+srcSpanStart (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
srcSpanStart (RealSrcSpan s b) = RealSrcLoc (realSrcSpanStart s) (fmap bufSpanStart b)
-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanEnd :: SrcSpan -> SrcLoc
srcSpanEnd (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
-srcSpanEnd (GeneratedSrcSpan d) = UnhelpfulLoc (generatedSrcSpanDetailsFS d)
+srcSpanEnd (GeneratedSrcSpan{}) = UnhelpfulLoc (generatedSrcSpanDetailsFS)
srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b)
realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
@@ -738,15 +737,15 @@ unhelpfulSpanFS r = case r of
pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc
pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r)
-generatedSrcSpanDetailsFS :: GeneratedSrcSpanDetails -> FastString
-generatedSrcSpanDetailsFS _ = fsLit "<generated>"
+generatedSrcSpanDetailsFS :: FastString
+generatedSrcSpanDetailsFS = fsLit "<generated>"
-pprGeneratedSrcSpanDetails :: GeneratedSrcSpanDetails -> SDoc
-pprGeneratedSrcSpanDetails d = ftext (generatedSrcSpanDetailsFS d)
+pprGeneratedSrcSpanDetails :: SDoc
+pprGeneratedSrcSpanDetails = ftext generatedSrcSpanDetailsFS
pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan _ (UnhelpfulSpan r) = pprUnhelpfulSpanReason r
-pprUserSpan _ (GeneratedSrcSpan d) = pprGeneratedSrcSpanDetails d
+pprUserSpan _ (GeneratedSrcSpan{}) = pprGeneratedSrcSpanDetails
pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdbd45e4d5355c0c28a049dfd520431…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdbd45e4d5355c0c28a049dfd520431…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T27078 at Glasgow Haskell Compiler / GHC
Commits:
f8ddc8c3 by Simon Peyton Jones at 2026-03-31T00:12:05+01:00
Wibbles
- - - - -
3 changed files:
- compiler/GHC/Core/Lint.hs
- + compiler/GHC/Core/SubstTypeLets.hs
- compiler/GHC/HsToCore/Utils.hs
Changes:
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -435,7 +435,7 @@ lintPassResult logger cfg binds
renderWithContext defaultSDocContext (lpr_passPpr cfg)
; displayLintResults logger
(lpr_passPpr cfg)
- (pprCoreBindings binds) warns_and_errs
+ (pprCoreBindings binds1) warns_and_errs
}
displayLintResults :: Logger
=====================================
compiler/GHC/Core/SubstTypeLets.hs
=====================================
@@ -0,0 +1,89 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
+-}
+
+module GHC.Core.SubstTypeLets(
+ substTypeLets
+ ) where
+
+import GHC.Prelude
+
+import GHC.Core
+import GHC.Core.Subst
+import GHC.Core.Utils( mkInScopeSetBndrs )
+
+import GHC.Types.Var
+
+import GHC.Utils.Misc( mapSnd )
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+
+{- Note [Substituting type-lets]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ToDo: write me
+
+NB: only substitutes /nested/ type-lets, not top level.
+-}
+
+substTypeLets :: CoreProgram -> CoreProgram
+substTypeLets binds = map stl_top binds
+ where
+ stl_top (NonRec b r) = NonRec b (stlExpr empty_subst r)
+ stl_top (Rec prs) = Rec (mapSnd (stlExpr empty_subst) prs)
+
+ empty_subst = mkEmptySubst $
+ mkInScopeSetBndrs binds
+
+----------------------
+stlBind :: Subst -> CoreBind -> (Subst, CoreBind)
+stlBind subst (Rec prs)
+ = assertPpr (not (any isTyVar bndrs)) (ppr prs) $
+ (subst', Rec prs')
+ where
+ (bndrs,rhss) = unzip prs
+ (subst', bndrs') = substBndrs subst bndrs
+ rhss' = map (stlExpr subst') rhss
+ prs' = bndrs' `zip` rhss'
+
+stlBind subst (NonRec bndr rhs)
+ = (subst', NonRec bndr' (stlExpr subst rhs))
+ where
+ (subst', bndr') = substBndr subst bndr
+
+----------------------
+stlExpr :: Subst -> CoreExpr -> CoreExpr
+
+-- This case is the main payload of the entire pass
+stlExpr subst (Let (NonRec tv (Type ty)) body)
+ = stlExpr (extendTvSubst subst tv ty) body
+
+stlExpr subst (Let bind body)
+ = Let bind' (stlExpr subst' body)
+ where
+ (subst', bind') = stlBind subst bind
+
+stlExpr subst (Lam bndr body)
+ = Lam bndr' (stlExpr subst' body)
+ where
+ (subst', bndr') = substBndr subst bndr
+
+stlExpr subst (Case scrut bndr ty alts)
+ = Case (stlExpr subst scrut) bndr' (substTy subst ty)
+ (map stl_alt alts)
+ where
+ (subst', bndr') = substBndr subst bndr
+
+ stl_alt (Alt con bndrs rhs)
+ = Alt con bndrs' (stlExpr subst'' rhs)
+ where
+ (subst'', bndrs') = substBndrs subst' bndrs
+
+-- Simple cases
+stlExpr _ (Lit l) = Lit l
+stlExpr subst (Var v) = lookupIdSubst subst v
+stlExpr subst (App e1 e2) = App (stlExpr subst e1) (stlExpr subst e2)
+stlExpr subst (Type ty) = Type (substTy subst ty)
+stlExpr subst (Tick t e) = Tick (substTickish subst t) (stlExpr subst e)
+stlExpr subst (Cast e co) = Cast (stlExpr subst e) (substCo subst co)
+stlExpr subst (Coercion co) = Coercion (substCo subst co)
=====================================
compiler/GHC/HsToCore/Utils.hs
=====================================
@@ -248,7 +248,6 @@ wrapBind :: Var -> Var -> CoreExpr -> CoreExpr
wrapBind new old body -- NB: this function must deal with term
| new==old = body -- variables, type variables or coercion variables
| otherwise = Let (NonRec new (varToCoreExpr old)) body
--- | otherwise = App (Lam new body) (varToCoreExpr old)
-- Used to force variables when desugaring strict binders. It's crucial that the
-- variable is shadowed by the case binder. See Wrinkle 1 in
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8ddc8c3b61ac4fc2d2399db8763515…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8ddc8c3b61ac4fc2d2399db8763515…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-apporv-Oct24] haddock comments for `tcValArg` and `cleanup getDeepSubsumption_flag` function
by Apoorv Ingle (＠ani) 31 Mar '26
by Apoorv Ingle (＠ani) 31 Mar '26
31 Mar '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
e7cfce77 by Apoorv Ingle at 2026-03-30T17:57:17-05:00
haddock comments for `tcValArg` and `cleanup getDeepSubsumption_flag` function
- - - - -
2 changed files:
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Utils/Unify.hs
Changes:
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -567,11 +567,11 @@ tcValArgs do_ql (fun, fun_lspan) args = go do_ql 0 args
= pos
-tcValArg :: QLFlag
- -> Int -- argument position (used only for error message generation)
- -> (HsExpr GhcRn, SrcSpan) -- Head of the application chain (used only for error message generation)
- -> HsExprArg 'TcpInst -- Actual argument
- -> TcM (HsExprArg 'TcpTc) -- Resulting argument
+tcValArg :: QLFlag -- ^ Are we typechecking with Quick Look turned on?
+ -> Int -- ^ Argument position (used only for error message generation)
+ -> (HsExpr GhcRn, SrcSpan) -- ^ Head of the application chain (used only for error message generation)
+ -> HsExprArg 'TcpInst -- ^ Actual argument
+ -> TcM (HsExprArg 'TcpTc) -- ^ Resulting argument
tcValArg _ _ _ (EPrag l p) = return (EPrag l (tcExprPrag p))
tcValArg _ _ _ (ETypeArg l hty ty) = return (ETypeArg l hty ty)
tcValArg do_ql _ _ (EWrap (EHsWrap w)) = do { whenQL do_ql $ qlMonoHsWrapper w
@@ -2018,8 +2018,9 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _
, eaql_res_rho = app_res_rho }) }}}
-mk_origin :: SrcSpan -- SrcSpan of the function
- -> HsExpr GhcRn -- The head of the expression application chain
+-- This function can be moved inside `tcInstFun` once we retire `tcExprSigma`
+mk_origin :: SrcSpan -- ^ SrcSpan of the function
+ -> HsExpr GhcRn -- ^ The head of the expression application chain
-> TcM CtOrigin
mk_origin fun_lspan rn_fun
| not (isGeneratedSrcSpan fun_lspan)
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -99,7 +99,7 @@ import qualified GHC.LanguageExtensions as LangExt
import GHC.Builtin.Types
import GHC.Types.Name
-import GHC.Types.Id( idType, isDataConId )
+import GHC.Types.Id( idType )
import GHC.Types.Var as Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
@@ -2079,26 +2079,12 @@ getDeepSubsumptionFlag_DataConHead app_head =
}
where
go :: HsExpr GhcTc -> DeepSubsumptionFlag
- go app_head
- | XExpr (ConLikeTc (RealDataCon {})) <- app_head
- = Deep TopSub
- | XExpr (ExpandedThingTc (HSE _ (L _ f))) <- app_head
- = go f
- | XExpr (WrapExpr _ f) <- app_head
- = go f
- | HsVar _ f <- app_head
- , isDataConId (unLoc f)
- = Deep TopSub
- | HsApp _ f _ <- app_head
- = go (unLoc f)
- | HsAppType _ f _ <- app_head
- = go (unLoc f)
- | OpApp _ _ f _ <- app_head
- = go (unLoc f)
- | HsPar _ f <- app_head
- = go (unLoc f)
- | otherwise
- = Shallow
+ go (XExpr (ConLikeTc (RealDataCon {}))) = Deep TopSub
+ go (XExpr (ExpandedThingTc (HSE _ (L _ f)))) = go f
+ go (XExpr (WrapExpr _ f)) = go f
+ go (HsApp _ f _) = go (unLoc f)
+ go (HsAppType _ f _) = go (unLoc f)
+ go _ = Shallow
-- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7cfce77e9a9437d939ac2e080aad81…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7cfce77e9a9437d939ac2e080aad81…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/no-ds-flag-cache] 7 commits: some comments and review changes
by Apoorv Ingle (＠ani) 31 Mar '26
by Apoorv Ingle (＠ani) 31 Mar '26
31 Mar '26
Apoorv Ingle pushed to branch wip/ani/no-ds-flag-cache at Glasgow Haskell Compiler / GHC
Commits:
97ca9953 by Apoorv Ingle at 2026-03-29T23:02:17-05:00
some comments and review changes
- - - - -
50f0aaae by Apoorv Ingle at 2026-03-30T14:14:47-05:00
revert back rep-poly err messages
- - - - -
43f1db4a by Apoorv Ingle at 2026-03-30T15:12:20-05:00
haddock comments for `tcValArg` and `cleanup getDeepSubsumption_flag` function
- - - - -
4581bea6 by Apoorv Ingle at 2026-03-30T17:24:00-05:00
do not recurse in ExpandedThingTc HsApp etc in getDeepSubsumptionFlag
- - - - -
63d6d3c3 by Apoorv Ingle at 2026-03-30T17:24:07-05:00
simplify get_Deepsubsumption_flag
- - - - -
1de1038e by Simon Peyton Jones at 2026-03-30T17:24:45-05:00
Wibbles from Simon
- - - - -
f027edfc by Simon Peyton Jones at 2026-03-30T17:24:52-05:00
More wibbles
- - - - -
12 changed files:
- compiler/GHC/Tc/Gen/App.hs
- − compiler/GHC/Tc/Gen/App.hs-boot
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- testsuite/tests/rep-poly/RepPolyDoBind.stderr
- testsuite/tests/rep-poly/RepPolyDoBody1.stderr
- testsuite/tests/rep-poly/RepPolyDoBody2.stderr
Changes:
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -11,7 +11,6 @@
module GHC.Tc.Gen.App
( tcApp
- , tcExprSigma
, tcExprPrag ) where
import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr )
@@ -165,34 +164,6 @@ Note [Instantiation variables are short lived]
-}
-{- *********************************************************************
-* *
- tcInferSigma
-* *
-********************************************************************* -}
-
--- Very similar to tcApp, but returns a sigma (uninstantiated) type
--- CAUTION: Any changes to tcApp should be reflected here
--- cf. T19167. the head is an expanded expression applied to a type
--- Caution: Currently we assume that the expression is compiler generated/expanded
--- Because that is what T19167 test case expects.
--- This function should go away after MR!15778 lands
-tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
-tcExprSigma inst fun_orig rn_expr
- = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr
- ; do_ql <- wantQuickLook rn_fun
- ; (tc_fun, fun_sigma) <- tcInferAppHead fun
- ; inGenCode <- inGeneratedCode
- ; traceTc "tcExprSigma" (vcat [ text "rn_expr:" <+> ppr rn_expr
- , text "tc_fun" <+> ppr tc_fun
- , text "inGeneratedCode:" <+> ppr inGenCode])
- ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (fun_orig, rn_fun, fun_lspan)
- tc_fun fun_sigma rn_args
- ; tc_args <- tcValArgs do_ql (rn_fun, fun_lspan) inst_args
- ; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args
- ; return (tc_expr, app_res_sigma) }
-
-
{- *********************************************************************
* *
Typechecking n-ary applications
@@ -488,8 +459,8 @@ checkResultTy :: HsExpr GhcRn
-- expose foralls, but maybe not /deeply/ instantiated
-> ExpRhoType -- Expected type; this is deeply skolemised
-> TcM HsWrapper
-checkResultTy rn_expr (tc_fun, _) _ app_res_rho (Infer inf_res)
- = do { ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun
+checkResultTy rn_expr _ _ app_res_rho (Infer inf_res)
+ = do { ds_flag <- getDeepSubsumptionFlag
; fillInferResult ds_flag (exprCtOrigin rn_expr) app_res_rho inf_res }
@@ -539,7 +510,10 @@ checkResultTy rn_expr (tc_fun, fun_loc) inst_args app_res_rho (Check res_ty)
thing_inside
----------------
-tcValArgs :: QLFlag -> (HsExpr GhcRn, SrcSpan) -> [HsExprArg 'TcpInst] -> TcM [HsExprArg 'TcpTc]
+tcValArgs :: QLFlag
+ -> (HsExpr GhcRn, SrcSpan) -- Head of the application chain (used only for error message generation)
+ -> [HsExprArg 'TcpInst]
+ -> TcM [HsExprArg 'TcpTc]
-- Importantly, tcValArgs works left-to-right, so that by the time we
-- encounter an argument, we have monomorphised all the instantiation
-- variables that its type contains. All that is left to do is an ordinary
@@ -553,7 +527,7 @@ tcValArgs do_ql (fun, fun_lspan) args = go do_ql 0 args
; return (arg' : args') }
where
-- increment position if the argument is user written type or value argument
- pos' | EValArg{} <- arg
+ !pos' | EValArg{} <- arg
= pos + 1
| EValArgQL{} <- arg
= pos + 1
@@ -564,8 +538,11 @@ tcValArgs do_ql (fun, fun_lspan) args = go do_ql 0 args
= pos
-tcValArg :: QLFlag -> Int -> (HsExpr GhcRn, SrcSpan) -> HsExprArg 'TcpInst -- Actual argument
- -> TcM (HsExprArg 'TcpTc) -- Resulting argument
+tcValArg :: QLFlag -- ^ Are we typechecking with Quick Look turned on?
+ -> Int -- ^ Argument position (used only for error message generation)
+ -> (HsExpr GhcRn, SrcSpan) -- ^ Head of the application chain (used only for error message generation)
+ -> HsExprArg 'TcpInst -- ^ Actual argument
+ -> TcM (HsExprArg 'TcpTc) -- ^ Resulting argument
tcValArg _ _ _ (EPrag l p) = return (EPrag l (tcExprPrag p))
tcValArg _ _ _ (ETypeArg l hty ty) = return (ETypeArg l hty ty)
tcValArg do_ql _ _ (EWrap (EHsWrap w)) = do { whenQL do_ql $ qlMonoHsWrapper w
@@ -630,7 +607,8 @@ tcValArg _ pos (fun, fun_lspan) (EValArgQL {
, text "app_lspan" <+> ppr lspan
, text "head_lspan" <+> ppr fun_lspan
, text "tc_head" <+> ppr tc_head])
- ; ds_flag <- getDeepSubsumptionFlag_DataConHead (fst tc_head)
+ ; ds_flag <- getDeepSubsumptionFlag
+ -- NB: whether to do deep /skolemisation/ is independent of data constructors
; (wrap, arg')
<- tcScalingUsage mult $
tcSkolemise ds_flag GenSigCtxt exp_arg_ty $ \ exp_arg_rho ->
@@ -888,8 +866,7 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg
matchActualFunTy herald
(Just $ HsExprTcThing tc_fun)
(n_val_args, fun_sigma) fun_ty
- ; ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun
- ; arg' <- quickLookArg ds_flag do_ql pos ctxt (rn_fun, fun_lspan) arg arg_ty
+ ; arg' <- quickLookArg do_ql pos ctxt (rn_fun, fun_lspan) arg arg_ty
; let acc' = arg' : addArgWrap (mkWpCastN fun_co) acc
; go (pos+1) acc' res_ty rest_args }
@@ -910,7 +887,7 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg
mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> ExpectedFunTyCtxt
mk_herald tc_fun arg
= case fun_orig of
- DoStmtOrigin -> ExpectedTySyntax DoStmtOrigin arg
+ DoStmtOrigin -> ExpectedFunTySyntaxOp DoStmtOrigin tc_fun
_ -> ExpectedFunTyArg (HsExprTcThing tc_fun) arg
-- Is the argument supposed to instantiate a forall?
@@ -1877,17 +1854,18 @@ This turned out to be more subtle than I expected. Wrinkles:
-}
-quickLookArg :: DeepSubsumptionFlag -> QLFlag -> Int
+quickLookArg :: QLFlag -> Int
-> SrcSpan -- ^ location span of the whole application
-> (HsExpr GhcRn, SrcSpan) -- ^ Head of the application chain and its source span
-> LHsExpr GhcRn -- ^ Argument
-> Scaled TcSigmaTypeFRR -- ^ Type expected by the function
-> TcM (HsExprArg 'TcpInst)
-- See Note [Quick Look at value arguments]
-quickLookArg _ NoQL _ app_lspan _ larg orig_arg_ty
+quickLookArg NoQL _ app_lspan _ larg orig_arg_ty
= skipQuickLook app_lspan larg orig_arg_ty
-quickLookArg ds_flag DoQL pos app_lspan fun_and_lspan larg orig_arg_ty
- = do { is_rho <- tcIsDeepRho ds_flag (scaledThing orig_arg_ty)
+quickLookArg DoQL pos app_lspan fun_and_lspan larg orig_arg_ty
+ = do { ds_flag <- getDeepSubsumptionFlag
+ ; is_rho <- tcIsDeepRho ds_flag (scaledThing orig_arg_ty)
; traceTc "qla" (ppr orig_arg_ty $$ ppr is_rho)
; if not is_rho
then skipQuickLook app_lspan larg orig_arg_ty
=====================================
compiler/GHC/Tc/Gen/App.hs-boot deleted
=====================================
@@ -1,12 +0,0 @@
-module GHC.Tc.Gen.App where
-
-import GHC.Hs ( HsExpr )
-import GHC.Tc.Types ( TcM )
-import GHC.Tc.Types.Origin ( CtOrigin )
-import GHC.Tc.Utils.TcType ( TcSigmaType )
-import GHC.Hs.Extension ( GhcRn, GhcTc )
-
-
-import GHC.Prelude (Bool)
-
-tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -13,7 +13,7 @@
module GHC.Tc.Gen.Expr
( tcCheckPolyExpr, tcCheckPolyExprNC,
tcCheckMonoExpr, tcCheckMonoExprNC,
- tcInferExpr, tcInferSigma,
+ tcInferExpr, tcInferSigma, tcInferExprSigma,
tcInferRho, tcInferRhoNC,
tcMonoLExpr, tcMonoLExprNC,
tcInferRhoFRR, tcInferRhoFRRNC,
@@ -237,6 +237,9 @@ tcPolyExprCheck expr res_ty
tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcSigmaType)
tcInferSigma = tcInferExpr IIF_Sigma
+tcInferExprSigma :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
+tcInferExprSigma e = runInfer IIF_Sigma IFRR_Any (tcExpr e)
+
tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
-- Infer a *rho*-type. The return type is always instantiated.
tcInferRho = tcInferExpr IIF_DeepRho
@@ -306,22 +309,25 @@ tcExpr :: HsExpr GhcRn
-- - HsAppType type applications
-- - ExprWithTySig (e :: type)
-- - HsRecSel overloaded record fields
--- - ExpandedThingRn renamer/pre-typechecker expansions
-- - HsOpApp operator applications
-- - HsOverLit overloaded literals
-- These constructors are the union of
-- - ones taken apart by GHC.Tc.Gen.Head.splitHsApps
-- - ones understood by GHC.Tc.Gen.Head.tcInferAppHead_maybe
-- See Note [Application chains and heads] in GHC.Tc.Gen.App
--- Se Note [Typechecking by expansion: overview]
tcExpr e@(HsVar {}) res_ty = tcApp e res_ty
tcExpr e@(HsApp {}) res_ty = tcApp e res_ty
tcExpr e@(OpApp {}) res_ty = tcApp e res_ty
tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty
tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty
+tcExpr e@(XExpr (HsRecSelRn{})) res_ty = tcApp e res_ty
+-- Renamer expanded expressions (eg. Right/Left sections)
+-- or tcExpr expanded expressions (eg. Do statements and Record updates)
+-- are type checked using tcHsExpansion.
+-- See Note [Typechecking by expansion: overview]
tcExpr (XExpr (ExpandedThingRn hse)) res_ty = tcHsExpansion hse res_ty
-tcExpr e@(XExpr{}) res_ty = tcApp e res_ty
+
-- Typecheck an occurrence of an unbound Id
--
@@ -527,8 +533,9 @@ tcExpr (HsCase ctxt scrut matches) res_ty
tcExpr (HsIf x pred b1 b2) res_ty
= do { pred' <- tcCheckMonoExpr pred boolTy
- ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty
- ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty
+ ; let res_ty' = adjustExpTypeForCaseBranches res_ty [b1,b2]
+ ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty'
+ ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty'
; tcEmitBindingUsage (supUE u1 u2)
; return (HsIf x pred' b1' b2') }
=====================================
compiler/GHC/Tc/Gen/Expr.hs-boot
=====================================
@@ -35,6 +35,8 @@ tcInferRho, tcInferRhoNC ::
tcInferRhoFRR, tcInferRhoFRRNC ::
FixedRuntimeRepContext -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
+tcInferExprSigma :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
+
tcInferExpr :: InferInstFlag -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
tcSyntaxOp :: CtOrigin
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -21,15 +21,14 @@ module GHC.Tc.Gen.Head
, pprArgInst, addFunResCtxt ) where
-import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckPolyExprNC, tcPolyLExprSig )
+import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckPolyExprNC, tcPolyLExprSig, tcInferExprSigma )
import {-# SOURCE #-} GHC.Tc.Gen.Splice( getUntypedSpliceBody )
-import {-# SOURCE #-} GHC.Tc.Gen.App( tcExprSigma )
import GHC.Prelude
import GHC.Hs
import GHC.Hs.Syn.Type
-import GHC.Rename.Utils (mkExpandedTc, mkExpandedExprTc)
+import GHC.Rename.Utils (mkExpandedExprTc)
import GHC.Tc.Gen.HsType
import GHC.Tc.Gen.Bind( chooseInferredQuantifiers )
@@ -446,8 +445,7 @@ tcInferAppHead (fun,fun_lspan)
do { mb_tc_fun <- tcInferAppHead_maybe fun
; case mb_tc_fun of
Just (fun', fun_sigma) -> return (fun', fun_sigma)
- Nothing -> runInferRho (tcExpr fun)
-
+ Nothing -> tcInferExprSigma fun
}
tcInferAppHead_maybe :: HsExpr GhcRn
@@ -457,23 +455,11 @@ tcInferAppHead_maybe :: HsExpr GhcRn
-- XExpr's although complicated needs to be looked through, useful for QL things when
-- the argument is an XExpr
tcInferAppHead_maybe fun = case fun of
- HsVar _ nm
- -> Just <$> tcInferId nm
- ExprWithTySig _ e hs_ty
- -> Just <$>tcExprWithSig e hs_ty
- HsOverLit _ lit
- -> Just <$> tcInferOverLit lit
- XExpr (HsRecSelRn f)
- -> Just <$> tcInferRecSelId f
- XExpr (ExpandedThingRn (HSE o (L loc e)))
- -> setSrcSpan (locA loc) $ Just <$>
- do { (e', ty) <- tcExprSigma False (hsCtxtCtOrigin o) e
- ; return (mkExpandedTc o (L loc e'), ty) }
- -- We do not want to instantiate the type of the head as there may be
- -- visible type applications in the argument.
- -- c.f. T19167
- _
- -> return Nothing
+ HsVar _ nm -> Just <$> tcInferId nm
+ ExprWithTySig _ e hs_ty -> Just <$>tcExprWithSig e hs_ty
+ HsOverLit _ lit -> Just <$> tcInferOverLit lit
+ XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f
+ _ -> return Nothing
{- *********************************************************************
* *
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -219,10 +219,10 @@ tcMatches :: (AnnoBody body, Outputable (body GhcTc))
-> MatchGroup GhcRn (LocatedA (body GhcRn))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
-tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches
+tcMatches ctxt tc_body pat_tys exp_ty (MG { mg_alts = L l matches
, mg_ext = origin })
| null matches -- Deal with case e of {}
- -- Since there are no branches, no one else will fill in rhs_ty
+ -- Since there are no branches, no one else will fill in exp_ty
-- when in inference mode, so we must do it ourselves,
-- here, using expTypeToType
= do { tcEmitBindingUsage bottomUE
@@ -233,17 +233,19 @@ tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches
[ExpForAllPatTy tvb] -> failWithTc $ TcRnEmptyCase ctxt (EmptyCaseForall tvb)
[] -> panic "tcMatches: no arguments in EmptyCase"
_t1:(_t2:_ts) -> panic "tcMatches: multiple arguments in EmptyCase"
- ; rhs_ty <- expTypeToType rhs_ty
+ ; rhs_ty <- expTypeToType exp_ty
; return (MG { mg_alts = L l []
, mg_ext = MatchGroupTc [pat_ty] rhs_ty origin
}) }
| otherwise
- = do { umatches <- mapM (tcCollectingUsage . tcMatch tc_body pat_tys rhs_ty) matches
- ; let (usages, matches') = unzip umatches
+ = do { let exp_ty' = adjustExpTypeForCaseBranches exp_ty matches
+ tc_match match = tcCollectingUsage $
+ tcMatch tc_body pat_tys exp_ty' match
+ ; (usages, matches') <- mapAndUnzipM tc_match matches
; tcEmitBindingUsage $ supUEs usages
; pat_tys <- mapM readScaledExpType (filter_out_forall_pat_tys pat_tys)
- ; rhs_ty <- readExpType rhs_ty
+ ; rhs_ty <- readExpType exp_ty
; traceTc "tcMatches" (ppr matches' $$ ppr pat_tys $$ ppr rhs_ty)
; return (MG { mg_alts = L l matches'
, mg_ext = MatchGroupTc pat_tys rhs_ty origin
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -1530,15 +1530,12 @@ data ExpectedFunTyCtxt
-- | A rebindable syntax operator is expected to have a function type.
--
-- Test cases for representation-polymorphism checks:
- -- RepPolyDoBind, RepPolyDoBody{1,2}, RepPolyMc{Bind,Body,Guard}, RepPolyNPlusK
+ -- RepPolyMc{Bind,Body,Guard}, RepPolyNPlusK
= forall (p :: Pass)
. (OutputableBndrId p)
=> ExpectedFunTySyntaxOp !CtOrigin !(HsExpr (GhcPass p))
-- ^ rebindable syntax operator
- -- |
- | ExpectedTySyntax !CtOrigin !(HsExpr GhcRn)
-
-- | A view pattern must have a function type.
--
-- Test cases for representation-polymorphism checks:
@@ -1594,9 +1591,6 @@ pprExpectedFunTyCtxt funTy_origin i =
, text "the rebindable syntax operator"
, quotes (ppr op) ]
, nest 2 (ppr orig) ]
- ExpectedTySyntax orig arg ->
- vcat [ text "The expression" <+> quotes (ppr arg)
- , nest 2 (ppr orig) ]
ExpectedFunTyViewPat expr ->
vcat [ the_arg_of <+> text "the view pattern"
, nest 2 (ppr expr) ]
@@ -1625,8 +1619,6 @@ pprExpectedFunTyCtxt funTy_origin i =
pprExpectedFunTyHerald :: ExpectedFunTyCtxt -> SDoc
pprExpectedFunTyHerald (ExpectedFunTySyntaxOp {})
= text "This rebindable syntax expects a function with"
-pprExpectedFunTyHerald (ExpectedTySyntax orig _)
- = pprCtOriginBriefly orig
pprExpectedFunTyHerald (ExpectedFunTyViewPat {})
= text "A view pattern expression expects"
pprExpectedFunTyHerald (ExpectedFunTyArg fun _)
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -63,7 +63,7 @@ module GHC.Tc.Utils.TcMType (
mkCheckExpType, newInferExpType, newInferExpTypeFRR,
runInfer, runInferRho, runInferSigma, runInferKind, runInferRhoFRR, runInferSigmaFRR,
readExpType, readExpType_maybe, readScaledExpType,
- expTypeToType, scaledExpTypeToType,
+ expTypeToType, scaledExpTypeToType, adjustExpTypeForCaseBranches,
checkingExpType_maybe, checkingExpType,
inferResultToType, ensureMonoType, promoteTcType,
@@ -499,6 +499,17 @@ inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl
; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr
; return tau }
+adjustExpTypeForCaseBranches :: ExpRhoType -> [branch] -> ExpRhoType
+-- See Note [fillInferResult: multiple branches]
+adjustExpTypeForCaseBranches exp_ty branches
+ = case exp_ty of
+ Infer ir | IR { ir_inst = IIF_Sigma } <- ir
+ , branches `lengthAtLeast` 2
+ -> Infer (ir { ir_inst = IIF_DeepRho })
+ | otherwise
+ -> exp_ty
+ Check {} -> exp_ty
+
{- Note [inferResultToType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
expTypeToType and inferResultType convert an InferResult to a monotype.
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -426,7 +426,7 @@ Some examples:
tcSkolemiseGeneral
:: HasDebugCallStack
- => DeepSubsumptionFlag
+ => DeepSubsumptionFlag -- Ignores the DeepSubsumptionDepth
-> UserTypeCtxt
-> TcType -> TcType -- top_ty and expected_ty
-- Here, top_ty is the type we started to skolemise; used only in SigSkol
@@ -1169,7 +1169,7 @@ fillInferResultNoInst act_res_ty (IR { ir_uniq = u
; return final_co } }
-fillInferResult :: DeepSubsumptionFlag -> CtOrigin -> TcType -> InferResult -> TcM HsWrapper
+fillInferResult :: DeepSubsumptionFlag -> CtOrigin -> TcSigmaType -> InferResult -> TcM HsWrapper
-- See Note [Instantiation of InferResult]
fillInferResult ds_flag ct_orig res_ty ires@(IR { ir_inst = iif })
= case iif of
@@ -1203,7 +1203,7 @@ There are two things to worry about:
T1 -> e1
T2 -> e2
-Our typing rules are:
+In general our typing rules are:
* The RHS of a existential or GADT alternative must always be a
monotype, regardless of the number of alternatives.
@@ -1218,17 +1218,13 @@ Our typing rules are:
We use choice (2) in that Section.
(GHC 8.10 and earlier used choice (1).)
- But note that
- case e of
- True -> hr
- False -> \x -> hr x
- will fail, because we still /infer/ both branches, so the \x will get
- a (monotype) unification variable, which will fail to unify with
- (forall a. a->a)
+Note [fillInferResult: GADTs and existentials]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We can detect the GADT/existential situation, case (1) of Note [fillInferResult],
+by seeing that the current TcLevel is greater than that stored in ir_lvl of the
+Infer ExpType. We bump the level whenever we go past a GADT/existential match.
-For (1) we can detect the GADT/existential situation by seeing that
-the current TcLevel is greater than that stored in ir_lvl of the Infer
-ExpType. We bump the level whenever we go past a GADT/existential match.
+We insist that the RHS has a monotype, regardless of the number of alternatives.
Then, before filling the hole use promoteTcType to promote the type
to the outer ir_lvl. promoteTcType does this
@@ -1239,11 +1235,6 @@ That forces the type to be a monotype (since unification variables can
only unify with monotypes); and catches skolem-escapes because the
alpha is untouchable until the equality floats out.
-For (2), we simply look to see if the hole is filled already.
- - if not, we promote (as above) and fill the hole
- - if it is filled, we simply unify with the type that is
- already there
-
(FIR1) There is one wrinkle. Suppose we have
case e of
T1 -> e1 :: (forall a. a->a) -> Int
@@ -1258,7 +1249,47 @@ For (2), we simply look to see if the hole is filled already.
So if we check G2 second, we still want to emit a constraint that restricts
the RHS to be a monotype. This is done by ensureMonoType, and it works
by simply generating a constraint (alpha ~ ty), where alpha is a fresh
-unification variable. We discard the evidence.
+ unification variable. We discard the evidence.
+
+Note [fillInferResult: multiple branches]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If there are multiple case branches, case (2) of Note [fillInferResult]
+we simply look to see if the hole is filled already.
+ - if not, we promote (as above) and fill the hole
+ - if it is filled, we simply unify with the type that is already there
+
+But consider
+ case x of
+ True -> True
+ False -> undefined
+and suppose we call `tcInferSigma` on this expression, so that the `ir_inst`
+field of the expected result type is `IIF_Sigma`. The danger is that we'll
+fill the hole with `Bool` (from the `True`) and then reject when we try to
+unify that with `forall a. a->a`, from the call to `undefined`.
+
+Another example:
+ case x of
+ True -> (e1 :: forall a b. a->b)
+ False -> (e3 :: forall b a. a->b)
+
+To avoid this, we never infer a sigma-type from a multi-branch `case`. Instead
+we just zap the `IIF_Sigma` to `IIF_DeepRho` when walking inside the branches
+of multi-arm case-expression, or an if-expression. See calls to
+`adjustExpTypeForCaseBranches`.
+
+This does mean that this would work:
+ (let x = 77+55 in h x x) @Int
+where
+ h :: Int -> Int -> forall a. a->a
+The `@Int` would instantiate the `forall a`.
+
+Note that
+ case e of
+ True -> hr
+ False -> \x -> hr x
+ where hr :: (forall a. a->a) -> Int
+will fail, because we still /infer/ both branches, so the \x will get a
+(monotype) unification variable, which will fail to unify with (forall a. a->a)
Note [Instantiation of InferResult]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2068,37 +2099,19 @@ getDeepSubsumptionFlag =
-- | Variant of 'getDeepSubsumptionFlag' which enables a top-level subsumption
-- in order to implement the plan of Note [Typechecking data constructors].
getDeepSubsumptionFlag_DataConHead :: HsExpr GhcTc -> TcM DeepSubsumptionFlag
-getDeepSubsumptionFlag_DataConHead app_head =
- do { user_ds <- xoptM LangExt.DeepSubsumption
- ; traceTc "getDeepSubsumptionFlag_DataConHead" (ppr app_head)
- ; return $
- if | user_ds
- -> Deep DeepSub
- | otherwise
- -> go app_head
- }
+getDeepSubsumptionFlag_DataConHead app_head
+ = do { user_ds <- xoptM LangExt.DeepSubsumption
+ ; return $ if | user_ds -> Deep DeepSub
+ | dc_head app_head -> Deep TopSub
+ | otherwise -> Shallow }
where
- go :: HsExpr GhcTc -> DeepSubsumptionFlag
- go app_head
- | XExpr (ConLikeTc (RealDataCon {})) <- app_head
- = Deep TopSub
- | XExpr (ExpandedThingTc (HSE _ (L _ f))) <- app_head
- = go f
- | XExpr (WrapExpr _ f) <- app_head
- = go f
- | HsVar _ f <- app_head
- , isDataConId (unLoc f)
- = Deep TopSub
- | HsApp _ f _ <- app_head
- = go (unLoc f)
- | HsAppType _ f _ <- app_head
- = go (unLoc f)
- | OpApp _ _ f _ <- app_head
- = go (unLoc f)
- | HsPar _ f <- app_head
- = go (unLoc f)
- | otherwise
- = Shallow
+ dc_head (XExpr (ConLikeTc (RealDataCon {}))) = True
+ dc_head (XExpr (WrapExpr _ f)) = dc_head f
+ dc_head (HsApp _ (L _ f) _) = dc_head f
+ dc_head (HsAppType _ (L _ f) _) = dc_head f
+ dc_head (OpApp _ _ (L _ f) _) = dc_head f
+ dc_head (HsPar _ (L _ f)) = dc_head f
+ dc_head _ = False
-- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption.
=====================================
testsuite/tests/rep-poly/RepPolyDoBind.stderr
=====================================
@@ -1,5 +1,5 @@
RepPolyDoBind.hs:26:3: error: [GHC-55287]
- • The expression ‘undefined’
+ • The first argument of the rebindable syntax operator ‘(>>=)’
arising from a do statement
does not have a fixed runtime representation.
Its type is:
=====================================
testsuite/tests/rep-poly/RepPolyDoBody1.stderr
=====================================
@@ -1,5 +1,5 @@
RepPolyDoBody1.hs:24:3: error: [GHC-55287]
- • The expression ‘undefined :: ma’
+ • The first argument of the rebindable syntax operator ‘(>>)’
arising from a do statement
does not have a fixed runtime representation.
Its type is:
=====================================
testsuite/tests/rep-poly/RepPolyDoBody2.stderr
=====================================
@@ -1,5 +1,5 @@
RepPolyDoBody2.hs:23:3: error: [GHC-55287]
- • The expression ‘return ()’
+ • The first argument of the rebindable syntax operator ‘(>>)’
arising from a do statement
does not have a fixed runtime representation.
Its type is:
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5adc452444e2fd8ea668fac5bd67f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5adc452444e2fd8ea668fac5bd67f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-apporv-Oct24] haddock comments for `tcValArg` and `cleanup getDeepSubsumption_flag` function
by Apoorv Ingle (＠ani) 31 Mar '26
by Apoorv Ingle (＠ani) 31 Mar '26
31 Mar '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
43f1db4a by Apoorv Ingle at 2026-03-30T15:12:20-05:00
haddock comments for `tcValArg` and `cleanup getDeepSubsumption_flag` function
- - - - -
2 changed files:
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Utils/Unify.hs
Changes:
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -567,11 +567,11 @@ tcValArgs do_ql (fun, fun_lspan) args = go do_ql 0 args
= pos
-tcValArg :: QLFlag
- -> Int -- argument position (used only for error message generation)
- -> (HsExpr GhcRn, SrcSpan) -- Head of the application chain (used only for error message generation)
- -> HsExprArg 'TcpInst -- Actual argument
- -> TcM (HsExprArg 'TcpTc) -- Resulting argument
+tcValArg :: QLFlag -- ^ Are we typechecking with Quick Look turned on?
+ -> Int -- ^ Argument position (used only for error message generation)
+ -> (HsExpr GhcRn, SrcSpan) -- ^ Head of the application chain (used only for error message generation)
+ -> HsExprArg 'TcpInst -- ^ Actual argument
+ -> TcM (HsExprArg 'TcpTc) -- ^ Resulting argument
tcValArg _ _ _ (EPrag l p) = return (EPrag l (tcExprPrag p))
tcValArg _ _ _ (ETypeArg l hty ty) = return (ETypeArg l hty ty)
tcValArg do_ql _ _ (EWrap (EHsWrap w)) = do { whenQL do_ql $ qlMonoHsWrapper w
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -2079,26 +2079,12 @@ getDeepSubsumptionFlag_DataConHead app_head =
}
where
go :: HsExpr GhcTc -> DeepSubsumptionFlag
- go app_head
- | XExpr (ConLikeTc (RealDataCon {})) <- app_head
- = Deep TopSub
- | XExpr (ExpandedThingTc (HSE _ (L _ f))) <- app_head
- = go f
- | XExpr (WrapExpr _ f) <- app_head
- = go f
- | HsVar _ f <- app_head
- , isDataConId (unLoc f)
- = Deep TopSub
- | HsApp _ f _ <- app_head
- = go (unLoc f)
- | HsAppType _ f _ <- app_head
- = go (unLoc f)
- | OpApp _ _ f _ <- app_head
- = go (unLoc f)
- | HsPar _ f <- app_head
- = go (unLoc f)
- | otherwise
- = Shallow
+ go (XExpr (ConLikeTc (RealDataCon {}))) = Deep TopSub
+ go (XExpr (ExpandedThingTc (HSE _ (L _ f)))) = go f
+ go (XExpr (WrapExpr _ f)) = go f
+ go (HsApp _ f _) = go (unLoc f)
+ go (HsAppType _ f _) = go (unLoc f)
+ go _ = Shallow
-- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43f1db4a6ba0d04dd8e77655e9ce071…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43f1db4a6ba0d04dd8e77655e9ce071…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: ghc-boot: remove unused SizedSeq instances and functions
by Marge Bot (＠marge-bot) 30 Mar '26
by Marge Bot (＠marge-bot) 30 Mar '26
30 Mar '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
cf942119 by Cheng Shao at 2026-03-30T15:24:37-04:00
ghc-boot: remove unused SizedSeq instances and functions
This commit removes unused `SizedSeq` instances and functions, only
keeping the bits we need for hpc tick sequence for now.
- - - - -
22c5b7cc by Cheng Shao at 2026-03-30T15:24:38-04:00
ghci: remove unused GHCi.BinaryArray
This patch removes the unused `GHCi.BinaryArray` module from `ghci`.
Closes #27108.
- - - - -
77abb4ab by Cheng Shao at 2026-03-30T15:25:21-04:00
testsuite: mark T17912 as fragile on Windows
T17912 is still fragile on Windows, it sometimes unexpectedly pass in
CI. This especially strains our already scarce Windows CI runner
resources. Mark it as fragile on Windows for the time being.
- - - - -
7f8cd5f5 by Andreas Klebinger at 2026-03-30T15:58:13-04:00
Bump minimum shake version for hadrian.
We also add the shake version we want to stack.yaml
Fixes #26884
- - - - -
59c9e83a by Vladislav Zavialov at 2026-03-30T15:58:13-04:00
Status check for the HsType~HsExpr refactoring (#25121)
Add a test case to track the status of a refactoring project within GHC
whose goal is to arrive at the following declaration:
type HsType = HsExpr
The rationale for this is to increase code reuse between the term- and
type-level code in the compiler front-end (AST, parser, renamer, type checker).
The status report is saved to testsuite/tests/ghc-api/T25121_status.stdout
and provides useful insights into what needs to happen to make progress on
the ticket.
- - - - -
2486b308 by fendor at 2026-03-30T15:58:14-04:00
Extract Binary instances to `GHC.ByteCode.Binary`
- - - - -
1ae4a964 by fendor at 2026-03-30T15:58:15-04:00
Add `seqNonEmpty` for evaluating `NonEmpty a`
- - - - -
982fce42 by fendor at 2026-03-30T15:58:15-04:00
Record `LinkableUsage` instead of `Linkable` in `LoaderState`
Retaining a ByteCode `Linkable` after it has been loaded retains its
`UnlinkedBCO`, keeping it alive for the remainder of the program.
This starts accumulating a lot of `UnlinkedBCO` and memory over time.
However, the `Linkable` is merely used to later record its usage in
`mkObjectUsage`, which is used for recompilation checking.
However, this is incorrect, as the interface file and bytecode objects
could be in different states, e.g. the interface changes, but the
bytecode library hasn't changed so we don't need to recompile and vice
versa.
By computing a `Fingerprint` for the `ModuleByteCode`, and recording it
in the `LinkableUsage`, we know precisely whether the `ByteCode` object
on disk is outdated.
Thus, parts of this commit just makes sure that we efficiently compute a
`Fingerprint` for `ModuleByteCode` and store it in the on-disk
representation of `ModuleByteCode`.
We change the `LoaderState` to retain `LinkableUsage`, which is smaller
representation of a `Linkable`. This allows us to free the unneeded
fields of `Linkable` after linking them.
We declare the following memory invariants that this commit implements:
* No `LinkablePart` should be retained from `LoaderState`.
* `Linkable`s should be unloaded after they have been loaded.
These invariants are unfortunately tricky to automatically uphold, so we
are simply documenting our assumptions for now.
We introduce the `linkable-space` test which makes sure that after
loading, no `DotGBC` or `UnlinkedBCO` is retained.
-------------------------
Metric Increase:
MultiLayerModulesTH_OneShot
-------------------------
We allocate a bit more, but the peak number of bytes doesn't change.
While a bit unfortunate, accepting the metric increase.
We add multiple new performance measurements where we were able to
observe the desired memory invariants. Further, we add regression tests
to validate that the recompilation checker behaves more correct than
before.
- - - - -
61d0ed32 by Simon Jakobi at 2026-03-30T15:58:15-04:00
Eliminate dictionary-passing in ListMap operations
Mark the ListMap helpers 'INLINABLE' so importing modules can specialise
the 'TrieMap (ListMap m)' methods and avoid recursive dictionary-passing.
See Note [Making ListMap operations specialisable].
Fixes #27097
- - - - -
aeafd242 by Cheng Shao at 2026-03-30T15:58:20-04:00
testsuite: fix testdir cleanup logic on Windows
testdir cleanup is unreliable on Windows (#13162) and despite existing
hacks in the driver, new failure mode has occurred. This patch makes
it print the warning and carry on when failed to clean up a testdir,
instead of reporting a spurious framework failure. See added comment
for detailed explanation.
- - - - -
55 changed files:
- + compiler/GHC/ByteCode/Binary.hs
- + compiler/GHC/ByteCode/Recomp/Binary.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Data/TrieMap.hs
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Recomp/Types.hs
- compiler/GHC/Linker/ByteCode.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Unit/Home/ModInfo.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/Status.hs
- compiler/GHC/Utils/Misc.hs
- compiler/ghc.cabal.in
- ghc/GHCi/Leak.hs
- hadrian/hadrian.cabal
- hadrian/stack.yaml
- libraries/base/tests/IO/all.T
- libraries/ghc-boot/GHC/Data/SizedSeq.hs
- − libraries/ghci/GHCi/BinaryArray.hs
- libraries/ghci/ghci.cabal.in
- testsuite/driver/testlib.py
- + testsuite/tests/bytecode/TLinkable/BCOTemplate.hs
- + testsuite/tests/bytecode/TLinkable/LinkableUsage01.stderr
- + testsuite/tests/bytecode/TLinkable/LinkableUsage02.stderr
- + testsuite/tests/bytecode/TLinkable/Makefile
- + testsuite/tests/bytecode/TLinkable/all.T
- + testsuite/tests/bytecode/TLinkable/genLinkables.sh
- + testsuite/tests/bytecode/TLinkable/linkable-space.hs
- + testsuite/tests/bytecode/TLinkable/linkable-space.stdout
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout
- + testsuite/tests/driver/recomp022/A1.hs
- + testsuite/tests/driver/recomp022/A2.hs
- + testsuite/tests/driver/recomp022/A3.hs
- + testsuite/tests/driver/recomp022/B.hs
- + testsuite/tests/driver/recomp022/C.hs
- + testsuite/tests/driver/recomp022/Makefile
- + testsuite/tests/driver/recomp022/all.T
- + testsuite/tests/driver/recomp022/recomp022a.stdout
- + testsuite/tests/driver/recomp022/recomp022b.stdout
- + testsuite/tests/ghc-api/T25121_status.hs
- + testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghci/should_run/BinaryArray.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b52a9dd6bb50a16fecde9906dba76f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b52a9dd6bb50a16fecde9906dba76f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0