merge GHC HEAD

[ghc-hetmet.git] / compiler / prelude / TysWiredIn.lhs

diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 9f5f369..bc45028 100644 (file)
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -47,6 +47,12 @@ module TysWiredIn (
         -- * Unit
        unitTy,
 
+        -- * Heterogeneous Metaprogramming
+       mkHetMetCodeTypeTy,
+        hetMetCodeTypeTyConName,
+       hetMetCodeTypeTyCon,     isHetMetCodeTypeTyCon,
+       hetMetCodeTypeTyCon_RDR,
+
         -- * Parallel arrays
        mkPArrTy,
        parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
@@ -115,6 +121,7 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
              , intTyCon
              , listTyCon
              , parrTyCon
+             , hetMetCodeTypeTyCon
              ]
 \end{code}
 
@@ -159,8 +166,14 @@ 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
+
 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 :: RdrName
 boolTyCon_RDR   = nameRdrName boolTyConName
 false_RDR      = nameRdrName falseDataConName
 true_RDR       = nameRdrName trueDataConName
@@ -170,6 +183,7 @@ intDataCon_RDR      = nameRdrName intDataConName
 listTyCon_RDR  = nameRdrName listTyConName
 consDataCon_RDR = nameRdrName consDataConName
 parrTyCon_RDR  = nameRdrName parrTyConName
+hetMetCodeTypeTyCon_RDR        = nameRdrName hetMetCodeTypeTyConName
 \end{code}
 
 
@@ -196,7 +210,6 @@ pcTyCon is_enum is_rec name tyvars cons
                (DataTyCon cons is_enum)
                NoParentTyCon
                 is_rec
-               True            -- All the wired-in tycons have generics
                False           -- Not in GADT syntax
 
 pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
@@ -261,7 +274,7 @@ unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mA
 mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
 mk_tuple boxity arity = (tycon, tuple_con)
   where
-       tycon   = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity gen_info 
+       tycon   = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity 
        modu    = mkTupleModule boxity arity
        tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
                                (ATyCon tycon) BuiltInSyntax
@@ -278,8 +291,6 @@ mk_tuple boxity arity = (tycon, tuple_con)
                                  (ADataCon tuple_con) BuiltInSyntax
        tc_uniq   = mkTupleTyConUnique   boxity arity
        dc_uniq   = mkTupleDataConUnique boxity arity
-       gen_info  = True                -- Tuples all have generics..
-                                       -- hmm: that's a *lot* of code
 
 unitTyCon :: TyCon
 unitTyCon     = tupleTyCon Boxed 0
@@ -595,3 +606,29 @@ 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]
+
+ecTyVar = head ecTyVars
+
+-- | Represents the type constructor of box types
+hetMetCodeTypeTyCon :: TyCon
+hetMetCodeTypeTyCon  = pcNonRecDataTyCon hetMetCodeTypeTyConName [ecTyVar, betaTyVar] [hetMetCodeTypeDataCon]
+
+-- | Check whether a type constructor is the constructor for box types
+isHetMetCodeTypeTyCon    :: TyCon -> Bool
+isHetMetCodeTypeTyCon tc  = tyConName tc == hetMetCodeTypeTyConName
+
+hetMetCodeTypeDataCon :: DataCon
+hetMetCodeTypeDataCon  = pcDataCon 
+                hetMetCodeTypeDataConName 
+                [betaTyVar]            -- forall'ed type variables
+                [betaTy] 
+                hetMetCodeTypeTyCon
+
+\end{code}