A collection of type-inference refactorings.
[ghc.git] / compiler / typecheck / TcPluginM.hs
1 {-# LANGUAGE CPP #-}
2 -- | This module provides an interface for typechecker plugins to
3 -- access select functions of the 'TcM', principally those to do with
4 -- reading parts of the state.
5 module TcPluginM (
6 #ifdef GHCI
7 -- * Basic TcPluginM functionality
8 TcPluginM,
9 tcPluginIO,
10 tcPluginTrace,
11 unsafeTcPluginTcM,
12
13 -- * Finding Modules and Names
14 FindResult(..),
15 findImportedModule,
16 lookupOrig,
17
18 -- * Looking up Names in the typechecking environment
19 tcLookupGlobal,
20 tcLookupTyCon,
21 tcLookupDataCon,
22 tcLookupClass,
23 tcLookup,
24 tcLookupId,
25
26 -- * Getting the TcM state
27 getTopEnv,
28 getEnvs,
29 getInstEnvs,
30 getFamInstEnvs,
31 matchFam,
32
33 -- * Type variables
34 newUnique,
35 newFlexiTyVar,
36 isTouchableTcPluginM,
37
38 -- * Zonking
39 zonkTcType,
40 zonkCt,
41
42 -- * Creating constraints
43 newWanted,
44 newDerived,
45 newGiven,
46 newCoercionHole,
47
48 -- * Manipulating evidence bindings
49 newEvVar,
50 setEvBind,
51 getEvBindsTcPluginM
52 #endif
53 ) where
54
55 #ifdef GHCI
56 import qualified TcRnMonad as TcM
57 import qualified TcSMonad as TcS
58 import qualified TcEnv as TcM
59 import qualified TcMType as TcM
60 import qualified FamInst as TcM
61 import qualified IfaceEnv
62 import qualified Finder
63
64 import FamInstEnv ( FamInstEnv )
65 import TcRnMonad ( TcGblEnv, TcLclEnv, Ct, CtLoc, TcPluginM
66 , unsafeTcPluginTcM, getEvBindsTcPluginM
67 , liftIO, traceTc )
68 import TcMType ( TcTyVar, TcType )
69 import TcEnv ( TcTyThing )
70 import TcEvidence ( TcCoercion, CoercionHole
71 , EvTerm, EvBind, mkGivenEvBind )
72 import TcRnTypes ( CtEvidence(..) )
73 import Var ( EvVar )
74
75 import Module
76 import Name
77 import TyCon
78 import DataCon
79 import Class
80 import HscTypes
81 import Outputable
82 import Type
83 import Id
84 import InstEnv
85 import FastString
86 import Unique
87
88
89 -- | Perform some IO, typically to interact with an external tool.
90 tcPluginIO :: IO a -> TcPluginM a
91 tcPluginIO a = unsafeTcPluginTcM (liftIO a)
92
93 -- | Output useful for debugging the compiler.
94 tcPluginTrace :: String -> SDoc -> TcPluginM ()
95 tcPluginTrace a b = unsafeTcPluginTcM (traceTc a b)
96
97
98 findImportedModule :: ModuleName -> Maybe FastString -> TcPluginM FindResult
99 findImportedModule mod_name mb_pkg = do
100 hsc_env <- getTopEnv
101 tcPluginIO $ Finder.findImportedModule hsc_env mod_name mb_pkg
102
103 lookupOrig :: Module -> OccName -> TcPluginM Name
104 lookupOrig mod = unsafeTcPluginTcM . IfaceEnv.lookupOrig mod
105
106
107 tcLookupGlobal :: Name -> TcPluginM TyThing
108 tcLookupGlobal = unsafeTcPluginTcM . TcM.tcLookupGlobal
109
110 tcLookupTyCon :: Name -> TcPluginM TyCon
111 tcLookupTyCon = unsafeTcPluginTcM . TcM.tcLookupTyCon
112
113 tcLookupDataCon :: Name -> TcPluginM DataCon
114 tcLookupDataCon = unsafeTcPluginTcM . TcM.tcLookupDataCon
115
116 tcLookupClass :: Name -> TcPluginM Class
117 tcLookupClass = unsafeTcPluginTcM . TcM.tcLookupClass
118
119 tcLookup :: Name -> TcPluginM TcTyThing
120 tcLookup = unsafeTcPluginTcM . TcM.tcLookup
121
122 tcLookupId :: Name -> TcPluginM Id
123 tcLookupId = unsafeTcPluginTcM . TcM.tcLookupId
124
125
126 getTopEnv :: TcPluginM HscEnv
127 getTopEnv = unsafeTcPluginTcM TcM.getTopEnv
128
129 getEnvs :: TcPluginM (TcGblEnv, TcLclEnv)
130 getEnvs = unsafeTcPluginTcM TcM.getEnvs
131
132 getInstEnvs :: TcPluginM InstEnvs
133 getInstEnvs = unsafeTcPluginTcM TcM.tcGetInstEnvs
134
135 getFamInstEnvs :: TcPluginM (FamInstEnv, FamInstEnv)
136 getFamInstEnvs = unsafeTcPluginTcM TcM.tcGetFamInstEnvs
137
138 matchFam :: TyCon -> [Type]
139 -> TcPluginM (Maybe (TcCoercion, TcType))
140 matchFam tycon args = unsafeTcPluginTcM $ TcS.matchFamTcM tycon args
141
142 newUnique :: TcPluginM Unique
143 newUnique = unsafeTcPluginTcM TcM.newUnique
144
145 newFlexiTyVar :: Kind -> TcPluginM TcTyVar
146 newFlexiTyVar = unsafeTcPluginTcM . TcM.newFlexiTyVar
147
148 isTouchableTcPluginM :: TcTyVar -> TcPluginM Bool
149 isTouchableTcPluginM = unsafeTcPluginTcM . TcM.isTouchableTcM
150
151 -- Confused by zonking? See Note [What is zonking?] in TcMType.
152 zonkTcType :: TcType -> TcPluginM TcType
153 zonkTcType = unsafeTcPluginTcM . TcM.zonkTcType
154
155 zonkCt :: Ct -> TcPluginM Ct
156 zonkCt = unsafeTcPluginTcM . TcM.zonkCt
157
158
159 -- | Create a new wanted constraint.
160 newWanted :: CtLoc -> PredType -> TcPluginM CtEvidence
161 newWanted loc pty
162 = unsafeTcPluginTcM (TcM.newWanted (TcM.ctLocOrigin loc) Nothing pty)
163
164 -- | Create a new derived constraint.
165 newDerived :: CtLoc -> PredType -> TcPluginM CtEvidence
166 newDerived loc pty = return CtDerived { ctev_pred = pty, ctev_loc = loc }
167
168 -- | Create a new given constraint, with the supplied evidence. This
169 -- must not be invoked from 'tcPluginInit' or 'tcPluginStop', or it
170 -- will panic.
171 newGiven :: CtLoc -> PredType -> EvTerm -> TcPluginM CtEvidence
172 newGiven loc pty evtm = do
173 new_ev <- newEvVar pty
174 setEvBind $ mkGivenEvBind new_ev evtm
175 return CtGiven { ctev_pred = pty, ctev_evar = new_ev, ctev_loc = loc }
176
177 -- | Create a fresh evidence variable.
178 newEvVar :: PredType -> TcPluginM EvVar
179 newEvVar = unsafeTcPluginTcM . TcM.newEvVar
180
181 -- | Create a fresh coercion hole.
182 newCoercionHole :: TcPluginM CoercionHole
183 newCoercionHole = unsafeTcPluginTcM $ TcM.newCoercionHole
184
185 -- | Bind an evidence variable. This must not be invoked from
186 -- 'tcPluginInit' or 'tcPluginStop', or it will panic.
187 setEvBind :: EvBind -> TcPluginM ()
188 setEvBind ev_bind = do
189 tc_evbinds <- getEvBindsTcPluginM
190 unsafeTcPluginTcM $ TcM.addTcEvBind tc_evbinds ev_bind
191 #endif