X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelNames.lhs;h=eb26d3404a77ed9aa32f763e43a0e9b0e749aee0;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=a180e61461e811c42adae966e02e4fe541ada887;hpb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index a180e61..eb26d34 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -50,9 +50,8 @@ module PrelNames ( #include "HsVersions.h" import Module ( Module, mkModule ) -import OccName ( dataName, tcName, clsName, varName, mkOccFS - ) - +import OccName ( dataName, tcName, clsName, varName, mkOccNameFS, + mkVarOccFS ) import RdrName ( RdrName, nameRdrName, mkOrig, rdrNameOcc, mkUnqual ) import Unique ( Unique, Uniquable(..), hasKey, mkPreludeMiscIdUnique, mkPreludeDataConUnique, @@ -75,7 +74,7 @@ import FastString This *local* name is used by the interactive stuff \begin{code} -itName uniq = mkInternalName uniq (mkOccFS varName FSLIT("it")) noSrcLoc +itName uniq = mkInternalName uniq (mkOccNameFS varName FSLIT("it")) noSrcLoc \end{code} \begin{code} @@ -103,11 +102,10 @@ wired in ones are defined in TysWiredIn etc. basicKnownKeyNames :: [Name] basicKnownKeyNames = genericTyConNames - ++ monadNames ++ typeableClassNames ++ [ -- Type constructors (synonyms especially) ioTyConName, ioDataConName, - runIOName, + runMainIOName, orderingTyConName, rationalTyConName, ratioDataConName, @@ -146,6 +144,7 @@ basicKnownKeyNames -- Monad stuff thenIOName, bindIOName, returnIOName, failIOName, + failMName, bindMName, thenMName, returnMName, -- MonadRec stuff mfixName, @@ -188,7 +187,16 @@ basicKnownKeyNames otherwiseIdName, plusIntegerName, timesIntegerName, eqStringName, assertName, assertErrorName, runSTRepName, - printName, splitName, fstName, sndName, + printName, fstName, sndName, + + -- MonadFix + monadFixClassName, mfixName, + + -- Splittable class + splittableClassName, splitName, + + -- Other classes + randomClassName, randomGenClassName, monadPlusClassName, -- Booleans andName, orName @@ -201,9 +209,6 @@ basicKnownKeyNames , marshalStringName, unmarshalStringName, checkDotnetResName ] -monadNames :: [Name] -- The monad ops need by a HsDo -monadNames = [returnMName, failMName, bindMName, thenMName] - genericTyConNames :: [Name] genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName] \end{code} @@ -254,18 +259,21 @@ lEX = mkModule "Text.Read.Lex" mAIN = mkModule "Main" pREL_INT = mkModule "GHC.Int" pREL_WORD = mkModule "GHC.Word" +mONAD = mkModule "Control.Monad" mONAD_FIX = mkModule "Control.Monad.Fix" aRROW = mkModule "Control.Arrow" aDDR = mkModule "Addr" +rANDOM = mkModule "System.Random" gLA_EXTS = mkModule "GHC.Exts" rOOT_MAIN = mkModule ":Main" -- Root module for initialisation - -- The ':xxx' makes a moudle name that the user can never + -- The ':xxx' makes a module name that the user can never -- use himself. The z-encoding for ':' is "ZC", so the z-encoded -- module name still starts with a capital letter, which keeps -- the z-encoded version consistent. iNTERACTIVE = mkModule ":Interactive" +thFAKE = mkModule ":THFake" \end{code} %************************************************************************ @@ -366,6 +374,8 @@ maxBound_RDR = varQual_RDR pREL_ENUM FSLIT("maxBound") range_RDR = varQual_RDR pREL_ARR FSLIT("range") inRange_RDR = varQual_RDR pREL_ARR FSLIT("inRange") index_RDR = varQual_RDR pREL_ARR FSLIT("index") +unsafeIndex_RDR = varQual_RDR pREL_ARR FSLIT("unsafeIndex") +unsafeRangeSize_RDR = varQual_RDR pREL_ARR FSLIT("unsafeRangeSize") readList_RDR = varQual_RDR pREL_READ FSLIT("readList") readListDefault_RDR = varQual_RDR pREL_READ FSLIT("readListDefault") @@ -404,10 +414,10 @@ inrDataCon_RDR = dataQual_RDR pREL_BASE FSLIT("Inr") genUnitDataCon_RDR = dataQual_RDR pREL_BASE FSLIT("Unit") ---------------------- -varQual_RDR mod str = mkOrig mod (mkOccFS varName str) -tcQual_RDR mod str = mkOrig mod (mkOccFS tcName str) -clsQual_RDR mod str = mkOrig mod (mkOccFS clsName str) -dataQual_RDR mod str = mkOrig mod (mkOccFS dataName str) +varQual_RDR mod str = mkOrig mod (mkOccNameFS varName str) +tcQual_RDR mod str = mkOrig mod (mkOccNameFS tcName str) +clsQual_RDR mod str = mkOrig mod (mkOccNameFS clsName str) +dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) \end{code} %************************************************************************ @@ -425,8 +435,7 @@ and it's convenient to write them all down in one place. \begin{code} -rootMainName = varQual rOOT_MAIN FSLIT("main") rootMainKey -runIOName = varQual pREL_TOP_HANDLER FSLIT("runIO") runMainKey +runMainIOName = varQual pREL_TOP_HANDLER FSLIT("runMainIO") runMainKey orderingTyConName = tcQual pREL_BASE FSLIT("Ordering") orderingTyConKey @@ -447,18 +456,18 @@ unpackCStringUtf8Name = varQual pREL_BASE FSLIT("unpackCStringUtf8#") unpackCS eqStringName = varQual pREL_BASE FSLIT("eqString") eqStringIdKey -- Base classes (Eq, Ord, Functor) -eqClassName = clsQual pREL_BASE FSLIT("Eq") eqClassKey -eqName = methName eqClassName FSLIT("==") eqClassOpKey -ordClassName = clsQual pREL_BASE FSLIT("Ord") ordClassKey -geName = methName ordClassName FSLIT(">=") geClassOpKey +eqClassName = clsQual pREL_BASE FSLIT("Eq") eqClassKey +eqName = methName eqClassName FSLIT("==") eqClassOpKey +ordClassName = clsQual pREL_BASE FSLIT("Ord") ordClassKey +geName = methName ordClassName FSLIT(">=") geClassOpKey functorClassName = clsQual pREL_BASE FSLIT("Functor") functorClassKey -- Class Monad -monadClassName = clsQual pREL_BASE FSLIT("Monad") monadClassKey -thenMName = methName monadClassName FSLIT(">>") thenMClassOpKey -bindMName = methName monadClassName FSLIT(">>=") bindMClassOpKey +monadClassName = clsQual pREL_BASE FSLIT("Monad") monadClassKey +thenMName = methName monadClassName FSLIT(">>") thenMClassOpKey +bindMName = methName monadClassName FSLIT(">>=") bindMClassOpKey returnMName = methName monadClassName FSLIT("return") returnMClassOpKey -failMName = methName monadClassName FSLIT("fail") failMClassOpKey +failMName = methName monadClassName FSLIT("fail") failMClassOpKey -- Random PrelBase functions otherwiseIdName = varQual pREL_BASE FSLIT("otherwise") otherwiseIdKey @@ -466,8 +475,8 @@ foldrName = varQual pREL_BASE FSLIT("foldr") foldrIdKey buildName = varQual pREL_BASE FSLIT("build") buildIdKey augmentName = varQual pREL_BASE FSLIT("augment") augmentIdKey appendName = varQual pREL_BASE FSLIT("++") appendIdKey -andName = varQual pREL_BASE FSLIT("&&") andIdKey -orName = varQual pREL_BASE FSLIT("||") orIdKey +andName = varQual pREL_BASE FSLIT("&&") andIdKey +orName = varQual pREL_BASE FSLIT("||") orIdKey assertName = varQual pREL_BASE FSLIT("assert") assertIdKey -- PrelTup @@ -601,18 +610,25 @@ newStablePtrName = varQual pREL_STABLE FSLIT("newStablePtr") newStablePtrI runSTRepName = varQual pREL_ST FSLIT("runSTRep") runSTRepIdKey -- The "split" Id for splittable implicit parameters -splitName = varQual gLA_EXTS FSLIT("split") splitIdKey +splittableClassName = clsQual gLA_EXTS FSLIT("Splittable") splittableClassKey +splitName = methName splittableClassName FSLIT("split") splitIdKey -- Recursive-do notation -mfixName = varQual mONAD_FIX FSLIT("mfix") mfixIdKey +monadFixClassName = clsQual mONAD_FIX FSLIT("MonadFix") monadFixClassKey +mfixName = methName monadFixClassName FSLIT("mfix") mfixIdKey -- Arrow notation -arrAName = varQual aRROW FSLIT("arr") arrAIdKey -composeAName = varQual aRROW FSLIT(">>>") composeAIdKey -firstAName = varQual aRROW FSLIT("first") firstAIdKey -appAName = varQual aRROW FSLIT("app") appAIdKey -choiceAName = varQual aRROW FSLIT("|||") choiceAIdKey -loopAName = varQual aRROW FSLIT("loop") loopAIdKey +arrAName = varQual aRROW FSLIT("arr") arrAIdKey +composeAName = varQual aRROW FSLIT(">>>") composeAIdKey +firstAName = varQual aRROW FSLIT("first") firstAIdKey +appAName = varQual aRROW FSLIT("app") appAIdKey +choiceAName = varQual aRROW FSLIT("|||") choiceAIdKey +loopAName = varQual aRROW FSLIT("loop") loopAIdKey + +-- Other classes, needed for type defaulting +monadPlusClassName = clsQual mONAD FSLIT("MonadPlus") monadPlusClassKey +randomClassName = clsQual rANDOM FSLIT("Random") randomClassKey +randomGenClassName = clsQual rANDOM FSLIT("RandomGen") randomGenClassKey -- dotnet interop objectTyConName = tcQual dOTNET FSLIT("Object") objectTyConKey @@ -639,17 +655,17 @@ tcQual = mk_known_key_name tcName clsQual = mk_known_key_name clsName mk_known_key_name space mod str uniq - = mkExternalName uniq mod (mkOccFS space str) + = mkExternalName uniq mod (mkOccNameFS space str) Nothing noSrcLoc conName :: Name -> FastString -> Unique -> Name conName tycon occ uniq - = mkExternalName uniq (nameModule tycon) (mkOccFS dataName occ) + = mkExternalName uniq (nameModule tycon) (mkOccNameFS dataName occ) (Just tycon) noSrcLoc methName :: Name -> FastString -> Unique -> Name methName cls occ uniq - = mkExternalName uniq (nameModule cls) (mkOccFS varName occ) + = mkExternalName uniq (nameModule cls) (mkVarOccFS occ) (Just cls) noSrcLoc \end{code} @@ -687,6 +703,13 @@ typeable4ClassKey = mkPreludeClassUnique 24 typeable5ClassKey = mkPreludeClassUnique 25 typeable6ClassKey = mkPreludeClassUnique 26 typeable7ClassKey = mkPreludeClassUnique 27 + +monadFixClassKey = mkPreludeClassUnique 28 +splittableClassKey = mkPreludeClassUnique 29 + +monadPlusClassKey = mkPreludeClassUnique 30 +randomClassKey = mkPreludeClassUnique 31 +randomGenClassKey = mkPreludeClassUnique 32 \end{code} %************************************************************************ @@ -935,7 +958,7 @@ arrAIdKey = mkPreludeMiscIdUnique 119 composeAIdKey = mkPreludeMiscIdUnique 120 -- >>> firstAIdKey = mkPreludeMiscIdUnique 121 appAIdKey = mkPreludeMiscIdUnique 122 -choiceAIdKey = mkPreludeMiscIdUnique 123 -- ||| +choiceAIdKey = mkPreludeMiscIdUnique 123 -- ||| loopAIdKey = mkPreludeMiscIdUnique 124 ---------------- Template Haskell ------------------- @@ -1011,7 +1034,12 @@ needsDataDeclCtxtClassKeys = -- see comments in TcDeriv [ readClassKey ] +-- The "standard classes" are used in defaulting (Haskell 98 report 4.3.4), +-- and are: "classes defined in the Prelude or a standard library" standardClassKeys = derivableClassKeys ++ numericClassKeys + ++ [randomClassKey, randomGenClassKey, + functorClassKey, + monadClassKey, monadPlusClassKey] noDictClassKeys = [] -- ToDo: remove? \end{code}