[project @ 2000-04-10 12:12:27 by simonpj]

[ghc-hetmet.git] / ghc / compiler / prelude / PrelInfo.lhs

diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
index 511dc85..a241961 100644 (file)
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/ghc/compiler/prelude/PrelInfo.lhs
@@ -14,19 +14,19 @@ module PrelInfo (
                        -- it is here, unique and all.  Includes all the 
 
        derivingOccurrences,    -- For a given class C, this tells what other 
-                               -- things are needed as a result of a 
+       derivableClassKeys,     -- things are needed as a result of a 
                                -- deriving(C) clause
 
 
        -- Random other things
        main_NAME, ioTyCon_NAME,
        deRefStablePtr_NAME, makeStablePtr_NAME,
-       bindIO_NAME, 
+       bindIO_NAME, returnIO_NAME,
 
        maybeCharLikeCon, maybeIntLikeCon,
        needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, 
        isNoDictClass, isNumericClass, isStandardClass, isCcallishClass, 
-       isCreturnableClass, numericTyKeys,
+       isCreturnableClass, numericTyKeys, fractionalClassKeys,
 
        -- RdrNames for lots of things, mainly used in derivings
        eq_RDR, ne_RDR, le_RDR, lt_RDR, ge_RDR, gt_RDR, max_RDR, min_RDR, 
@@ -64,7 +64,7 @@ import MkId           -- Ditto
 
 import PrelMods                -- Prelude module names
 import PrimOp          ( PrimOp(..), allThePrimOps, primOpRdrName )
-import DataCon         ( DataCon )
+import DataCon         ( DataCon, dataConId, dataConWrapId )
 import PrimRep         ( PrimRep(..) )
 import TysPrim         -- TYPES
 import TysWiredIn
@@ -75,7 +75,7 @@ import Var            ( varUnique, Id )
 import Name            ( Name, OccName, Provenance(..), 
                          NameSpace, tcName, clsName, varName, dataName,
                          mkKnownKeyGlobal,
-                         getName, mkGlobalName, nameRdrName, systemProvenance
+                         getName, mkGlobalName, nameRdrName
                        )
 import RdrName         ( rdrNameModule, rdrNameOcc, mkSrcQual )
 import Class           ( Class, classKey )
@@ -108,7 +108,7 @@ builtinNames
        , listToBag (map getName wiredInIds)
 
                -- PrimOps
-       , listToBag (map (getName . mkPrimitiveId) allThePrimOps)
+       , listToBag (map (getName . mkPrimOpId) allThePrimOps)
 
                -- Thin-air ids
        , listToBag thinAirIdNames
@@ -123,8 +123,11 @@ builtinNames
 getTyConNames :: TyCon -> Bag Name
 getTyConNames tycon
     = getName tycon `consBag` 
-      listToBag (map getName (tyConDataCons tycon))
+      unionManyBags (map get_data_con_names (tyConDataCons tycon))
        -- Synonyms return empty list of constructors
+    where
+      get_data_con_names dc = listToBag [getName (dataConId dc),       -- Worker
+                                        getName (dataConWrapId dc)]    -- Wrapper
 \end{code}
 
 We let a lot of "non-standard" values be visible, so that we can make
@@ -200,6 +203,7 @@ main_NAME     = mkKnownKeyGlobal (main_RDR,          mainKey)
 
  -- Operations needed when compiling FFI decls
 bindIO_NAME        = mkKnownKeyGlobal (bindIO_RDR,         bindIOIdKey)
+returnIO_NAME      = mkKnownKeyGlobal (returnIO_RDR,       returnIOIdKey)
 deRefStablePtr_NAME = mkKnownKeyGlobal (deRefStablePtr_RDR, deRefStablePtrIdKey)
 makeStablePtr_NAME  = mkKnownKeyGlobal (makeStablePtr_RDR,  makeStablePtrIdKey)
 
@@ -263,6 +267,7 @@ knownKeyNames
     , (deRefStablePtr_RDR,     deRefStablePtrIdKey)
     , (makeStablePtr_RDR,      makeStablePtrIdKey)
     , (bindIO_RDR,             bindIOIdKey)
+    , (returnIO_RDR,           returnIOIdKey)
 
     , (map_RDR,                        mapIdKey)
     , (append_RDR,             appendIdKey)
@@ -317,14 +322,16 @@ intTyCon_RDR              = nameRdrName (getName intTyCon)
 ioTyCon_RDR            = tcQual   pREL_IO_BASE_Name SLIT("IO")
 ioDataCon_RDR                  = dataQual pREL_IO_BASE_Name SLIT("IO")
 bindIO_RDR             = varQual  pREL_IO_BASE_Name SLIT("bindIO")
+returnIO_RDR           = varQual  pREL_IO_BASE_Name SLIT("returnIO")
 
 orderingTyCon_RDR      = tcQual   pREL_BASE_Name SLIT("Ordering")
-rationalTyCon_RDR      = tcQual   pREL_NUM_Name  SLIT("Rational")
-ratioTyCon_RDR         = tcQual   pREL_NUM_Name  SLIT("Ratio")
-ratioDataCon_RDR       = dataQual pREL_NUM_Name  SLIT(":%")
 
-byteArrayTyCon_RDR             = tcQual pREL_ARR_Name  SLIT("ByteArray")
-mutableByteArrayTyCon_RDR      = tcQual pREL_ARR_Name  SLIT("MutableByteArray")
+rationalTyCon_RDR      = tcQual   pREL_REAL_Name  SLIT("Rational")
+ratioTyCon_RDR         = tcQual   pREL_REAL_Name  SLIT("Ratio")
+ratioDataCon_RDR       = dataQual pREL_REAL_Name  SLIT(":%")
+
+byteArrayTyCon_RDR             = tcQual pREL_BYTEARR_Name  SLIT("ByteArray")
+mutableByteArrayTyCon_RDR      = tcQual pREL_BYTEARR_Name  SLIT("MutableByteArray")
 
 foreignObjTyCon_RDR    = tcQual   pREL_IO_BASE_Name SLIT("ForeignObj")
 stablePtrTyCon_RDR     = tcQual   pREL_STABLE_Name SLIT("StablePtr")
@@ -401,19 +408,20 @@ plus_RDR     = varQual pREL_NUM_Name SLIT("+")
 times_RDR         = varQual pREL_NUM_Name SLIT("*")
 
 -- Other numberic classes
-realClass_RDR          = clsQual pREL_NUM_Name  SLIT("Real")
-integralClass_RDR      = clsQual pREL_NUM_Name  SLIT("Integral")
-fractionalClass_RDR    = clsQual pREL_NUM_Name  SLIT("Fractional")
-floatingClass_RDR      = clsQual pREL_NUM_Name  SLIT("Floating")
-realFracClass_RDR      = clsQual pREL_NUM_Name  SLIT("RealFrac")
-realFloatClass_RDR     = clsQual pREL_NUM_Name  SLIT("RealFloat")
-fromRational_RDR       = varQual pREL_NUM_Name  SLIT("fromRational")
+realClass_RDR          = clsQual pREL_REAL_Name  SLIT("Real")
+integralClass_RDR      = clsQual pREL_REAL_Name  SLIT("Integral")
+realFracClass_RDR      = clsQual pREL_REAL_Name  SLIT("RealFrac")
+fractionalClass_RDR    = clsQual pREL_REAL_Name  SLIT("Fractional")
+fromRational_RDR       = varQual pREL_REAL_Name  SLIT("fromRational")
+
+floatingClass_RDR      = clsQual pREL_FLOAT_Name  SLIT("Floating")
+realFloatClass_RDR     = clsQual pREL_FLOAT_Name  SLIT("RealFloat")
 
 -- Class Ix
-ixClass_RDR       = clsQual iX_Name      SLIT("Ix")
-range_RDR         = varQual iX_Name   SLIT("range")
-index_RDR         = varQual iX_Name   SLIT("index")
-inRange_RDR       = varQual iX_Name   SLIT("inRange")
+ixClass_RDR       = clsQual pREL_ARR_Name SLIT("Ix")
+range_RDR         = varQual pREL_ARR_Name SLIT("range")
+index_RDR         = varQual pREL_ARR_Name SLIT("index")
+inRange_RDR       = varQual pREL_ARR_Name SLIT("inRange")
 
 -- Class CCallable and CReturnable
 ccallableClass_RDR     = clsQual pREL_GHC_Name  SLIT("CCallable")
@@ -549,6 +557,7 @@ because the list of ambiguous dictionaries hasn't been simplified.
 isCcallishClass, isCreturnableClass, isNoDictClass, 
   isNumericClass, isStandardClass :: Class -> Bool
 
+isFractionalClass  clas = classKey clas `is_elem` fractionalClassKeys
 isNumericClass     clas = classKey clas `is_elem` numericClassKeys
 isStandardClass    clas = classKey clas `is_elem` standardClassKeys
 isCcallishClass           clas = classKey clas `is_elem` cCallishClassKeys
@@ -560,7 +569,11 @@ numericClassKeys =
        [ numClassKey
        , realClassKey
        , integralClassKey
-       , fractionalClassKey
+       ]
+       ++ fractionalClassKeys
+
+fractionalClassKeys = 
+       [ fractionalClassKey
        , floatingClassKey
        , realFracClassKey
        , realFloatClassKey