[project @ 1999-01-27 14:51:14 by simonpj]
[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                         -- wiredd-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         int2IntegerId, addr2IntegerId,
29         integerMinusOneId, integerZeroId, integerPlusOneId, integerPlusTwoId,
30         packStringForCId, unpackCStringId, unpackCString2Id,
31         unpackCStringAppendId, unpackCStringFoldrId,
32         foldrId,
33
34         -- Random other things
35         main_NAME, ioTyCon_NAME,
36         deRefStablePtr_NAME, makeStablePtr_NAME,
37         bindIO_NAME,
38
39         maybeCharLikeCon, maybeIntLikeCon,
40         needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, 
41         isNoDictClass, isNumericClass, isStandardClass, isCcallishClass, 
42         isCreturnableClass, numericTyKeys,
43
44         -- RdrNames for lots of things, mainly used in derivings
45         eq_RDR, ne_RDR, le_RDR, lt_RDR, ge_RDR, gt_RDR, max_RDR, min_RDR, 
46         compare_RDR, minBound_RDR, maxBound_RDR, enumFrom_RDR, enumFromTo_RDR,
47         enumFromThen_RDR, enumFromThenTo_RDR, succ_RDR, pred_RDR, fromEnum_RDR, toEnum_RDR, 
48         ratioDataCon_RDR, range_RDR, index_RDR, inRange_RDR, readsPrec_RDR,
49         readList_RDR, showsPrec_RDR, showList_RDR, plus_RDR, times_RDR,
50         ltTag_RDR, eqTag_RDR, gtTag_RDR, eqH_Char_RDR, ltH_Char_RDR, 
51         eqH_Word_RDR, ltH_Word_RDR, eqH_Addr_RDR, ltH_Addr_RDR, eqH_Float_RDR,
52         ltH_Float_RDR, eqH_Double_RDR, ltH_Double_RDR, eqH_Int_RDR, 
53         ltH_Int_RDR, geH_RDR, leH_RDR, minusH_RDR, false_RDR, true_RDR,
54         and_RDR, not_RDR, append_RDR, map_RDR, compose_RDR, mkInt_RDR,
55         error_RDR, assertErr_RDR,
56         showString_RDR, showParen_RDR, readParen_RDR, lex_RDR,
57         showSpace_RDR, showList___RDR, readList___RDR, negate_RDR,
58
59         numClass_RDR, fractionalClass_RDR, eqClass_RDR, 
60         ccallableClass_RDR, creturnableClass_RDR,
61         monadClass_RDR, enumClass_RDR, ordClass_RDR,
62         ioDataCon_RDR,
63
64         mkTupConRdrName, mkUbxTupConRdrName
65
66     ) where
67
68 #include "HsVersions.h"
69
70
71 -- friends:
72 import PrelMods         -- Prelude module names
73 import PrelVals         -- VALUES
74 import MkId             ( mkPrimitiveId )
75 import PrimOp           ( PrimOp(..), allThePrimOps )
76 import DataCon          ( DataCon )
77 import PrimRep          ( PrimRep(..) )
78 import TysPrim          -- TYPES
79 import TysWiredIn
80
81 -- others:
82 import RdrName          ( RdrName, mkPreludeQual )
83 import Var              ( varUnique, Id )
84 import Name             ( Name, OccName, Provenance(..), 
85                           NameSpace, tcName, clsName, varName, dataName,
86                           getName, mkGlobalName, nameRdrName, systemProvenance
87                         )
88 import RdrName          ( rdrNameModule, rdrNameOcc, mkSrcQual )
89 import Class            ( Class, classKey )
90 import TyCon            ( tyConDataCons, TyCon )
91 import Type             ( funTyCon )
92 import Bag
93 import Unique           -- *Key stuff
94 import UniqFM           ( UniqFM, listToUFM, lookupWithDefaultUFM ) 
95 import Util             ( isIn )
96 import Panic            ( panic )
97
98 import IOExts
99 \end{code}
100
101 %************************************************************************
102 %*                                                                      *
103 \subsection[builtinNameInfo]{Lookup built-in names}
104 %*                                                                      *
105 %************************************************************************
106
107 We have two ``builtin name funs,'' one to look up @TyCons@ and
108 @Classes@, the other to look up values.
109
110 \begin{code}
111 builtinNames :: Bag Name
112 builtinNames
113   = unionManyBags
114         [       -- Wired in TyCons
115           unionManyBags (map getTyConNames wired_in_tycons)
116
117                 -- Wired in Ids
118         , listToBag (map getName wired_in_ids)
119
120                 -- PrimOps
121         , listToBag (map (getName . mkPrimitiveId) allThePrimOps)
122
123                 -- Thin-air ids
124         , listToBag thinAirIdNames
125
126                 -- Other names with magic keys
127         , listToBag knownKeyNames
128         ]
129 \end{code}
130
131
132 \begin{code}
133 getTyConNames :: TyCon -> Bag Name
134 getTyConNames tycon
135     = getName tycon `consBag` 
136       listToBag (map getName (tyConDataCons tycon))
137         -- Synonyms return empty list of constructors
138 \end{code}
139
140 We let a lot of "non-standard" values be visible, so that we can make
141 sense of them in interface pragmas. It's cool, though they all have
142 "non-standard" names, so they won't get past the parser in user code.
143
144
145 %************************************************************************
146 %*                                                                      *
147 \subsection{Wired in TyCons}
148 %*                                                                      *
149 %************************************************************************
150
151 \begin{code}
152 wired_in_tycons = [funTyCon] ++
153                   prim_tycons ++
154                   tuple_tycons ++
155                   unboxed_tuple_tycons ++
156                   data_tycons
157
158 prim_tycons
159   = [ addrPrimTyCon
160     , arrayPrimTyCon
161     , byteArrayPrimTyCon
162     , charPrimTyCon
163     , doublePrimTyCon
164     , floatPrimTyCon
165     , intPrimTyCon
166     , int64PrimTyCon
167     , foreignObjPrimTyCon
168     , weakPrimTyCon
169     , mutableArrayPrimTyCon
170     , mutableByteArrayPrimTyCon
171     , mVarPrimTyCon
172     , mutVarPrimTyCon
173     , realWorldTyCon
174     , stablePtrPrimTyCon
175     , stableNamePrimTyCon
176     , statePrimTyCon
177     , threadIdPrimTyCon
178     , wordPrimTyCon
179     , word64PrimTyCon
180     ]
181
182 tuple_tycons = unitTyCon : [tupleTyCon i | i <- [2..37] ]
183 unboxed_tuple_tycons = [unboxedTupleTyCon i | i <- [1..37] ]
184
185 data_tycons
186   = [ addrTyCon
187     , boolTyCon
188     , charTyCon
189     , doubleTyCon
190     , floatTyCon
191     , intTyCon
192     , int8TyCon
193     , int16TyCon
194     , int32TyCon
195     , int64TyCon
196     , integerTyCon
197     , listTyCon
198     , wordTyCon
199     , word8TyCon
200     , word16TyCon
201     , word32TyCon
202     , word64TyCon
203     ]
204 \end{code}
205
206
207 %************************************************************************
208 %*                                                                      *
209 \subsection{Wired in Ids}
210 %*                                                                      *
211 %************************************************************************
212
213 \begin{code}
214 wired_in_ids
215   = [   -- These error-y things are wired in because we don't yet have
216         -- a way to express in an interface file that the result type variable
217         -- is 'open'; that is can be unified with an unboxed type
218         -- 
219         -- [The interface file format now carry such information, but there's
220         --  no way yet of expressing at the definition site for these error-reporting
221         --  functions that they have an 'open' result type. -- sof 1/99]
222         -- 
223       aBSENT_ERROR_ID
224     , eRROR_ID
225     , iRREFUT_PAT_ERROR_ID
226     , nON_EXHAUSTIVE_GUARDS_ERROR_ID
227     , nO_METHOD_BINDING_ERROR_ID
228     , pAR_ERROR_ID
229     , pAT_ERROR_ID
230     , rEC_CON_ERROR_ID
231     , rEC_UPD_ERROR_ID
232
233         -- These two can't be defined in Haskell
234     , realWorldPrimId
235     , unsafeCoerceId
236     ]
237
238 \end{code}
239
240 %************************************************************************
241 %*                                                                      *
242 \subsection{Thin air entities}
243 %*                                                                      *
244 %************************************************************************
245
246 These are Ids that we need to reference in various parts of the
247 system, and we'd like to pull them out of thin air rather than pass
248 them around.  We'd also like to have all the IdInfo available for each
249 one: i.e. everything that gets pulled out of the interface file.
250
251 The solution is to generate this map of global Ids after the
252 typechecker, and assign it to a global variable.  Any subsequent
253 pass may refer to the map to pull Ids out.  Any invalid
254 (i.e. pre-typechecker) access to the map will result in a panic.
255
256 \begin{code}
257 thinAirIdNames 
258   = map mkKnownKeyGlobal
259     [
260         -- Needed for converting literals to Integers (used in tidyCoreExpr)
261       (varQual pREL_BASE SLIT("int2Integer"),  int2IntegerIdKey)        
262     , (varQual pREL_BASE SLIT("addr2Integer"), addr2IntegerIdKey)
263
264         -- OK, this is Will's idea: we should have magic values for Integers 0,
265         -- +1, +2, and -1 (go ahead, fire me):
266     , (varQual pREL_BASE SLIT("integer_0"),  integerZeroIdKey)    
267     , (varQual pREL_BASE SLIT("integer_1"),  integerPlusOneIdKey) 
268     , (varQual pREL_BASE SLIT("integer_2"),  integerPlusTwoIdKey) 
269     , (varQual pREL_BASE SLIT("integer_m1"), integerMinusOneIdKey)
270
271
272         -- String literals
273     , (varQual pREL_PACK SLIT("packCString#"),   packCStringIdKey)
274     , (varQual pREL_PACK SLIT("unpackCString#"), unpackCStringIdKey)
275     , (varQual pREL_PACK SLIT("unpackNBytes#"),  unpackCString2IdKey)
276     , (varQual pREL_PACK SLIT("unpackAppendCString#"), unpackCStringAppendIdKey)
277     , (varQual pREL_PACK SLIT("unpackFoldrCString#"),  unpackCStringFoldrIdKey)
278
279         -- Folds; introduced by desugaring list comprehensions
280     , (varQual pREL_BASE SLIT("foldr"), foldrIdKey)
281     ]
282
283 thinAirModules = [pREL_PACK]    -- See notes with RnIfaces.findAndReadIface
284
285 noRepIntegerIds = [integerZeroId, integerPlusOneId, integerPlusTwoId, integerMinusOneId,
286                    int2IntegerId, addr2IntegerId]
287
288 noRepStrIds = [unpackCString2Id, unpackCStringId]
289
290 int2IntegerId  = lookupThinAirId int2IntegerIdKey
291 addr2IntegerId = lookupThinAirId addr2IntegerIdKey
292
293 integerMinusOneId = lookupThinAirId integerMinusOneIdKey
294 integerZeroId     = lookupThinAirId integerZeroIdKey
295 integerPlusOneId  = lookupThinAirId integerPlusOneIdKey
296 integerPlusTwoId  = lookupThinAirId integerPlusTwoIdKey
297
298 packStringForCId = lookupThinAirId packCStringIdKey
299 unpackCStringId  = lookupThinAirId unpackCStringIdKey
300 unpackCString2Id = lookupThinAirId unpackCString2IdKey 
301 unpackCStringAppendId = lookupThinAirId unpackCStringAppendIdKey 
302 unpackCStringFoldrId  = lookupThinAirId unpackCStringFoldrIdKey 
303
304 foldrId = lookupThinAirId foldrIdKey
305 \end{code}
306
307
308 \begin{code}
309 \end{code}
310
311 \begin{code}
312 thinAirIdMapRef :: IORef (UniqFM Id)
313 thinAirIdMapRef = unsafePerformIO (newIORef (panic "thinAirIdMap: still empty"))
314
315 setThinAirIds :: [Id] -> IO ()
316 setThinAirIds thin_air_ids
317   = writeIORef thinAirIdMapRef the_map
318   where
319     the_map = listToUFM [(varUnique id, id) | id <- thin_air_ids]
320
321 thinAirIdMap :: UniqFM Id
322 thinAirIdMap = unsafePerformIO (readIORef thinAirIdMapRef)
323   -- Read it just once, the first time someone tugs on thinAirIdMap
324
325 lookupThinAirId :: Unique -> Id
326 lookupThinAirId uniq = lookupWithDefaultUFM thinAirIdMap
327                         (panic "lookupThinAirId: no mapping") uniq 
328 \end{code}
329
330
331 %************************************************************************
332 %*                                                                      *
333 \subsection{Built-in keys}
334 %*                                                                      *
335 %************************************************************************
336
337 Ids, Synonyms, Classes and ClassOps with builtin keys. 
338
339 \begin{code}
340 mkKnownKeyGlobal :: (RdrName, Unique) -> Name
341 mkKnownKeyGlobal (rdr_name, uniq)
342   = mkGlobalName uniq (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
343                  systemProvenance
344
345 ioTyCon_NAME      = mkKnownKeyGlobal (ioTyCon_RDR,       ioTyConKey)
346 main_NAME         = mkKnownKeyGlobal (main_RDR,          mainKey)
347
348  -- Operations needed when compiling FFI decls
349 bindIO_NAME         = mkKnownKeyGlobal (bindIO_RDR,         bindIOIdKey)
350 deRefStablePtr_NAME = mkKnownKeyGlobal (deRefStablePtr_RDR, deRefStablePtrIdKey)
351 makeStablePtr_NAME  = mkKnownKeyGlobal (makeStablePtr_RDR,  makeStablePtrIdKey)
352
353 knownKeyNames :: [Name]
354 knownKeyNames
355   = [main_NAME, ioTyCon_NAME]
356     ++
357     map mkKnownKeyGlobal
358     [
359         -- Type constructors (synonyms especially)
360       (orderingTyCon_RDR,       orderingTyConKey)
361     , (rationalTyCon_RDR,       rationalTyConKey)
362     , (ratioDataCon_RDR,        ratioDataConKey)
363     , (ratioTyCon_RDR,          ratioTyConKey)
364     , (byteArrayTyCon_RDR,      byteArrayTyConKey)
365     , (mutableByteArrayTyCon_RDR, mutableByteArrayTyConKey)
366     , (foreignObjTyCon_RDR,     foreignObjTyConKey)
367     , (stablePtrTyCon_RDR,      stablePtrTyConKey)
368
369         --  Classes.  *Must* include:
370         --      classes that are grabbed by key (e.g., eqClassKey)
371         --      classes in "Class.standardClassKeys" (quite a few)
372     , (eqClass_RDR,             eqClassKey)             -- mentioned, derivable
373     , (ordClass_RDR,            ordClassKey)            -- derivable
374     , (boundedClass_RDR,        boundedClassKey)        -- derivable
375     , (numClass_RDR,            numClassKey)            -- mentioned, numeric
376     , (enumClass_RDR,           enumClassKey)           -- derivable
377     , (monadClass_RDR,          monadClassKey)
378     , (monadPlusClass_RDR,      monadPlusClassKey)
379     , (functorClass_RDR,        functorClassKey)
380     , (showClass_RDR,           showClassKey)           -- derivable
381     , (realClass_RDR,           realClassKey)           -- numeric
382     , (integralClass_RDR,       integralClassKey)       -- numeric
383     , (fractionalClass_RDR,     fractionalClassKey)     -- numeric
384     , (floatingClass_RDR,       floatingClassKey)       -- numeric
385     , (realFracClass_RDR,       realFracClassKey)       -- numeric
386     , (realFloatClass_RDR,      realFloatClassKey)      -- numeric
387     , (readClass_RDR,           readClassKey)           -- derivable
388     , (ixClass_RDR,             ixClassKey)             -- derivable (but it isn't Prelude.Ix; hmmm)
389     , (ccallableClass_RDR,      cCallableClassKey)      -- mentioned, ccallish
390     , (creturnableClass_RDR,    cReturnableClassKey)    -- mentioned, ccallish
391
392         -- ClassOps 
393     , (fromInt_RDR,             fromIntClassOpKey)
394     , (fromInteger_RDR,         fromIntegerClassOpKey)
395     , (ge_RDR,                  geClassOpKey) 
396     , (minus_RDR,               minusClassOpKey)
397     , (enumFrom_RDR,            enumFromClassOpKey)
398     , (enumFromThen_RDR,        enumFromThenClassOpKey)
399     , (enumFromTo_RDR,          enumFromToClassOpKey)
400     , (enumFromThenTo_RDR,      enumFromThenToClassOpKey)
401     , (fromEnum_RDR,            fromEnumClassOpKey)
402     , (toEnum_RDR,              toEnumClassOpKey)
403     , (eq_RDR,                  eqClassOpKey)
404     , (thenM_RDR,               thenMClassOpKey)
405     , (returnM_RDR,             returnMClassOpKey)
406     , (failM_RDR,               failMClassOpKey)
407     , (fromRational_RDR,        fromRationalClassOpKey)
408     
409     , (deRefStablePtr_RDR,      deRefStablePtrIdKey)
410     , (makeStablePtr_RDR,       makeStablePtrIdKey)
411     , (bindIO_RDR,              bindIOIdKey)
412
413     , (map_RDR,                 mapIdKey)
414     , (append_RDR,              appendIdKey)
415
416         -- List operations
417     , (concat_RDR,              concatIdKey)
418     , (filter_RDR,              filterIdKey)
419     , (zip_RDR,                 zipIdKey)
420
421         -- Others
422     , (otherwiseId_RDR,         otherwiseIdKey)
423     , (assert_RDR,              assertIdKey)
424     ]
425 \end{code}
426
427 ToDo: make it do the ``like'' part properly (as in 0.26 and before).
428
429 \begin{code}
430 maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
431 maybeCharLikeCon con = getUnique con == charDataConKey
432 maybeIntLikeCon  con = getUnique con == intDataConKey
433 \end{code}
434
435 %************************************************************************
436 %*                                                                      *
437 \subsection{Commonly-used RdrNames}
438 %*                                                                      *
439 %************************************************************************
440
441 These RdrNames are not really "built in", but some parts of the compiler
442 (notably the deriving mechanism) need to mention their names, and it's convenient
443 to write them all down in one place.
444
445 \begin{code}
446 prelude_primop op = nameRdrName (getName (mkPrimitiveId op))
447
448 main_RDR                = varQual mAIN      SLIT("main")
449 otherwiseId_RDR         = varQual pREL_BASE SLIT("otherwise")
450
451 intTyCon_RDR            = nameRdrName (getName intTyCon)
452 ioTyCon_RDR             = tcQual   pREL_IO_BASE SLIT("IO")
453 ioDataCon_RDR           = dataQual pREL_IO_BASE SLIT("IO")
454 bindIO_RDR              = varQual  pREL_IO_BASE SLIT("bindIO")
455
456 orderingTyCon_RDR       = tcQual   pREL_BASE SLIT("Ordering")
457 rationalTyCon_RDR       = tcQual   pREL_NUM  SLIT("Rational")
458 ratioTyCon_RDR          = tcQual   pREL_NUM  SLIT("Ratio")
459 ratioDataCon_RDR        = dataQual pREL_NUM  SLIT(":%")
460
461 byteArrayTyCon_RDR              = tcQual pREL_ARR  SLIT("ByteArray")
462 mutableByteArrayTyCon_RDR       = tcQual pREL_ARR  SLIT("MutableByteArray")
463
464 foreignObjTyCon_RDR     = tcQual  pREL_IO_BASE SLIT("ForeignObj")
465 stablePtrTyCon_RDR      = tcQual  pREL_FOREIGN SLIT("StablePtr")
466 deRefStablePtr_RDR      = varQual pREL_FOREIGN SLIT("deRefStablePtr")
467 makeStablePtr_RDR       = varQual pREL_FOREIGN SLIT("makeStablePtr")
468
469 eqClass_RDR             = clsQual pREL_BASE SLIT("Eq")
470 ordClass_RDR            = clsQual pREL_BASE SLIT("Ord")
471 boundedClass_RDR        = clsQual pREL_BASE SLIT("Bounded")
472 numClass_RDR            = clsQual pREL_BASE SLIT("Num")
473 enumClass_RDR           = clsQual pREL_BASE SLIT("Enum")
474 monadClass_RDR          = clsQual pREL_BASE SLIT("Monad")
475 monadPlusClass_RDR      = clsQual pREL_BASE SLIT("MonadPlus")
476 functorClass_RDR        = clsQual pREL_BASE SLIT("Functor")
477 showClass_RDR           = clsQual pREL_BASE SLIT("Show")
478 realClass_RDR           = clsQual pREL_NUM  SLIT("Real")
479 integralClass_RDR       = clsQual pREL_NUM  SLIT("Integral")
480 fractionalClass_RDR     = clsQual pREL_NUM  SLIT("Fractional")
481 floatingClass_RDR       = clsQual pREL_NUM  SLIT("Floating")
482 realFracClass_RDR       = clsQual pREL_NUM  SLIT("RealFrac")
483 realFloatClass_RDR      = clsQual pREL_NUM  SLIT("RealFloat")
484 readClass_RDR           = clsQual pREL_READ SLIT("Read")
485 ixClass_RDR             = clsQual iX        SLIT("Ix")
486 ccallableClass_RDR      = clsQual pREL_GHC  SLIT("CCallable")
487 creturnableClass_RDR    = clsQual pREL_GHC  SLIT("CReturnable")
488
489 fromInt_RDR        = varQual pREL_BASE SLIT("fromInt")
490 fromInteger_RDR    = varQual pREL_BASE SLIT("fromInteger")
491 minus_RDR          = varQual pREL_BASE SLIT("-")
492 succ_RDR           = varQual pREL_BASE SLIT("succ")
493 pred_RDR           = varQual pREL_BASE SLIT("pred")
494 toEnum_RDR         = varQual pREL_BASE SLIT("toEnum")
495 fromEnum_RDR       = varQual pREL_BASE SLIT("fromEnum")
496 enumFrom_RDR       = varQual pREL_BASE SLIT("enumFrom")
497 enumFromTo_RDR     = varQual pREL_BASE SLIT("enumFromTo")
498 enumFromThen_RDR   = varQual pREL_BASE SLIT("enumFromThen")
499 enumFromThenTo_RDR = varQual pREL_BASE SLIT("enumFromThenTo")
500
501 thenM_RDR          = varQual pREL_BASE SLIT(">>=")
502 returnM_RDR        = varQual pREL_BASE SLIT("return")
503 failM_RDR          = varQual pREL_BASE SLIT("fail")
504
505 fromRational_RDR   = varQual pREL_NUM  SLIT("fromRational")
506 negate_RDR         = varQual pREL_BASE SLIT("negate")
507 eq_RDR             = varQual pREL_BASE SLIT("==")
508 ne_RDR             = varQual pREL_BASE SLIT("/=")
509 le_RDR             = varQual pREL_BASE SLIT("<=")
510 lt_RDR             = varQual pREL_BASE SLIT("<")
511 ge_RDR             = varQual pREL_BASE SLIT(">=")
512 gt_RDR             = varQual pREL_BASE SLIT(">")
513 ltTag_RDR          = dataQual pREL_BASE SLIT("LT")
514 eqTag_RDR          = dataQual pREL_BASE SLIT("EQ")
515 gtTag_RDR          = dataQual pREL_BASE SLIT("GT")
516 max_RDR            = varQual pREL_BASE SLIT("max")
517 min_RDR            = varQual pREL_BASE SLIT("min")
518 compare_RDR        = varQual pREL_BASE SLIT("compare")
519 minBound_RDR       = varQual pREL_BASE SLIT("minBound")
520 maxBound_RDR       = varQual pREL_BASE SLIT("maxBound")
521 false_RDR          = dataQual pREL_BASE SLIT("False")
522 true_RDR           = dataQual pREL_BASE SLIT("True")
523 and_RDR            = varQual pREL_BASE SLIT("&&")
524 not_RDR            = varQual pREL_BASE SLIT("not")
525 compose_RDR        = varQual pREL_BASE SLIT(".")
526 append_RDR         = varQual pREL_BASE SLIT("++")
527 map_RDR            = varQual pREL_BASE SLIT("map")
528 concat_RDR         = varQual mONAD     SLIT("concat")
529 filter_RDR         = varQual mONAD     SLIT("filter")
530 zip_RDR            = varQual pREL_LIST SLIT("zip")
531
532 showList___RDR     = varQual pREL_BASE  SLIT("showList__")
533 showsPrec_RDR      = varQual pREL_BASE SLIT("showsPrec")
534 showList_RDR       = varQual pREL_BASE SLIT("showList")
535 showSpace_RDR      = varQual pREL_BASE SLIT("showSpace")
536 showString_RDR     = varQual pREL_BASE SLIT("showString")
537 showParen_RDR      = varQual pREL_BASE SLIT("showParen")
538
539 range_RDR          = varQual iX   SLIT("range")
540 index_RDR          = varQual iX   SLIT("index")
541 inRange_RDR        = varQual iX   SLIT("inRange")
542
543 readsPrec_RDR      = varQual pREL_READ SLIT("readsPrec")
544 readList_RDR       = varQual pREL_READ SLIT("readList")
545 readParen_RDR      = varQual pREL_READ SLIT("readParen")
546 lex_RDR            = varQual pREL_READ SLIT("lex")
547 readList___RDR     = varQual pREL_READ SLIT("readList__")
548
549 plus_RDR           = varQual pREL_BASE SLIT("+")
550 times_RDR          = varQual pREL_BASE SLIT("*")
551 mkInt_RDR          = dataQual pREL_BASE SLIT("I#")
552
553 error_RDR          = varQual pREL_ERR SLIT("error")
554 assert_RDR         = varQual pREL_GHC SLIT("assert")
555 assertErr_RDR      = varQual pREL_ERR SLIT("assertError")
556
557 eqH_Char_RDR    = prelude_primop CharEqOp
558 ltH_Char_RDR    = prelude_primop CharLtOp
559 eqH_Word_RDR    = prelude_primop WordEqOp
560 ltH_Word_RDR    = prelude_primop WordLtOp
561 eqH_Addr_RDR    = prelude_primop AddrEqOp
562 ltH_Addr_RDR    = prelude_primop AddrLtOp
563 eqH_Float_RDR   = prelude_primop FloatEqOp
564 ltH_Float_RDR   = prelude_primop FloatLtOp
565 eqH_Double_RDR  = prelude_primop DoubleEqOp
566 ltH_Double_RDR  = prelude_primop DoubleLtOp
567 eqH_Int_RDR     = prelude_primop IntEqOp
568 ltH_Int_RDR     = prelude_primop IntLtOp
569 geH_RDR         = prelude_primop IntGeOp
570 leH_RDR         = prelude_primop IntLeOp
571 minusH_RDR      = prelude_primop IntSubOp
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, 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 the constructor.  Ugh!
686 cCallishTyKeys = 
687         [ addrTyConKey
688         , wordTyConKey
689         , byteArrayTyConKey
690         , mutableByteArrayTyConKey
691         , foreignObjTyConKey
692         , stablePtrTyConKey
693         ]
694
695 standardClassKeys
696   = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys
697     --
698     -- We have to have "CCallable" and "CReturnable" in the standard
699     -- classes, so that if you go...
700     --
701     --      _ccall_ foo ... 93{-numeric literal-} ...
702     --
703     -- ... it can do The Right Thing on the 93.
704
705 noDictClassKeys         -- These classes are used only for type annotations;
706                         -- they are not implemented by dictionaries, ever.
707   = cCallishClassKeys
708 \end{code}
709
710
711 %************************************************************************
712 %*                                                                      *
713 \subsection{Local helpers}
714 %*                                                                      *
715 %************************************************************************
716
717 \begin{code}
718 varQual  = mkPreludeQual varName
719 dataQual = mkPreludeQual dataName
720 tcQual   = mkPreludeQual tcName
721 clsQual  = mkPreludeQual clsName
722 \end{code}
723