never executed always true always false
1
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 GHC.Tc.Plugin (
6 -- * Basic TcPluginM functionality
7 TcPluginM,
8 tcPluginIO,
9 tcPluginTrace,
10 unsafeTcPluginTcM,
11
12 -- * Finding Modules and Names
13 Finder.FindResult(..),
14 findImportedModule,
15 lookupOrig,
16
17 -- * Looking up Names in the typechecking environment
18 tcLookupGlobal,
19 tcLookupTyCon,
20 tcLookupDataCon,
21 tcLookupClass,
22 tcLookup,
23 tcLookupId,
24
25 -- * Getting the TcM state
26 getTopEnv,
27 getTargetPlatform,
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 ) where
52
53 import GHC.Prelude
54
55 import GHC.Platform (Platform)
56
57 import qualified GHC.Tc.Utils.Monad as TcM
58 import qualified GHC.Tc.Solver.Monad as TcS
59 import qualified GHC.Tc.Utils.Env as TcM
60 import qualified GHC.Tc.Utils.TcMType as TcM
61 import qualified GHC.Tc.Instance.Family as TcM
62 import qualified GHC.Iface.Env as IfaceEnv
63 import qualified GHC.Unit.Finder as Finder
64
65 import GHC.Core.FamInstEnv ( FamInstEnv )
66 import GHC.Tc.Utils.Monad ( TcGblEnv, TcLclEnv, TcPluginM
67 , unsafeTcPluginTcM
68 , liftIO, traceTc )
69 import GHC.Tc.Types.Constraint ( Ct, CtLoc, CtEvidence(..), ctLocOrigin )
70 import GHC.Tc.Utils.TcMType ( TcTyVar, TcType )
71 import GHC.Tc.Utils.Env ( TcTyThing )
72 import GHC.Tc.Types.Evidence ( CoercionHole, EvTerm(..)
73 , EvExpr, EvBindsVar, EvBind, mkGivenEvBind )
74 import GHC.Types.Var ( EvVar )
75
76 import GHC.Unit.Module ( ModuleName, Module )
77 import GHC.Types.Name ( OccName, Name )
78 import GHC.Types.TyThing ( TyThing )
79 import GHC.Core.Reduction ( Reduction )
80 import GHC.Core.TyCon ( TyCon )
81 import GHC.Core.DataCon ( DataCon )
82 import GHC.Core.Class ( Class )
83 import GHC.Driver.Config.Finder ( initFinderOpts )
84 import GHC.Driver.Env ( HscEnv(..), hsc_home_unit, hsc_units )
85 import GHC.Utils.Outputable ( SDoc )
86 import GHC.Core.Type ( Kind, Type, PredType )
87 import GHC.Types.Id ( Id )
88 import GHC.Core.InstEnv ( InstEnvs )
89 import GHC.Types.Unique ( Unique )
90 import GHC.Types.PkgQual ( PkgQual )
91
92
93 -- | Perform some IO, typically to interact with an external tool.
94 tcPluginIO :: IO a -> TcPluginM a
95 tcPluginIO a = unsafeTcPluginTcM (liftIO a)
96
97 -- | Output useful for debugging the compiler.
98 tcPluginTrace :: String -> SDoc -> TcPluginM ()
99 tcPluginTrace a b = unsafeTcPluginTcM (traceTc a b)
100
101
102 findImportedModule :: ModuleName -> PkgQual -> TcPluginM Finder.FindResult
103 findImportedModule mod_name mb_pkg = do
104 hsc_env <- getTopEnv
105 let fc = hsc_FC hsc_env
106 let home_unit = hsc_home_unit hsc_env
107 let units = hsc_units hsc_env
108 let dflags = hsc_dflags hsc_env
109 let fopts = initFinderOpts dflags
110 tcPluginIO $ Finder.findImportedModule fc fopts units home_unit mod_name mb_pkg
111
112 lookupOrig :: Module -> OccName -> TcPluginM Name
113 lookupOrig mod = unsafeTcPluginTcM . IfaceEnv.lookupOrig mod
114
115
116 tcLookupGlobal :: Name -> TcPluginM TyThing
117 tcLookupGlobal = unsafeTcPluginTcM . TcM.tcLookupGlobal
118
119 tcLookupTyCon :: Name -> TcPluginM TyCon
120 tcLookupTyCon = unsafeTcPluginTcM . TcM.tcLookupTyCon
121
122 tcLookupDataCon :: Name -> TcPluginM DataCon
123 tcLookupDataCon = unsafeTcPluginTcM . TcM.tcLookupDataCon
124
125 tcLookupClass :: Name -> TcPluginM Class
126 tcLookupClass = unsafeTcPluginTcM . TcM.tcLookupClass
127
128 tcLookup :: Name -> TcPluginM TcTyThing
129 tcLookup = unsafeTcPluginTcM . TcM.tcLookup
130
131 tcLookupId :: Name -> TcPluginM Id
132 tcLookupId = unsafeTcPluginTcM . TcM.tcLookupId
133
134
135 getTopEnv :: TcPluginM HscEnv
136 getTopEnv = unsafeTcPluginTcM TcM.getTopEnv
137
138 getTargetPlatform :: TcPluginM Platform
139 getTargetPlatform = unsafeTcPluginTcM TcM.getPlatform
140
141
142 getEnvs :: TcPluginM (TcGblEnv, TcLclEnv)
143 getEnvs = unsafeTcPluginTcM TcM.getEnvs
144
145 getInstEnvs :: TcPluginM InstEnvs
146 getInstEnvs = unsafeTcPluginTcM TcM.tcGetInstEnvs
147
148 getFamInstEnvs :: TcPluginM (FamInstEnv, FamInstEnv)
149 getFamInstEnvs = unsafeTcPluginTcM TcM.tcGetFamInstEnvs
150
151 matchFam :: TyCon -> [Type]
152 -> TcPluginM (Maybe Reduction)
153 matchFam tycon args = unsafeTcPluginTcM $ TcS.matchFamTcM tycon args
154
155 newUnique :: TcPluginM Unique
156 newUnique = unsafeTcPluginTcM TcM.newUnique
157
158 newFlexiTyVar :: Kind -> TcPluginM TcTyVar
159 newFlexiTyVar = unsafeTcPluginTcM . TcM.newFlexiTyVar
160
161 isTouchableTcPluginM :: TcTyVar -> TcPluginM Bool
162 isTouchableTcPluginM = unsafeTcPluginTcM . TcM.isTouchableTcM
163
164 -- Confused by zonking? See Note [What is zonking?] in GHC.Tc.Utils.TcMType.
165 zonkTcType :: TcType -> TcPluginM TcType
166 zonkTcType = unsafeTcPluginTcM . TcM.zonkTcType
167
168 zonkCt :: Ct -> TcPluginM Ct
169 zonkCt = unsafeTcPluginTcM . TcM.zonkCt
170
171 -- | Create a new wanted constraint.
172 newWanted :: CtLoc -> PredType -> TcPluginM CtEvidence
173 newWanted loc pty
174 = unsafeTcPluginTcM (TcM.newWanted (ctLocOrigin loc) Nothing pty)
175
176 -- | Create a new derived constraint.
177 newDerived :: CtLoc -> PredType -> TcPluginM CtEvidence
178 newDerived loc pty = return CtDerived { ctev_pred = pty, ctev_loc = loc }
179
180 -- | Create a new given constraint, with the supplied evidence.
181 --
182 -- This should only be invoked within 'tcPluginSolve'.
183 newGiven :: EvBindsVar -> CtLoc -> PredType -> EvExpr -> TcPluginM CtEvidence
184 newGiven tc_evbinds loc pty evtm = do
185 new_ev <- newEvVar pty
186 setEvBind tc_evbinds $ mkGivenEvBind new_ev (EvExpr evtm)
187 return CtGiven { ctev_pred = pty, ctev_evar = new_ev, ctev_loc = loc }
188
189 -- | Create a fresh evidence variable.
190 --
191 -- This should only be invoked within 'tcPluginSolve'.
192 newEvVar :: PredType -> TcPluginM EvVar
193 newEvVar = unsafeTcPluginTcM . TcM.newEvVar
194
195 -- | Create a fresh coercion hole.
196 -- This should only be invoked within 'tcPluginSolve'.
197 newCoercionHole :: PredType -> TcPluginM CoercionHole
198 newCoercionHole = unsafeTcPluginTcM . TcM.newCoercionHole
199
200 -- | Bind an evidence variable.
201 --
202 -- This should only be invoked within 'tcPluginSolve'.
203 setEvBind :: EvBindsVar -> EvBind -> TcPluginM ()
204 setEvBind tc_evbinds ev_bind = do
205 unsafeTcPluginTcM $ TcM.addTcEvBind tc_evbinds ev_bind