never executed always true always false
1 {-
2 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3
4 -}
5
6
7
8 -- | The @GHC.Builtin.Utils@ interface to the compiler's prelude knowledge.
9 --
10 -- This module serves as the central gathering point for names which the
11 -- compiler knows something about. This includes functions for,
12 --
13 -- * discerning whether a 'Name' is known-key
14 --
15 -- * given a 'Unique', looking up its corresponding known-key 'Name'
16 --
17 -- See Note [Known-key names] and Note [About wired-in things] for information
18 -- about the two types of prelude things in GHC.
19 --
20 module GHC.Builtin.Utils (
21 -- * Known-key names
22 isKnownKeyName,
23 lookupKnownKeyName,
24 lookupKnownNameInfo,
25
26 -- ** Internal use
27 -- | 'knownKeyNames' is exported to seed the original name cache only;
28 -- if you find yourself wanting to look at it you might consider using
29 -- 'lookupKnownKeyName' or 'isKnownKeyName'.
30 knownKeyNames,
31
32 -- * Miscellaneous
33 wiredInIds, ghcPrimIds,
34 primOpRules, builtinRules,
35
36 ghcPrimExports,
37 ghcPrimDeclDocs,
38 primOpId,
39
40 -- * Random other things
41 maybeCharLikeCon, maybeIntLikeCon,
42
43 -- * Class categories
44 isNumericClass, isStandardClass
45
46 ) where
47
48 import GHC.Prelude
49
50 import GHC.Builtin.Uniques
51 import GHC.Builtin.PrimOps
52 import GHC.Builtin.Types
53 import GHC.Builtin.Types.Literals ( typeNatTyCons )
54 import GHC.Builtin.Types.Prim
55 import GHC.Builtin.Names.TH ( templateHaskellNames )
56 import GHC.Builtin.Names
57
58 import GHC.Core.ConLike ( ConLike(..) )
59 import GHC.Core.Opt.ConstantFold
60 import GHC.Core.DataCon
61 import GHC.Core.Class
62 import GHC.Core.TyCon
63
64 import GHC.Types.Avail
65 import GHC.Types.Basic
66 import GHC.Types.Id
67 import GHC.Types.Name
68 import GHC.Types.Name.Env
69 import GHC.Types.Id.Make
70 import GHC.Types.Unique.FM
71 import GHC.Types.TyThing
72 import GHC.Types.Unique ( isValidKnownKeyUnique )
73
74 import GHC.Utils.Outputable
75 import GHC.Utils.Misc as Utils
76 import GHC.Utils.Panic
77 import GHC.Utils.Constants (debugIsOn)
78 import GHC.Hs.Doc
79 import GHC.Unit.Module.ModIface (IfaceExport)
80
81 import GHC.Data.List.SetOps
82
83 import Control.Applicative ((<|>))
84 import Data.List ( intercalate , find )
85 import Data.Array
86 import Data.Maybe
87 import qualified Data.Map as Map
88
89 {-
90 ************************************************************************
91 * *
92 \subsection[builtinNameInfo]{Lookup built-in names}
93 * *
94 ************************************************************************
95
96 Note [About wired-in things]
97 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
98 * Wired-in things are Ids\/TyCons that are completely known to the compiler.
99 They are global values in GHC, (e.g. listTyCon :: TyCon).
100
101 * A wired-in Name contains the thing itself inside the Name:
102 see Name.wiredInNameTyThing_maybe
103 (E.g. listTyConName contains listTyCon.
104
105 * The name cache is initialised with (the names of) all wired-in things
106 (except tuples and sums; see Note [Infinite families of known-key names])
107
108 * The type environment itself contains no wired in things. The type
109 checker sees if the Name is wired in before looking up the name in
110 the type environment.
111
112 * GHC.Iface.Make prunes out wired-in things before putting them in an interface file.
113 So interface files never contain wired-in things.
114 -}
115
116
117 -- | This list is used to ensure that when you say "Prelude.map" in your source
118 -- code, or in an interface file, you get a Name with the correct known key (See
119 -- Note [Known-key names] in "GHC.Builtin.Names")
120 knownKeyNames :: [Name]
121 knownKeyNames
122 | debugIsOn
123 , Just badNamesStr <- knownKeyNamesOkay all_names
124 = panic ("badAllKnownKeyNames:\n" ++ badNamesStr)
125 -- NB: We can't use ppr here, because this is sometimes evaluated in a
126 -- context where there are no DynFlags available, leading to a cryptic
127 -- "<<details unavailable>>" error. (This seems to happen only in the
128 -- stage 2 compiler, for reasons I [Richard] have no clue of.)
129 | otherwise
130 = all_names
131 where
132 all_names =
133 -- We exclude most tuples from this list—see
134 -- Note [Infinite families of known-key names] in GHC.Builtin.Names.
135 -- We make an exception for Solo (i.e., the boxed 1-tuple), since it does
136 -- not use special syntax like other tuples.
137 -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)
138 -- in GHC.Builtin.Types.
139 tupleTyConName BoxedTuple 1 : tupleDataConName Boxed 1 :
140 concat [ concatMap wired_tycon_kk_names primTyCons
141 , concatMap wired_tycon_kk_names wiredInTyCons
142 , concatMap wired_tycon_kk_names typeNatTyCons
143 , map idName wiredInIds
144 , map (idName . primOpId) allThePrimOps
145 , map (idName . primOpWrapperId) allThePrimOps
146 , basicKnownKeyNames
147 , templateHaskellNames
148 ]
149 -- All of the names associated with a wired-in TyCon.
150 -- This includes the TyCon itself, its DataCons and promoted TyCons.
151 wired_tycon_kk_names :: TyCon -> [Name]
152 wired_tycon_kk_names tc =
153 tyConName tc : (rep_names tc ++ implicits)
154 where implicits = concatMap thing_kk_names (implicitTyConThings tc)
155
156 wired_datacon_kk_names :: DataCon -> [Name]
157 wired_datacon_kk_names dc =
158 dataConName dc : rep_names (promoteDataCon dc)
159
160 thing_kk_names :: TyThing -> [Name]
161 thing_kk_names (ATyCon tc) = wired_tycon_kk_names tc
162 thing_kk_names (AConLike (RealDataCon dc)) = wired_datacon_kk_names dc
163 thing_kk_names thing = [getName thing]
164
165 -- The TyConRepName for a known-key TyCon has a known key,
166 -- but isn't itself an implicit thing. Yurgh.
167 -- NB: if any of the wired-in TyCons had record fields, the record
168 -- field names would be in a similar situation. Ditto class ops.
169 -- But it happens that there aren't any
170 rep_names tc = case tyConRepName_maybe tc of
171 Just n -> [n]
172 Nothing -> []
173
174 -- | Check the known-key names list of consistency.
175 knownKeyNamesOkay :: [Name] -> Maybe String
176 knownKeyNamesOkay all_names
177 | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names
178 = Just $ " Out-of-range known-key uniques: ["
179 ++ intercalate ", " (map (occNameString . nameOccName) ns) ++
180 "]"
181 | null badNamesPairs
182 = Nothing
183 | otherwise
184 = Just badNamesStr
185 where
186 namesEnv = foldl' (\m n -> extendNameEnv_Acc (:) Utils.singleton m n n)
187 emptyUFM all_names
188 badNamesEnv = filterNameEnv (\ns -> ns `lengthExceeds` 1) namesEnv
189 badNamesPairs = nonDetUFMToList badNamesEnv
190 -- It's OK to use nonDetUFMToList here because the ordering only affects
191 -- the message when we get a panic
192 badNamesStrs = map pairToStr badNamesPairs
193 badNamesStr = unlines badNamesStrs
194
195 pairToStr (uniq, ns) = " " ++
196 show uniq ++
197 ": [" ++
198 intercalate ", " (map (occNameString . nameOccName) ns) ++
199 "]"
200
201 -- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
202 -- known-key thing.
203 lookupKnownKeyName :: Unique -> Maybe Name
204 lookupKnownKeyName u =
205 knownUniqueName u <|> lookupUFM_Directly knownKeysMap u
206
207 -- | Is a 'Name' known-key?
208 isKnownKeyName :: Name -> Bool
209 isKnownKeyName n =
210 isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap
211
212 -- | Maps 'Unique's to known-key names.
213 --
214 -- The type is @UniqFM Name Name@ to denote that the 'Unique's used
215 -- in the domain are 'Unique's associated with 'Name's (as opposed
216 -- to some other namespace of 'Unique's).
217 knownKeysMap :: UniqFM Name Name
218 knownKeysMap = listToIdentityUFM knownKeyNames
219
220 -- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
221 -- GHCi's ':info' command.
222 lookupKnownNameInfo :: Name -> SDoc
223 lookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of
224 -- If we do find a doc, we add comment delimiters to make the output
225 -- of ':info' valid Haskell.
226 Nothing -> empty
227 Just doc -> vcat [text "{-", doc, text "-}"]
228
229 -- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390)
230 knownNamesInfo :: NameEnv SDoc
231 knownNamesInfo = unitNameEnv coercibleTyConName $
232 vcat [ text "Coercible is a special constraint with custom solving rules."
233 , text "It is not a class."
234 , text "Please see section `The Coercible constraint`"
235 , text "of the user's guide for details." ]
236
237 {-
238 We let a lot of "non-standard" values be visible, so that we can make
239 sense of them in interface pragmas. It's cool, though they all have
240 "non-standard" names, so they won't get past the parser in user code.
241
242 ************************************************************************
243 * *
244 PrimOpIds
245 * *
246 ************************************************************************
247 -}
248
249 primOpIds :: Array Int Id
250 -- A cache of the PrimOp Ids, indexed by PrimOp tag
251 primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op)
252 | op <- allThePrimOps ]
253
254 primOpId :: PrimOp -> Id
255 primOpId op = primOpIds ! primOpTag op
256
257 {-
258 ************************************************************************
259 * *
260 Export lists for pseudo-modules (GHC.Prim)
261 * *
262 ************************************************************************
263 -}
264
265 ghcPrimExports :: [IfaceExport]
266 ghcPrimExports
267 = map (avail . idName) ghcPrimIds ++
268 map (avail . idName . primOpId) allThePrimOps ++
269 [ availTC n [n] []
270 | tc <- exposedPrimTyCons, let n = tyConName tc ]
271
272 ghcPrimDeclDocs :: DeclDocMap
273 ghcPrimDeclDocs = DeclDocMap $ Map.fromList $ mapMaybe findName primOpDocs
274 where
275 names = map idName ghcPrimIds ++
276 map (idName . primOpId) allThePrimOps ++
277 map tyConName exposedPrimTyCons
278 findName (nameStr, doc)
279 | Just name <- find ((nameStr ==) . getOccString) names
280 = Just (name, mkHsDocString doc)
281 | otherwise = Nothing
282
283 {-
284 ************************************************************************
285 * *
286 Built-in keys
287 * *
288 ************************************************************************
289
290 ToDo: make it do the ``like'' part properly (as in 0.26 and before).
291 -}
292
293 maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
294 maybeCharLikeCon con = con `hasKey` charDataConKey
295 maybeIntLikeCon con = con `hasKey` intDataConKey
296
297 {-
298 ************************************************************************
299 * *
300 Class predicates
301 * *
302 ************************************************************************
303 -}
304
305 isNumericClass, isStandardClass :: Class -> Bool
306
307 isNumericClass clas = classKey clas `is_elem` numericClassKeys
308 isStandardClass clas = classKey clas `is_elem` standardClassKeys
309
310 is_elem :: Eq a => a -> [a] -> Bool
311 is_elem = isIn "is_X_Class"