Initial checkin of HetMet / -XModalTypes modifications
[ghc-hetmet.git] / compiler / prelude / PrelNames.lhs
index 842f98d..0f027c5 100644 (file)
@@ -58,7 +58,7 @@ import Unique   ( Unique, Uniquable(..), hasKey,
                    mkTupleTyConUnique
                  ) 
 import BasicTypes ( Boxity(..), Arity )
-import Name      ( Name, mkInternalName, mkExternalName )
+import Name       ( Name, mkInternalName, mkExternalName, mkSystemVarName )
 import SrcLoc
 import FastString
 \end{code}
@@ -136,9 +136,12 @@ basicKnownKeyNames
        traversableClassName,
 
        -- Numeric stuff
-       negateName, minusName, 
-       fromRationalName, fromIntegerName, 
-       geName, eqName, 
+        negateName, minusName, geName, eqName,
+
+        -- Conversion functions
+        fromRationalName, fromIntegerName,
+        toIntegerName, toRationalName,
+        fromIntegralName, realToFracName,
 
         -- String stuff
         fromStringName,
@@ -172,7 +175,7 @@ basicKnownKeyNames
        newStablePtrName,
 
     -- GHC Extensions
-    groupWithName,
+        groupWithName,
 
        -- Strings and lists
        unpackCStringName, unpackCStringAppendName,
@@ -182,6 +185,8 @@ basicKnownKeyNames
        concatName, filterName, mapName,
        zipName, foldrName, buildName, augmentName, appendName,
 
+        dollarName,        -- The ($) apply function
+
         -- Parallel array operations
        nullPName, lengthPName, replicatePName, singletonPName, mapPName,
        filterPName, zipPName, crossMapPName, indexPName,
@@ -206,6 +211,11 @@ basicKnownKeyNames
        -- Other classes
        randomClassName, randomGenClassName, monadPlusClassName,
 
+        -- Code types
+        hetmet_brak_name, hetmet_esc_name, hetmet_csp_name,
+        hetmet_guest_integer_literal_name, hetmet_guest_string_literal_name,
+                                         hetmet_guest_char_literal_name,
+
         -- Annotation type checking
         toAnnotationWrapperName
 
@@ -234,8 +244,11 @@ genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName]
 pRELUDE :: Module
 pRELUDE                = mkBaseModule_ pRELUDE_NAME
 
-gHC_PRIM, gHC_TYPES, gHC_BOOL, gHC_UNIT, gHC_ORDERING, gHC_GENERICS, gHC_CLASSES, gHC_BASE, gHC_ENUM,
+gHC_PRIM, gHC_TYPES, gHC_UNIT, gHC_ORDERING, gHC_GENERICS,
+    gHC_MAGIC,
+    gHC_CLASSES, gHC_BASE, gHC_ENUM,
     gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER, gHC_INTEGER_TYPE, gHC_LIST, gHC_PARR,
+    gHC_HETMET_CODETYPES,
     gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING, dATA_FOLDABLE, dATA_TRAVERSABLE,
     gHC_PACK, gHC_CONC, gHC_IO, gHC_IO_Exception,
     gHC_ST, gHC_ARR, gHC_STABLE, gHC_ADDR, gHC_PTR, gHC_ERR, gHC_REAL,
@@ -246,9 +259,9 @@ gHC_PRIM, gHC_TYPES, gHC_BOOL, gHC_UNIT, gHC_ORDERING, gHC_GENERICS, gHC_CLASSES
 gHC_PRIM       = mkPrimModule (fsLit "GHC.Prim")   -- Primitive types and values
 gHC_TYPES       = mkPrimModule (fsLit "GHC.Types")
 gHC_UNIT       = mkPrimModule (fsLit "GHC.Unit")
-gHC_BOOL       = mkPrimModule (fsLit "GHC.Bool")
 gHC_ORDERING   = mkPrimModule (fsLit "GHC.Ordering")
 gHC_GENERICS   = mkPrimModule (fsLit "GHC.Generics")
+gHC_MAGIC      = mkPrimModule (fsLit "GHC.Magic")
 
 gHC_CLASSES    = mkBaseModule (fsLit "GHC.Classes")
 gHC_BASE       = mkBaseModule (fsLit "GHC.Base")
@@ -260,6 +273,7 @@ gHC_INTEGER = mkIntegerModule (fsLit "GHC.Integer")
 gHC_INTEGER_TYPE= mkIntegerModule (fsLit "GHC.Integer.Type")
 gHC_LIST       = mkBaseModule (fsLit "GHC.List")
 gHC_PARR       = mkBaseModule (fsLit "GHC.PArr")
+gHC_HETMET_CODETYPES = mkBaseModule (fsLit "GHC.HetMet.CodeTypes")
 gHC_TUPLE      = mkPrimModule (fsLit "GHC.Tuple")
 dATA_TUPLE     = mkBaseModule (fsLit "Data.Tuple")
 dATA_EITHER    = mkBaseModule (fsLit "Data.Either")
@@ -535,6 +549,9 @@ and it's convenient to write them all down in one place.
 
 
 \begin{code}
+wildCardName :: Name
+wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
+
 runMainIOName :: Name
 runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey
 
@@ -564,7 +581,7 @@ stringTyConName         = tcQual  gHC_BASE (fsLit "String") stringTyConKey
 
 -- The 'inline' function
 inlineIdName :: Name
-inlineIdName           = varQual gHC_BASE (fsLit "inline") inlineIdKey
+inlineIdName           = varQual gHC_MAGIC (fsLit "inline") inlineIdKey
 
 -- Base classes (Eq, Ord, Functor)
 eqClassName, eqName, ordClassName, geName, functorClassName :: Name
@@ -596,14 +613,15 @@ groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey
 fromStringName, otherwiseIdName, foldrName, buildName, augmentName,
     mapName, appendName, assertName,
     breakpointName, breakpointCondName, breakpointAutoName,
-    opaqueTyConName :: Name
+    dollarName, opaqueTyConName :: Name
 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
-mapName       = varQual gHC_BASE (fsLit "map")        mapIdKey
+mapName           = varQual gHC_BASE (fsLit "map")        mapIdKey
 appendName       = varQual gHC_BASE (fsLit "++")         appendIdKey
+dollarName       = varQual gHC_BASE (fsLit "$")          dollarIdKey
 assertName        = varQual gHC_BASE (fsLit "assert")     assertIdKey
 breakpointName    = varQual gHC_BASE (fsLit "breakpoint") breakpointIdKey
 breakpointCondName= varQual gHC_BASE (fsLit "breakpointCond") breakpointCondIdKey
@@ -634,7 +652,7 @@ fstName, sndName :: Name
 fstName                  = varQual dATA_TUPLE (fsLit "fst") fstIdKey
 sndName                  = varQual dATA_TUPLE (fsLit "snd") sndIdKey
 
--- Module PrelNum
+-- Module GHC.Num
 numClassName, fromIntegerName, minusName, negateName, plusIntegerName,
     timesIntegerName,
     integerTyConName, smallIntegerName :: Name
@@ -647,10 +665,11 @@ timesIntegerName  = varQual  gHC_INTEGER (fsLit "timesInteger") timesIntegerIdKe
 integerTyConName  = tcQual   gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey
 smallIntegerName = varQual gHC_INTEGER (fsLit "smallInteger") smallIntegerIdKey
 
--- PrelReal types and classes
+-- GHC.Real types and classes
 rationalTyConName, ratioTyConName, ratioDataConName, realClassName,
     integralClassName, realFracClassName, fractionalClassName,
-    fromRationalName :: Name
+    fromRationalName, toIntegerName, toRationalName, fromIntegralName,
+    realToFracName :: Name
 rationalTyConName   = tcQual  gHC_REAL (fsLit "Rational") rationalTyConKey
 ratioTyConName     = tcQual  gHC_REAL (fsLit "Ratio") ratioTyConKey
 ratioDataConName    = conName gHC_REAL (fsLit ":%") ratioDataConKey
@@ -658,7 +677,11 @@ realClassName          = clsQual gHC_REAL (fsLit "Real") realClassKey
 integralClassName   = clsQual gHC_REAL (fsLit "Integral") integralClassKey
 realFracClassName   = clsQual gHC_REAL (fsLit "RealFrac") realFracClassKey
 fractionalClassName = clsQual gHC_REAL (fsLit "Fractional") fractionalClassKey
-fromRationalName    = methName gHC_REAL  (fsLit "fromRational") fromRationalClassOpKey
+fromRationalName    = methName gHC_REAL (fsLit "fromRational") fromRationalClassOpKey
+toIntegerName       = methName gHC_REAL (fsLit "toInteger") toIntegerClassOpKey
+toRationalName      = methName gHC_REAL (fsLit "toRational") toRationalClassOpKey
+fromIntegralName    = varQual  gHC_REAL (fsLit "fromIntegral") fromIntegralIdKey
+realToFracName      = varQual  gHC_REAL (fsLit "realToFrac") realToFracIdKey
 
 -- PrelFloat classes
 floatingClassName, realFloatClassName :: Name
@@ -739,6 +762,16 @@ toPName              = varQual gHC_PARR (fsLit "toP")               toPIdKey
 emptyPName        = varQual gHC_PARR (fsLit "emptyP")            emptyPIdKey
 appPName          = varQual gHC_PARR (fsLit "+:+")               appPIdKey
 
+-- code type things
+hetmet_brak_name, hetmet_esc_name, hetmet_csp_name :: Name
+hetmet_guest_integer_literal_name, hetmet_guest_string_literal_name, hetmet_guest_char_literal_name :: Name
+hetmet_brak_name = varQual gHC_HETMET_CODETYPES (fsLit "hetmet_brak") hetmet_brak_key
+hetmet_esc_name  = varQual gHC_HETMET_CODETYPES (fsLit "hetmet_esc")  hetmet_esc_key
+hetmet_csp_name  = varQual gHC_HETMET_CODETYPES (fsLit "hetmet_csp") hetmet_csp_key
+hetmet_guest_integer_literal_name = varQual gHC_HETMET_CODETYPES (fsLit "hetmet_guest_integer_literal") hetmet_guest_integer_literal_key
+hetmet_guest_string_literal_name  = varQual gHC_HETMET_CODETYPES (fsLit "hetmet_guest_string_literal")  hetmet_guest_string_literal_key
+hetmet_guest_char_literal_name    = varQual gHC_HETMET_CODETYPES (fsLit "hetmet_guest_char_literal")    hetmet_guest_char_literal_key
+
 -- IO things
 ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName,
     failIOName :: Name
@@ -1026,7 +1059,8 @@ argTypeKindTyConKey                     = mkPreludeTyConUnique 91
 
 -- Coercion constructors
 symCoercionTyConKey, transCoercionTyConKey, leftCoercionTyConKey,
-    rightCoercionTyConKey, instCoercionTyConKey, unsafeCoercionTyConKey
+    rightCoercionTyConKey, instCoercionTyConKey, unsafeCoercionTyConKey,
+    csel1CoercionTyConKey, csel2CoercionTyConKey, cselRCoercionTyConKey
     :: Unique
 symCoercionTyConKey                     = mkPreludeTyConUnique 93
 transCoercionTyConKey                   = mkPreludeTyConUnique 94
@@ -1034,10 +1068,13 @@ leftCoercionTyConKey                    = mkPreludeTyConUnique 95
 rightCoercionTyConKey                   = mkPreludeTyConUnique 96
 instCoercionTyConKey                    = mkPreludeTyConUnique 97
 unsafeCoercionTyConKey                  = mkPreludeTyConUnique 98
+csel1CoercionTyConKey                   = mkPreludeTyConUnique 99
+csel2CoercionTyConKey                   = mkPreludeTyConUnique 100
+cselRCoercionTyConKey                   = mkPreludeTyConUnique 101
 
 unknownTyConKey, unknown1TyConKey, unknown2TyConKey, unknown3TyConKey,
     opaqueTyConKey :: Unique
-unknownTyConKey                                = mkPreludeTyConUnique 99
+unknownTyConKey                                = mkPreludeTyConUnique 129
 unknown1TyConKey                       = mkPreludeTyConUnique 130
 unknown2TyConKey                       = mkPreludeTyConUnique 131
 unknown3TyConKey                       = mkPreludeTyConUnique 132
@@ -1046,6 +1083,10 @@ opaqueTyConKey                          = mkPreludeTyConUnique 133
 stringTyConKey :: Unique
 stringTyConKey                         = mkPreludeTyConUnique 134
 
+-- Heterogeneous Metaprogramming code type constructor
+hetMetCodeTypeTyConKey :: Unique
+hetMetCodeTypeTyConKey                 = mkPreludeTyConUnique 135
+
 ---------------- Template Haskell -------------------
 --     USES TyConUniques 100-129
 -----------------------------------------------------
@@ -1093,6 +1134,10 @@ parrDataConKey                           = mkPreludeDataConUnique 24
 leftDataConKey, rightDataConKey :: Unique
 leftDataConKey                         = mkPreludeDataConUnique 25
 rightDataConKey                                = mkPreludeDataConUnique 26
+
+-- Data constructor for Heterogeneous Metaprogramming code types
+hetMetCodeTypeDataConKey :: Unique
+hetMetCodeTypeDataConKey                       = mkPreludeDataConUnique 27
 \end{code}
 
 %************************************************************************
@@ -1103,17 +1148,18 @@ rightDataConKey                         = mkPreludeDataConUnique 26
 
 \begin{code}
 absentErrorIdKey, augmentIdKey, appendIdKey, buildIdKey, errorIdKey,
-    foldlIdKey, foldrIdKey, recSelErrorIdKey,
+    foldlIdKey, foldrIdKey, recSelErrorIdKey, 
     integerMinusOneIdKey, integerPlusOneIdKey,
     integerPlusTwoIdKey, integerZeroIdKey,
     int2IntegerIdKey, seqIdKey, irrefutPatErrorIdKey, eqStringIdKey,
     noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey,
     runtimeErrorIdKey, parErrorIdKey, parIdKey, patErrorIdKey,
     realWorldPrimIdKey, recConErrorIdKey, recUpdErrorIdKey,
-    traceIdKey,
+    traceIdKey, wildCardKey,
     unpackCStringUtf8IdKey, unpackCStringAppendIdKey,
     unpackCStringFoldrIdKey, unpackCStringIdKey :: Unique
-absentErrorIdKey             = mkPreludeMiscIdUnique  1
+wildCardKey                   = mkPreludeMiscIdUnique  0  -- See Note [WildCard]
+absentErrorIdKey              = mkPreludeMiscIdUnique  1
 augmentIdKey                 = mkPreludeMiscIdUnique  3
 appendIdKey                  = mkPreludeMiscIdUnique  4
 buildIdKey                   = mkPreludeMiscIdUnique  5
@@ -1192,9 +1238,10 @@ breakpointAutoJumpIdKey       = mkPreludeMiscIdUnique 67
 inlineIdKey :: Unique
 inlineIdKey                  = mkPreludeMiscIdUnique 68
 
-mapIdKey, groupWithIdKey :: Unique
-mapIdKey                     = mkPreludeMiscIdUnique 69
+mapIdKey, groupWithIdKey, dollarIdKey :: Unique
+mapIdKey             = mkPreludeMiscIdUnique 69
 groupWithIdKey        = mkPreludeMiscIdUnique 70
+dollarIdKey           = mkPreludeMiscIdUnique 71
 
 -- Parallel array functions
 singletonPIdKey, nullPIdKey, lengthPIdKey, replicatePIdKey, mapPIdKey,
@@ -1276,6 +1323,22 @@ fromStringClassOpKey           = mkPreludeMiscIdUnique 125
 toAnnotationWrapperIdKey :: Unique
 toAnnotationWrapperIdKey      = mkPreludeMiscIdUnique 126
 
+-- Conversion functions
+fromIntegralIdKey, realToFracIdKey, toIntegerClassOpKey, toRationalClassOpKey :: Unique
+fromIntegralIdKey    = mkPreludeMiscIdUnique 127
+realToFracIdKey      = mkPreludeMiscIdUnique 128
+toIntegerClassOpKey  = mkPreludeMiscIdUnique 129
+toRationalClassOpKey = mkPreludeMiscIdUnique 130
+
+-- code types
+hetmet_brak_key, hetmet_esc_key, hetmet_csp_key :: Unique
+hetmet_brak_key    = mkPreludeMiscIdUnique 131
+hetmet_esc_key     = mkPreludeMiscIdUnique 132
+hetmet_csp_key     = mkPreludeMiscIdUnique 133
+hetmet_guest_integer_literal_key, hetmet_guest_string_literal_key, hetmet_guest_char_literal_key :: Unique
+hetmet_guest_integer_literal_key = mkPreludeMiscIdUnique 134
+hetmet_guest_string_literal_key  = mkPreludeMiscIdUnique 135
+hetmet_guest_char_literal_key    = mkPreludeMiscIdUnique 136
 
 ---------------- Template Haskell -------------------
 --     USES IdUniques 200-399
@@ -1298,6 +1361,13 @@ numericTyKeys =
        , doubleTyConKey
        , floatTyConKey
        ]
+
+kindKeys :: [Unique] 
+kindKeys = [ liftedTypeKindTyConKey
+          , openTypeKindTyConKey
+          , unliftedTypeKindTyConKey
+          , ubxTupleKindTyConKey 
+          , argTypeKindTyConKey ]
 \end{code}