[project @ 1999-04-26 16:06:27 by simonm]
[ghc-hetmet.git] / ghc / compiler / prelude / PrelInfo.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge}
5
6 \begin{code}
7 module PrelInfo (
8         builtinNames,   -- Names of things whose *unique* must be known, but 
9                         -- that is all. If something is in here, you know that
10                         -- if it's used at all then it's Name will be just as
11                         -- it is here, unique and all.  Includes all the 
12                         -- wired-in names.
13
14         thinAirIdNames, -- Names of non-wired-in Ids that may be used out of
15         setThinAirIds,  -- thin air in any compilation. If they are not wired in
16         thinAirModules, -- we must be sure to import them from some Prelude 
17                         -- interface file even if they are not overtly 
18                         -- mentioned.  Subset of builtinNames.
19         noRepIntegerIds,
20         noRepStrIds,
21
22         derivingOccurrences,    -- For a given class C, this tells what other 
23                                 -- things are needed as a result of a 
24                                 -- deriving(C) clause
25
26
27         -- Here are the thin-air Ids themselves
28         addr2IntegerId,
29         packStringForCId, unpackCStringId, unpackCString2Id,
30         unpackCStringAppendId, unpackCStringFoldrId,
31         foldrId,
32
33         -- Random other things
34         main_NAME, ioTyCon_NAME,
35         deRefStablePtr_NAME, makeStablePtr_NAME,
36         bindIO_NAME, 
37
38         maybeCharLikeCon, maybeIntLikeCon,
39         needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, 
40         isNoDictClass, isNumericClass, isStandardClass, isCcallishClass, 
41         isCreturnableClass, numericTyKeys,
42
43         -- RdrNames for lots of things, mainly used in derivings
44         eq_RDR, ne_RDR, le_RDR, lt_RDR, ge_RDR, gt_RDR, max_RDR, min_RDR, 
45         compare_RDR, minBound_RDR, maxBound_RDR, enumFrom_RDR, enumFromTo_RDR,
46         enumFromThen_RDR, enumFromThenTo_RDR, succ_RDR, pred_RDR, fromEnum_RDR, toEnum_RDR, 
47         ratioDataCon_RDR, range_RDR, index_RDR, inRange_RDR, readsPrec_RDR,
48         readList_RDR, showsPrec_RDR, showList_RDR, plus_RDR, times_RDR,
49         ltTag_RDR, eqTag_RDR, gtTag_RDR, eqH_Char_RDR, ltH_Char_RDR, 
50         eqH_Word_RDR, ltH_Word_RDR, eqH_Addr_RDR, ltH_Addr_RDR, eqH_Float_RDR,
51         ltH_Float_RDR, eqH_Double_RDR, ltH_Double_RDR, eqH_Int_RDR, 
52         ltH_Int_RDR, geH_RDR, leH_RDR, minusH_RDR, false_RDR, true_RDR,
53         and_RDR, not_RDR, append_RDR, map_RDR, compose_RDR, mkInt_RDR,
54         error_RDR, assertErr_RDR, getTag_RDR,
55         showString_RDR, showParen_RDR, readParen_RDR, lex_RDR,
56         showSpace_RDR, showList___RDR, readList___RDR, negate_RDR,
57
58         numClass_RDR, fractionalClass_RDR, eqClass_RDR, 
59         ccallableClass_RDR, creturnableClass_RDR,
60         monadClass_RDR, enumClass_RDR, ordClass_RDR,
61         ioDataCon_RDR,
62
63         mkTupConRdrName, mkUbxTupConRdrName
64
65     ) where
66
67 #include "HsVersions.h"
68
69
70 -- friends:
71 import PrelMods         -- Prelude module names
72 import PrelVals         -- VALUES
73 import MkId             ( mkPrimitiveId )
74 import PrimOp           ( PrimOp(..), allThePrimOps )
75 import DataCon          ( DataCon )
76 import PrimRep          ( PrimRep(..) )
77 import TysPrim          -- TYPES
78 import TysWiredIn
79
80 -- others:
81 import RdrName          ( RdrName, mkPreludeQual )
82 import Var              ( varUnique, Id )
83 import Name             ( Name, OccName, Provenance(..), 
84                           NameSpace, tcName, clsName, varName, dataName,
85                           getName, mkGlobalName, nameRdrName, systemProvenance
86                         )
87 import RdrName          ( rdrNameModule, rdrNameOcc, mkSrcQual )
88 import Class            ( Class, classKey )
89 import TyCon            ( tyConDataCons, TyCon )
90 import Type             ( funTyCon )
91 import Bag
92 import Unique           -- *Key stuff
93 import UniqFM           ( UniqFM, listToUFM, lookupWithDefaultUFM ) 
94 import Util             ( isIn )
95 import Panic            ( panic )
96
97 import IOExts
98 \end{code}
99
100 %************************************************************************
101 %*                                                                      *
102 \subsection[builtinNameInfo]{Lookup built-in names}
103 %*                                                                      *
104 %************************************************************************
105
106 We have two ``builtin name funs,'' one to look up @TyCons@ and
107 @Classes@, the other to look up values.
108
109 \begin{code}
110 builtinNames :: Bag Name
111 builtinNames
112   = unionManyBags
113         [       -- Wired in TyCons
114           unionManyBags (map getTyConNames wired_in_tycons)
115
116                 -- Wired in Ids
117         , listToBag (map getName wired_in_ids)
118
119                 -- PrimOps
120         , listToBag (map (getName . mkPrimitiveId) allThePrimOps)
121
122                 -- Thin-air ids
123         , listToBag thinAirIdNames
124
125                 -- Other names with magic keys
126         , listToBag knownKeyNames
127         ]
128 \end{code}
129
130
131 \begin{code}
132 getTyConNames :: TyCon -> Bag Name
133 getTyConNames tycon
134     = getName tycon `consBag` 
135       listToBag (map getName (tyConDataCons tycon))
136         -- Synonyms return empty list of constructors
137 \end{code}
138
139 We let a lot of "non-standard" values be visible, so that we can make
140 sense of them in interface pragmas. It's cool, though they all have
141 "non-standard" names, so they won't get past the parser in user code.
142
143
144 %************************************************************************
145 %*                                                                      *
146 \subsection{Wired in TyCons}
147 %*                                                                      *
148 %************************************************************************
149
150 \begin{code}
151 wired_in_tycons = [funTyCon] ++
152                   prim_tycons ++
153                   tuple_tycons ++
154                   unboxed_tuple_tycons ++
155                   data_tycons
156
157 prim_tycons
158   = [ addrPrimTyCon
159     , arrayPrimTyCon
160     , byteArrayPrimTyCon
161     , charPrimTyCon
162     , doublePrimTyCon
163     , floatPrimTyCon
164     , intPrimTyCon
165     , int64PrimTyCon
166     , foreignObjPrimTyCon
167     , weakPrimTyCon
168     , mutableArrayPrimTyCon
169     , mutableByteArrayPrimTyCon
170     , mVarPrimTyCon
171     , mutVarPrimTyCon
172     , realWorldTyCon
173     , stablePtrPrimTyCon
174     , stableNamePrimTyCon
175     , statePrimTyCon
176     , threadIdPrimTyCon
177     , wordPrimTyCon
178     , word64PrimTyCon
179     ]
180
181 tuple_tycons = unitTyCon : [tupleTyCon i | i <- [2..37] ]
182 unboxed_tuple_tycons = [unboxedTupleTyCon i | i <- [1..37] ]
183
184 data_tycons
185   = [ addrTyCon
186     , boolTyCon
187     , charTyCon
188     , doubleTyCon
189     , floatTyCon
190     , intTyCon
191     , integerTyCon
192     , listTyCon
193     , wordTyCon
194     ]
195 \end{code}
196
197
198 %************************************************************************
199 %*                                                                      *
200 \subsection{Wired in Ids}
201 %*                                                                      *
202 %************************************************************************
203
204 \begin{code}
205 wired_in_ids
206   = [   -- These error-y things are wired in because we don't yet have
207         -- a way to express in an interface file that the result type variable
208         -- is 'open'; that is can be unified with an unboxed type
209         -- 
210         -- [The interface file format now carry such information, but there's
211         --  no way yet of expressing at the definition site for these error-reporting
212         --  functions that they have an 'open' result type. -- sof 1/99]
213         -- 
214       aBSENT_ERROR_ID
215     , eRROR_ID
216     , iRREFUT_PAT_ERROR_ID
217     , nON_EXHAUSTIVE_GUARDS_ERROR_ID
218     , nO_METHOD_BINDING_ERROR_ID
219     , pAR_ERROR_ID
220     , pAT_ERROR_ID
221     , rEC_CON_ERROR_ID
222     , rEC_UPD_ERROR_ID
223
224         -- These three can't be defined in Haskell
225     , realWorldPrimId
226     , unsafeCoerceId
227     , getTagId
228     ]
229
230 \end{code}
231
232 %************************************************************************
233 %*                                                                      *
234 \subsection{Thin air entities}
235 %*                                                                      *
236 %************************************************************************
237
238 These are Ids that we need to reference in various parts of the
239 system, and we'd like to pull them out of thin air rather than pass
240 them around.  We'd also like to have all the IdInfo available for each
241 one: i.e. everything that gets pulled out of the interface file.
242
243 The solution is to generate this map of global Ids after the
244 typechecker, and assign it to a global variable.  Any subsequent
245 pass may refer to the map to pull Ids out.  Any invalid
246 (i.e. pre-typechecker) access to the map will result in a panic.
247
248 \begin{code}
249 thinAirIdNames 
250   = map mkKnownKeyGlobal
251     [
252         -- Needed for converting literals to Integers (used in tidyCoreExpr)
253       (varQual pREL_BASE SLIT("addr2Integer"), addr2IntegerIdKey)
254
255         -- String literals
256     , (varQual pREL_PACK SLIT("packCString#"),   packCStringIdKey)
257     , (varQual pREL_PACK SLIT("unpackCString#"), unpackCStringIdKey)
258     , (varQual pREL_PACK SLIT("unpackNBytes#"),  unpackCString2IdKey)
259     , (varQual pREL_PACK SLIT("unpackAppendCString#"), unpackCStringAppendIdKey)
260     , (varQual pREL_PACK SLIT("unpackFoldrCString#"),  unpackCStringFoldrIdKey)
261
262         -- Folds; introduced by desugaring list comprehensions
263     , (varQual pREL_BASE SLIT("foldr"), foldrIdKey)
264     ]
265
266 thinAirModules = [pREL_PACK]    -- See notes with RnIfaces.findAndReadIface
267
268 noRepIntegerIds = [addr2IntegerId]
269
270 noRepStrIds = [unpackCString2Id, unpackCStringId]
271
272 addr2IntegerId = lookupThinAirId addr2IntegerIdKey
273
274 packStringForCId = lookupThinAirId packCStringIdKey
275 unpackCStringId  = lookupThinAirId unpackCStringIdKey
276 unpackCString2Id = lookupThinAirId unpackCString2IdKey 
277 unpackCStringAppendId = lookupThinAirId unpackCStringAppendIdKey 
278 unpackCStringFoldrId  = lookupThinAirId unpackCStringFoldrIdKey 
279
280 foldrId = lookupThinAirId foldrIdKey
281 \end{code}
282
283
284 \begin{code}
285 \end{code}
286
287 \begin{code}
288 thinAirIdMapRef :: IORef (UniqFM Id)
289 thinAirIdMapRef = unsafePerformIO (newIORef (panic "thinAirIdMap: still empty"))
290
291 setThinAirIds :: [Id] -> IO ()
292 setThinAirIds thin_air_ids
293   = writeIORef thinAirIdMapRef the_map
294   where
295     the_map = listToUFM [(varUnique id, id) | id <- thin_air_ids]
296
297 thinAirIdMap :: UniqFM Id
298 thinAirIdMap = unsafePerformIO (readIORef thinAirIdMapRef)
299   -- Read it just once, the first time someone tugs on thinAirIdMap
300
301 lookupThinAirId :: Unique -> Id
302 lookupThinAirId uniq = lookupWithDefaultUFM thinAirIdMap
303                         (panic "lookupThinAirId: no mapping") uniq 
304 \end{code}
305
306
307 %************************************************************************
308 %*                                                                      *
309 \subsection{Built-in keys}
310 %*                                                                      *
311 %************************************************************************
312
313 Ids, Synonyms, Classes and ClassOps with builtin keys. 
314
315 \begin{code}
316 mkKnownKeyGlobal :: (RdrName, Unique) -> Name
317 mkKnownKeyGlobal (rdr_name, uniq)
318   = mkGlobalName uniq (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
319                  systemProvenance
320
321 ioTyCon_NAME      = mkKnownKeyGlobal (ioTyCon_RDR,       ioTyConKey)
322 main_NAME         = mkKnownKeyGlobal (main_RDR,          mainKey)
323
324  -- Operations needed when compiling FFI decls
325 bindIO_NAME         = mkKnownKeyGlobal (bindIO_RDR,         bindIOIdKey)
326 deRefStablePtr_NAME = mkKnownKeyGlobal (deRefStablePtr_RDR, deRefStablePtrIdKey)
327 makeStablePtr_NAME  = mkKnownKeyGlobal (makeStablePtr_RDR,  makeStablePtrIdKey)
328
329 knownKeyNames :: [Name]
330 knownKeyNames
331   = [main_NAME, ioTyCon_NAME]
332     ++
333     map mkKnownKeyGlobal
334     [
335         -- Type constructors (synonyms especially)
336       (orderingTyCon_RDR,       orderingTyConKey)
337     , (rationalTyCon_RDR,       rationalTyConKey)
338     , (ratioDataCon_RDR,        ratioDataConKey)
339     , (ratioTyCon_RDR,          ratioTyConKey)
340     , (byteArrayTyCon_RDR,      byteArrayTyConKey)
341     , (mutableByteArrayTyCon_RDR, mutableByteArrayTyConKey)
342     , (foreignObjTyCon_RDR,     foreignObjTyConKey)
343     , (stablePtrTyCon_RDR,      stablePtrTyConKey)
344     , (stablePtrDataCon_RDR,    stablePtrDataConKey)
345
346         --  Classes.  *Must* include:
347         --      classes that are grabbed by key (e.g., eqClassKey)
348         --      classes in "Class.standardClassKeys" (quite a few)
349     , (eqClass_RDR,             eqClassKey)             -- mentioned, derivable
350     , (ordClass_RDR,            ordClassKey)            -- derivable
351     , (boundedClass_RDR,        boundedClassKey)        -- derivable
352     , (numClass_RDR,            numClassKey)            -- mentioned, numeric
353     , (enumClass_RDR,           enumClassKey)           -- derivable
354     , (monadClass_RDR,          monadClassKey)
355     , (monadPlusClass_RDR,      monadPlusClassKey)
356     , (functorClass_RDR,        functorClassKey)
357     , (showClass_RDR,           showClassKey)           -- derivable
358     , (realClass_RDR,           realClassKey)           -- numeric
359     , (integralClass_RDR,       integralClassKey)       -- numeric
360     , (fractionalClass_RDR,     fractionalClassKey)     -- numeric
361     , (floatingClass_RDR,       floatingClassKey)       -- numeric
362     , (realFracClass_RDR,       realFracClassKey)       -- numeric
363     , (realFloatClass_RDR,      realFloatClassKey)      -- numeric
364     , (readClass_RDR,           readClassKey)           -- derivable
365     , (ixClass_RDR,             ixClassKey)             -- derivable (but it isn't Prelude.Ix; hmmm)
366     , (ccallableClass_RDR,      cCallableClassKey)      -- mentioned, ccallish
367     , (creturnableClass_RDR,    cReturnableClassKey)    -- mentioned, ccallish
368
369         -- ClassOps 
370     , (fromInt_RDR,             fromIntClassOpKey)
371     , (fromInteger_RDR,         fromIntegerClassOpKey)
372     , (ge_RDR,                  geClassOpKey) 
373     , (minus_RDR,               minusClassOpKey)
374     , (enumFrom_RDR,            enumFromClassOpKey)
375     , (enumFromThen_RDR,        enumFromThenClassOpKey)
376     , (enumFromTo_RDR,          enumFromToClassOpKey)
377     , (enumFromThenTo_RDR,      enumFromThenToClassOpKey)
378     , (fromEnum_RDR,            fromEnumClassOpKey)
379     , (toEnum_RDR,              toEnumClassOpKey)
380     , (eq_RDR,                  eqClassOpKey)
381     , (thenM_RDR,               thenMClassOpKey)
382     , (returnM_RDR,             returnMClassOpKey)
383     , (failM_RDR,               failMClassOpKey)
384     , (fromRational_RDR,        fromRationalClassOpKey)
385     
386     , (deRefStablePtr_RDR,      deRefStablePtrIdKey)
387     , (makeStablePtr_RDR,       makeStablePtrIdKey)
388     , (bindIO_RDR,              bindIOIdKey)
389
390     , (map_RDR,                 mapIdKey)
391     , (append_RDR,              appendIdKey)
392
393         -- List operations
394     , (concat_RDR,              concatIdKey)
395     , (filter_RDR,              filterIdKey)
396     , (zip_RDR,                 zipIdKey)
397
398         -- FFI primitive types that are not wired-in.
399     , (int8TyCon_RDR,           int8TyConKey)
400     , (int16TyCon_RDR,          int16TyConKey)
401     , (int32TyCon_RDR,          int32TyConKey)
402     , (int64TyCon_RDR,          int64TyConKey)
403     , (word8TyCon_RDR,          word8TyConKey)
404     , (word16TyCon_RDR,         word16TyConKey)
405     , (word32TyCon_RDR,         word32TyConKey)
406     , (word64TyCon_RDR,         word64TyConKey)
407
408         -- Others
409     , (otherwiseId_RDR,         otherwiseIdKey)
410     , (assert_RDR,              assertIdKey)
411     ]
412 \end{code}
413
414 ToDo: make it do the ``like'' part properly (as in 0.26 and before).
415
416 \begin{code}
417 maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
418 maybeCharLikeCon con = getUnique con == charDataConKey
419 maybeIntLikeCon  con = getUnique con == intDataConKey
420 \end{code}
421
422 %************************************************************************
423 %*                                                                      *
424 \subsection{Commonly-used RdrNames}
425 %*                                                                      *
426 %************************************************************************
427
428 These RdrNames are not really "built in", but some parts of the compiler
429 (notably the deriving mechanism) need to mention their names, and it's convenient
430 to write them all down in one place.
431
432 \begin{code}
433 prelude_primop op = nameRdrName (getName (mkPrimitiveId op))
434
435 main_RDR                = varQual mAIN      SLIT("main")
436 otherwiseId_RDR         = varQual pREL_BASE SLIT("otherwise")
437
438 intTyCon_RDR            = nameRdrName (getName intTyCon)
439 ioTyCon_RDR             = tcQual   pREL_IO_BASE SLIT("IO")
440 ioDataCon_RDR           = dataQual pREL_IO_BASE SLIT("IO")
441 bindIO_RDR              = varQual  pREL_IO_BASE SLIT("bindIO")
442
443 orderingTyCon_RDR       = tcQual   pREL_BASE SLIT("Ordering")
444 rationalTyCon_RDR       = tcQual   pREL_NUM  SLIT("Rational")
445 ratioTyCon_RDR          = tcQual   pREL_NUM  SLIT("Ratio")
446 ratioDataCon_RDR        = dataQual pREL_NUM  SLIT(":%")
447
448 byteArrayTyCon_RDR              = tcQual pREL_ARR  SLIT("ByteArray")
449 mutableByteArrayTyCon_RDR       = tcQual pREL_ARR  SLIT("MutableByteArray")
450
451 foreignObjTyCon_RDR     = tcQual   pREL_IO_BASE SLIT("ForeignObj")
452 stablePtrTyCon_RDR      = tcQual   pREL_STABLE SLIT("StablePtr")
453 stablePtrDataCon_RDR    = dataQual pREL_STABLE SLIT("StablePtr")
454 deRefStablePtr_RDR      = varQual  pREL_STABLE SLIT("deRefStablePtr")
455 makeStablePtr_RDR       = varQual  pREL_STABLE SLIT("makeStablePtr")
456
457 eqClass_RDR             = clsQual pREL_BASE SLIT("Eq")
458 ordClass_RDR            = clsQual pREL_BASE SLIT("Ord")
459 boundedClass_RDR        = clsQual pREL_BASE SLIT("Bounded")
460 numClass_RDR            = clsQual pREL_BASE SLIT("Num")
461 enumClass_RDR           = clsQual pREL_BASE SLIT("Enum")
462 monadClass_RDR          = clsQual pREL_BASE SLIT("Monad")
463 monadPlusClass_RDR      = clsQual pREL_BASE SLIT("MonadPlus")
464 functorClass_RDR        = clsQual pREL_BASE SLIT("Functor")
465 showClass_RDR           = clsQual pREL_BASE SLIT("Show")
466 realClass_RDR           = clsQual pREL_NUM  SLIT("Real")
467 integralClass_RDR       = clsQual pREL_NUM  SLIT("Integral")
468 fractionalClass_RDR     = clsQual pREL_NUM  SLIT("Fractional")
469 floatingClass_RDR       = clsQual pREL_NUM  SLIT("Floating")
470 realFracClass_RDR       = clsQual pREL_NUM  SLIT("RealFrac")
471 realFloatClass_RDR      = clsQual pREL_NUM  SLIT("RealFloat")
472 readClass_RDR           = clsQual pREL_READ SLIT("Read")
473 ixClass_RDR             = clsQual iX        SLIT("Ix")
474 ccallableClass_RDR      = clsQual pREL_GHC  SLIT("CCallable")
475 creturnableClass_RDR    = clsQual pREL_GHC  SLIT("CReturnable")
476
477 fromInt_RDR        = varQual pREL_BASE SLIT("fromInt")
478 fromInteger_RDR    = varQual pREL_BASE SLIT("fromInteger")
479 minus_RDR          = varQual pREL_BASE SLIT("-")
480 succ_RDR           = varQual pREL_BASE SLIT("succ")
481 pred_RDR           = varQual pREL_BASE SLIT("pred")
482 toEnum_RDR         = varQual pREL_BASE SLIT("toEnum")
483 fromEnum_RDR       = varQual pREL_BASE SLIT("fromEnum")
484 enumFrom_RDR       = varQual pREL_BASE SLIT("enumFrom")
485 enumFromTo_RDR     = varQual pREL_BASE SLIT("enumFromTo")
486 enumFromThen_RDR   = varQual pREL_BASE SLIT("enumFromThen")
487 enumFromThenTo_RDR = varQual pREL_BASE SLIT("enumFromThenTo")
488
489 thenM_RDR          = varQual pREL_BASE SLIT(">>=")
490 returnM_RDR        = varQual pREL_BASE SLIT("return")
491 failM_RDR          = varQual pREL_BASE SLIT("fail")
492
493 fromRational_RDR   = varQual pREL_NUM  SLIT("fromRational")
494 negate_RDR         = varQual pREL_BASE SLIT("negate")
495 eq_RDR             = varQual pREL_BASE SLIT("==")
496 ne_RDR             = varQual pREL_BASE SLIT("/=")
497 le_RDR             = varQual pREL_BASE SLIT("<=")
498 lt_RDR             = varQual pREL_BASE SLIT("<")
499 ge_RDR             = varQual pREL_BASE SLIT(">=")
500 gt_RDR             = varQual pREL_BASE SLIT(">")
501 ltTag_RDR          = dataQual pREL_BASE SLIT("LT")
502 eqTag_RDR          = dataQual pREL_BASE SLIT("EQ")
503 gtTag_RDR          = dataQual pREL_BASE SLIT("GT")
504 max_RDR            = varQual pREL_BASE SLIT("max")
505 min_RDR            = varQual pREL_BASE SLIT("min")
506 compare_RDR        = varQual pREL_BASE SLIT("compare")
507 minBound_RDR       = varQual pREL_BASE SLIT("minBound")
508 maxBound_RDR       = varQual pREL_BASE SLIT("maxBound")
509 false_RDR          = dataQual pREL_BASE SLIT("False")
510 true_RDR           = dataQual pREL_BASE SLIT("True")
511 and_RDR            = varQual pREL_BASE SLIT("&&")
512 not_RDR            = varQual pREL_BASE SLIT("not")
513 compose_RDR        = varQual pREL_BASE SLIT(".")
514 append_RDR         = varQual pREL_BASE SLIT("++")
515 map_RDR            = varQual pREL_BASE SLIT("map")
516 concat_RDR         = varQual mONAD     SLIT("concat")
517 filter_RDR         = varQual mONAD     SLIT("filter")
518 zip_RDR            = varQual pREL_LIST SLIT("zip")
519
520 showList___RDR     = varQual pREL_BASE  SLIT("showList__")
521 showsPrec_RDR      = varQual pREL_BASE SLIT("showsPrec")
522 showList_RDR       = varQual pREL_BASE SLIT("showList")
523 showSpace_RDR      = varQual pREL_BASE SLIT("showSpace")
524 showString_RDR     = varQual pREL_BASE SLIT("showString")
525 showParen_RDR      = varQual pREL_BASE SLIT("showParen")
526
527 range_RDR          = varQual iX   SLIT("range")
528 index_RDR          = varQual iX   SLIT("index")
529 inRange_RDR        = varQual iX   SLIT("inRange")
530
531 readsPrec_RDR      = varQual pREL_READ SLIT("readsPrec")
532 readList_RDR       = varQual pREL_READ SLIT("readList")
533 readParen_RDR      = varQual pREL_READ SLIT("readParen")
534 lex_RDR            = varQual pREL_READ SLIT("lex")
535 readList___RDR     = varQual pREL_READ SLIT("readList__")
536
537 plus_RDR           = varQual pREL_BASE SLIT("+")
538 times_RDR          = varQual pREL_BASE SLIT("*")
539 mkInt_RDR          = dataQual pREL_BASE SLIT("I#")
540
541 int8TyCon_RDR    = tcQual iNT       SLIT("Int8")
542 int16TyCon_RDR   = tcQual iNT       SLIT("Int16")
543 int32TyCon_RDR   = tcQual iNT       SLIT("Int32")
544 int64TyCon_RDR   = tcQual pREL_ADDR SLIT("Int64")
545
546 word8TyCon_RDR    = tcQual wORD      SLIT("Word8")
547 word16TyCon_RDR   = tcQual wORD      SLIT("Word16")
548 word32TyCon_RDR   = tcQual wORD      SLIT("Word32")
549 word64TyCon_RDR   = tcQual pREL_ADDR SLIT("Word64")
550
551 error_RDR          = varQual pREL_ERR SLIT("error")
552 assert_RDR         = varQual pREL_GHC SLIT("assert")
553 assertErr_RDR      = varQual pREL_ERR SLIT("assertError")
554
555 eqH_Char_RDR    = prelude_primop CharEqOp
556 ltH_Char_RDR    = prelude_primop CharLtOp
557 eqH_Word_RDR    = prelude_primop WordEqOp
558 ltH_Word_RDR    = prelude_primop WordLtOp
559 eqH_Addr_RDR    = prelude_primop AddrEqOp
560 ltH_Addr_RDR    = prelude_primop AddrLtOp
561 eqH_Float_RDR   = prelude_primop FloatEqOp
562 ltH_Float_RDR   = prelude_primop FloatLtOp
563 eqH_Double_RDR  = prelude_primop DoubleEqOp
564 ltH_Double_RDR  = prelude_primop DoubleLtOp
565 eqH_Int_RDR     = prelude_primop IntEqOp
566 ltH_Int_RDR     = prelude_primop IntLtOp
567 geH_RDR         = prelude_primop IntGeOp
568 leH_RDR         = prelude_primop IntLeOp
569 minusH_RDR      = prelude_primop IntSubOp
570
571 getTag_RDR      = varQual pREL_GHC SLIT("getTag#")
572 \end{code}
573
574 \begin{code}
575 mkTupConRdrName :: Int -> RdrName 
576 mkTupConRdrName arity = case mkTupNameStr arity of
577                           (mod, occ) -> dataQual mod occ
578
579 mkUbxTupConRdrName :: Int -> RdrName
580 mkUbxTupConRdrName arity = case mkUbxTupNameStr arity of
581                                 (mod, occ) -> dataQual mod occ
582 \end{code}
583
584
585 %************************************************************************
586 %*                                                                      *
587 \subsection[Class-std-groups]{Standard groups of Prelude classes}
588 %*                                                                      *
589 %************************************************************************
590
591 @derivableClassKeys@ is also used in checking \tr{deriving} constructs
592 (@TcDeriv@).
593
594 @derivingOccurrences@ maps a class name to a list of the (qualified) occurrences
595 that will be mentioned by  the derived code for the class when it is later generated.
596 We don't need to put in things that are WiredIn (because they are already mapped to their
597 correct name by the @NameSupply@.  The class itself, and all its class ops, is
598 already flagged as an occurrence so we don't need to mention that either.
599
600 @derivingOccurrences@ has an item for every derivable class, even if that item is empty,
601 because we treat lookup failure as indicating that the class is illegal in a deriving clause.
602
603 \begin{code}
604 derivingOccurrences :: UniqFM [RdrName]
605 derivingOccurrences = listToUFM deriving_occ_info
606
607 derivableClassKeys  = map fst deriving_occ_info
608
609 deriving_occ_info
610   = [ (eqClassKey,      [intTyCon_RDR, and_RDR, not_RDR])
611     , (ordClassKey,     [intTyCon_RDR, compose_RDR, eqTag_RDR])
612                                 -- EQ (from Ordering) is needed to force in the constructors
613                                 -- as well as the type constructor.
614     , (enumClassKey,    [intTyCon_RDR, eq_RDR, ge_RDR, and_RDR, map_RDR, plus_RDR, showsPrec_RDR, append_RDR]) 
615                                 -- The last two Enum deps are only used to produce better
616                                 -- error msgs for derived toEnum methods.
617     , (boundedClassKey, [intTyCon_RDR])
618     , (showClassKey,    [intTyCon_RDR, numClass_RDR, ordClass_RDR, compose_RDR, showString_RDR, 
619                          showParen_RDR, showSpace_RDR, showList___RDR])
620     , (readClassKey,    [intTyCon_RDR, numClass_RDR, ordClass_RDR, append_RDR, 
621                          lex_RDR, readParen_RDR, readList___RDR, thenM_RDR])
622                              -- returnM (and the rest of the Monad class decl) 
623                              -- will be forced in as result of depending
624                              -- on thenM.   -- SOF 1/99
625     , (ixClassKey,      [intTyCon_RDR, numClass_RDR, and_RDR, map_RDR, enumFromTo_RDR, 
626                          returnM_RDR, failM_RDR])
627                              -- the last two are needed to force returnM, thenM and failM
628                              -- in before typechecking the list(monad) comprehension
629                              -- generated for derived Ix instances (range method)
630                              -- of single constructor types.  -- SOF 8/97
631     ]
632         -- intTyCon: Practically any deriving needs Int, either for index calculations, 
633         --              or for taggery.
634         -- ordClass: really it's the methods that are actually used.
635         -- numClass: for Int literals
636 \end{code}
637
638
639 NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@
640 even though every numeric class has these two as a superclass,
641 because the list of ambiguous dictionaries hasn't been simplified.
642
643 \begin{code}
644 isCcallishClass, isCreturnableClass, isNoDictClass, 
645   isNumericClass, isStandardClass :: Class -> Bool
646
647 isNumericClass     clas = classKey clas `is_elem` numericClassKeys
648 isStandardClass    clas = classKey clas `is_elem` standardClassKeys
649 isCcallishClass    clas = classKey clas `is_elem` cCallishClassKeys
650 isCreturnableClass clas = classKey clas == cReturnableClassKey
651 isNoDictClass      clas = classKey clas `is_elem` noDictClassKeys
652 is_elem = isIn "is_X_Class"
653
654 numericClassKeys =
655         [ numClassKey
656         , realClassKey
657         , integralClassKey
658         , fractionalClassKey
659         , floatingClassKey
660         , realFracClassKey
661         , realFloatClassKey
662         ]
663
664         -- the strictness analyser needs to know about numeric types
665         -- (see SaAbsInt.lhs)
666 numericTyKeys = 
667         [ addrTyConKey
668         , wordTyConKey
669         , intTyConKey
670         , integerTyConKey
671         , doubleTyConKey
672         , floatTyConKey
673         ]
674
675 needsDataDeclCtxtClassKeys = -- see comments in TcDeriv
676         [ readClassKey
677         ]
678
679 cCallishClassKeys = 
680         [ cCallableClassKey
681         , cReturnableClassKey
682         ]
683
684         -- Renamer always imports these data decls replete with constructors
685         -- so that desugarer can always see their constructors.  Ugh!
686 cCallishTyKeys = 
687         [ addrTyConKey
688         , wordTyConKey
689         , byteArrayTyConKey
690         , mutableByteArrayTyConKey
691         , foreignObjTyConKey
692         , stablePtrTyConKey
693         , int8TyConKey
694         , int16TyConKey
695         , int32TyConKey
696         , int64TyConKey
697         , word8TyConKey
698         , word16TyConKey
699         , word32TyConKey
700         , word64TyConKey
701         ]
702
703 standardClassKeys
704   = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys
705     --
706     -- We have to have "CCallable" and "CReturnable" in the standard
707     -- classes, so that if you go...
708     --
709     --      _ccall_ foo ... 93{-numeric literal-} ...
710     --
711     -- ... it can do The Right Thing on the 93.
712
713 noDictClassKeys         -- These classes are used only for type annotations;
714                         -- they are not implemented by dictionaries, ever.
715   = cCallishClassKeys
716 \end{code}
717
718
719 %************************************************************************
720 %*                                                                      *
721 \subsection{Local helpers}
722 %*                                                                      *
723 %************************************************************************
724
725 \begin{code}
726 varQual  = mkPreludeQual varName
727 dataQual = mkPreludeQual dataName
728 tcQual   = mkPreludeQual tcName
729 clsQual  = mkPreludeQual clsName
730 \end{code}
731