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/e7cfce77e9a9437d939ac2e080aad814... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7cfce77e9a9437d939ac2e080aad814... You're receiving this email because of your account on gitlab.haskell.org.