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         pRELUDE, pRELUDE_BUILTIN, pRELUDE_CORE, pRELUDE_RATIO,
  12         pRELUDE_LIST, pRELUDE_TEXT,
  13         pRELUDE_PRIMIO, pRELUDE_IO, pRELUDE_PS,
  14         gLASGOW_ST, gLASGOW_MISC,
  15
  16         -- lookup functions for built-in names, for the renamer:
  17         builtinNameInfo,
  18
  19         -- *odd* values that need to be reached out and grabbed:
  20         eRROR_ID, pAT_ERROR_ID, aBSENT_ERROR_ID,
  21         packStringForCId,
  22         unpackCStringId, unpackCString2Id,
  23         unpackCStringAppendId, unpackCStringFoldrId,
  24         integerZeroId, integerPlusOneId,
  25         integerPlusTwoId, integerMinusOneId,
  26
  27         -----------------------------------------------------
  28         -- the rest of the export list is organised by *type*
  29         -----------------------------------------------------
  30
  31         -- type: Bool
  32         boolTyCon, boolTy, falseDataCon, trueDataCon,
  33
  34         -- types: Char#, Char, String (= [Char])
  35         charPrimTy, charTy, stringTy,
  36         charPrimTyCon, charTyCon, charDataCon,
  37
  38         -- type: Ordering (used in deriving)
  39         orderingTy, ltDataCon, eqDataCon, gtDataCon,
  40
  41         -- types: Double#, Double
  42         doublePrimTy, doubleTy,
  43         doublePrimTyCon, doubleTyCon, doubleDataCon,
  44
  45         -- types: Float#, Float
  46         floatPrimTy, floatTy,
  47         floatPrimTyCon, floatTyCon, floatDataCon,
  48
  49         -- types: Glasgow *primitive* arrays, sequencing and I/O
  50         mkPrimIoTy, -- to typecheck "mainPrimIO" & for _ccall_s
  51         realWorldStatePrimTy, realWorldStateTy{-boxed-},
  52         realWorldTy, realWorldTyCon, realWorldPrimId,
  53         statePrimTyCon, stateDataCon, getStatePairingConInfo,
  54
  55         byteArrayPrimTy,
  56
  57         -- types: Void# (only used within the compiler)
  58         voidPrimTy, voidPrimId,
  59
  60         -- types: Addr#, Int#, Word#, Int
  61         intPrimTy, intTy, intPrimTyCon, intTyCon, intDataCon,
  62         wordPrimTyCon, wordPrimTy, wordTy, wordTyCon, wordDataCon,
  63         addrPrimTyCon, addrPrimTy, addrTy, addrTyCon, addrDataCon,
  64
  65         -- types: Integer, Rational (= Ratio Integer)
  66         integerTy, rationalTy,
  67         integerTyCon, integerDataCon,
  68         rationalTyCon, ratioDataCon,
  69
  70         -- type: Lift
  71         liftTyCon, liftDataCon, mkLiftTy,
  72
  73         -- type: List
  74         listTyCon, mkListTy, nilDataCon, consDataCon,
  75
  76         -- type: tuples
  77         mkTupleTy, unitTy,
  78
  79         -- for compilation of List Comprehensions and foldr
  80         foldlId, foldrId,
  81         mkBuild, buildId, augmentId, appendId
  82
  83         -- and, finally, we must put in some (abstract) data types,
  84         -- to make the interface self-sufficient
  85     ) where
  86
  87 import Ubiq
  88 import PrelLoop         ( primOpNameInfo )
  89
  90 -- friends:
  91 import PrelMods         -- Prelude module names
  92 import PrelVals         -- VALUES
  93 import PrimOp           ( PrimOp(..), allThePrimOps )
  94 import PrimRep          ( PrimRep(..) )
  95 import TysPrim          -- TYPES
  96 import TysWiredIn
  97
  98 -- others:
  99 import CmdLineOpts
 100 import FiniteMap
 101 import Id               ( mkTupleCon, GenId{-instances-} )
 102 import Name             ( Name(..) )
 103 import NameTypes        ( mkPreludeCoreName, FullName, ShortName )
 104 import TyCon            ( tyConDataCons, mkFunTyCon, mkTupleTyCon, TyCon{-instances-} )
 105 import Type
 106 import Unique           -- *Key stuff
 107 import Util             ( nOfThem, panic )
 108 \end{code}
 109
 110 %************************************************************************
 111 %*                                                                      *
 112 \subsection[builtinNameInfo]{Lookup built-in names}
 113 %*                                                                      *
 114 %************************************************************************
 115
 116 We have two ``builtin name funs,'' one to look up @TyCons@ and
 117 @Classes@, the other to look up values.
 118
 119 \begin{code}
 120 builtinNameInfo :: (FAST_STRING -> Maybe Name,  -- name lookup fn for values
 121                     FAST_STRING -> Maybe Name)  -- name lookup fn for tycons/classes
 122
 123 builtinNameInfo
 124   = (init_val_lookup_fn, init_tc_lookup_fn)
 125   where
 126     --
 127     -- values (including data constructors)
 128     --
 129     init_val_lookup_fn
 130       = if      opt_HideBuiltinNames then
 131                 (\ x -> Nothing)
 132         else if opt_HideMostBuiltinNames then
 133                 lookupFM (listToFM (concat min_val_assoc_lists))
 134         else
 135                 lookupFM (listToFM (concat val_assoc_lists))
 136
 137     min_val_assoc_lists         -- min needed when compiling bits of Prelude
 138         = [
 139             concat (map pcDataConNameInfo g_con_tycons),
 140             concat (map pcDataConNameInfo min_nonprim_tycon_list),
 141             totally_wired_in_Ids,
 142             unboxed_ops
 143           ]
 144
 145     val_assoc_lists
 146         = [
 147             concat (map pcDataConNameInfo g_con_tycons),
 148             concat (map pcDataConNameInfo data_tycons),
 149             totally_wired_in_Ids,
 150             unboxed_ops,
 151             special_class_ops,
 152             if opt_ForConcurrent then parallel_vals else []
 153           ]
 154
 155     --
 156     -- type constructors and classes
 157     --
 158     init_tc_lookup_fn
 159       = if      opt_HideBuiltinNames then
 160                 (\ x -> Nothing)
 161         else if opt_HideMostBuiltinNames then
 162                 lookupFM (listToFM (concat min_tc_assoc_lists))
 163         else
 164                 lookupFM (listToFM (concat tc_assoc_lists))
 165
 166     min_tc_assoc_lists  -- again, pretty ad-hoc
 167         = [
 168             map pcTyConNameInfo prim_tycons,
 169             map pcTyConNameInfo g_tycons,
 170             map pcTyConNameInfo min_nonprim_tycon_list
 171           ]
 172
 173     tc_assoc_lists
 174         = [
 175             map pcTyConNameInfo prim_tycons,
 176             map pcTyConNameInfo g_tycons,
 177             map pcTyConNameInfo data_tycons,
 178             map pcTyConNameInfo synonym_tycons,
 179             std_tycon_list,
 180             std_class_list
 181           ]
 182
 183     -- We let a lot of "non-standard" values be visible, so that we
 184     -- can make sense of them in interface pragmas. It's cool, though
 185     -- they all have "non-standard" names, so they won't get past
 186     -- the parser in user code.
 187
 188
 189 prim_tycons
 190   = [addrPrimTyCon,
 191      arrayPrimTyCon,
 192      byteArrayPrimTyCon,
 193      charPrimTyCon,
 194      doublePrimTyCon,
 195      floatPrimTyCon,
 196      intPrimTyCon,
 197      mallocPtrPrimTyCon,
 198      mutableArrayPrimTyCon,
 199      mutableByteArrayPrimTyCon,
 200      synchVarPrimTyCon,
 201      realWorldTyCon,
 202      stablePtrPrimTyCon,
 203      statePrimTyCon,
 204      wordPrimTyCon
 205     ]
 206
 207 g_tycons
 208   = mkFunTyCon : g_con_tycons
 209
 210 g_con_tycons
 211   = listTyCon : mkTupleTyCon 0 : [mkTupleTyCon i | i <- [2..32] ]
 212
 213 min_nonprim_tycon_list  -- used w/ HideMostBuiltinNames
 214   = [ boolTyCon,
 215       orderingTyCon,
 216       charTyCon,
 217       intTyCon,
 218       floatTyCon,
 219       doubleTyCon,
 220       integerTyCon,
 221       ratioTyCon,
 222       liftTyCon,
 223       return2GMPsTyCon, -- ADR asked for these last two (WDP 94/11)
 224       returnIntAndGMPTyCon ]
 225
 226 data_tycons
 227   = [addrTyCon,
 228      boolTyCon,
 229 --   byteArrayTyCon,
 230      charTyCon,
 231      orderingTyCon,
 232      doubleTyCon,
 233      floatTyCon,
 234      intTyCon,
 235      integerTyCon,
 236      liftTyCon,
 237      mallocPtrTyCon,
 238 --   mutableArrayTyCon,
 239 --   mutableByteArrayTyCon,
 240      ratioTyCon,
 241      return2GMPsTyCon,
 242      returnIntAndGMPTyCon,
 243      stablePtrTyCon,
 244      stateAndAddrPrimTyCon,
 245      stateAndArrayPrimTyCon,
 246      stateAndByteArrayPrimTyCon,
 247      stateAndCharPrimTyCon,
 248      stateAndDoublePrimTyCon,
 249      stateAndFloatPrimTyCon,
 250      stateAndIntPrimTyCon,
 251      stateAndMallocPtrPrimTyCon,
 252      stateAndMutableArrayPrimTyCon,
 253      stateAndMutableByteArrayPrimTyCon,
 254      stateAndSynchVarPrimTyCon,
 255      stateAndPtrPrimTyCon,
 256      stateAndStablePtrPrimTyCon,
 257      stateAndWordPrimTyCon,
 258      stateTyCon,
 259      wordTyCon
 260     ]
 261
 262 synonym_tycons
 263   = [primIoTyCon,
 264      rationalTyCon,
 265      stTyCon,
 266      stringTyCon]
 267
 268
 269 totally_wired_in_Ids
 270   = [(SLIT("error"),            WiredInVal eRROR_ID),
 271      (SLIT("patError#"),        WiredInVal pAT_ERROR_ID), -- occurs in i/faces
 272      (SLIT("parError#"),        WiredInVal pAR_ERROR_ID), -- ditto
 273      (SLIT("_trace"),           WiredInVal tRACE_ID),
 274
 275      -- now the foldr/build Ids, which need to be built in
 276      -- because they have magic unfoldings
 277      (SLIT("_build"),           WiredInVal buildId),
 278      (SLIT("_augment"),         WiredInVal augmentId),
 279      (SLIT("foldl"),            WiredInVal foldlId),
 280      (SLIT("foldr"),            WiredInVal foldrId),
 281      (SLIT("unpackAppendPS#"),  WiredInVal unpackCStringAppendId),
 282      (SLIT("unpackFoldrPS#"),   WiredInVal unpackCStringFoldrId),
 283
 284      (SLIT("_runST"),           WiredInVal runSTId),
 285      (SLIT("_seq_"),            WiredInVal seqId),  -- yes, used in sequential-land, too
 286                                                     -- WDP 95/11
 287      (SLIT("realWorld#"),       WiredInVal realWorldPrimId)
 288     ]
 289
 290 parallel_vals
 291   =[(SLIT("_par_"),             WiredInVal parId),
 292     (SLIT("_fork_"),            WiredInVal forkId)
 293 #ifdef GRAN
 294     ,
 295     (SLIT("_parLocal_"),        WiredInVal parLocalId),
 296     (SLIT("_parGlobal_"),       WiredInVal parGlobalId)
 297     -- Add later:
 298     -- (SLIT("_parAt_"),        WiredInVal parAtId)
 299     -- (SLIT("_parAtForNow_"),  WiredInVal parAtForNowId)
 300     -- (SLIT("_copyable_"),     WiredInVal copyableId)
 301     -- (SLIT("_noFollow_"),     WiredInVal noFollowId)
 302 #endif {-GRAN-}
 303    ]
 304
 305 special_class_ops
 306   = let
 307         swizzle_over (str, key)
 308           = (str, ClassOpName key bottom1 str bottom2)
 309
 310         bottom1 = panic "PrelInfo.special_class_ops:class"
 311         bottom2 = panic "PrelInfo.special_class_ops:tag"
 312     in
 313      map swizzle_over
 314       [ (SLIT("fromInt"),       fromIntClassOpKey),
 315         (SLIT("fromInteger"),   fromIntegerClassOpKey),
 316         (SLIT("fromRational"),  fromRationalClassOpKey),
 317         (SLIT("enumFrom"),      enumFromClassOpKey),
 318         (SLIT("enumFromThen"),  enumFromThenClassOpKey),
 319         (SLIT("enumFromTo"),    enumFromToClassOpKey),
 320         (SLIT("enumFromThenTo"),enumFromThenToClassOpKey),
 321         (SLIT("=="),            eqClassOpKey),
 322         (SLIT(">="),            geClassOpKey),
 323         (SLIT("-"),             negateClassOpKey)
 324       ]
 325
 326 unboxed_ops
 327   =  map primOpNameInfo allThePrimOps
 328      -- plus some of the same ones but w/ different names ...
 329   ++ map fn funny_name_primops
 330   where
 331     fn (op,s) = case (primOpNameInfo op) of (_,n) -> (s,n)
 332
 333 funny_name_primops
 334   = [(IntAddOp,      SLIT("+#")),
 335      (IntSubOp,      SLIT("-#")),
 336      (IntMulOp,      SLIT("*#")),
 337      (IntGtOp,       SLIT(">#")),
 338      (IntGeOp,       SLIT(">=#")),
 339      (IntEqOp,       SLIT("==#")),
 340      (IntNeOp,       SLIT("/=#")),
 341      (IntLtOp,       SLIT("<#")),
 342      (IntLeOp,       SLIT("<=#")),
 343      (DoubleAddOp,   SLIT("+##")),
 344      (DoubleSubOp,   SLIT("-##")),
 345      (DoubleMulOp,   SLIT("*##")),
 346      (DoubleDivOp,   SLIT("/##")),
 347      (DoublePowerOp, SLIT("**##")),
 348      (DoubleGtOp,    SLIT(">##")),
 349      (DoubleGeOp,    SLIT(">=##")),
 350      (DoubleEqOp,    SLIT("==##")),
 351      (DoubleNeOp,    SLIT("/=##")),
 352      (DoubleLtOp,    SLIT("<##")),
 353      (DoubleLeOp,    SLIT("<=##"))]
 354
 355
 356 std_tycon_list
 357   = let
 358         swizzle_over (mod, nm, key, arity, is_data)
 359           = let
 360                 fname = mkPreludeCoreName mod nm
 361             in
 362             (nm, TyConName key fname arity is_data (panic "std_tycon_list:data_cons"))
 363     in
 364     map swizzle_over
 365         [(SLIT("PreludeMonadicIO"), SLIT("IO"), iOTyConKey,    1, False)
 366         ]
 367
 368 std_class_list
 369   = let
 370         swizzle_over (str, key)
 371           = (str, ClassName key (mkPreludeCoreName pRELUDE_CORE str) (panic "std_class_list:ops"))
 372     in
 373     map swizzle_over
 374         [(SLIT("Eq"),           eqClassKey),
 375          (SLIT("Ord"),          ordClassKey),
 376          (SLIT("Num"),          numClassKey),
 377          (SLIT("Real"),         realClassKey),
 378          (SLIT("Integral"),     integralClassKey),
 379          (SLIT("Fractional"),   fractionalClassKey),
 380          (SLIT("Floating"),     floatingClassKey),
 381          (SLIT("RealFrac"),     realFracClassKey),
 382          (SLIT("RealFloat"),    realFloatClassKey),
 383          (SLIT("Ix"),           ixClassKey),
 384          (SLIT("Enum"),         enumClassKey),
 385          (SLIT("Show"),         showClassKey),
 386          (SLIT("Read"),         readClassKey),
 387          (SLIT("Monad"),        monadClassKey),
 388          (SLIT("MonadZero"),    monadZeroClassKey),
 389          (SLIT("Binary"),       binaryClassKey),
 390          (SLIT("_CCallable"),   cCallableClassKey),
 391          (SLIT("_CReturnable"), cReturnableClassKey)
 392         ]
 393
 394 \end{code}
 395
 396 Make table entries for various things:
 397 \begin{code}
 398 pcTyConNameInfo :: TyCon -> (FAST_STRING, Name)
 399 pcTyConNameInfo tc = (getOccurrenceName tc, WiredInTyCon tc)
 400
 401 pcDataConNameInfo :: TyCon -> [(FAST_STRING, Name)]
 402 pcDataConNameInfo tycon
 403   = -- slurp out its data constructors...
 404     [ (getOccurrenceName con, WiredInVal con) | con <- tyConDataCons tycon ]
 405 \end{code}