| ... |
... |
@@ -32,7 +32,8 @@ import GHC.Tc.Gen.HsType |
|
32
|
32
|
import GHC.Tc.Utils.Concrete ( unifyConcrete, idConcreteTvs )
|
|
33
|
33
|
import GHC.Tc.Utils.TcMType
|
|
34
|
34
|
import GHC.Tc.Types.Evidence
|
|
35
|
|
-import GHC.Tc.Types.ErrCtxt ( FunAppCtxtFunArg(..) )
|
|
|
35
|
+import GHC.Tc.Types.ErrCtxt ( FunAppCtxtFunArg(..), ErrCtxt (..) )
|
|
|
36
|
+import GHC.Tc.Errors.Ppr (pprErrCtxtMsg)
|
|
36
|
37
|
import GHC.Tc.Types.Origin
|
|
37
|
38
|
import GHC.Tc.Utils.TcType as TcType
|
|
38
|
39
|
import GHC.Tc.Utils.Concrete( hasFixedRuntimeRep_syntactic )
|
| ... |
... |
@@ -943,9 +944,18 @@ addArgCtxt :: Int -> HsExpr GhcRn -> LHsExpr GhcRn |
|
943
|
944
|
-- See Note [Expanding HsDo with XXExprGhcRn] in GHC.Tc.Gen.Do
|
|
944
|
945
|
addArgCtxt arg_no fun (L arg_loc arg) thing_inside
|
|
945
|
946
|
= do { in_generated_code <- inGeneratedCode
|
|
|
947
|
+ ; err_ctx <- getErrCtxt
|
|
|
948
|
+ ; env0 <- liftZonkM tcInitTidyEnv
|
|
|
949
|
+ ; err_ctx_msg <- mkErrCtxt env0 err_ctx
|
|
946
|
950
|
; traceTc "addArgCtxt" (vcat [ text "generated:" <+> ppr in_generated_code
|
|
947
|
951
|
, text "arg: " <+> ppr arg
|
|
948
|
|
- , text "arg_loc" <+> ppr arg_loc])
|
|
|
952
|
+ , text "arg_loc:" <+> ppr arg_loc
|
|
|
953
|
+ , text "fun:" <+> ppr fun
|
|
|
954
|
+ , text "err_ctx" <+> vcat (fmap (\ (x, y) -> case x of
|
|
|
955
|
+ UserCodeCtxt{} -> text "<USER>" <+> pprErrCtxtMsg y
|
|
|
956
|
+ ExpansionCodeCtxt{} -> text "<EXPN>" <+> pprErrCtxtMsg y)
|
|
|
957
|
+ (take 2 (zip err_ctx err_ctx_msg)))
|
|
|
958
|
+ ])
|
|
949
|
959
|
; if in_generated_code
|
|
950
|
960
|
then updCtxtForArg (locA arg_loc) arg $
|
|
951
|
961
|
thing_inside
|