ghc/compiler/prelude/PrelInfo.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module PrelInfo (
  10
  11         -- finite maps for built-in things (for the renamer and typechecker):
  12         builtinNameInfo, BuiltinNames(..),
  13         BuiltinKeys(..), BuiltinIdInfos(..),
  14
  15         maybeCharLikeTyCon, maybeIntLikeTyCon
  16     ) where
  17
  18 import Ubiq
  19 import PrelLoop         ( primOpNameInfo )
  20
  21 -- friends:
  22 import PrelMods         -- Prelude module names
  23 import PrelVals         -- VALUES
  24 import PrimOp           ( PrimOp(..), allThePrimOps )
  25 import PrimRep          ( PrimRep(..) )
  26 import TysPrim          -- TYPES
  27 import TysWiredIn
  28
  29 -- others:
  30 import CmdLineOpts      ( opt_HideBuiltinNames,
  31                           opt_HideMostBuiltinNames,
  32                           opt_ForConcurrent
  33                         )
  34 import FiniteMap        ( FiniteMap, emptyFM, listToFM )
  35 import Id               ( mkTupleCon, GenId, Id(..) )
  36 import Maybes           ( catMaybes )
  37 import Name             ( moduleNamePair )
  38 import RnHsSyn          ( RnName(..) )
  39 import TyCon            ( tyConDataCons, mkFunTyCon, mkTupleTyCon, TyCon )
  40 import Type
  41 import UniqFM           ( UniqFM, emptyUFM, listToUFM )
  42 import Unique           -- *Key stuff
  43 import Util             ( nOfThem, panic )
  44 \end{code}
  45
  46 %************************************************************************
  47 %*                                                                      *
  48 \subsection[builtinNameInfo]{Lookup built-in names}
  49 %*                                                                      *
  50 %************************************************************************
  51
  52 We have two ``builtin name funs,'' one to look up @TyCons@ and
  53 @Classes@, the other to look up values.
  54
  55 \begin{code}
  56 builtinNameInfo :: ( BuiltinNames, BuiltinKeys, BuiltinIdInfos )
  57
  58 type BuiltinNames   = (FiniteMap (FAST_STRING,Module) RnName, -- WiredIn Ids
  59                        FiniteMap (FAST_STRING,Module) RnName) -- WiredIn TyCons
  60                         -- Two maps because "[]" is in both...
  61
  62 type BuiltinKeys    = FiniteMap (FAST_STRING,Module) (Unique, Name -> RnName)
  63                                                      -- Names with known uniques
  64
  65 type BuiltinIdInfos = UniqFM IdInfo                  -- Info for known unique Ids
  66
  67 builtinNameInfo
  68   = if opt_HideBuiltinNames then
  69         (
  70          (emptyFM, emptyFM),
  71          emptyFM,
  72          emptyUFM
  73         )
  74     else if opt_HideMostBuiltinNames then
  75         (
  76          (listToFM min_assoc_val_wired, listToFM min_assoc_tc_wired),
  77          emptyFM,
  78          emptyUFM
  79         )
  80     else
  81         (
  82          (listToFM assoc_val_wired, listToFM assoc_tc_wired),
  83          listToFM assoc_keys,
  84          listToUFM assoc_id_infos
  85         )
  86
  87   where
  88     min_assoc_val_wired -- min needed when compiling bits of Prelude
  89       = concat [
  90             -- data constrs
  91             concat (map pcDataConWiredInInfo g_con_tycons),
  92             concat (map pcDataConWiredInInfo min_nonprim_tycon_list),
  93
  94             -- values
  95             map pcIdWiredInInfo wired_in_ids,
  96             primop_ids
  97          ]
  98     min_assoc_tc_wired
  99       = concat [
 100             -- tycons
 101             map pcTyConWiredInInfo prim_tycons,
 102             map pcTyConWiredInInfo g_tycons,
 103             map pcTyConWiredInInfo min_nonprim_tycon_list
 104          ]
 105
 106     assoc_val_wired
 107         = concat [
 108             -- data constrs
 109             concat (map pcDataConWiredInInfo g_con_tycons),
 110             concat (map pcDataConWiredInInfo data_tycons),
 111
 112             -- values
 113             map pcIdWiredInInfo wired_in_ids,
 114             map pcIdWiredInInfo parallel_ids,
 115             primop_ids
 116           ]
 117     assoc_tc_wired
 118         = concat [
 119             -- tycons
 120             map pcTyConWiredInInfo prim_tycons,
 121             map pcTyConWiredInInfo g_tycons,
 122             map pcTyConWiredInInfo data_tycons,
 123             map pcTyConWiredInInfo synonym_tycons
 124           ]
 125
 126     assoc_keys
 127         = concat
 128           [
 129             id_keys,
 130             tysyn_keys,
 131             class_keys,
 132             class_op_keys
 133           ]
 134
 135     id_keys = map id_key id_keys_infos
 136     id_key (str_mod, uniq, info) = (str_mod, (uniq, RnImplicit))
 137
 138     assoc_id_infos = catMaybes (map assoc_info id_keys_infos)
 139     assoc_info (str_mod, uniq, Just info) = Just (uniq, info)
 140     assoc_info (str_mod, uniq, Nothing)   = Nothing
 141 \end{code}
 142
 143
 144 We let a lot of "non-standard" values be visible, so that we can make
 145 sense of them in interface pragmas. It's cool, though they all have
 146 "non-standard" names, so they won't get past the parser in user code.
 147
 148 The WiredIn TyCons and DataCons ...
 149 \begin{code}
 150
 151 prim_tycons
 152   = [ addrPrimTyCon
 153     , arrayPrimTyCon
 154     , byteArrayPrimTyCon
 155     , charPrimTyCon
 156     , doublePrimTyCon
 157     , floatPrimTyCon
 158     , intPrimTyCon
 159     , foreignObjPrimTyCon
 160     , mutableArrayPrimTyCon
 161     , mutableByteArrayPrimTyCon
 162     , synchVarPrimTyCon
 163     , realWorldTyCon
 164     , stablePtrPrimTyCon
 165     , statePrimTyCon
 166     , wordPrimTyCon
 167     ]
 168
 169 g_tycons
 170   = mkFunTyCon : g_con_tycons
 171
 172 g_con_tycons
 173   = listTyCon : mkTupleTyCon 0 : [mkTupleTyCon i | i <- [2..32] ]
 174
 175 min_nonprim_tycon_list  -- used w/ HideMostBuiltinNames
 176   = [ boolTyCon
 177     , orderingTyCon
 178     , charTyCon
 179     , intTyCon
 180     , floatTyCon
 181     , doubleTyCon
 182     , integerTyCon
 183     , ratioTyCon
 184     , liftTyCon
 185     , return2GMPsTyCon  -- ADR asked for these last two (WDP 94/11)
 186     , returnIntAndGMPTyCon
 187     ]
 188
 189
 190 data_tycons
 191   = [ addrTyCon
 192     , boolTyCon
 193     , charTyCon
 194     , orderingTyCon
 195     , doubleTyCon
 196     , floatTyCon
 197     , intTyCon
 198     , integerTyCon
 199     , liftTyCon
 200     , foreignObjTyCon
 201     , ratioTyCon
 202     , return2GMPsTyCon
 203     , returnIntAndGMPTyCon
 204     , stablePtrTyCon
 205     , stateAndAddrPrimTyCon
 206     , stateAndArrayPrimTyCon
 207     , stateAndByteArrayPrimTyCon
 208     , stateAndCharPrimTyCon
 209     , stateAndDoublePrimTyCon
 210     , stateAndFloatPrimTyCon
 211     , stateAndIntPrimTyCon
 212     , stateAndForeignObjPrimTyCon
 213     , stateAndMutableArrayPrimTyCon
 214     , stateAndMutableByteArrayPrimTyCon
 215     , stateAndSynchVarPrimTyCon
 216     , stateAndPtrPrimTyCon
 217     , stateAndStablePtrPrimTyCon
 218     , stateAndWordPrimTyCon
 219     , stateTyCon
 220     , wordTyCon
 221     ]
 222
 223 synonym_tycons
 224   = [ primIoTyCon
 225     , rationalTyCon
 226     , stTyCon
 227     , stringTyCon
 228     ]
 229 \end{code}
 230
 231 The WiredIn Ids ...
 232 ToDo: Some of these should be moved to id_keys_infos!
 233 \begin{code}
 234 wired_in_ids
 235   = [ eRROR_ID
 236     , pAT_ERROR_ID      -- occurs in i/faces
 237     , pAR_ERROR_ID      -- ditto
 238     , tRACE_ID
 239
 240     , runSTId
 241     , seqId
 242     , realWorldPrimId
 243
 244       -- foldr/build Ids have magic unfoldings
 245     , buildId
 246     , augmentId
 247     , foldlId
 248     , foldrId
 249     , unpackCStringAppendId
 250     , unpackCStringFoldrId
 251     ]
 252
 253 parallel_ids
 254   = if not opt_ForConcurrent then
 255         []
 256     else
 257         [ parId
 258         , forkId
 259         , copyableId
 260         , noFollowId
 261         , parAtAbsId
 262         , parAtForNowId
 263         , parAtId
 264         , parAtRelId
 265         , parGlobalId
 266         , parLocalId
 267         ]
 268
 269
 270 pcTyConWiredInInfo :: TyCon -> ((FAST_STRING,Module), RnName)
 271 pcTyConWiredInInfo tc = (swap (moduleNamePair tc), WiredInTyCon tc)
 272
 273 pcDataConWiredInInfo :: TyCon -> [((FAST_STRING,Module), RnName)]
 274 pcDataConWiredInInfo tycon
 275   = [ (swap (moduleNamePair con), WiredInId con) | con <- tyConDataCons tycon ]
 276
 277 pcIdWiredInInfo :: Id -> ((FAST_STRING,Module), RnName)
 278 pcIdWiredInInfo id = (swap (moduleNamePair id), WiredInId id)
 279
 280 swap (x,y) = (y,x)
 281 \end{code}
 282
 283 WiredIn primitive numeric operations ...
 284 \begin{code}
 285 primop_ids
 286   = map prim_fn allThePrimOps ++ map funny_fn funny_name_primops
 287   where
 288     prim_fn  op     = case (primOpNameInfo op) of (s,n) -> ((s,pRELUDE),n)
 289     funny_fn (op,s) = case (primOpNameInfo op) of (_,n) -> ((s,pRELUDE),n)
 290
 291 funny_name_primops
 292   = [ (IntAddOp,      SLIT("+#"))
 293     , (IntSubOp,      SLIT("-#"))
 294     , (IntMulOp,      SLIT("*#"))
 295     , (IntGtOp,       SLIT(">#"))
 296     , (IntGeOp,       SLIT(">=#"))
 297     , (IntEqOp,       SLIT("==#"))
 298     , (IntNeOp,       SLIT("/=#"))
 299     , (IntLtOp,       SLIT("<#"))
 300     , (IntLeOp,       SLIT("<=#"))
 301     , (DoubleAddOp,   SLIT("+##"))
 302     , (DoubleSubOp,   SLIT("-##"))
 303     , (DoubleMulOp,   SLIT("*##"))
 304     , (DoubleDivOp,   SLIT("/##"))
 305     , (DoublePowerOp, SLIT("**##"))
 306     , (DoubleGtOp,    SLIT(">##"))
 307     , (DoubleGeOp,    SLIT(">=##"))
 308     , (DoubleEqOp,    SLIT("==##"))
 309     , (DoubleNeOp,    SLIT("/=##"))
 310     , (DoubleLtOp,    SLIT("<##"))
 311     , (DoubleLeOp,    SLIT("<=##"))
 312     ]
 313 \end{code}
 314
 315
 316 Ids, Synonyms, Classes and ClassOps with builtin keys.
 317 For the Ids we may also have some builtin IdInfo.
 318 \begin{code}
 319 id_keys_infos :: [((FAST_STRING,Module), Unique, Maybe IdInfo)]
 320 id_keys_infos
 321   = [ ((SLIT("main"),SLIT("Main")),       mainIdKey,       Nothing)
 322     , ((SLIT("mainPrimIO"),SLIT("Main")), mainPrimIOIdKey, Nothing)
 323     ]
 324
 325 tysyn_keys
 326   = [ ((SLIT("IO"),pRELUDE), (iOTyConKey, RnImplicitTyCon))
 327     ]
 328
 329 -- this "class_keys" list *must* include:
 330 --  classes that are grabbed by key (e.g., eqClassKey)
 331 --  classes in "Class.standardClassKeys" (quite a few)
 332
 333 class_keys
 334   = [ (str_mod, (k, RnImplicitClass)) | (str_mod,k) <-
 335     [ ((SLIT("Eq"),pRELUDE),            eqClassKey)             -- mentioned, derivable
 336     , ((SLIT("Eval"),pRELUDE),          evalClassKey)           -- mentioned
 337     , ((SLIT("Ord"),pRELUDE),           ordClassKey)            -- derivable
 338     , ((SLIT("Num"),pRELUDE),           numClassKey)            -- mentioned, numeric
 339     , ((SLIT("Real"),pRELUDE),          realClassKey)           -- numeric
 340     , ((SLIT("Integral"),pRELUDE),      integralClassKey)       -- numeric
 341     , ((SLIT("Fractional"),pRELUDE),    fractionalClassKey)     -- numeric
 342     , ((SLIT("Floating"),pRELUDE),      floatingClassKey)       -- numeric
 343     , ((SLIT("RealFrac"),pRELUDE),      realFracClassKey)       -- numeric
 344     , ((SLIT("RealFloat"),pRELUDE),     realFloatClassKey)      -- numeric
 345     , ((SLIT("Ix"),iX),                 ixClassKey)             -- derivable (but it isn't Prelude.Ix; hmmm)
 346     , ((SLIT("Bounded"),pRELUDE),       boundedClassKey)        -- derivable
 347     , ((SLIT("Enum"),pRELUDE),          enumClassKey)           -- derivable
 348     , ((SLIT("Show"),pRELUDE),          showClassKey)           -- derivable
 349     , ((SLIT("Read"),pRELUDE),          readClassKey)           -- derivable
 350     , ((SLIT("Monad"),pRELUDE),         monadClassKey)
 351     , ((SLIT("MonadZero"),pRELUDE),     monadZeroClassKey)
 352     , ((SLIT("MonadPlus"),pRELUDE),     monadPlusClassKey)
 353     , ((SLIT("Functor"),pRELUDE),       functorClassKey)
 354     , ((SLIT("CCallable"),pRELUDE),     cCallableClassKey)      -- mentioned, ccallish
 355     , ((SLIT("CReturnable"),pRELUDE),   cReturnableClassKey)    -- mentioned, ccallish
 356     ]]
 357
 358 class_op_keys
 359   = [ (str_mod, (k, RnImplicit)) | (str_mod,k) <-
 360     [ ((SLIT("fromInt"),pRELUDE),       fromIntClassOpKey)
 361     , ((SLIT("fromInteger"),pRELUDE),   fromIntegerClassOpKey)
 362     , ((SLIT("fromRational"),pRELUDE),  fromRationalClassOpKey)
 363     , ((SLIT("enumFrom"),pRELUDE),      enumFromClassOpKey)
 364     , ((SLIT("enumFromThen"),pRELUDE),  enumFromThenClassOpKey)
 365     , ((SLIT("enumFromTo"),pRELUDE),    enumFromToClassOpKey)
 366     , ((SLIT("enumFromThenTo"),pRELUDE),enumFromThenToClassOpKey)
 367     , ((SLIT("=="),pRELUDE),            eqClassOpKey)
 368     ]]
 369 \end{code}
 370
 371 ToDo: make it do the ``like'' part properly (as in 0.26 and before).
 372 \begin{code}
 373 maybeCharLikeTyCon tc = if (uniqueOf tc == charDataConKey) then Just charDataCon else Nothing
 374 maybeIntLikeTyCon  tc = if (uniqueOf tc == intDataConKey)  then Just intDataCon  else Nothing
 375 \end{code}