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
2 changed files:
Changes:
| ... | ... | @@ -567,11 +567,11 @@ tcValArgs do_ql (fun, fun_lspan) args = go do_ql 0 args |
| 567 | 567 | = pos
|
| 568 | 568 | |
| 569 | 569 | |
| 570 | -tcValArg :: QLFlag
|
|
| 571 | - -> Int -- argument position (used only for error message generation)
|
|
| 572 | - -> (HsExpr GhcRn, SrcSpan) -- Head of the application chain (used only for error message generation)
|
|
| 573 | - -> HsExprArg 'TcpInst -- Actual argument
|
|
| 574 | - -> TcM (HsExprArg 'TcpTc) -- Resulting argument
|
|
| 570 | +tcValArg :: QLFlag -- ^ Are we typechecking with Quick Look turned on?
|
|
| 571 | + -> Int -- ^ Argument position (used only for error message generation)
|
|
| 572 | + -> (HsExpr GhcRn, SrcSpan) -- ^ Head of the application chain (used only for error message generation)
|
|
| 573 | + -> HsExprArg 'TcpInst -- ^ Actual argument
|
|
| 574 | + -> TcM (HsExprArg 'TcpTc) -- ^ Resulting argument
|
|
| 575 | 575 | tcValArg _ _ _ (EPrag l p) = return (EPrag l (tcExprPrag p))
|
| 576 | 576 | tcValArg _ _ _ (ETypeArg l hty ty) = return (ETypeArg l hty ty)
|
| 577 | 577 | 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 _ |
| 2018 | 2018 | , eaql_res_rho = app_res_rho }) }}}
|
| 2019 | 2019 | |
| 2020 | 2020 | |
| 2021 | -mk_origin :: SrcSpan -- SrcSpan of the function
|
|
| 2022 | - -> HsExpr GhcRn -- The head of the expression application chain
|
|
| 2021 | +-- This function can be moved inside `tcInstFun` once we retire `tcExprSigma`
|
|
| 2022 | +mk_origin :: SrcSpan -- ^ SrcSpan of the function
|
|
| 2023 | + -> HsExpr GhcRn -- ^ The head of the expression application chain
|
|
| 2023 | 2024 | -> TcM CtOrigin
|
| 2024 | 2025 | mk_origin fun_lspan rn_fun
|
| 2025 | 2026 | | not (isGeneratedSrcSpan fun_lspan)
|
| ... | ... | @@ -99,7 +99,7 @@ import qualified GHC.LanguageExtensions as LangExt |
| 99 | 99 | |
| 100 | 100 | import GHC.Builtin.Types
|
| 101 | 101 | import GHC.Types.Name
|
| 102 | -import GHC.Types.Id( idType, isDataConId )
|
|
| 102 | +import GHC.Types.Id( idType )
|
|
| 103 | 103 | import GHC.Types.Var as Var
|
| 104 | 104 | import GHC.Types.Var.Set
|
| 105 | 105 | import GHC.Types.Var.Env
|
| ... | ... | @@ -2079,26 +2079,12 @@ getDeepSubsumptionFlag_DataConHead app_head = |
| 2079 | 2079 | }
|
| 2080 | 2080 | where
|
| 2081 | 2081 | go :: HsExpr GhcTc -> DeepSubsumptionFlag
|
| 2082 | - go app_head
|
|
| 2083 | - | XExpr (ConLikeTc (RealDataCon {})) <- app_head
|
|
| 2084 | - = Deep TopSub
|
|
| 2085 | - | XExpr (ExpandedThingTc (HSE _ (L _ f))) <- app_head
|
|
| 2086 | - = go f
|
|
| 2087 | - | XExpr (WrapExpr _ f) <- app_head
|
|
| 2088 | - = go f
|
|
| 2089 | - | HsVar _ f <- app_head
|
|
| 2090 | - , isDataConId (unLoc f)
|
|
| 2091 | - = Deep TopSub
|
|
| 2092 | - | HsApp _ f _ <- app_head
|
|
| 2093 | - = go (unLoc f)
|
|
| 2094 | - | HsAppType _ f _ <- app_head
|
|
| 2095 | - = go (unLoc f)
|
|
| 2096 | - | OpApp _ _ f _ <- app_head
|
|
| 2097 | - = go (unLoc f)
|
|
| 2098 | - | HsPar _ f <- app_head
|
|
| 2099 | - = go (unLoc f)
|
|
| 2100 | - | otherwise
|
|
| 2101 | - = Shallow
|
|
| 2082 | + go (XExpr (ConLikeTc (RealDataCon {}))) = Deep TopSub
|
|
| 2083 | + go (XExpr (ExpandedThingTc (HSE _ (L _ f)))) = go f
|
|
| 2084 | + go (XExpr (WrapExpr _ f)) = go f
|
|
| 2085 | + go (HsApp _ f _) = go (unLoc f)
|
|
| 2086 | + go (HsAppType _ f _) = go (unLoc f)
|
|
| 2087 | + go _ = Shallow
|
|
| 2102 | 2088 | |
| 2103 | 2089 | |
| 2104 | 2090 | -- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption.
|