Add typed holes support in Template Haskell.
[ghc.git] / compiler / prelude / THNames.hs
index 9367d4b..062f957 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
@@ -512,6 +523,12 @@ quotePatName        = qqFun (fsLit "quotePat")  quotePatKey
 quoteDecName        = qqFun (fsLit "quoteDec")  quoteDecKey
 quoteTypeName       = qqFun (fsLit "quoteType") quoteTypeKey
 
+-- ClassUniques available: 200-299
+-- Check in PrelNames if you want to change this
+
+liftClassKey :: Unique
+liftClassKey = mkPreludeClassUnique 200
+
 -- TyConUniques available: 200-299
 -- Check in PrelNames if you want to change this
 
@@ -562,7 +579,8 @@ kindTyConKey            = mkPreludeTyConUnique 232
 
 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 +591,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 +652,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 +681,7 @@ sigEIdKey         = mkPreludeMiscIdUnique 293
 recConEIdKey      = mkPreludeMiscIdUnique 294
 recUpdEIdKey      = mkPreludeMiscIdUnique 295
 staticEIdKey      = mkPreludeMiscIdUnique 296
+unboundVarEIdKey  = mkPreludeMiscIdUnique 297
 
 -- type FieldExp = ...
 fieldExpIdKey :: Unique
@@ -873,3 +894,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