-nextDFunIndex :: TcM Int -- Get the next dfun index
-nextDFunIndex = do { env <- getGblEnv
- ; let dfun_n_var = tcg_dfun_n env
- ; n <- readMutVar dfun_n_var
- ; writeMutVar dfun_n_var (n+1)
- ; return n }
-
-getLIEVar :: TcM (TcRef LIE)
-getLIEVar = do { env <- getLclEnv; return (tcl_lie env) }
-
-setLIEVar :: TcRef LIE -> TcM a -> TcM a
-setLIEVar lie_var = updLclEnv (\ env -> env { tcl_lie = lie_var })
-
-getLIE :: TcM a -> TcM (a, [Inst])
--- (getLIE m) runs m, and returns the type constraints it generates
-getLIE thing_inside
- = do { lie_var <- newMutVar emptyLIE ;
- res <- updLclEnv (\ env -> env { tcl_lie = lie_var })
- thing_inside ;
- lie <- readMutVar lie_var ;
- return (res, lieToList lie) }
-
-extendLIE :: Inst -> TcM ()
-extendLIE inst
- = do { lie_var <- getLIEVar ;
- lie <- readMutVar lie_var ;
- writeMutVar lie_var (inst `consLIE` lie) }
-
-extendLIEs :: [Inst] -> TcM ()
-extendLIEs []
- = return ()
-extendLIEs insts
- = do { lie_var <- getLIEVar ;
- lie <- readMutVar lie_var ;
- writeMutVar lie_var (mkLIE insts `plusLIE` lie) }
-\end{code}
+newTcEvBinds :: TcM EvBindsVar
+newTcEvBinds = do { ref <- newTcRef emptyEvBindMap
+ ; uniq <- newUnique
+ ; return (EvBindsVar ref uniq) }
+
+extendTcEvBinds :: TcEvBinds -> EvVar -> EvTerm -> TcM TcEvBinds
+extendTcEvBinds binds@(TcEvBinds binds_var) var rhs
+ = do { addTcEvBind binds_var var rhs
+ ; return binds }
+extendTcEvBinds (EvBinds bnds) var rhs
+ = return (EvBinds (bnds `snocBag` EvBind var rhs))
+
+addTcEvBind :: EvBindsVar -> EvVar -> EvTerm -> TcM ()
+-- Add a binding to the TcEvBinds by side effect
+addTcEvBind (EvBindsVar ev_ref _) var rhs
+ = do { bnds <- readTcRef ev_ref
+ ; writeTcRef ev_ref (extendEvBinds bnds var rhs) }
+
+chooseUniqueOccTc :: (OccSet -> OccName) -> TcM OccName
+chooseUniqueOccTc fn =
+ do { env <- getGblEnv
+ ; let dfun_n_var = tcg_dfun_n env
+ ; set <- readTcRef dfun_n_var
+ ; let occ = fn set
+ ; writeTcRef dfun_n_var (extendOccSet set occ)
+ ; return occ }
+
+getConstraintVar :: TcM (TcRef WantedConstraints)
+getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) }
+
+setConstraintVar :: TcRef WantedConstraints -> TcM a -> TcM a
+setConstraintVar lie_var = updLclEnv (\ env -> env { tcl_lie = lie_var })
+
+emitConstraints :: WantedConstraints -> TcM ()
+emitConstraints ct
+ = do { lie_var <- getConstraintVar ;
+ 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) }
+
+emitImplications :: Bag Implication -> TcM ()
+emitImplications ct
+ = do { lie_var <- getConstraintVar ;
+ 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 emptyWC ;
+ res <- updLclEnv (\ env -> env { tcl_lie = lie_var })
+ thing_inside ;
+ lie <- readTcRef lie_var ;
+ return (res, lie) }
+
+captureUntouchables :: TcM a -> TcM (a, Untouchables)
+captureUntouchables thing_inside
+ = do { env <- getLclEnv
+ ; low_meta <- readTcRef (tcl_meta env)
+ ; res <- setLclEnv (env { tcl_untch = low_meta })
+ thing_inside
+ ; high_meta <- readTcRef (tcl_meta env)
+ ; return (res, TouchableRange low_meta high_meta) }
+
+isUntouchable :: TcTyVar -> TcM Bool
+isUntouchable tv = do { env <- getLclEnv
+ ; return (varUnique tv < tcl_untch env) }
+
+getLclTypeEnv :: TcM (NameEnv TcTyThing)
+getLclTypeEnv = do { env <- getLclEnv; return (tcl_env env) }