| ... |
... |
@@ -238,6 +238,7 @@ import Data.IORef |
|
238
|
238
|
import Control.Monad
|
|
239
|
239
|
|
|
240
|
240
|
import qualified Data.Map as Map
|
|
|
241
|
+import Data.List (tails)
|
|
241
|
242
|
import GHC.Core.Coercion (isReflCo)
|
|
242
|
243
|
|
|
243
|
244
|
|
| ... |
... |
@@ -1226,14 +1227,14 @@ setErrCtxt ctxt = updLclEnv (setLclEnvErrCtxt ctxt) |
|
1226
|
1227
|
|
|
1227
|
1228
|
-- | Add a fixed message to the error context. This message should not
|
|
1228
|
1229
|
-- do any tidying.
|
|
1229
|
|
--- no op in generated code
|
|
|
1230
|
+-- NB. No op in generated code
|
|
1230
|
1231
|
-- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
|
|
1231
|
1232
|
addErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a
|
|
1232
|
1233
|
{-# INLINE addErrCtxt #-} -- Note [Inlining addErrCtxt]
|
|
1233
|
1234
|
addErrCtxt msg = addErrCtxtM (\env -> return (env, msg))
|
|
1234
|
1235
|
|
|
1235
|
1236
|
-- | Add a message to the error context. This message may do tidying.
|
|
1236
|
|
--- no op in generated code
|
|
|
1237
|
+-- NB. No op in generated code
|
|
1237
|
1238
|
-- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
|
|
1238
|
1239
|
addErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
|
|
1239
|
1240
|
{-# INLINE addErrCtxtM #-} -- Note [Inlining addErrCtxt]
|
| ... |
... |
@@ -1719,12 +1720,13 @@ mkErrCtxt env ctxts |
|
1719
|
1720
|
-- if dbg -- In -dppr-debug style the output
|
|
1720
|
1721
|
-- then return empty -- just becomes too voluminous
|
|
1721
|
1722
|
-- else go dbg 0 env ctxts
|
|
1722
|
|
- = go False 0 env ctxts
|
|
|
1723
|
+ = do xs <- go False 0 env ctxts
|
|
|
1724
|
+ return $ take mAX_CONTEXTS (filter_stmt_adj xs)
|
|
1723
|
1725
|
where
|
|
1724
|
1726
|
go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
|
|
1725
|
1727
|
go _ _ _ [] = return []
|
|
1726
|
1728
|
go dbg n env ((is_landmark, ctxt) : ctxts)
|
|
1727
|
|
- | is_landmark || n < mAX_CONTEXTS -- Too verbose || dbg
|
|
|
1729
|
+ | is_landmark || n < (mAX_CONTEXTS + 1) -- Too verbose || dbg
|
|
1728
|
1730
|
= do { (env', msg) <- liftZonkM $ ctxt env
|
|
1729
|
1731
|
; let n' = if is_landmark then n else n+1
|
|
1730
|
1732
|
; rest <- go dbg n' env' ctxts
|
| ... |
... |
@@ -1732,6 +1734,14 @@ mkErrCtxt env ctxts |
|
1732
|
1734
|
| otherwise
|
|
1733
|
1735
|
= go dbg n env ctxts
|
|
1734
|
1736
|
|
|
|
1737
|
+ filter_stmt_adj :: [ErrCtxtMsg] -> [ErrCtxtMsg]
|
|
|
1738
|
+ filter_stmt_adj = concat . map stmtAdj . tails
|
|
|
1739
|
+
|
|
|
1740
|
+ stmtAdj :: [ErrCtxtMsg] -> [ErrCtxtMsg]
|
|
|
1741
|
+ stmtAdj (ExprCtxt{} : StmtErrCtxt{} : _ ) = []
|
|
|
1742
|
+ stmtAdj (s : _ ) = [s]
|
|
|
1743
|
+ stmtAdj xs = xs
|
|
|
1744
|
+
|
|
1735
|
1745
|
mAX_CONTEXTS :: Int -- No more than this number of non-landmark contexts
|
|
1736
|
1746
|
mAX_CONTEXTS = 3
|
|
1737
|
1747
|
|