[Git][ghc/ghc][wip/ani/precise-fun-loc] compute a more accuate application chain head location

3 Apr 2026


      Apoorv Ingle pushed to branch wip/ani/precise-fun-loc at Glasgow Haskell Compiler / GHC


Commits:
c9af140d by Apoorv Ingle at 2026-04-02T21:19:03-05:00
compute a more accuate application chain head location

- - - - -


3 changed files:

- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Head.hs
- testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr


Changes:

=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -243,7 +243,7 @@ tcApp accepts 4 arguments:
   3. the argument list (types and terms)
   4. The expected result type
 
-PRECONDITION : the head (2.) and the list of arguments (3.) will
+PRECONDITION : the head (2.) and the list of arguments (3.)
                are the de-constructred version of the expression (1.)
 POSTCONDITION: The return expression is the typechecked version of (1.)
 
@@ -365,7 +365,7 @@ tcApp :: HsExpr GhcRn        -- ^ The whole application (For error messages)
 -- See Note [tcApp: typechecking applications]
 -- See Note [splitHsApps] in GHC.Tc.Head
 tcApp rn_expr rn_fun rn_args exp_res_ty
-  = do { fun_lspan <- getFunSrcSpan rn_args
+  = do { fun_lspan <- getFunSrcSpan rn_fun rn_args
        ; traceTc "tcApp {" $
            vcat [ text "rn_fun:" <+> ppr rn_fun
                 , text "fun_lspan:" <+> ppr fun_lspan
@@ -1958,14 +1958,14 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_
                                            -- generated by calls in arg
     do { traceTc "qla1" (ppr arg)
 
-       ; (rn_fun_arg, rn_args) <- splitHsApps arg
+       ; (rn_arg_head, rn_arg_args) <- splitHsApps arg
 
        ; traceTc "qla2" (ppr arg)
 
-       ; fun_lspan_arg <- getFunSrcSpan rn_args
+       ; fun_lspan_arg <- getFunSrcSpan rn_arg_head rn_arg_args
 
        -- Step 1: get the type of the head of the argument
-       ; (fun_ue, mb_fun_ty) <- tcCollectingUsage $ tcInferAppHead_maybe rn_fun_arg
+       ; (fun_ue, mb_fun_ty) <- tcCollectingUsage $ tcInferAppHead_maybe rn_arg_head
          -- tcCollectingUsage: the use of an Id at the head generates usage-info
          -- See the call to `tcEmitBindingUsage` in `check_local_id`.  So we must
          -- capture and save it in the `EValArgQL`.  See (QLA6) in
@@ -1974,8 +1974,8 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_
        ; traceTc "quickLookArg {" $
          vcat [ text "arg:" <+> ppr arg
               , text "orig_arg_rho:" <+> ppr orig_arg_rho
-              , text "head:" <+> ppr rn_fun_arg <+> dcolon <+> ppr mb_fun_ty
-              , text "args:" <+> ppr rn_args ]
+              , text "head:" <+> ppr rn_arg_head <+> dcolon <+> ppr mb_fun_ty
+              , text "args:" <+> ppr rn_arg_args ]
 
        ; case mb_fun_ty of {
            Nothing -> skipQuickLook app_lspan larg sc_arg_ty ;    -- fun is too complicated
@@ -1983,11 +1983,11 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_
 
        -- step 2: use |-inst to instantiate the head applied to the arguments
     do { let arg_tc_head = (tc_fun_arg_head, fun_lspan_arg)
-       ; do_ql <- wantQuickLook rn_fun_arg
+       ; do_ql <- wantQuickLook rn_arg_head
 
        ; ((inst_args, app_res_rho), wanted)
              <- captureConstraints $
-                tcInstFun do_ql True (rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args
+                tcInstFun do_ql True (rn_arg_head, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_arg_args
                 -- We must capture type-class and equality constraints here, but
                 -- not usage information.  See (QLA6) in Note [Quick Look at
                 -- value arguments]
@@ -2017,13 +2017,13 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_
        ; when arg_influences_enclosing_call $
          qlUnify app_res_rho orig_arg_rho
 
-       ; traceTc "quickLookArg done }" (ppr rn_fun_arg)
+       ; traceTc "quickLookArg done }" (ppr rn_arg_head)
 
        ; return (EValArgQL { eaql_loc_span = app_lspan
                            , eaql_arg_ty   = sc_arg_ty
                            , eaql_larg     = larg
                            , eaql_tc_fun   = arg_tc_head
-                           , eaql_rn_fun   = rn_fun_arg
+                           , eaql_rn_fun   = rn_arg_head
                            , eaql_fun_ue   = fun_ue
                            , eaql_args     = inst_args
                            , eaql_wanted   = wanted


=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -223,14 +223,15 @@ addArgWrap wrap args
 
 
 --------------------
-getFunSrcSpan :: [HsExprArg 'TcpRn] -> TcM SrcSpan
-getFunSrcSpan [] = getSrcSpanM
-getFunSrcSpan (ETypeArg { ea_loc_span = l }    : _)    = return (locA l)
-getFunSrcSpan (EValArg  { ea_loc_span = l }    : _)    = return (locA l)
-getFunSrcSpan (EPrag l _                       : _)    = return (locA l)
-getFunSrcSpan (EWrap (EPar l)                  : _)    = return (locA l)
-getFunSrcSpan (EWrap (EExpand l _)             : _)    = return (locA l)
-getFunSrcSpan (EWrap (EHsWrap {})              : args) = getFunSrcSpan args
+getFunSrcSpan :: HsExpr GhcRn -> [HsExprArg 'TcpRn] -> TcM SrcSpan
+getFunSrcSpan (ExprWithTySig _ (L l _) _) _              = return (locA l)
+getFunSrcSpan _                                    []    = getSrcSpanM
+getFunSrcSpan _ (ETypeArg { ea_loc_span = l }    : _)    = return (locA l)
+getFunSrcSpan _ (EValArg  { ea_loc_span = l }    : _)    = return (locA l)
+getFunSrcSpan _ (EPrag l _                       : _)    = return (locA l)
+getFunSrcSpan _ (EWrap (EPar l)                  : _)    = return (locA l)
+getFunSrcSpan _ (EWrap (EExpand l _)             : _)    = return (locA l)
+getFunSrcSpan f (EWrap (EHsWrap {})              : args) = getFunSrcSpan f args
 
 --------------------
 isHsValArg :: HsExprArg id -> Bool
@@ -294,10 +295,10 @@ instance Outputable EWrap where
 splitHsApps :: HsExpr GhcRn -> TcM (HsExpr GhcRn, [HsExprArg 'TcpRn])
 splitHsApps e = go e []
   where
-    go (HsPar _ (L l fun))        args = go fun (EWrap (EPar l)   : args)
-    go (HsPragE _ p (L l fun))    args = go fun (EPrag      l p   : args)
-    go (HsAppType _ (L l fun) ty) args = go fun (mkETypeArg l ty  : args)
-    go (HsApp _ (L l fun) arg)    args = go fun (mkEValArg  l arg : args)
+    go (HsPar _ (L l fun))         args = go fun (EWrap (EPar l)   : args)
+    go (HsPragE _ p (L l fun))     args = go fun (EPrag      l p   : args)
+    go (HsAppType _ (L l fun) ty)  args = go fun (mkETypeArg l ty  : args)
+    go (HsApp _ (L l fun) arg)     args = go fun (mkEValArg  l arg : args)
     go fun args = do { mb_hse <- tcExpand fun
                      ; case mb_hse of
                           Just (HSE { hse_ctxt = orig, hse_exp = L l fun' })


=====================================
testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
=====================================
@@ -20,7 +20,8 @@ SplicesUsed.hs:8:26: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefau
     • Found type wildcard ‘_’ standing for ‘Bool’
     • In the first argument of ‘Maybe’, namely ‘_’
       In an expression type signature: Maybe _
-      In the expression: Just True :: Maybe _
+      In the first argument of ‘id :: _a -> _a’, namely
+        ‘(Just True :: Maybe _)’
     • Relevant bindings include
         maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1)
 



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

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

    

Apoorv Ingle (＠ani)

tags

participants (1)