never executed always true always false
1 {-# OPTIONS_GHC -fno-warn-duplicate-exports -fno-warn-orphans #-}
2
3 -- | This module is not used by GHC itself. Rather, it exports all of
4 -- the functions and types you are likely to need when writing a
5 -- plugin for GHC. So authors of plugins can probably get away simply
6 -- with saying "import GHC.Plugins".
7 --
8 -- Particularly interesting modules for plugin writers include
9 -- "GHC.Core" and "GHC.Core.Opt.Monad".
10 module GHC.Plugins
11 ( module GHC.Driver.Plugins
12 , module GHC.Types.Name.Reader
13 , module GHC.Types.Name.Occurrence
14 , module GHC.Types.Name
15 , module GHC.Types.Var
16 , module GHC.Types.Id
17 , module GHC.Types.Id.Info
18 , module GHC.Types.PkgQual
19 , module GHC.Core.Opt.Monad
20 , module GHC.Core
21 , module GHC.Types.Literal
22 , module GHC.Core.DataCon
23 , module GHC.Core.Utils
24 , module GHC.Core.Make
25 , module GHC.Core.FVs
26 , module GHC.Core.Subst
27 , module GHC.Core.Rules
28 , module GHC.Types.Annotations
29 , module GHC.Driver.Session
30 , module GHC.Driver.Ppr
31 , module GHC.Unit.State
32 , module GHC.Unit.Module
33 , module GHC.Unit.Home
34 , module GHC.Core.Type
35 , module GHC.Core.TyCon
36 , module GHC.Core.Coercion
37 , module GHC.Builtin.Types
38 , module GHC.Driver.Env
39 , module GHC.Types.Basic
40 , module GHC.Types.Var.Set
41 , module GHC.Types.Var.Env
42 , module GHC.Types.Name.Set
43 , module GHC.Types.Name.Env
44 , module GHC.Types.Unique
45 , module GHC.Types.Unique.Set
46 , module GHC.Types.Unique.FM
47 , module GHC.Data.FiniteMap
48 , module GHC.Utils.Misc
49 , module GHC.Serialized
50 , module GHC.Types.SrcLoc
51 , module GHC.Utils.Outputable
52 , module GHC.Utils.Panic
53 , module GHC.Types.Unique.Supply
54 , module GHC.Data.FastString
55 , module GHC.Tc.Errors.Hole.FitTypes -- for hole-fit plugins
56 , module GHC.Unit.Module.ModGuts
57 , module GHC.Unit.Module.ModSummary
58 , module GHC.Unit.Module.ModIface
59 , module GHC.Types.Meta
60 , module GHC.Types.SourceError
61 , -- * Getting 'Name's
62 thNameToGhcName
63 )
64 where
65
66 -- Plugin stuff itself
67 import GHC.Driver.Plugins
68
69 -- Variable naming
70 import GHC.Types.TyThing
71 import GHC.Types.PkgQual
72 import GHC.Types.SourceError
73 import GHC.Types.Name.Reader
74 import GHC.Types.Name.Occurrence hiding ( varName {- conflicts with Var.varName -} )
75 import GHC.Types.Name hiding ( varName {- reexport from OccName, conflicts with Var.varName -} )
76 import GHC.Types.Var
77 import GHC.Types.Id hiding ( lazySetIdInfo, setIdExported, setIdNotExported {- all three conflict with Var -} )
78 import GHC.Types.Id.Info
79
80 -- Core
81 import GHC.Core.Opt.Monad
82 import GHC.Core
83 import GHC.Types.Literal
84 import GHC.Core.DataCon
85 import GHC.Core.Utils
86 import GHC.Core.Make
87 import GHC.Core.FVs
88 import GHC.Core.Subst hiding( substTyVarBndr, substCoVarBndr, extendCvSubst )
89 -- These names are also exported by Type
90
91 import GHC.Core.Rules
92 import GHC.Types.Annotations
93 import GHC.Types.Meta
94
95 import GHC.Driver.Session
96 import GHC.Unit.State
97
98 import GHC.Unit.Home
99 import GHC.Unit.Module
100 import GHC.Unit.Module.ModGuts
101 import GHC.Unit.Module.ModSummary
102 import GHC.Unit.Module.ModIface
103 import GHC.Core.Type hiding {- conflict with GHC.Core.Subst -}
104 ( substTy, extendTvSubst, extendTvSubstList, isInScope )
105 import GHC.Core.Coercion hiding {- conflict with GHC.Core.Subst -}
106 ( substCo )
107 import GHC.Core.TyCon
108 import GHC.Builtin.Types
109 import GHC.Driver.Env
110 import GHC.Types.Basic
111
112 -- Collections and maps
113 import GHC.Types.Var.Set
114 import GHC.Types.Var.Env
115 import GHC.Types.Name.Set
116 import GHC.Types.Name.Env
117 import GHC.Types.Unique.Set
118 import GHC.Types.Unique.FM
119 -- Conflicts with UniqFM:
120 --import LazyUniqFM
121 import GHC.Data.FiniteMap
122
123 -- Common utilities
124 import GHC.Utils.Misc
125 import GHC.Serialized
126 import GHC.Types.SrcLoc
127 import GHC.Utils.Outputable
128 import GHC.Utils.Panic
129 import GHC.Driver.Ppr
130 import GHC.Types.Unique.Supply
131 import GHC.Types.Unique ( Unique, Uniquable(..) )
132 import GHC.Data.FastString
133 import Data.Maybe
134
135 import GHC.Iface.Env ( lookupOrigIO )
136 import GHC.Prelude
137 import GHC.Utils.Monad ( mapMaybeM )
138 import GHC.ThToHs ( thRdrNameGuesses )
139 import GHC.Tc.Utils.Env ( lookupGlobal )
140
141 import GHC.Tc.Errors.Hole.FitTypes
142
143 import qualified Language.Haskell.TH as TH
144
145 {- This instance is defined outside GHC.Core.Opt.Monad so that
146 GHC.Core.Opt.Monad does not depend on GHC.Tc.Utils.Env -}
147 instance MonadThings CoreM where
148 lookupThing name = do { hsc_env <- getHscEnv
149 ; liftIO $ lookupGlobal hsc_env name }
150
151 {-
152 ************************************************************************
153 * *
154 Template Haskell interoperability
155 * *
156 ************************************************************************
157 -}
158
159 -- | Attempt to convert a Template Haskell name to one that GHC can
160 -- understand. Original TH names such as those you get when you use
161 -- the @'foo@ syntax will be translated to their equivalent GHC name
162 -- exactly. Qualified or unqualified TH names will be dynamically bound
163 -- to names in the module being compiled, if possible. Exact TH names
164 -- will be bound to the name they represent, exactly.
165 thNameToGhcName :: TH.Name -> CoreM (Maybe Name)
166 thNameToGhcName th_name
167 = do { names <- mapMaybeM lookup (thRdrNameGuesses th_name)
168 -- Pick the first that works
169 -- E.g. reify (mkName "A") will pick the class A in preference
170 -- to the data constructor A
171 ; return (listToMaybe names) }
172 where
173 lookup rdr_name
174 | Just n <- isExact_maybe rdr_name -- This happens in derived code
175 = return $ if isExternalName n then Just n else Nothing
176 | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
177 = do { hsc_env <- getHscEnv
178 ; Just <$> liftIO (lookupOrigIO hsc_env rdr_mod rdr_occ) }
179 | otherwise = return Nothing