Commit 81928d04 authored by Joachim Breitner's avatar Joachim Breitner
Browse files

Expose more in the TcS monad

in preparation for the Coercible class implementation.
parent e239753c
...@@ -38,12 +38,15 @@ module TcSMonad ( ...@@ -38,12 +38,15 @@ module TcSMonad (
-- Getting and setting the flattening cache -- Getting and setting the flattening cache
addSolvedDict, addSolvedFunEq, getFlattenSkols, addSolvedDict, addSolvedFunEq, getFlattenSkols,
-- Marking stuff as used
addUsedRdrNamesTcS,
deferTcSForAllEq, deferTcSForAllEq,
setEvBind, setEvBind,
XEvTerm(..), XEvTerm(..),
MaybeNew (..), isFresh, freshGoals, getEvTerms, MaybeNew (..), isFresh, freshGoal, freshGoals, getEvTerm, getEvTerms,
xCtFlavor, -- Transform a CtEvidence during a step xCtFlavor, -- Transform a CtEvidence during a step
rewriteCtFlavor, -- Specialized version of xCtFlavor for coercions rewriteCtFlavor, -- Specialized version of xCtFlavor for coercions
...@@ -85,7 +88,7 @@ module TcSMonad ( ...@@ -85,7 +88,7 @@ module TcSMonad (
Untouchables, isTouchableMetaTyVarTcS, isFilledMetaTyVar_maybe, Untouchables, isTouchableMetaTyVarTcS, isFilledMetaTyVar_maybe,
zonkTyVarsAndFV, zonkTyVarsAndFV,
getDefaultInfo, getDynFlags, getDefaultInfo, getDynFlags, getGlobalRdrEnvTcS,
matchFam, matchOpenFam, matchFam, matchOpenFam,
checkWellStagedDFun, checkWellStagedDFun,
...@@ -119,6 +122,8 @@ import Class ...@@ -119,6 +122,8 @@ import Class
import TyCon import TyCon
import Name import Name
import RdrName (RdrName, GlobalRdrEnv)
import RnEnv (addUsedRdrNames)
import Var import Var
import VarEnv import VarEnv
import Outputable import Outputable
...@@ -1012,6 +1017,9 @@ traceTcS herald doc = wrapTcS (TcM.traceTc herald doc) ...@@ -1012,6 +1017,9 @@ traceTcS herald doc = wrapTcS (TcM.traceTc herald doc)
instance HasDynFlags TcS where instance HasDynFlags TcS where
getDynFlags = wrapTcS getDynFlags getDynFlags = wrapTcS getDynFlags
getGlobalRdrEnvTcS :: TcS GlobalRdrEnv
getGlobalRdrEnvTcS = wrapTcS TcM.getGlobalRdrEnv
bumpStepCountTcS :: TcS () bumpStepCountTcS :: TcS ()
bumpStepCountTcS = TcS $ \env -> do { let ref = tcs_count env bumpStepCountTcS = TcS $ \env -> do { let ref = tcs_count env
; n <- TcM.readTcRef ref ; n <- TcM.readTcRef ref
...@@ -1275,6 +1283,12 @@ getTopEnv = wrapTcS $ TcM.getTopEnv ...@@ -1275,6 +1283,12 @@ getTopEnv = wrapTcS $ TcM.getTopEnv
getGblEnv :: TcS TcGblEnv getGblEnv :: TcS TcGblEnv
getGblEnv = wrapTcS $ TcM.getGblEnv getGblEnv = wrapTcS $ TcM.getGblEnv
-- Setting names as used (used in the deriving of Coercible evidence)
-- Too hackish to expose it to TcS? In that case somehow extract the used
-- constructors from the result of solveInteract
addUsedRdrNamesTcS :: [RdrName] -> TcS ()
addUsedRdrNamesTcS names = wrapTcS $ addUsedRdrNames names
-- Various smaller utilities [TODO, maybe will be absorbed in the instance matcher] -- Various smaller utilities [TODO, maybe will be absorbed in the instance matcher]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
...@@ -1474,6 +1488,10 @@ getEvTerm (Cached tm) = tm ...@@ -1474,6 +1488,10 @@ getEvTerm (Cached tm) = tm
getEvTerms :: [MaybeNew] -> [EvTerm] getEvTerms :: [MaybeNew] -> [EvTerm]
getEvTerms = map getEvTerm getEvTerms = map getEvTerm
freshGoal :: MaybeNew -> Maybe CtEvidence
freshGoal (Fresh ctev) = Just ctev
freshGoal _ = Nothing
freshGoals :: [MaybeNew] -> [CtEvidence] freshGoals :: [MaybeNew] -> [CtEvidence]
freshGoals mns = [ ctev | Fresh ctev <- mns ] freshGoals mns = [ ctev | Fresh ctev <- mns ]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment