diff options
Diffstat (limited to 'compiler/GHC/Tc/Utils/Monad.hs')
| -rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index 2fc741ce6f..d7fbd2e095 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -98,7 +98,8 @@ module GHC.Tc.Utils.Monad( chooseUniqueOccTc, getConstraintVar, setConstraintVar, emitConstraints, emitStaticConstraints, emitSimple, emitSimples, - emitImplication, emitImplications, emitInsoluble, emitHole, + emitImplication, emitImplications, emitInsoluble, + emitHole, emitHoles, discardConstraints, captureConstraints, tryCaptureConstraints, pushLevelAndCaptureConstraints, pushTcLevelM_, pushTcLevelM, pushTcLevelsM, @@ -1145,7 +1146,7 @@ askNoErrs thing_inside ; addMessages msgs ; case mb_res of - Nothing -> do { emitConstraints (insolublesOnly lie) + Nothing -> do { emitConstraints (dropMisleading lie) ; failM } Just res -> do { emitConstraints lie @@ -1167,7 +1168,7 @@ tryCaptureConstraints thing_inside -- See Note [Constraints and errors] ; let lie_to_keep = case mb_res of - Nothing -> insolublesOnly lie + Nothing -> dropMisleading lie Just {} -> lie ; return (mb_res, lie_to_keep) } @@ -1589,7 +1590,13 @@ emitHole :: Hole -> TcM () emitHole hole = do { traceTc "emitHole" (ppr hole) ; lie_var <- getConstraintVar - ; updTcRef lie_var (`addHole` hole) } + ; updTcRef lie_var (`addHoles` unitBag hole) } + +emitHoles :: Bag Hole -> TcM () +emitHoles holes + = do { traceTc "emitHoles" (ppr holes) + ; lie_var <- getConstraintVar + ; updTcRef lie_var (`addHoles` holes) } -- | Throw out any constraints emitted by the thing_inside discardConstraints :: TcM a -> TcM a |