[commit: ghc] wip/th-new: Add names for TExp type constructor and unType. (2be8067)
git at git.haskell.org
git at git.haskell.org
Mon Sep 16 07:07:00 CEST 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/th-new
Link : http://ghc.haskell.org/trac/ghc/changeset/2be8067c363ade6315dd2abbe99ba7525c708755/ghc
>---------------------------------------------------------------
commit 2be8067c363ade6315dd2abbe99ba7525c708755
Author: Geoffrey Mainland <mainland at apeiron.net>
Date: Wed Apr 24 14:33:51 2013 +0100
Add names for TExp type constructor and unType.
>---------------------------------------------------------------
2be8067c363ade6315dd2abbe99ba7525c708755
compiler/deSugar/DsMeta.hs | 28 +++++++++++++++++++++++-----
1 file changed, 23 insertions(+), 5 deletions(-)
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 218b00e..fab136d 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -18,7 +18,8 @@ module DsMeta( dsBracket,
liftName, liftStringName, expQTyConName, patQTyConName,
decQTyConName, decsQTyConName, typeQTyConName,
decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName,
- quoteExpName, quotePatName, quoteDecName, quoteTypeName
+ quoteExpName, quotePatName, quoteDecName, quoteTypeName,
+ tExpTyConName, tExpDataConName, unTypeName
) where
#include "HsVersions.h"
@@ -2018,6 +2019,7 @@ templateHaskellNames = [
returnQName, bindQName, sequenceQName, newNameName, liftName,
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
liftStringName,
+ unTypeName,
-- Lit
charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
@@ -2092,6 +2094,8 @@ templateHaskellNames = [
conLikeDataConName, funLikeDataConName,
-- Phases
allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName,
+ -- TExp
+ tExpDataConName,
-- RuleBndr
ruleVarName, typedRuleVarName,
-- FunDep
@@ -2109,6 +2113,7 @@ templateHaskellNames = [
typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
predQTyConName, decsQTyConName, ruleBndrQTyConName, tySynEqnQTyConName,
+ tExpTyConName,
-- Quasiquoting
quoteDecName, quoteTypeName, quoteExpName, quotePatName]
@@ -2133,7 +2138,7 @@ qqFun = mk_known_key_name OccName.varName qqLib
qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
- predTyConName :: Name
+ predTyConName, tExpTyConName :: Name
qTyConName = thTc (fsLit "Q") qTyConKey
nameTyConName = thTc (fsLit "Name") nameTyConKey
fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey
@@ -2147,10 +2152,11 @@ matchTyConName = thTc (fsLit "Match") matchTyConKey
clauseTyConName = thTc (fsLit "Clause") clauseTyConKey
funDepTyConName = thTc (fsLit "FunDep") funDepTyConKey
predTyConName = thTc (fsLit "Pred") predTyConKey
+tExpTyConName = thTc (fsLit "TExp") tExpTyConKey
returnQName, bindQName, sequenceQName, newNameName, liftName,
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
- mkNameLName, liftStringName :: Name
+ mkNameLName, liftStringName, unTypeName :: Name
returnQName = thFun (fsLit "returnQ") returnQIdKey
bindQName = thFun (fsLit "bindQ") bindQIdKey
sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
@@ -2162,6 +2168,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
+unTypeName = thFun (fsLit "unType") unTypeIdKey
-------------------- TH.Lib -----------------------
@@ -2406,6 +2413,10 @@ 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
+
-- data RuleBndr = ...
ruleVarName, typedRuleVarName :: Name
ruleVarName = libFun (fsLit ("ruleVar")) ruleVarIdKey
@@ -2462,7 +2473,8 @@ expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
- predQTyConKey, decsQTyConKey, ruleBndrQTyConKey, tySynEqnQTyConKey :: Unique
+ predQTyConKey, decsQTyConKey, ruleBndrQTyConKey, tySynEqnQTyConKey,
+ tExpTyConKey :: Unique
expTyConKey = mkPreludeTyConUnique 200
matchTyConKey = mkPreludeTyConUnique 201
clauseTyConKey = mkPreludeTyConUnique 202
@@ -2492,13 +2504,14 @@ tyVarBndrTyConKey = mkPreludeTyConUnique 225
decsQTyConKey = mkPreludeTyConUnique 226
ruleBndrQTyConKey = mkPreludeTyConUnique 227
tySynEqnQTyConKey = mkPreludeTyConUnique 228
+tExpTyConKey = mkPreludeTyConUnique 229
-- 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 :: Unique
+ mkNameLIdKey, unTypeIdKey :: Unique
returnQIdKey = mkPreludeMiscIdUnique 200
bindQIdKey = mkPreludeMiscIdUnique 201
sequenceQIdKey = mkPreludeMiscIdUnique 202
@@ -2509,6 +2522,7 @@ mkNameG_vIdKey = mkPreludeMiscIdUnique 206
mkNameG_dIdKey = mkPreludeMiscIdUnique 207
mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
mkNameLIdKey = mkPreludeMiscIdUnique 209
+unTypeIdKey = mkPreludeMiscIdUnique 210
-- data Lit = ...
@@ -2753,6 +2767,10 @@ allPhasesDataConKey = mkPreludeDataConUnique 45
fromPhaseDataConKey = mkPreludeDataConUnique 46
beforePhaseDataConKey = mkPreludeDataConUnique 47
+-- newtype TExp a = ...
+tExpDataConKey :: Unique
+tExpDataConKey = mkPreludeDataConUnique 48
+
-- data FunDep = ...
funDepIdKey :: Unique
funDepIdKey = mkPreludeMiscIdUnique 418
More information about the ghc-commits
mailing list