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
3 changed files:
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Head.hs
- testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
Changes:
| ... | ... | @@ -243,7 +243,7 @@ tcApp accepts 4 arguments: |
| 243 | 243 | 3. the argument list (types and terms)
|
| 244 | 244 | 4. The expected result type
|
| 245 | 245 | |
| 246 | -PRECONDITION : the head (2.) and the list of arguments (3.) will
|
|
| 246 | +PRECONDITION : the head (2.) and the list of arguments (3.)
|
|
| 247 | 247 | are the de-constructred version of the expression (1.)
|
| 248 | 248 | POSTCONDITION: The return expression is the typechecked version of (1.)
|
| 249 | 249 | |
| ... | ... | @@ -365,7 +365,7 @@ tcApp :: HsExpr GhcRn -- ^ The whole application (For error messages) |
| 365 | 365 | -- See Note [tcApp: typechecking applications]
|
| 366 | 366 | -- See Note [splitHsApps] in GHC.Tc.Head
|
| 367 | 367 | tcApp rn_expr rn_fun rn_args exp_res_ty
|
| 368 | - = do { fun_lspan <- getFunSrcSpan rn_args
|
|
| 368 | + = do { fun_lspan <- getFunSrcSpan rn_fun rn_args
|
|
| 369 | 369 | ; traceTc "tcApp {" $
|
| 370 | 370 | vcat [ text "rn_fun:" <+> ppr rn_fun
|
| 371 | 371 | , 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_ |
| 1958 | 1958 | -- generated by calls in arg
|
| 1959 | 1959 | do { traceTc "qla1" (ppr arg)
|
| 1960 | 1960 | |
| 1961 | - ; (rn_fun_arg, rn_args) <- splitHsApps arg
|
|
| 1961 | + ; (rn_arg_head, rn_arg_args) <- splitHsApps arg
|
|
| 1962 | 1962 | |
| 1963 | 1963 | ; traceTc "qla2" (ppr arg)
|
| 1964 | 1964 | |
| 1965 | - ; fun_lspan_arg <- getFunSrcSpan rn_args
|
|
| 1965 | + ; fun_lspan_arg <- getFunSrcSpan rn_arg_head rn_arg_args
|
|
| 1966 | 1966 | |
| 1967 | 1967 | -- Step 1: get the type of the head of the argument
|
| 1968 | - ; (fun_ue, mb_fun_ty) <- tcCollectingUsage $ tcInferAppHead_maybe rn_fun_arg
|
|
| 1968 | + ; (fun_ue, mb_fun_ty) <- tcCollectingUsage $ tcInferAppHead_maybe rn_arg_head
|
|
| 1969 | 1969 | -- tcCollectingUsage: the use of an Id at the head generates usage-info
|
| 1970 | 1970 | -- See the call to `tcEmitBindingUsage` in `check_local_id`. So we must
|
| 1971 | 1971 | -- 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_ |
| 1974 | 1974 | ; traceTc "quickLookArg {" $
|
| 1975 | 1975 | vcat [ text "arg:" <+> ppr arg
|
| 1976 | 1976 | , text "orig_arg_rho:" <+> ppr orig_arg_rho
|
| 1977 | - , text "head:" <+> ppr rn_fun_arg <+> dcolon <+> ppr mb_fun_ty
|
|
| 1978 | - , text "args:" <+> ppr rn_args ]
|
|
| 1977 | + , text "head:" <+> ppr rn_arg_head <+> dcolon <+> ppr mb_fun_ty
|
|
| 1978 | + , text "args:" <+> ppr rn_arg_args ]
|
|
| 1979 | 1979 | |
| 1980 | 1980 | ; case mb_fun_ty of {
|
| 1981 | 1981 | 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_ |
| 1983 | 1983 | |
| 1984 | 1984 | -- step 2: use |-inst to instantiate the head applied to the arguments
|
| 1985 | 1985 | do { let arg_tc_head = (tc_fun_arg_head, fun_lspan_arg)
|
| 1986 | - ; do_ql <- wantQuickLook rn_fun_arg
|
|
| 1986 | + ; do_ql <- wantQuickLook rn_arg_head
|
|
| 1987 | 1987 | |
| 1988 | 1988 | ; ((inst_args, app_res_rho), wanted)
|
| 1989 | 1989 | <- captureConstraints $
|
| 1990 | - tcInstFun do_ql True (rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args
|
|
| 1990 | + tcInstFun do_ql True (rn_arg_head, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_arg_args
|
|
| 1991 | 1991 | -- We must capture type-class and equality constraints here, but
|
| 1992 | 1992 | -- not usage information. See (QLA6) in Note [Quick Look at
|
| 1993 | 1993 | -- value arguments]
|
| ... | ... | @@ -2017,13 +2017,13 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_ |
| 2017 | 2017 | ; when arg_influences_enclosing_call $
|
| 2018 | 2018 | qlUnify app_res_rho orig_arg_rho
|
| 2019 | 2019 | |
| 2020 | - ; traceTc "quickLookArg done }" (ppr rn_fun_arg)
|
|
| 2020 | + ; traceTc "quickLookArg done }" (ppr rn_arg_head)
|
|
| 2021 | 2021 | |
| 2022 | 2022 | ; return (EValArgQL { eaql_loc_span = app_lspan
|
| 2023 | 2023 | , eaql_arg_ty = sc_arg_ty
|
| 2024 | 2024 | , eaql_larg = larg
|
| 2025 | 2025 | , eaql_tc_fun = arg_tc_head
|
| 2026 | - , eaql_rn_fun = rn_fun_arg
|
|
| 2026 | + , eaql_rn_fun = rn_arg_head
|
|
| 2027 | 2027 | , eaql_fun_ue = fun_ue
|
| 2028 | 2028 | , eaql_args = inst_args
|
| 2029 | 2029 | , eaql_wanted = wanted
|
| ... | ... | @@ -223,14 +223,15 @@ addArgWrap wrap args |
| 223 | 223 | |
| 224 | 224 | |
| 225 | 225 | --------------------
|
| 226 | -getFunSrcSpan :: [HsExprArg 'TcpRn] -> TcM SrcSpan
|
|
| 227 | -getFunSrcSpan [] = getSrcSpanM
|
|
| 228 | -getFunSrcSpan (ETypeArg { ea_loc_span = l } : _) = return (locA l)
|
|
| 229 | -getFunSrcSpan (EValArg { ea_loc_span = l } : _) = return (locA l)
|
|
| 230 | -getFunSrcSpan (EPrag l _ : _) = return (locA l)
|
|
| 231 | -getFunSrcSpan (EWrap (EPar l) : _) = return (locA l)
|
|
| 232 | -getFunSrcSpan (EWrap (EExpand l _) : _) = return (locA l)
|
|
| 233 | -getFunSrcSpan (EWrap (EHsWrap {}) : args) = getFunSrcSpan args
|
|
| 226 | +getFunSrcSpan :: HsExpr GhcRn -> [HsExprArg 'TcpRn] -> TcM SrcSpan
|
|
| 227 | +getFunSrcSpan (ExprWithTySig _ (L l _) _) _ = return (locA l)
|
|
| 228 | +getFunSrcSpan _ [] = getSrcSpanM
|
|
| 229 | +getFunSrcSpan _ (ETypeArg { ea_loc_span = l } : _) = return (locA l)
|
|
| 230 | +getFunSrcSpan _ (EValArg { ea_loc_span = l } : _) = return (locA l)
|
|
| 231 | +getFunSrcSpan _ (EPrag l _ : _) = return (locA l)
|
|
| 232 | +getFunSrcSpan _ (EWrap (EPar l) : _) = return (locA l)
|
|
| 233 | +getFunSrcSpan _ (EWrap (EExpand l _) : _) = return (locA l)
|
|
| 234 | +getFunSrcSpan f (EWrap (EHsWrap {}) : args) = getFunSrcSpan f args
|
|
| 234 | 235 | |
| 235 | 236 | --------------------
|
| 236 | 237 | isHsValArg :: HsExprArg id -> Bool
|
| ... | ... | @@ -294,10 +295,10 @@ instance Outputable EWrap where |
| 294 | 295 | splitHsApps :: HsExpr GhcRn -> TcM (HsExpr GhcRn, [HsExprArg 'TcpRn])
|
| 295 | 296 | splitHsApps e = go e []
|
| 296 | 297 | where
|
| 297 | - go (HsPar _ (L l fun)) args = go fun (EWrap (EPar l) : args)
|
|
| 298 | - go (HsPragE _ p (L l fun)) args = go fun (EPrag l p : args)
|
|
| 299 | - go (HsAppType _ (L l fun) ty) args = go fun (mkETypeArg l ty : args)
|
|
| 300 | - go (HsApp _ (L l fun) arg) args = go fun (mkEValArg l arg : args)
|
|
| 298 | + go (HsPar _ (L l fun)) args = go fun (EWrap (EPar l) : args)
|
|
| 299 | + go (HsPragE _ p (L l fun)) args = go fun (EPrag l p : args)
|
|
| 300 | + go (HsAppType _ (L l fun) ty) args = go fun (mkETypeArg l ty : args)
|
|
| 301 | + go (HsApp _ (L l fun) arg) args = go fun (mkEValArg l arg : args)
|
|
| 301 | 302 | go fun args = do { mb_hse <- tcExpand fun
|
| 302 | 303 | ; case mb_hse of
|
| 303 | 304 | Just (HSE { hse_ctxt = orig, hse_exp = L l fun' })
|
| ... | ... | @@ -20,7 +20,8 @@ SplicesUsed.hs:8:26: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefau |
| 20 | 20 | • Found type wildcard ‘_’ standing for ‘Bool’
|
| 21 | 21 | • In the first argument of ‘Maybe’, namely ‘_’
|
| 22 | 22 | In an expression type signature: Maybe _
|
| 23 | - In the expression: Just True :: Maybe _
|
|
| 23 | + In the first argument of ‘id :: _a -> _a’, namely
|
|
| 24 | + ‘(Just True :: Maybe _)’
|
|
| 24 | 25 | • Relevant bindings include
|
| 25 | 26 | maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1)
|
| 26 | 27 |