[project @ 1997-07-31 02:22:44 by sof]

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

diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
index 7001a7b..0dab797 100644 (file)
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/ghc/compiler/prelude/PrelInfo.lhs
@@ -15,7 +15,7 @@ module PrelInfo (
 
        eq_RDR, ne_RDR, le_RDR, lt_RDR, ge_RDR, gt_RDR, max_RDR, min_RDR, compare_RDR, 
        minBound_RDR, maxBound_RDR, enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, 
-       enumFromThenTo_RDR, fromEnum_RDR,
+       enumFromThenTo_RDR, fromEnum_RDR, toEnum_RDR, ratioDataCon_RDR,
        range_RDR, index_RDR, inRange_RDR, readsPrec_RDR, readList_RDR, 
        showsPrec_RDR, showList_RDR, plus_RDR, times_RDR, ltTag_RDR, eqTag_RDR, gtTag_RDR, 
        eqH_Char_RDR, ltH_Char_RDR, eqH_Word_RDR, ltH_Word_RDR, eqH_Addr_RDR, ltH_Addr_RDR, 
@@ -27,15 +27,19 @@ module PrelInfo (
        numClass_RDR, fractionalClass_RDR, eqClass_RDR, ccallableClass_RDR, creturnableClass_RDR,
        monadZeroClass_RDR, enumClass_RDR, evalClass_RDR, ordClass_RDR,
 
-       main_NAME, mainPrimIO_NAME, ioTyCon_NAME, primIoTyCon_NAME,
+       main_NAME, mainPrimIO_NAME, ioTyCon_NAME, primIoTyCon_NAME, allClass_NAME,
 
-       needsDataDeclCtxtClassKeys, cCallishClassKeys, isNoDictClass,
+       needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, isNoDictClass,
        isNumericClass, isStandardClass, isCcallishClass
     ) where
 
 IMP_Ubiq()
+
+#if __GLASGOW_HASKELL__ >= 202
+import IdUtils ( primOpName )
+#else
 IMPORT_DELOOPER(PrelLoop) ( primOpName )
--- IMPORT_DELOOPER(IdLoop)       ( SpecEnv )
+#endif
 
 -- friends:
 import PrelMods                -- Prelude module names
@@ -48,8 +52,9 @@ import TysWiredIn
 -- others:
 import SpecEnv         ( SpecEnv )
 import RdrHsSyn                ( RdrName(..), varQual, tcQual, qual )
+import BasicTypes      ( IfaceFlavour )
 import Id              ( GenId, SYN_IE(Id) )
-import Name            ( Name, OccName(..), DefnInfo(..), Provenance(..),
+import Name            ( Name, OccName(..), Provenance(..),
                          getName, mkGlobalName, modAndOcc )
 import Class           ( Class(..), GenClass, classKey )
 import TyCon           ( tyConDataCons, mkFunTyCon, TyCon )
@@ -246,8 +251,10 @@ Ids, Synonyms, Classes and ClassOps with builtin keys.
 
 \begin{code}
 mkKnownKeyGlobal :: (RdrName, Unique) -> Name
-mkKnownKeyGlobal (Qual mod occ, uniq) = mkGlobalName uniq mod occ VanillaDefn Implicit
+mkKnownKeyGlobal (Qual mod occ hif, uniq)
+  = mkGlobalName uniq mod occ (Implicit hif)
 
+allClass_NAME    = mkKnownKeyGlobal (allClass_RDR,   allClassKey)
 main_NAME       = mkKnownKeyGlobal (main_RDR,       mainKey)
 mainPrimIO_NAME  = mkKnownKeyGlobal (mainPrimIO_RDR, mainPrimIoKey)
 ioTyCon_NAME     = mkKnownKeyGlobal (ioTyCon_RDR,    iOTyConKey)
@@ -255,14 +262,18 @@ primIoTyCon_NAME = getName primIoTyCon
 
 knownKeyNames :: [Name]
 knownKeyNames
-  = [main_NAME, mainPrimIO_NAME, ioTyCon_NAME]
+  = [main_NAME, mainPrimIO_NAME, ioTyCon_NAME, allClass_NAME]
     ++
     map mkKnownKeyGlobal
     [
        -- Type constructors (synonyms especially)
       (orderingTyCon_RDR,  orderingTyConKey)
     , (rationalTyCon_RDR,  rationalTyConKey)
+    , (ratioDataCon_RDR,   ratioDataConKey)
     , (ratioTyCon_RDR,     ratioTyConKey)
+    , (byteArrayTyCon_RDR, byteArrayTyConKey)
+    , (mutableByteArrayTyCon_RDR, mutableByteArrayTyConKey)
+
 
        --  Classes.  *Must* include:
        --      classes that are grabbed by key (e.g., eqClassKey)
@@ -292,15 +303,22 @@ knownKeyNames
        -- ClassOps 
     , (fromInt_RDR,            fromIntClassOpKey)
     , (fromInteger_RDR,                fromIntegerClassOpKey)
+    , (ge_RDR,                 geClassOpKey) 
+    , (minus_RDR,              minusClassOpKey)
     , (enumFrom_RDR,           enumFromClassOpKey)
     , (enumFromThen_RDR,       enumFromThenClassOpKey)
     , (enumFromTo_RDR,         enumFromToClassOpKey)
     , (enumFromThenTo_RDR,     enumFromThenToClassOpKey)
     , (fromEnum_RDR,           fromEnumClassOpKey)
+    , (toEnum_RDR,             toEnumClassOpKey)
     , (eq_RDR,                 eqClassOpKey)
     , (thenM_RDR,              thenMClassOpKey)
+    , (returnM_RDR,            returnMClassOpKey)
     , (zeroM_RDR,              zeroClassOpKey)
     , (fromRational_RDR,       fromRationalClassOpKey)
+
+       -- Others
+    , (otherwiseId_RDR,                otherwiseIdKey)
     ]
 \end{code}
 
@@ -329,7 +347,12 @@ ioTyCon_RDR                = tcQual (iO_BASE,   SLIT("IO"))
 orderingTyCon_RDR      = tcQual (pREL_BASE, SLIT("Ordering"))
 rationalTyCon_RDR      = tcQual (pREL_NUM,  SLIT("Rational"))
 ratioTyCon_RDR         = tcQual (pREL_NUM,  SLIT("Ratio"))
+ratioDataCon_RDR       = varQual (pREL_NUM, SLIT(":%"))
 
+byteArrayTyCon_RDR             = tcQual (aRR_BASE,  SLIT("ByteArray"))
+mutableByteArrayTyCon_RDR      = tcQual (aRR_BASE,  SLIT("MutableByteArray"))
+
+allClass_RDR           = tcQual (gHC__,     SLIT("All"))
 eqClass_RDR            = tcQual (pREL_BASE, SLIT("Eq"))
 ordClass_RDR           = tcQual (pREL_BASE, SLIT("Ord"))
 evalClass_RDR          = tcQual (pREL_BASE, SLIT("Eval"))
@@ -354,6 +377,8 @@ creturnableClass_RDR        = tcQual (fOREIGN,   SLIT("CReturnable"))
 
 fromInt_RDR       = varQual (pREL_BASE, SLIT("fromInt"))
 fromInteger_RDR           = varQual (pREL_BASE, SLIT("fromInteger"))
+minus_RDR         = varQual (pREL_BASE, SLIT("-"))
+toEnum_RDR        = varQual (pREL_BASE, SLIT("toEnum"))
 fromEnum_RDR      = varQual (pREL_BASE, SLIT("fromEnum"))
 enumFrom_RDR      = varQual (pREL_BASE, SLIT("enumFrom"))
 enumFromTo_RDR    = varQual (pREL_BASE, SLIT("enumFromTo"))
@@ -361,8 +386,9 @@ enumFromThen_RDR   = varQual (pREL_BASE, SLIT("enumFromThen"))
 enumFromThenTo_RDR = varQual (pREL_BASE, SLIT("enumFromThenTo"))
 
 thenM_RDR         = varQual (pREL_BASE, SLIT(">>="))
+returnM_RDR       = varQual (pREL_BASE, SLIT("return"))
 zeroM_RDR         = varQual (pREL_BASE, SLIT("zero"))
-fromRational_RDR   = varQual (pREL_NUM, SLIT("fromRational"))
+fromRational_RDR   = varQual (pREL_NUM,  SLIT("fromRational"))
 
 negate_RDR        = varQual (pREL_BASE, SLIT("negate"))
 eq_RDR            = varQual (pREL_BASE, SLIT("=="))
@@ -428,6 +454,8 @@ minusH_RDR  = prelude_primop IntSubOp
 
 main_RDR       = varQual (mAIN,     SLIT("main"))
 mainPrimIO_RDR = varQual (gHC_MAIN, SLIT("mainPrimIO"))
+
+otherwiseId_RDR = varQual (pREL_BASE, SLIT("otherwise"))
 \end{code}
 
 %************************************************************************
@@ -456,7 +484,9 @@ derivableClassKeys  = map fst deriving_occ_info
 
 deriving_occ_info
   = [ (eqClassKey,     [intTyCon_RDR, and_RDR, not_RDR])
-    , (ordClassKey,    [intTyCon_RDR, compose_RDR])
+    , (ordClassKey,    [intTyCon_RDR, compose_RDR, eqTag_RDR])
+                               -- EQ (from Ordering) is needed to force in the constructors
+                               -- as well as the type constructor.
     , (enumClassKey,   [intTyCon_RDR, map_RDR])
     , (evalClassKey,   [intTyCon_RDR])
     , (boundedClassKey,        [intTyCon_RDR])
@@ -464,7 +494,7 @@ deriving_occ_info
                         showParen_RDR, showSpace_RDR, showList___RDR])
     , (readClassKey,   [intTyCon_RDR, numClass_RDR, ordClass_RDR, append_RDR, 
                         lex_RDR, readParen_RDR, readList___RDR])
-    , (ixClassKey,     [intTyCon_RDR, numClass_RDR, and_RDR, map_RDR])
+    , (ixClassKey,     [intTyCon_RDR, numClass_RDR, and_RDR, map_RDR, enumFromTo_RDR])
     ]
        -- intTyCon: Practically any deriving needs Int, either for index calculations, 
        --              or for taggery.
@@ -502,6 +532,10 @@ needsDataDeclCtxtClassKeys -- see comments in TcDeriv
 
 cCallishClassKeys = [ cCallableClassKey, cReturnableClassKey ]
 
+       -- Renamer always imports these data decls replete with constructors
+       -- so that desugarer can always see the constructor.  Ugh!
+cCallishTyKeys = [ addrTyConKey, wordTyConKey, byteArrayTyConKey, mutableByteArrayTyConKey ]
+
 standardClassKeys
   = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys
     --