[project @ 1998-03-06 10:50:44 by simonm]
[ghc-hetmet.git] / ghc / compiler / prelude / PrelInfo.lhs
index 37de70c..3e948ee 100644 (file)
@@ -4,42 +4,41 @@
 \section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge}
 
 \begin{code}
-#include "HsVersions.h"
-
 module PrelInfo (
        -- finite maps for built-in things (for the renamer and typechecker):
        builtinNames, derivingOccurrences,
-       SYN_IE(BuiltinNames),
-
-       maybeCharLikeTyCon, maybeIntLikeTyCon,
-
-       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, 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, 
-       eqH_Float_RDR, ltH_Float_RDR, eqH_Double_RDR, ltH_Double_RDR, eqH_Int_RDR, ltH_Int_RDR, 
-       geH_RDR, leH_RDR, minusH_RDR, false_RDR, true_RDR, and_RDR, not_RDR, append_RDR, 
-       map_RDR, compose_RDR, mkInt_RDR, error_RDR, showString_RDR, showParen_RDR, readParen_RDR, 
-       lex_RDR, showSpace_RDR, showList___RDR, readList___RDR, negate_RDR,
-
-       numClass_RDR, fractionalClass_RDR, eqClass_RDR, ccallableClass_RDR, creturnableClass_RDR,
+       BuiltinNames,
+
+       maybeCharLikeCon, maybeIntLikeCon,
+
+       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, 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, eqH_Float_RDR,
+       ltH_Float_RDR, eqH_Double_RDR, ltH_Double_RDR, eqH_Int_RDR, 
+       ltH_Int_RDR, geH_RDR, leH_RDR, minusH_RDR, false_RDR, true_RDR,
+       and_RDR, not_RDR, append_RDR, map_RDR, compose_RDR, mkInt_RDR,
+       error_RDR, assert_RDR,
+       showString_RDR, showParen_RDR, readParen_RDR, lex_RDR,
+       showSpace_RDR, showList___RDR, readList___RDR, negate_RDR,
+
+       numClass_RDR, fractionalClass_RDR, eqClass_RDR, 
+       ccallableClass_RDR, creturnableClass_RDR,
        monadZeroClass_RDR, enumClass_RDR, evalClass_RDR, ordClass_RDR,
+       ioDataCon_RDR, ioOkDataCon_RDR,
 
-       main_NAME, mainPrimIO_NAME, ioTyCon_NAME, primIoTyCon_NAME, allClass_NAME,
+       main_NAME, allClass_NAME, ioTyCon_NAME,
 
        needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, isNoDictClass,
-       isNumericClass, isStandardClass, isCcallishClass
+       isNumericClass, isStandardClass, isCcallishClass, isCreturnableClass
     ) where
 
-IMP_Ubiq()
+#include "HsVersions.h"
 
-#if __GLASGOW_HASKELL__ >= 202
 import IdUtils ( primOpName )
-#else
-IMPORT_DELOOPER(PrelLoop) ( primOpName )
-#endif
 
 -- friends:
 import PrelMods                -- Prelude module names
@@ -50,17 +49,18 @@ import TysPrim              -- TYPES
 import TysWiredIn
 
 -- others:
-import SpecEnv         ( SpecEnv )
 import RdrHsSyn                ( RdrName(..), varQual, tcQual, qual )
-import Id              ( GenId, SYN_IE(Id) )
-import Name            ( Name, OccName(..), DefnInfo(..), Provenance(..),
-                         getName, mkGlobalName, modAndOcc )
-import Class           ( Class(..), GenClass, classKey )
+import BasicTypes      ( IfaceFlavour )
+import Id              ( GenId, Id )
+import Name            ( Name, OccName(..), Provenance(..),
+                         getName, mkGlobalName, modAndOcc
+                       )
+import Class           ( Class, classKey )
 import TyCon           ( tyConDataCons, mkFunTyCon, TyCon )
 import Type
 import Bag
 import Unique          -- *Key stuff
-import UniqFM          ( UniqFM, listToUFM, Uniquable(..) ) 
+import UniqFM          ( UniqFM, listToUFM ) 
 import Util            ( isIn )
 \end{code}
 
@@ -149,10 +149,10 @@ data_tycons
     , intTyCon
     , integerTyCon
     , liftTyCon
-    , primIoTyCon
     , return2GMPsTyCon
     , returnIntAndGMPTyCon
     , stTyCon
