X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FTysWiredIn.lhs;h=21e51c464919ed4112819b237cbd756a0e3c2fd7;hp=5a80067160b555a78375e6c02a97ed22fc0130ca;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hpb=1b381af863d64aaa0a4dd9c816170c58e6131a9e

diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 5a80067..21e51c4 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -47,6 +47,19 @@ module TysWiredIn (
         -- * Unit
 	unitTy,
 
+        -- * Heterogeneous Metaprogramming
+	mkHetMetCodeTypeTy,
+        hetMetCodeTypeTyConName,
+	hetMetCodeTypeTyCon,
+        isHetMetCodeTypeTyCon,
+	hetMetCodeTypeTyCon_RDR,
+
+	mkHetMetKappaTy,
+        hetMetKappaTyConName,
+	hetMetKappaTyCon,
+	hetMetKappaTyCon_RDR,
+        isHetMetKappaTyCon,
+
         -- * Parallel arrays
 	mkPArrTy,
 	parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
@@ -115,6 +128,8 @@ wiredInTyCons = [ unitTyCon	-- Not treated like other tuples, because
     	      , intTyCon
     	      , listTyCon
 	      , parrTyCon
+	      , hetMetCodeTypeTyCon
+	      , hetMetKappaTyCon
     	      ]
 \end{code}
 
@@ -159,8 +174,18 @@ parrTyConName   = mkWiredInTyConName   BuiltInSyntax
 parrDataConName = mkWiredInDataConName UserSyntax    
                     gHC_PARR' (fsLit "PArr") parrDataConKey parrDataCon
 
+hetMetCodeTypeTyConName :: Name
+hetMetCodeTypeTyConName	= mkWiredInTyConName   BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "<{}>@")      hetMetCodeTypeTyConKey   hetMetCodeTypeTyCon 
+hetMetCodeTypeDataConName :: Name
+hetMetCodeTypeDataConName	=
+    mkWiredInDataConName  BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "<{}>")      hetMetCodeTypeDataConKey hetMetCodeTypeDataCon
+
+hetMetKappaTyConName :: Name
+hetMetKappaTyConName = mkWiredInTyConName   BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "~~>")  hetMetKappaTyConKey hetMetKappaTyCon
+
 boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
-    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR:: RdrName
+    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR, hetMetCodeTypeTyCon_RDR,
+    hetMetKappaTyCon_RDR :: RdrName
 boolTyCon_RDR   = nameRdrName boolTyConName
 false_RDR	= nameRdrName falseDataConName
 true_RDR	= nameRdrName trueDataConName
@@ -170,6 +195,8 @@ intDataCon_RDR	= nameRdrName intDataConName
 listTyCon_RDR	= nameRdrName listTyConName
 consDataCon_RDR = nameRdrName consDataConName
 parrTyCon_RDR	= nameRdrName parrTyConName
+hetMetCodeTypeTyCon_RDR	= nameRdrName hetMetCodeTypeTyConName
+hetMetKappaTyCon_RDR = nameRdrName hetMetKappaTyConName
 \end{code}
 
 
@@ -592,3 +619,38 @@ mkPArrFakeCon arity  = data_con
 isPArrFakeCon      :: DataCon -> Bool
 isPArrFakeCon dcon  = dcon == parrFakeCon (dataConSourceArity dcon)
 \end{code}
+
+Heterogeneous Metaprogramming
+
+\begin{code}
+-- | Construct a type representing the application of the box type
+mkHetMetCodeTypeTy    :: TyVar -> Type -> Type
+mkHetMetCodeTypeTy ecn ty = mkTyConApp hetMetCodeTypeTyCon [(mkTyVarTy ecn), ty]
+
+mkHetMetKappaTy    :: Type -> Type -> Type
+mkHetMetKappaTy a b = mkTyConApp hetMetKappaTyCon [a, b]
+
+ecTyVar = head ecTyVars
+
+-- | Represents the type constructor of box types
+hetMetCodeTypeTyCon :: TyCon
+hetMetCodeTypeTyCon  = pcNonRecDataTyCon hetMetCodeTypeTyConName [ecTyVar, betaTyVar] [hetMetCodeTypeDataCon]
+
+hetMetKappaTyCon :: TyCon
+hetMetKappaTyCon  = pcNonRecDataTyCon hetMetKappaTyConName [alphaTyVar, betaTyVar] []
+
+-- | Check whether a type constructor is the constructor for box types
+isHetMetCodeTypeTyCon    :: TyCon -> Bool
+isHetMetCodeTypeTyCon tc  = tyConName tc == hetMetCodeTypeTyConName
+
+isHetMetKappaTyCon    :: TyCon -> Bool
+isHetMetKappaTyCon tc  = tyConName tc == hetMetKappaTyConName
+
+hetMetCodeTypeDataCon :: DataCon
+hetMetCodeTypeDataCon  = pcDataCon 
+	         hetMetCodeTypeDataConName 
+		 [betaTyVar]		-- forall'ed type variables
+		 [betaTy] 
+		 hetMetCodeTypeTyCon
+
+\end{code}