| ... |
... |
@@ -1226,14 +1226,14 @@ setErrCtxt ctxt = updLclEnv (setLclEnvErrCtxt ctxt) |
|
1226
|
1226
|
|
|
1227
|
1227
|
-- | Add a fixed message to the error context. This message should not
|
|
1228
|
1228
|
-- do any tidying.
|
|
1229
|
|
--- no op in generated code
|
|
|
1229
|
+-- NB. No op in generated code
|
|
1230
|
1230
|
-- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
|
|
1231
|
1231
|
addErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a
|
|
1232
|
1232
|
{-# INLINE addErrCtxt #-} -- Note [Inlining addErrCtxt]
|
|
1233
|
1233
|
addErrCtxt msg = addErrCtxtM (\env -> return (env, msg))
|
|
1234
|
1234
|
|
|
1235
|
1235
|
-- | Add a message to the error context. This message may do tidying.
|
|
1236
|
|
--- no op in generated code
|
|
|
1236
|
+-- NB. No op in generated code
|
|
1237
|
1237
|
-- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
|
|
1238
|
1238
|
addErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
|
|
1239
|
1239
|
{-# INLINE addErrCtxtM #-} -- Note [Inlining addErrCtxt]
|
| ... |
... |
@@ -1720,9 +1720,26 @@ mkErrCtxt env ctxts |
|
1720
|
1720
|
-- then return empty -- just becomes too voluminous
|
|
1721
|
1721
|
-- else go dbg 0 env ctxts
|
|
1722
|
1722
|
= go False 0 env ctxts
|
|
|
1723
|
+
|
|
1723
|
1724
|
where
|
|
1724
|
1725
|
go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
|
|
1725
|
1726
|
go _ _ _ [] = return []
|
|
|
1727
|
+ go dbg n env ((is_landmark1, ctxt1) : (is_landmark2, ctxt2) : ctxts)
|
|
|
1728
|
+ | is_landmark1 || n < mAX_CONTEXTS -- Too verbose || dbg
|
|
|
1729
|
+ = do { (env', msg1) <- liftZonkM $ ctxt1 env
|
|
|
1730
|
+ ; (env'', msg2) <- liftZonkM $ ctxt2 env'
|
|
|
1731
|
+ ; case (msg1, msg2) of
|
|
|
1732
|
+ (ExprCtxt{}, StmtErrCtxt (HsDoStmt (DoExpr{})) _)
|
|
|
1733
|
+ -> do { let n' = if is_landmark2 then n else n+1
|
|
|
1734
|
+ ; rest <- go dbg n' env' ctxts
|
|
|
1735
|
+ ; return (msg2 : rest) }
|
|
|
1736
|
+ _
|
|
|
1737
|
+ -> do { let n' = if is_landmark1 then n else n+1
|
|
|
1738
|
+ ; rest <- go dbg n' env' ((is_landmark2, ctxt2) : ctxts)
|
|
|
1739
|
+ ; return (msg1 : rest) }
|
|
|
1740
|
+ }
|
|
|
1741
|
+ | otherwise
|
|
|
1742
|
+ = go dbg n env ((is_landmark2, ctxt2) : ctxts)
|
|
1726
|
1743
|
go dbg n env ((is_landmark, ctxt) : ctxts)
|
|
1727
|
1744
|
| is_landmark || n < mAX_CONTEXTS -- Too verbose || dbg
|
|
1728
|
1745
|
= do { (env', msg) <- liftZonkM $ ctxt env
|
| ... |
... |
@@ -1732,6 +1749,14 @@ mkErrCtxt env ctxts |
|
1732
|
1749
|
| otherwise
|
|
1733
|
1750
|
= go dbg n env ctxts
|
|
1734
|
1751
|
|
|
|
1752
|
+ -- filter_stmt_adj :: [ErrCtxtMsg] -> [ErrCtxtMsg]
|
|
|
1753
|
+ -- filter_stmt_adj = concat . map stmtAdj . tails
|
|
|
1754
|
+
|
|
|
1755
|
+ -- stmtAdj :: [ErrCtxtMsg] -> [ErrCtxtMsg]
|
|
|
1756
|
+ -- stmtAdj (ExprCtxt{} : StmtErrCtxt{} : _ ) = []
|
|
|
1757
|
+ -- stmtAdj (s : _ ) = [s]
|
|
|
1758
|
+ -- stmtAdj xs = xs
|
|
|
1759
|
+
|
|
1735
|
1760
|
mAX_CONTEXTS :: Int -- No more than this number of non-landmark contexts
|
|
1736
|
1761
|
mAX_CONTEXTS = 3
|
|
1737
|
1762
|
|