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