import TcType
import InstEnv
import FamInstEnv
+import PrelNames ( iNTERACTIVE )
import Var
import Id
keep_var <- newIORef emptyNameSet ;
used_rdr_var <- newIORef Set.empty ;
th_var <- newIORef False ;
- lie_var <- newIORef emptyBag ;
+ lie_var <- newIORef emptyWC ;
dfun_n_var <- newIORef emptyOccSet ;
type_env_var <- case hsc_type_env_var hsc_env of {
Just (_mod, te_var) -> return te_var ;
tcg_warns = NoWarnings,
tcg_anns = [],
tcg_insts = [],
- tcg_fam_insts = [],
- tcg_rules = [],
- tcg_fords = [],
- tcg_dfun_n = dfun_n_var,
- tcg_keep = keep_var,
+ tcg_fam_insts = [],
+ tcg_rules = [],
+ tcg_fords = [],
+ tcg_vects = [],
+ tcg_dfun_n = dfun_n_var,
+ tcg_keep = keep_var,
tcg_doc_hdr = Nothing,
tcg_hpc = False,
tcg_main = Nothing
-- Check for unsolved constraints
lie <- readIORef lie_var ;
- if isEmptyBag lie
+ if isEmptyWC lie
then return ()
else pprPanic "initTc: unsolved constraints"
(pprWantedsWithLocs lie) ;
setModule :: Module -> TcRn a -> TcRn a
setModule mod thing_inside = updGblEnv (\env -> env { tcg_mod = mod }) thing_inside
+getIsGHCi :: TcRn Bool
+getIsGHCi = do { mod <- getModule; return (mod == iNTERACTIVE) }
+
tcIsHsBoot :: TcRn Bool
tcIsHsBoot = do { env <- getGblEnv; return (isHsBoot (tcg_src env)) }
updCtxt upd = updLclEnv (\ env@(TcLclEnv { tcl_ctxt = ctxt }) ->
env { tcl_ctxt = upd ctxt })
--- Conditionally add an error context
-maybeAddErrCtxt :: Maybe Message -> TcM a -> TcM a
-maybeAddErrCtxt (Just msg) thing_inside = addErrCtxt msg thing_inside
-maybeAddErrCtxt Nothing thing_inside = thing_inside
-
popErrCtxt :: TcM a -> TcM a
popErrCtxt = updCtxt (\ msgs -> case msgs of { [] -> []; (_ : ms) -> ms })
emitConstraints :: WantedConstraints -> TcM ()
emitConstraints ct
= do { lie_var <- getConstraintVar ;
- updTcRef lie_var (`andWanteds` ct) }
+ updTcRef lie_var (`andWC` ct) }
+
+emitFlat :: WantedEvVar -> TcM ()
+emitFlat ct
+ = do { lie_var <- getConstraintVar ;
+ updTcRef lie_var (`addFlats` unitBag ct) }
+
+emitFlats :: Bag WantedEvVar -> TcM ()
+emitFlats ct
+ = do { lie_var <- getConstraintVar ;
+ updTcRef lie_var (`addFlats` ct) }
+
+emitImplication :: Implication -> TcM ()
+emitImplication ct
+ = do { lie_var <- getConstraintVar ;
+ updTcRef lie_var (`addImplics` unitBag ct) }
-emitConstraint :: WantedConstraint -> TcM ()
-emitConstraint ct
+emitImplications :: Bag Implication -> TcM ()
+emitImplications ct
= do { lie_var <- getConstraintVar ;
- updTcRef lie_var (`extendWanteds` ct) }
+ updTcRef lie_var (`addImplics` ct) }
captureConstraints :: TcM a -> TcM (a, WantedConstraints)
-- (captureConstraints m) runs m, and returns the type constraints it generates
captureConstraints thing_inside
- = do { lie_var <- newTcRef emptyWanteds ;
+ = do { lie_var <- newTcRef emptyWC ;
res <- updLclEnv (\ env -> env { tcl_lie = lie_var })
thing_inside ;
lie <- readTcRef lie_var ;