+    , stRetTyCon
     , stablePtrTyCon
     , stateAndAddrPrimTyCon
     , stateAndArrayPrimTyCon
@@ -168,22 +168,9 @@ data_tycons
     , stateAndStablePtrPrimTyCon
     , stateAndSynchVarPrimTyCon
     , stateAndWordPrimTyCon
-    , stateTyCon
     , voidTyCon
     , wordTyCon
     ]
-
-min_nonprim_tycon_list         -- used w/ HideMostBuiltinNames
-  = [ boolTyCon
-    , charTyCon
-    , intTyCon
-    , floatTyCon
-    , doubleTyCon
-    , integerTyCon
-    , liftTyCon
-    , return2GMPsTyCon -- ADR asked for these last two (WDP 94/11)
-    , returnIntAndGMPTyCon
-    ]
 \end{code}
 
 %************************************************************************
@@ -209,15 +196,13 @@ wired_in_ids
     , integerPlusTwoId
     , integerZeroId
     , nON_EXHAUSTIVE_GUARDS_ERROR_ID
-    , nO_DEFAULT_METHOD_ERROR_ID
-    , nO_EXPLICIT_METHOD_ERROR_ID
+    , nO_METHOD_BINDING_ERROR_ID
     , pAR_ERROR_ID
     , pAT_ERROR_ID
     , packStringForCId
     , rEC_CON_ERROR_ID
     , rEC_UPD_ERROR_ID
     , realWorldPrimId
-    , runSTId
     , tRACE_ID
     , unpackCString2Id
     , unpackCStringAppendId
@@ -250,22 +235,22 @@ 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 NoProvenance
 
 allClass_NAME    = mkKnownKeyGlobal (allClass_RDR,   allClassKey)
+ioTyCon_NAME    = mkKnownKeyGlobal (ioTyCon_RDR,    ioTyConKey)
 main_NAME       = mkKnownKeyGlobal (main_RDR,       mainKey)
-mainPrimIO_NAME  = mkKnownKeyGlobal (mainPrimIO_RDR, mainPrimIoKey)
-ioTyCon_NAME     = mkKnownKeyGlobal (ioTyCon_RDR,    iOTyConKey)
-primIoTyCon_NAME = getName primIoTyCon
 
 knownKeyNames :: [Name]
 knownKeyNames
