GitLab

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

Commits:

1d8da680

by Apoorv Ingle at 2025-12-01T09:09:42-06:00

do not add error context in tcExprSigma for XExpr and do not setQLInstLevel before tcInstFun

3 changed files:

compiler/GHC/Tc/Gen/App.hs
compiler/GHC/Tc/Gen/Do.hs
compiler/GHC/Tc/Gen/Head.hs

Changes:

compiler/GHC/Tc/Gen/App.hs

@@ -679,9 +679,9 @@ quickLookKeys = [dollarIdKey, leftSectionKey, rightSectionKey]
  *                                                                      *
  ********************************************************************* -}
 -setQLInstLevel :: QLFlag -> TcM a -> TcM a
 -setQLInstLevel DoQL thing_inside = setTcLevel QLInstVar thing_inside
 -setQLInstLevel NoQL thing_inside = thing_inside
 +-- setQLInstLevel :: QLFlag -> TcM a -> TcM a
 +-- setQLInstLevel DoQL thing_inside = setTcLevel QLInstVar thing_inside
 +-- setQLInstLevel NoQL thing_inside = thing_inside
  tcInstFun :: QLFlag
            -> Bool   -- False <=> Instantiate only /top-level, inferred/ variables;
@@ -706,7 +706,7 @@ tcInstFun do_ql inst_final ds_flag (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigm
                                     , text "args:" <+> ppr rn_args
                                     , text "do_ql" <+> ppr do_ql
                                     , text "ctx" <+> ppr fun_lspan])
 -       ; res@(_, fun_ty) <- setQLInstLevel do_ql $  -- See (TCAPP1) and (TCAPP2) in
 +       ; res@(_, fun_ty) <- -- setQLInstLevel do_ql $  -- See (TCAPP1) and (TCAPP2) in
                                                      -- Note [tcApp: typechecking applications]
                                  go 1 [] fun_sigma rn_args
         ; traceTc "tcInstFun:ret" (ppr fun_ty)

compiler/GHC/Tc/Gen/Do.hs

