[Git][ghc/ghc][wip/spj-apporv-Oct24] testing pushing VAExpansion into tcApp

[Apoorv Ingle (@ani)]

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC


Commits:
69f342dc by Apoorv Ingle at 2025-01-12T22:13:33-06:00
testing pushing VAExpansion into tcApp

- - - - -


3 changed files:

- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs


Changes:

=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -177,7 +177,7 @@ tcInferSigma :: Bool -> LHsExpr GhcRn -> TcM TcSigmaType
 tcInferSigma inst (L loc rn_expr)
   = addExprCtxt rn_expr $
     setSrcSpanA loc     $
-    do { (fun@(rn_fun,fun_ctxt), rn_args) <- splitHsApps rn_expr
+    do { (fun@(rn_fun,fun_ctxt), rn_args) <- splitHsApps Nothing rn_expr
        ; do_ql <- wantQuickLook rn_fun
        ; (tc_fun, fun_sigma) <- tcInferAppHead fun
        ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (tc_fun, fun_ctxt) fun_sigma rn_args
@@ -386,13 +386,14 @@ Unify result type /before/ typechecking the args
 The latter is much better. That is why we call checkResultType before tcValArgs.
 -}
 
-tcApp :: HsExpr GhcRn
+tcApp :: Maybe HsThingRn -- Just x <=> Expr is a compiler generated expression
+      -> HsExpr GhcRn
       -> ExpRhoType   -- When checking, -XDeepSubsumption <=> deeply skolemised
       -> TcM (HsExpr GhcTc)
 -- See Note [tcApp: typechecking applications]
-tcApp rn_expr exp_res_ty
+tcApp mb_oexpr rn_expr exp_res_ty
   = do { -- Step 1: Split the application chain
-         (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr
+         (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps mb_oexpr rn_expr
        ; traceTc "tcApp {" $
            vcat [ text "rn_expr:" <+> ppr rn_expr
                 , text "rn_fun:" <+> ppr rn_fun
@@ -1727,7 +1728,7 @@ quickLookArg1 :: AppCtxt -> LHsExpr GhcRn
 quickLookArg1 ctxt larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_rho)
   = addArgCtxt ctxt larg $ -- Context needed for constraints
                            -- generated by calls in arg
-    do { ((rn_fun, fun_ctxt), rn_args) <- splitHsApps arg
+    do { ((rn_fun, fun_ctxt), rn_args) <- splitHsApps Nothing arg
 
        -- Step 1: get the type of the head of the argument
        ; (fun_ue, mb_fun_ty) <- tcCollectingUsage $ tcInferAppHead_maybe rn_fun


=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -288,11 +288,11 @@ tcExpr :: HsExpr GhcRn
 --   - 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
-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@(HsVar {})              res_ty = tcApp Nothing e res_ty
+tcExpr e@(HsApp {})              res_ty = tcApp Nothing e res_ty
+tcExpr e@(OpApp {})              res_ty = tcApp Nothing e res_ty
+tcExpr e@(HsAppType {})          res_ty = tcApp Nothing e res_ty
+tcExpr e@(ExprWithTySig {})      res_ty = tcApp Nothing e res_ty
 
 tcExpr (XExpr e)                 res_ty = tcXExpr e res_ty
 
@@ -360,7 +360,7 @@ tcExpr e@(HsOverLit _ lit) res_ty
          -- See Note [Short cut for overloaded literals] in GHC.Tc.Utils.TcMType
        ; case mb_res of
            Just lit' -> return (HsOverLit noExtField lit')
-           Nothing   -> tcApp e res_ty }
+           Nothing   -> tcApp Nothing e res_ty }
            -- Why go via tcApp? See Note [Typechecking overloaded literals]
 
 {- Note [Typechecking overloaded literals]
@@ -749,10 +749,10 @@ tcXExpr (PopErrCtxt e) res_ty
 tcXExpr (ExpandedThingRn o@(OrigStmt stmt flav) e) res_ty
    = addThingCtxt o $
        mkExpandedStmtTc stmt flav <$>
-       tcExpr e res_ty
+       tcApp (Just o) e res_ty
 
 -- For record selection
-tcXExpr xe res_ty = tcApp (XExpr xe) res_ty
+tcXExpr xe res_ty = tcApp Nothing (XExpr xe) res_ty
 
 
 {-


=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -283,7 +283,8 @@ addArgWrap wrap args
  | isIdHsWrapper wrap = args
  | otherwise          = EWrap (EHsWrap wrap) : args
 
-splitHsApps :: HsExpr GhcRn
+splitHsApps :: Maybe HsThingRn
+            -> HsExpr GhcRn
             -> TcM ( (HsExpr GhcRn, AppCtxt)  -- Head
                    , [HsExprArg 'TcpRn])      -- Args
 -- See Note [splitHsApps].
@@ -291,7 +292,10 @@ splitHsApps :: HsExpr GhcRn
 -- This uses the TcM monad solely because we must run modFinalizers when looking
 -- through HsUntypedSplices
 -- (see Note [Looking through Template Haskell splices in splitHsApps]).
-splitHsApps e = go e (top_ctxt 0 e) []
+splitHsApps mb_oexpr e = case mb_oexpr of
+                           Just x@(OrigStmt (L l _) _) -> go e (VAExpansion x (locA l) generatedSrcSpan) []
+                           Just x -> go e (VAExpansion x generatedSrcSpan generatedSrcSpan) []
+                           Nothing -> go e (top_ctxt 0 e) []
   where
     top_ctxt :: Int -> HsExpr GhcRn -> AppCtxt
     -- Always returns VACall fun n_val_args noSrcSpan



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69f342dc6695854ae60fc5f9630d21f5bcc63e96

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69f342dc6695854ae60fc5f9630d21f5bcc63e96
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250112/0118434e/attachment-0001.html>