X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FPrelNames.lhs;h=98392906af025bbdbebde02ca8a85048f9c767d3;hp=bccf84fa1d469766dd7d0257304cfc1ce3953a93;hb=a52f14894e48d47e62b5b33f7d7f4b3f2cc88a79;hpb=b00b5bc04ff36a551552470060064f0b7d84ca30 diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index bccf84f..9839290 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -60,8 +60,8 @@ import Unique ( Unique, Uniquable(..), hasKey, mkTupleTyConUnique ) import BasicTypes ( Boxity(..), Arity ) -import Name ( Name, mkInternalName, mkExternalName, nameModule ) -import SrcLoc ( noSrcLoc ) +import Name ( Name, mkInternalName, mkExternalName ) +import SrcLoc import FastString \end{code} @@ -75,14 +75,14 @@ import FastString This *local* name is used by the interactive stuff \begin{code} -itName uniq = mkInternalName uniq (mkOccNameFS varName FSLIT("it")) noSrcLoc +itName uniq = mkInternalName uniq (mkOccNameFS varName FSLIT("it")) noSrcSpan \end{code} \begin{code} -- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly -- during compiler debugging. mkUnboundName :: RdrName -> Name -mkUnboundName rdr_name = mkInternalName unboundKey (rdrNameOcc rdr_name) noSrcLoc +mkUnboundName rdr_name = mkInternalName unboundKey (rdrNameOcc rdr_name) noSrcSpan isUnboundName :: Name -> Bool isUnboundName name = name `hasKey` unboundKey @@ -104,11 +104,13 @@ basicKnownKeyNames :: [Name] basicKnownKeyNames = genericTyConNames ++ typeableClassNames + ++ ndpNames ++ [ -- Type constructors (synonyms especially) ioTyConName, ioDataConName, runMainIOName, orderingTyConName, rationalTyConName, + stringTyConName, ratioDataConName, ratioTyConName, integerTyConName, smallIntegerDataConName, largeIntegerDataConName, @@ -130,11 +132,15 @@ basicKnownKeyNames realFracClassName, -- numeric realFloatClassName, -- numeric dataClassName, + isStringClassName, -- Numeric stuff negateName, minusName, fromRationalName, fromIntegerName, geName, eqName, + + -- String stuff + fromStringName, -- Enum stuff enumFromName, enumFromThenName, @@ -174,7 +180,7 @@ basicKnownKeyNames -- Parallel array operations nullPName, lengthPName, replicatePName, mapPName, - filterPName, zipPName, crossPName, indexPName, + filterPName, zipPName, crossMapPName, indexPName, toPName, bpermutePName, bpermuteDftPName, indexOfPName, -- FFI primitive types that are not wired-in. @@ -183,9 +189,10 @@ basicKnownKeyNames wordTyConName, word8TyConName, word16TyConName, word32TyConName, word64TyConName, -- Others - otherwiseIdName, + otherwiseIdName, inlineIdName, plusIntegerName, timesIntegerName, eqStringName, assertName, breakpointName, breakpointCondName, + breakpointAutoName, opaqueTyConName, assertErrorName, runSTRepName, printName, fstName, sndName, @@ -208,6 +215,15 @@ basicKnownKeyNames genericTyConNames :: [Name] genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName] + +ndpNames :: [Name] +ndpNames = [ parrayTyConName, paTyConName, preprTyConName, prTyConName + , embedTyConName + , closureTyConName + , mkClosureName, applyClosureName + , mkClosurePName, applyClosurePName + , lengthPAName, replicatePAName, emptyPAName, packPAName, + combinePAName, intEqPAName ] \end{code} @@ -231,6 +247,7 @@ gHC_LIST = mkBaseModule FSLIT("GHC.List") gHC_PARR = mkBaseModule FSLIT("GHC.PArr") dATA_TUP = mkBaseModule FSLIT("Data.Tuple") dATA_EITHER = mkBaseModule FSLIT("Data.Either") +dATA_STRING = mkBaseModule FSLIT("Data.String") gHC_PACK = mkBaseModule FSLIT("GHC.Pack") gHC_CONC = mkBaseModule FSLIT("GHC.Conc") gHC_IO_BASE = mkBaseModule FSLIT("GHC.IOBase") @@ -258,6 +275,12 @@ aRROW = mkBaseModule FSLIT("Control.Arrow") rANDOM = mkBaseModule FSLIT("System.Random") gLA_EXTS = mkBaseModule FSLIT("GHC.Exts") +nDP_PARRAY = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.PArray") +nDP_REPR = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Repr") +nDP_UTILS = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Utils") +nDP_CLOSURE = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Closure") +nDP_INSTANCES = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Instances") + mAIN = mkMainModule_ mAIN_NAME rOOT_MAIN = mkMainModule FSLIT(":Main") -- Root module for initialisation @@ -277,6 +300,12 @@ mkBaseModule m = mkModule basePackageId (mkModuleNameFS m) mkBaseModule_ :: ModuleName -> Module mkBaseModule_ m = mkModule basePackageId m +mkNDPModule :: FastString -> Module +mkNDPModule m = mkModule ndpPackageId (mkModuleNameFS m) + +mkNDPModule_ :: ModuleName -> Module +mkNDPModule_ m = mkModule ndpPackageId m + mkMainModule :: FastString -> Module mkMainModule m = mkModule mainPackageId (mkModuleNameFS m) @@ -370,6 +399,8 @@ minus_RDR = nameRdrName minusName times_RDR = varQual_RDR gHC_NUM FSLIT("*") plus_RDR = varQual_RDR gHC_NUM FSLIT("+") +fromString_RDR = nameRdrName fromStringName + compose_RDR = varQual_RDR gHC_BASE FSLIT(".") not_RDR = varQual_RDR gHC_BASE FSLIT("not") @@ -461,6 +492,7 @@ unpackCStringAppendName = varQual gHC_BASE FSLIT("unpackAppendCString#") unpackC unpackCStringFoldrName = varQual gHC_BASE FSLIT("unpackFoldrCString#") unpackCStringFoldrIdKey unpackCStringUtf8Name = varQual gHC_BASE FSLIT("unpackCStringUtf8#") unpackCStringUtf8IdKey eqStringName = varQual gHC_BASE FSLIT("eqString") eqStringIdKey +stringTyConName = tcQual gHC_BASE FSLIT("String") stringTyConKey -- The 'inline' function inlineIdName = varQual gHC_BASE FSLIT("inline") inlineIdKey @@ -480,26 +512,35 @@ returnMName = methName gHC_BASE FSLIT("return") returnMClassOpKey failMName = methName gHC_BASE FSLIT("fail") failMClassOpKey -- Random PrelBase functions +fromStringName = methName dATA_STRING FSLIT("fromString") fromStringClassOpKey otherwiseIdName = varQual gHC_BASE FSLIT("otherwise") otherwiseIdKey foldrName = varQual gHC_BASE FSLIT("foldr") foldrIdKey buildName = varQual gHC_BASE FSLIT("build") buildIdKey augmentName = varQual gHC_BASE FSLIT("augment") augmentIdKey appendName = varQual gHC_BASE FSLIT("++") appendIdKey -andName = varQual gHC_BASE FSLIT("&&") andIdKey -orName = varQual gHC_BASE FSLIT("||") orIdKey +andName = varQual gHC_BASE FSLIT("&&") andIdKey +orName = varQual gHC_BASE FSLIT("||") orIdKey assertName = varQual gHC_BASE FSLIT("assert") assertIdKey breakpointName = varQual gHC_BASE FSLIT("breakpoint") breakpointIdKey breakpointCondName= varQual gHC_BASE FSLIT("breakpointCond") breakpointCondIdKey +breakpointAutoName= varQual gHC_BASE FSLIT("breakpointAuto") breakpointAutoIdKey +opaqueTyConName = tcQual gHC_BASE FSLIT("Opaque") opaqueTyConKey + breakpointJumpName = mkInternalName breakpointJumpIdKey (mkOccNameFS varName FSLIT("breakpointJump")) - noSrcLoc + noSrcSpan breakpointCondJumpName = mkInternalName breakpointCondJumpIdKey (mkOccNameFS varName FSLIT("breakpointCondJump")) - noSrcLoc + noSrcSpan +breakpointAutoJumpName + = mkInternalName + breakpointAutoJumpIdKey + (mkOccNameFS varName FSLIT("breakpointAutoJump")) + noSrcSpan -- PrelTup fstName = varQual dATA_TUP FSLIT("fst") fstIdKey @@ -581,7 +622,7 @@ replicatePName = varQual gHC_PARR FSLIT("replicateP") replicatePIdKey mapPName = varQual gHC_PARR FSLIT("mapP") mapPIdKey filterPName = varQual gHC_PARR FSLIT("filterP") filterPIdKey zipPName = varQual gHC_PARR FSLIT("zipP") zipPIdKey -crossPName = varQual gHC_PARR FSLIT("crossP") crossPIdKey +crossMapPName = varQual gHC_PARR FSLIT("crossMapP") crossMapPIdKey indexPName = varQual gHC_PARR FSLIT("!:") indexPIdKey toPName = varQual gHC_PARR FSLIT("toP") toPIdKey bpermutePName = varQual gHC_PARR FSLIT("bpermuteP") bpermutePIdKey @@ -640,6 +681,7 @@ loopAName = varQual aRROW FSLIT("loop") loopAIdKey monadPlusClassName = clsQual mONAD FSLIT("MonadPlus") monadPlusClassKey randomClassName = clsQual rANDOM FSLIT("Random") randomClassKey randomGenClassName = clsQual rANDOM FSLIT("RandomGen") randomGenClassKey +isStringClassName = clsQual dATA_STRING FSLIT("IsString") isStringClassKey -- dotnet interop objectTyConName = tcQual dOTNET FSLIT("Object") objectTyConKey @@ -650,6 +692,24 @@ marshalObjectName = varQual dOTNET FSLIT("marshalObject") marshalObjectIdKey marshalStringName = varQual dOTNET FSLIT("marshalString") marshalStringIdKey unmarshalStringName = varQual dOTNET FSLIT("unmarshalString") unmarshalStringIdKey checkDotnetResName = varQual dOTNET FSLIT("checkResult") checkDotnetResNameIdKey + +-- NDP stuff +parrayTyConName = tcQual nDP_PARRAY FSLIT("PArray") parrayTyConKey +paTyConName = tcQual nDP_PARRAY FSLIT("PA") paTyConKey +preprTyConName = tcQual nDP_PARRAY FSLIT("PRepr") preprTyConKey +prTyConName = clsQual nDP_PARRAY FSLIT("PR") prTyConKey +embedTyConName = tcQual nDP_REPR FSLIT("Embed") embedTyConKey +lengthPAName = varQual nDP_PARRAY FSLIT("lengthPA") lengthPAIdKey +replicatePAName = varQual nDP_PARRAY FSLIT("replicatePA") replicatePAIdKey +emptyPAName = varQual nDP_PARRAY FSLIT("emptyPA") emptyPAIdKey +packPAName = varQual nDP_PARRAY FSLIT("packPA") packPAIdKey +combinePAName = varQual nDP_PARRAY FSLIT("combinePA") combinePAIdKey +intEqPAName = varQual nDP_UTILS FSLIT("intEqPA") intEqPAIdKey +closureTyConName = tcQual nDP_CLOSURE FSLIT(":->") closureTyConKey +mkClosureName = varQual nDP_CLOSURE FSLIT("mkClosure") mkClosureIdKey +applyClosureName = varQual nDP_CLOSURE FSLIT("$:") applyClosureIdKey +mkClosurePName = varQual nDP_CLOSURE FSLIT("mkClosureP") mkClosurePIdKey +applyClosurePName = varQual nDP_CLOSURE FSLIT("$:^") applyClosurePIdKey \end{code} %************************************************************************ @@ -666,15 +726,15 @@ tcQual = mk_known_key_name tcName clsQual = mk_known_key_name clsName mk_known_key_name space mod str uniq - = mkExternalName uniq mod (mkOccNameFS space str) noSrcLoc + = mkExternalName uniq mod (mkOccNameFS space str) noSrcSpan conName :: Module -> FastString -> Unique -> Name conName mod occ uniq - = mkExternalName uniq mod (mkOccNameFS dataName occ) noSrcLoc + = mkExternalName uniq mod (mkOccNameFS dataName occ) noSrcSpan methName :: Module -> FastString -> Unique -> Name methName mod occ uniq - = mkExternalName uniq mod (mkVarOccFS occ) noSrcLoc + = mkExternalName uniq mod (mkVarOccFS occ) noSrcSpan \end{code} %************************************************************************ @@ -717,6 +777,8 @@ monadFixClassKey = mkPreludeClassUnique 28 monadPlusClassKey = mkPreludeClassUnique 30 randomClassKey = mkPreludeClassUnique 31 randomGenClassKey = mkPreludeClassUnique 32 + +isStringClassKey = mkPreludeClassUnique 33 \end{code} %************************************************************************ @@ -758,6 +820,10 @@ rationalTyConKey = mkPreludeTyConUnique 33 realWorldTyConKey = mkPreludeTyConUnique 34 stablePtrPrimTyConKey = mkPreludeTyConUnique 35 stablePtrTyConKey = mkPreludeTyConUnique 36 + +anyPrimTyConKey = mkPreludeTyConUnique 37 +anyPrimTyCon1Key = mkPreludeTyConUnique 38 + statePrimTyConKey = mkPreludeTyConUnique 50 stableNamePrimTyConKey = mkPreludeTyConUnique 51 stableNameTyConKey = mkPreludeTyConUnique 52 @@ -798,7 +864,7 @@ eitherTyConKey = mkPreludeTyConUnique 84 -- Super Kinds constructors tySuperKindTyConKey = mkPreludeTyConUnique 85 -coSuperKindTyConKey = mkPreludeTyConUnique 86 +coSuperKindTyConKey = mkPreludeTyConUnique 86 -- Kind constructors liftedTypeKindTyConKey = mkPreludeTyConUnique 87 @@ -815,6 +881,21 @@ rightCoercionTyConKey = mkPreludeTyConUnique 96 instCoercionTyConKey = mkPreludeTyConUnique 97 unsafeCoercionTyConKey = mkPreludeTyConUnique 98 +unknownTyConKey = mkPreludeTyConUnique 99 +unknown1TyConKey = mkPreludeTyConUnique 130 +unknown2TyConKey = mkPreludeTyConUnique 131 +unknown3TyConKey = mkPreludeTyConUnique 132 +opaqueTyConKey = mkPreludeTyConUnique 133 + +stringTyConKey = mkPreludeTyConUnique 134 + +parrayTyConKey = mkPreludeTyConUnique 135 +closureTyConKey = mkPreludeTyConUnique 136 +paTyConKey = mkPreludeTyConUnique 137 +preprTyConKey = mkPreludeTyConUnique 138 +embedTyConKey = mkPreludeTyConUnique 139 +prTyConKey = mkPreludeTyConUnique 140 + ---------------- Template Haskell ------------------- -- USES TyConUniques 100-129 @@ -927,10 +1008,12 @@ assertErrorIdKey = mkPreludeMiscIdUnique 61 breakpointIdKey = mkPreludeMiscIdUnique 62 breakpointCondIdKey = mkPreludeMiscIdUnique 63 -breakpointJumpIdKey = mkPreludeMiscIdUnique 64 -breakpointCondJumpIdKey = mkPreludeMiscIdUnique 65 +breakpointAutoIdKey = mkPreludeMiscIdUnique 64 +breakpointJumpIdKey = mkPreludeMiscIdUnique 65 +breakpointCondJumpIdKey = mkPreludeMiscIdUnique 66 +breakpointAutoJumpIdKey = mkPreludeMiscIdUnique 67 -inlineIdKey = mkPreludeMiscIdUnique 66 +inlineIdKey = mkPreludeMiscIdUnique 68 -- Parallel array functions nullPIdKey = mkPreludeMiscIdUnique 80 @@ -939,7 +1022,7 @@ replicatePIdKey = mkPreludeMiscIdUnique 82 mapPIdKey = mkPreludeMiscIdUnique 83 filterPIdKey = mkPreludeMiscIdUnique 84 zipPIdKey = mkPreludeMiscIdUnique 85 -crossPIdKey = mkPreludeMiscIdUnique 86 +crossMapPIdKey = mkPreludeMiscIdUnique 86 indexPIdKey = mkPreludeMiscIdUnique 87 toPIdKey = mkPreludeMiscIdUnique 88 enumFromToPIdKey = mkPreludeMiscIdUnique 89 @@ -991,6 +1074,21 @@ appAIdKey = mkPreludeMiscIdUnique 122 choiceAIdKey = mkPreludeMiscIdUnique 123 -- ||| loopAIdKey = mkPreludeMiscIdUnique 124 +fromStringClassOpKey = mkPreludeMiscIdUnique 125 + +-- Flattened parallel array functions +mkClosureIdKey = mkPreludeMiscIdUnique 126 +applyClosureIdKey = mkPreludeMiscIdUnique 127 +mkClosurePIdKey = mkPreludeMiscIdUnique 128 +applyClosurePIdKey = mkPreludeMiscIdUnique 129 +closurePAIdKey = mkPreludeMiscIdUnique 130 +lengthPAIdKey = mkPreludeMiscIdUnique 131 +replicatePAIdKey = mkPreludeMiscIdUnique 132 +emptyPAIdKey = mkPreludeMiscIdUnique 133 +packPAIdKey = mkPreludeMiscIdUnique 134 +combinePAIdKey = mkPreludeMiscIdUnique 135 +intEqPAIdKey = mkPreludeMiscIdUnique 136 + ---------------- Template Haskell ------------------- -- USES IdUniques 200-399 ----------------------------------------------------- @@ -1050,7 +1148,9 @@ needsDataDeclCtxtClassKeys = -- see comments in TcDeriv standardClassKeys = derivableClassKeys ++ numericClassKeys ++ [randomClassKey, randomGenClassKey, functorClassKey, - monadClassKey, monadPlusClassKey] + monadClassKey, monadPlusClassKey, + isStringClassKey + ] \end{code} @derivableClassKeys@ is also used in checking \tr{deriving} constructs