@@ -275,22 +275,22 @@ They capture the essence of statement expansions as implemented in `expand_do_st
    DO【 _ 】 maps a sequence of do statements and recursively converts them into expressions
 -          (1) DO【 s; ss 】      = ‹ExpansionStmt s›((>>) (‹PopErrCtxt› s) (‹PopErrCtxt› DO【 ss 】))
 +          (1) DO【 s; ss 】      = ‹ExpansionStmt s›((>>) s (DO【 ss 】))
            (2) DO【 p <- e; ss 】 = if p is irrefutable
                                     then ‹ExpansionStmt (p <- e)›
 -                                          (>>=) (‹PopExprCtxt› s) ((\ p -> ‹PopExprCtxt› DO【 ss 】))
 +                                          (>>=) s ((\ p -> DO【 ss 】))
                                     else ‹ExpansionStmt (p <- e)›
 -                                          (>>=) (‹PopExprCtxt› s)
 -                                                (\case p -> ‹PopExprCtxt› DO【 ss 】
 -                                                       _ -> fail "pattern p failure")
 +                                          (>>=) s
 +                                                (\case p -> DO【 ss 】
 +                                                       _ -> ‹ExpansionPat (p <- e) p› fail "pattern p failure")
            (3) DO【 let x = e; ss 】
 -                                 = ‹ExpansionStmt (let x = e)› (let x = e in (‹PopErrCtxt›DO【 ss 】))
 +                                 = ‹ExpansionStmt (let x = e)› (let x = e in (DO【 ss 】))
            (4) DO【 rec ss; sss 】
 -                                 = (>>=) e (\vars -> ‹PopErrCtxt›DO【 sss 】))
 +                                 = (>>=) e (\vars -> DO【 sss 】))
                                             where (vars, e) = RECDO【 ss 】
            (5) DO【 s 】          = s
@@ -428,10 +428,10 @@ It stores the original statement (with location) and the expanded expression
        ‹ExpandedThingRn do { e1; e2; e3 }›                        -- Original Do Expression
                                                                   -- Expanded Do Expression
            (‹ExpandedThingRn e1›                                  -- Original Statement
 -               ({(>>) ‹PopErrCtxt› e1}                           -- Expanded Expression
 -                      ‹PopErrCtxt› (‹ExpandedThingRn e2›
 -                         ({(>>) ‹PopErrCtxt› e2}
 -                                ‹PopErrCtxt› (‹ExpandedThingRn e3› {e3})))))
 +               ({(>>) ‹ExpandedThingRn e1› e1}                           -- Expanded Expression
 +                      (‹ExpandedThingRn e2›
 +                         ({(>>) ‹ExpandedThingRn e2› e2}
 +                                (‹ExpandedThingRn e3› {e3})))))
    * Whenever the typechecker steps through an `ExpandedThingRn`,
      we push the original statement in the error context, set the error location to the
@@ -441,7 +441,7 @@ It stores the original statement (with location) and the expanded expression
    * Recall, that when a source function argument fails to typecheck,
      we print an error message like "In the second argument of the function f..".
 -    However, `(>>)` is generated thus, we don't want to display that to the user; it would be confusing.
 +    However, `(>>)` is compiler expanded thus, we don't want to display that to the user; it would be confusing.
      But also, we do not want to completely ignore it as we do want to keep the error blame carets
      as precise as possible, and not just blame the complete `do`-block.
      Thus, when we typecheck the application `(>>) e1`, we push the "In the stmt of do block e1" with
@@ -452,15 +452,15 @@ It stores the original statement (with location) and the expanded expression
      and before moving to the next statement of the `do`-block, we need to first pop the top
      of the error context stack which contains the error message for
      the previous statement: eg. "In the stmt of a do block: e1".
 -    This is explicitly encoded in the expansion expression using
 -    the `XXExprGhcRn.PopErrCtxt`. Whenever `GHC.Tc.Gen.Expr.tcExpr` (via `GHC.Tc.Gen.tcXExpr`)
 -    sees a `PopErrCtxt` it calls `GHC.Tc.Utils.Monad.popErrCtxt` to pop of the top of error context stack.
 -    See ‹PopErrCtxt› in the example above.
 -    Without this popping business for error context stack,
 -    if there is a type error in `e2`, we would get a spurious and confusing error message
 +    This popping is implicitly done when we push the error context message for the next statment.
 +    See Note [ErrCtxtStack Manipulation] and `LclEnv.setLclCtxtSrcCodeOrigin`
++
 +    Sans the popping business for error context stack,
 +    if there were to be a type error in `e2`, we would get a spurious and confusing error message
      which mentions "In the stmt of a do block e1" along with the message
      "In the stmt of a do block e2".
++
    B. Expanding Bind Statements
    -----------------------------
    A `do`-block with a bind statement:
@@ -473,7 +473,7 @@ It stores the original statement (with location) and the expanded expression
                                                                                --
           (‹ExpandedThingRn (p <- e1)›                                         -- Original Statement
                          (((>>=) e1)                                           -- Expanded Expression
 -                           ‹PopErrCtxt› ((\ p -> ‹ExpandedThingRn (e2)› e2)))
 +                           ((\ p -> ‹ExpandedThingRn (e2)› e2)))
+          )

compiler/GHC/Tc/Gen/Head.hs

@@ -469,7 +469,7 @@ tcInferAppHead_maybe fun = case fun of
        ExprWithTySig _ e hs_ty     -> Just <$> with_get_ds (tcExprWithSig e hs_ty)
        HsOverLit _ lit             -> Just <$> with_get_ds (tcInferOverLit lit)
        XExpr (HsRecSelRn f)        -> Just <$> with_get_ds (tcInferRecSelId f)
 -      XExpr (ExpandedThingRn o e) -> Just <$> (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $
 +      XExpr (ExpandedThingRn o e) -> Just <$> (-- addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $
                                                -- We do not want to instantiate the type of the head as there may be
                                                -- visible type applications in the argument.
                                                -- c.f. T19167