-  = [main_NAME, mainPrimIO_NAME, ioTyCon_NAME, allClass_NAME]
+  = [main_NAME, allClass_NAME, ioTyCon_NAME]
     ++
     map mkKnownKeyGlobal
     [
        -- Type constructors (synonyms especially)
-      (orderingTyCon_RDR,  orderingTyConKey)
+      (ioOkDataCon_RDR,    ioOkDataConKey)
+    , (orderingTyCon_RDR,  orderingTyConKey)
     , (rationalTyCon_RDR,  rationalTyConKey)
     , (ratioDataCon_RDR,   ratioDataConKey)
     , (ratioTyCon_RDR,     ratioTyConKey)
@@ -323,8 +308,9 @@ knownKeyNames
 ToDo: make it do the ``like'' part properly (as in 0.26 and before).
 
 \begin{code}
-maybeCharLikeTyCon tc = if (uniqueOf tc == charDataConKey) then Just charDataCon else Nothing
-maybeIntLikeTyCon  tc = if (uniqueOf tc == intDataConKey)  then Just intDataCon  else Nothing
+maybeCharLikeCon, maybeIntLikeCon :: Id -> Bool
+maybeCharLikeCon con = uniqueOf con == charDataConKey
+maybeIntLikeCon  con = uniqueOf con == intDataConKey
 \end{code}
 
 %************************************************************************
@@ -341,16 +327,18 @@ to write them all down in one place.
 prelude_primop op = qual (modAndOcc (primOpName op))
 
 intTyCon_RDR           = qual (modAndOcc intTyCon)
-ioTyCon_RDR            = tcQual (iO_BASE,   SLIT("IO"))
+ioTyCon_RDR            = tcQual (pREL_IO_BASE,   SLIT("IO"))
+ioDataCon_RDR                  = varQual (pREL_IO_BASE,   SLIT("IO"))
+ioOkDataCon_RDR                = varQual (pREL_IO_BASE,   SLIT("IOok"))
 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"))
+byteArrayTyCon_RDR             = tcQual (pREL_ARR,  SLIT("ByteArray"))
+mutableByteArrayTyCon_RDR      = tcQual (pREL_ARR,  SLIT("MutableByteArray"))
 
-allClass_RDR           = tcQual (gHC__,     SLIT("All"))
+allClass_RDR           = tcQual (pREL_GHC,  SLIT("All"))
 eqClass_RDR            = tcQual (pREL_BASE, SLIT("Eq"))
 ordClass_RDR           = tcQual (pREL_BASE, SLIT("Ord"))
 evalClass_RDR          = tcQual (pREL_BASE, SLIT("Eval"))
@@ -370,8 +358,8 @@ realFracClass_RDR   = tcQual (pREL_NUM,  SLIT("RealFrac"))
 realFloatClass_RDR     = tcQual (pREL_NUM,  SLIT("RealFloat"))
 readClass_RDR          = tcQual (pREL_READ, SLIT("Read"))
 ixClass_RDR            = tcQual (iX,        SLIT("Ix"))
-ccallableClass_RDR     = tcQual (fOREIGN,   SLIT("CCallable"))
-creturnableClass_RDR   = tcQual (fOREIGN,   SLIT("CReturnable"))
+ccallableClass_RDR     = tcQual (pREL_GHC,  SLIT("CCallable"))
+creturnableClass_RDR   = tcQual (pREL_GHC,  SLIT("CReturnable"))
 
 fromInt_RDR       = varQual (pREL_BASE, SLIT("fromInt"))
 fromInteger_RDR           = varQual (pREL_BASE, SLIT("fromInteger"))
@@ -432,7 +420,8 @@ plus_RDR       = varQual (pREL_BASE, SLIT("+"))
 times_RDR         = varQual (pREL_BASE, SLIT("*"))
 mkInt_RDR         = varQual (pREL_BASE, SLIT("I#"))
 
-error_RDR         = varQual (iO_BASE, SLIT("error"))
+error_RDR         = varQual (pREL_ERR, SLIT("error"))
+assert_RDR         = varQual (pREL_ERR, SLIT("assert__"))
 
 eqH_Char_RDR   = prelude_primop CharEqOp
 ltH_Char_RDR   = prelude_primop CharLtOp
@@ -451,7 +440,6 @@ leH_RDR             = prelude_primop IntLeOp
 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}
@@ -492,7 +480,12 @@ 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, enumFromTo_RDR])
+    , (ixClassKey,     [intTyCon_RDR, numClass_RDR, and_RDR, map_RDR, enumFromTo_RDR, 
+                        returnM_RDR, zeroM_RDR])
+                            -- the last two are needed to force returnM, thenM and zeroM
+                            -- in before typechecking the list(monad) comprehension
+                            -- generated for derived Ix instances (range method)
+                            -- of single constructor types.  -- SOF 8/97
     ]
        -- intTyCon: Practically any deriving needs Int, either for index calculations, 
        --              or for taggery.
@@ -506,12 +499,14 @@ even though every numeric class has these two as a superclass,
 because the list of ambiguous dictionaries hasn't been simplified.
 
 \begin{code}
-isCcallishClass, isNoDictClass, isNumericClass, isStandardClass :: Class -> Bool
-
-isNumericClass   clas = classKey clas `is_elem` numericClassKeys
-isStandardClass  clas = classKey clas `is_elem` standardClassKeys
-isCcallishClass         clas = classKey clas `is_elem` cCallishClassKeys
-isNoDictClass    clas = classKey clas `is_elem` noDictClassKeys
+isCcallishClass, isCreturnableClass, isNoDictClass, 
+  isNumericClass, isStandardClass :: Class -> Bool
+
+isNumericClass     clas = classKey clas `is_elem` numericClassKeys
+isStandardClass    clas = classKey clas `is_elem` standardClassKeys
+isCcallishClass           clas = classKey clas `is_elem` cCallishClassKeys
+isCreturnableClass clas = classKey clas == cReturnableClassKey
+isNoDictClass      clas = classKey clas `is_elem` noDictClassKeys
 is_elem = isIn "is_X_Class"
 
 numericClassKeys
@@ -532,7 +527,8 @@ 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 ]
+cCallishTyKeys = [ addrTyConKey, wordTyConKey, byteArrayTyConKey, 
+                  mutableByteArrayTyConKey, foreignObjTyConKey ]
 
 standardClassKeys
   = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys