Generate Typeable info at definition sites
[ghc.git] / compiler / prelude / THNames.hs
index 9367d4b..571487a 100644 (file)
@@ -7,9 +7,10 @@
 module THNames where
 
 import PrelNames( mk_known_key_name )
-import Module( Module, mkModuleNameFS, mkModule, thPackageKey )
+import Module( Module, mkModuleNameFS, mkModule, thUnitId )
 import Name( Name )
-import OccName( tcName, dataName, varName )
+import OccName( tcName, clsName, dataName, varName )
+import RdrName( RdrName, nameRdrName )
 import Unique
 import FastString
 
@@ -26,6 +27,7 @@ templateHaskellNames :: [Name]
 templateHaskellNames = [
     returnQName, bindQName, sequenceQName, newNameName, liftName,
     mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
+    mkNameSName,
     liftStringName,
     unTypeName,
     unTypeQName,
@@ -51,7 +53,7 @@ templateHaskellNames = [
     tupEName, unboxedTupEName,
     condEName, multiIfEName, letEName, caseEName, doEName, compEName,
     fromEName, fromThenEName, fromToEName, fromThenToEName,
-    listEName, sigEName, recConEName, recUpdEName, staticEName,
+    listEName, sigEName, recConEName, recUpdEName, staticEName, unboundVarEName,
     -- FieldExp
     fieldExpName,
     -- Body
@@ -122,6 +124,9 @@ templateHaskellNames = [
     -- AnnTarget
     valueAnnotationName, typeAnnotationName, moduleAnnotationName,
 
+    -- The type classes
+    liftClassName,
+
     -- And the tycons
     qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
     clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
@@ -141,17 +146,21 @@ thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
 qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
 
 mkTHModule :: FastString -> Module
-mkTHModule m = mkModule thPackageKey (mkModuleNameFS m)
+mkTHModule m = mkModule thUnitId (mkModuleNameFS m)
 
-libFun, libTc, thFun, thTc, thCon, qqFun :: FastString -> Unique -> Name
+libFun, libTc, thFun, thTc, thCls, thCon, qqFun :: FastString -> Unique -> Name
 libFun = mk_known_key_name OccName.varName  thLib
 libTc  = mk_known_key_name OccName.tcName   thLib
 thFun  = mk_known_key_name OccName.varName  thSyn
 thTc   = mk_known_key_name OccName.tcName   thSyn
+thCls  = mk_known_key_name OccName.clsName  thSyn
 thCon  = mk_known_key_name OccName.dataName thSyn
 qqFun  = mk_known_key_name OccName.varName  qqLib
 
 -------------------- TH.Syntax -----------------------
+liftClassName :: Name
+liftClassName = thCls (fsLit "Lift") liftClassKey
+
 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
     fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
     tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
@@ -176,7 +185,7 @@ kindTyConName     = thTc (fsLit "Kind")           kindTyConKey
 
 returnQName, bindQName, sequenceQName, newNameName, liftName,
     mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
-    mkNameLName, liftStringName, unTypeName, unTypeQName,
+    mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeQName,
     unsafeTExpCoerceName :: Name
 returnQName    = thFun (fsLit "returnQ")   returnQIdKey
 bindQName      = thFun (fsLit "bindQ")     bindQIdKey
@@ -189,6 +198,7 @@ mkNameG_vName  = thFun (fsLit "mkNameG_v")  mkNameG_vIdKey
 mkNameG_dName  = thFun (fsLit "mkNameG_d")  mkNameG_dIdKey
 mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
 mkNameLName    = thFun (fsLit "mkNameL")    mkNameLIdKey
+mkNameSName    = thFun (fsLit "mkNameS")    mkNameSIdKey
 unTypeName     = thFun (fsLit "unType")     unTypeIdKey
 unTypeQName    = thFun (fsLit "unTypeQ")    unTypeQIdKey
 unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey
@@ -244,7 +254,7 @@ clauseName = libFun (fsLit "clause") clauseIdKey
 varEName, conEName, litEName, appEName, infixEName, infixAppName,
     sectionLName, sectionRName, lamEName, lamCaseEName, tupEName,
     unboxedTupEName, condEName, multiIfEName, letEName, caseEName,
-    doEName, compEName, staticEName :: Name
+    doEName, compEName, staticEName, unboundVarEName :: Name
 varEName        = libFun (fsLit "varE")        varEIdKey
 conEName        = libFun (fsLit "conE")        conEIdKey
 litEName        = libFun (fsLit "litE")        litEIdKey
@@ -276,6 +286,7 @@ sigEName        = libFun (fsLit "sigE")        sigEIdKey
 recConEName     = libFun (fsLit "recConE")     recConEIdKey
 recUpdEName     = libFun (fsLit "recUpdE")     recUpdEIdKey
 staticEName     = libFun (fsLit "staticE")     staticEIdKey
+unboundVarEName = libFun (fsLit "unboundVarE") unboundVarEIdKey
 
 -- type FieldExp = ...
 fieldExpName :: Name
@@ -437,23 +448,6 @@ unsafeName     = libFun (fsLit "unsafe") unsafeIdKey
 safeName       = libFun (fsLit "safe") safeIdKey
 interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
 
--- data Inline = ...
-noInlineDataConName, inlineDataConName, inlinableDataConName :: Name
-noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
-inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
-inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
-
--- data RuleMatch = ...
-conLikeDataConName, funLikeDataConName :: Name
-conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
-funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
-
--- data Phases = ...
-allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name
-allPhasesDataConName   = thCon (fsLit "AllPhases")   allPhasesDataConKey
-fromPhaseDataConName   = thCon (fsLit "FromPhase")   fromPhaseDataConKey
-beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
-
 -- newtype TExp a = ...
 tExpDataConName :: Name
 tExpDataConName = thCon (fsLit "TExp") tExpDataConKey
@@ -512,6 +506,42 @@ quotePatName        = qqFun (fsLit "quotePat")  quotePatKey
 quoteDecName        = qqFun (fsLit "quoteDec")  quoteDecKey
 quoteTypeName       = qqFun (fsLit "quoteType") quoteTypeKey
 
+-- data Inline = ...
+noInlineDataConName, inlineDataConName, inlinableDataConName :: Name
+noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
+inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
+inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
+
+-- data RuleMatch = ...
+conLikeDataConName, funLikeDataConName :: Name
+conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
+funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
+
+-- data Phases = ...
+allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name
+allPhasesDataConName   = thCon (fsLit "AllPhases")   allPhasesDataConKey
+fromPhaseDataConName   = thCon (fsLit "FromPhase")   fromPhaseDataConKey
+beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
+
+
+{- *********************************************************************
+*                                                                      *
+                     Class keys
+*                                                                      *
+********************************************************************* -}
+
+-- ClassUniques available: 200-299
+-- Check in PrelNames if you want to change this
+
+liftClassKey :: Unique
+liftClassKey = mkPreludeClassUnique 200
+
+{- *********************************************************************
+*                                                                      *
+                     TyCon keys
+*                                                                      *
+********************************************************************* -}
+
 -- TyConUniques available: 200-299
 -- Check in PrelNames if you want to change this
 
@@ -557,12 +587,50 @@ tExpTyConKey            = mkPreludeTyConUnique 230
 injAnnTyConKey          = mkPreludeTyConUnique 231
 kindTyConKey            = mkPreludeTyConUnique 232
 
+{- *********************************************************************
+*                                                                      *
+                     DataCon keys
+*                                                                      *
+********************************************************************* -}
+
+-- DataConUniques available: 100-150
+-- If you want to change this, make sure you check in PrelNames
+
+-- data Inline = ...
+noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
+noInlineDataConKey  = mkPreludeDataConUnique 100
+inlineDataConKey    = mkPreludeDataConUnique 101
+inlinableDataConKey = mkPreludeDataConUnique 102
+
+-- data RuleMatch = ...
+conLikeDataConKey, funLikeDataConKey :: Unique
+conLikeDataConKey = mkPreludeDataConUnique 103
+funLikeDataConKey = mkPreludeDataConUnique 104
+
+-- data Phases = ...
+allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
+allPhasesDataConKey   = mkPreludeDataConUnique 105
+fromPhaseDataConKey   = mkPreludeDataConUnique 106
+beforePhaseDataConKey = mkPreludeDataConUnique 107
+
+-- newtype TExp a = ...
+tExpDataConKey :: Unique
+tExpDataConKey = mkPreludeDataConUnique 108
+
+
+{- *********************************************************************
+*                                                                      *
+                     Id keys
+*                                                                      *
+********************************************************************* -}
+
 -- IdUniques available: 200-499
 -- If you want to change this, make sure you check in PrelNames
 
 returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
     mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
-    mkNameLIdKey, unTypeIdKey, unTypeQIdKey, unsafeTExpCoerceIdKey :: Unique
+    mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeQIdKey,
+    unsafeTExpCoerceIdKey :: Unique
 returnQIdKey        = mkPreludeMiscIdUnique 200
 bindQIdKey          = mkPreludeMiscIdUnique 201
 sequenceQIdKey      = mkPreludeMiscIdUnique 202
@@ -573,9 +641,10 @@ mkNameG_vIdKey       = mkPreludeMiscIdUnique 206
 mkNameG_dIdKey       = mkPreludeMiscIdUnique 207
 mkNameG_tcIdKey      = mkPreludeMiscIdUnique 208
 mkNameLIdKey         = mkPreludeMiscIdUnique 209
-unTypeIdKey          = mkPreludeMiscIdUnique 210
-unTypeQIdKey         = mkPreludeMiscIdUnique 211
-unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 212
+mkNameSIdKey         = mkPreludeMiscIdUnique 210
+unTypeIdKey          = mkPreludeMiscIdUnique 211
+unTypeQIdKey         = mkPreludeMiscIdUnique 212
+unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 213
 
 
 -- data Lit = ...
@@ -633,7 +702,8 @@ varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
     unboxedTupEIdKey, condEIdKey, multiIfEIdKey,
     letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
     fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
-    listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey :: Unique
+    listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey,
+    unboundVarEIdKey :: Unique
 varEIdKey         = mkPreludeMiscIdUnique 270
 conEIdKey         = mkPreludeMiscIdUnique 271
 litEIdKey         = mkPreludeMiscIdUnique 272
@@ -661,6 +731,7 @@ sigEIdKey         = mkPreludeMiscIdUnique 293
 recConEIdKey      = mkPreludeMiscIdUnique 294
 recUpdEIdKey      = mkPreludeMiscIdUnique 295
 staticEIdKey      = mkPreludeMiscIdUnique 296
+unboundVarEIdKey  = mkPreludeMiscIdUnique 297
 
 -- type FieldExp = ...
 fieldExpIdKey :: Unique
@@ -822,27 +893,6 @@ unsafeIdKey        = mkPreludeMiscIdUnique 430
 safeIdKey          = mkPreludeMiscIdUnique 431
 interruptibleIdKey = mkPreludeMiscIdUnique 432
 
--- data Inline = ...
-noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
-noInlineDataConKey  = mkPreludeDataConUnique 40
-inlineDataConKey    = mkPreludeDataConUnique 41
-inlinableDataConKey = mkPreludeDataConUnique 42
-
--- data RuleMatch = ...
-conLikeDataConKey, funLikeDataConKey :: Unique
-conLikeDataConKey = mkPreludeDataConUnique 43
-funLikeDataConKey = mkPreludeDataConUnique 44
-
--- data Phases = ...
-allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
-allPhasesDataConKey   = mkPreludeDataConUnique 45
-fromPhaseDataConKey   = mkPreludeDataConUnique 46
-beforePhaseDataConKey = mkPreludeDataConUnique 47
-
--- newtype TExp a = ...
-tExpDataConKey :: Unique
-tExpDataConKey = mkPreludeDataConUnique 48
-
 -- data FunDep = ...
 funDepIdKey :: Unique
 funDepIdKey = mkPreludeMiscIdUnique 440
@@ -873,3 +923,34 @@ valueAnnotationIdKey, typeAnnotationIdKey, moduleAnnotationIdKey :: Unique
 valueAnnotationIdKey  = mkPreludeMiscIdUnique 490
 typeAnnotationIdKey   = mkPreludeMiscIdUnique 491
 moduleAnnotationIdKey = mkPreludeMiscIdUnique 492
+
+{-
+************************************************************************
+*                                                                      *
+                        RdrNames
+*                                                                      *
+************************************************************************
+-}
+
+lift_RDR, mkNameG_dRDR, mkNameG_vRDR :: RdrName
+lift_RDR     = nameRdrName liftName
+mkNameG_dRDR = nameRdrName mkNameG_dName
+mkNameG_vRDR = nameRdrName mkNameG_vName
+
+-- data Exp = ...
+conE_RDR, litE_RDR, appE_RDR, infixApp_RDR :: RdrName
+conE_RDR     = nameRdrName conEName
+litE_RDR     = nameRdrName litEName
+appE_RDR     = nameRdrName appEName
+infixApp_RDR = nameRdrName infixAppName
+
+-- data Lit = ...
+stringL_RDR, intPrimL_RDR, wordPrimL_RDR, floatPrimL_RDR,
+    doublePrimL_RDR, stringPrimL_RDR, charPrimL_RDR :: RdrName
+stringL_RDR     = nameRdrName stringLName
+intPrimL_RDR    = nameRdrName intPrimLName
+wordPrimL_RDR   = nameRdrName wordPrimLName
+floatPrimL_RDR  = nameRdrName floatPrimLName
+doublePrimL_RDR = nameRdrName doublePrimLName
+stringPrimL_RDR = nameRdrName stringPrimLName
+charPrimL_RDR   = nameRdrName charPrimLName