-- * Unit
unitTy,
+ -- * Heterogeneous Metaprogramming
+ mkHetMetCodeTypeTy,
+ hetMetCodeTypeTyConName,
+ hetMetCodeTypeTyCon,
+ isHetMetCodeTypeTyCon,
+ hetMetCodeTypeTyCon_RDR,
+
+ mkHetMetKappaTy,
+ hetMetKappaTyConName,
+ hetMetKappaTyCon,
+ hetMetKappaTyCon_RDR,
+ isHetMetKappaTyCon,
+
-- * Parallel arrays
mkPArrTy,
parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
-- others:
import Constants ( mAX_TUPLE_SIZE )
import Module ( Module )
+import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
+import Var
+import TyCon
+import TypeRep
import RdrName
import Name
-import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
-import Var
-import TyCon ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons,
- mkTupleTyCon, mkAlgTyCon, tyConName,
- TyConParent(NoParentTyCon) )
-
-import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, HsBang(..) )
-
-import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys,
- TyThing(..) )
-import Coercion ( unsafeCoercionTyCon, symCoercionTyCon,
- transCoercionTyCon, leftCoercionTyCon,
- rightCoercionTyCon, instCoercionTyCon )
-import TypeRep ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
-import Unique ( incrUnique, mkTupleTyConUnique,
+import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, HsBang(..) )
+import Unique ( incrUnique, mkTupleTyConUnique,
mkTupleDataConUnique, mkPArrDataConUnique )
import Data.Array
import FastString
, intTyCon
, listTyCon
, parrTyCon
- , unsafeCoercionTyCon
- , symCoercionTyCon
- , transCoercionTyCon
- , leftCoercionTyCon
- , rightCoercionTyCon
- , instCoercionTyCon
+ , hetMetCodeTypeTyCon
+ , hetMetKappaTyCon
]
\end{code}
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
listTyCon_RDR = nameRdrName listTyConName
consDataCon_RDR = nameRdrName consDataConName
parrTyCon_RDR = nameRdrName parrTyConName
+hetMetCodeTypeTyCon_RDR = nameRdrName hetMetCodeTypeTyConName
+hetMetKappaTyCon_RDR = nameRdrName hetMetKappaTyConName
\end{code}
(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
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
(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
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}