X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FTysWiredIn.lhs;h=bc450281991faa8dd930730b9c8baceea1e3fa33;hp=ed7da333c4ff6e8e85a83e0283f858f706c3e288;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=8e2c0b76cd426ae794bd0ff046b95c437cef6e4a diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index ed7da33..bc45028 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -3,46 +3,57 @@ % \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types} -This module is about types that can be defined in Haskell, but which -must be wired into the compiler nonetheless. - -This module tracks the ``state interface'' document, ``GHC prelude: -types and operations.'' - \begin{code} +-- | This module is about types that can be defined in Haskell, but which +-- must be wired into the compiler nonetheless. C.f module TysPrim module TysWiredIn ( + -- * All wired in things wiredInTyCons, + -- * Bool boolTy, boolTyCon, boolTyCon_RDR, boolTyConName, trueDataCon, trueDataConId, true_RDR, falseDataCon, falseDataConId, false_RDR, + -- * Char charTyCon, charDataCon, charTyCon_RDR, charTy, stringTy, charTyConName, - + -- * Double doubleTyCon, doubleDataCon, doubleTy, doubleTyConName, + -- * Float floatTyCon, floatDataCon, floatTy, floatTyConName, + -- * Int intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName, intTy, + -- * Word + wordTyCon, wordDataCon, wordTyConName, wordTy, + + -- * List listTyCon, nilDataCon, consDataCon, listTyCon_RDR, consDataCon_RDR, listTyConName, mkListTy, - -- tuples - mkTupleTy, + -- * Tuples + mkTupleTy, mkBoxedTupleTy, tupleTyCon, tupleCon, unitTyCon, unitDataCon, unitDataConId, pairTyCon, unboxedSingletonTyCon, unboxedSingletonDataCon, unboxedPairTyCon, unboxedPairDataCon, + -- * Unit unitTy, - voidTy, - -- parallel arrays + -- * Heterogeneous Metaprogramming + mkHetMetCodeTypeTy, + hetMetCodeTypeTyConName, + hetMetCodeTypeTyCon, isHetMetCodeTypeTyCon, + hetMetCodeTypeTyCon_RDR, + + -- * Parallel arrays mkPArrTy, parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon, parrTyCon_RDR, parrTyConName @@ -59,33 +70,24 @@ import TysPrim -- others: import Constants ( mAX_TUPLE_SIZE ) import Module ( Module ) -import RdrName ( nameRdrName ) -import Name ( Name, BuiltInSyntax(..), nameUnique, nameOccName, - nameModule, mkWiredInName ) -import OccName ( mkOccNameFS, tcName, dataName, mkTupleOcc, - mkDataConWorkerOcc ) -import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity ) -import Var ( TyVar, tyVarKind ) -import TyCon ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons, - mkTupleTyCon, mkAlgTyCon, tyConName ) - -import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, - StrictnessMark(..) ) - -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 DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity ) +import Var +import TyCon +import TypeRep +import RdrName +import Name +import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, HsBang(..) ) +import Unique ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique, mkPArrDataConUnique ) -import Array +import Data.Array import FastString import Outputable +alpha_tyvar :: [TyVar] alpha_tyvar = [alphaTyVar] -alpha_ty = [alphaTy] + +alpha_ty :: [Type] +alpha_ty = [alphaTy] \end{code} @@ -119,50 +121,59 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because , intTyCon , listTyCon , parrTyCon - , unsafeCoercionTyCon - , symCoercionTyCon - , transCoercionTyCon - , leftCoercionTyCon - , rightCoercionTyCon - , instCoercionTyCon + , hetMetCodeTypeTyCon ] \end{code} \begin{code} mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name -mkWiredInTyConName built_in mod fs uniq tycon - = mkWiredInName mod (mkOccNameFS tcName fs) uniq - Nothing -- No parent object +mkWiredInTyConName built_in modu fs unique tycon + = mkWiredInName modu (mkTcOccFS fs) unique (ATyCon tycon) -- Relevant TyCon built_in -mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name -> Name -mkWiredInDataConName built_in mod fs uniq datacon parent - = mkWiredInName mod (mkOccNameFS dataName fs) uniq - (Just parent) -- Name of parent TyCon +mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name +mkWiredInDataConName built_in modu fs unique datacon + = mkWiredInName modu (mkDataOccFS fs) unique (ADataCon datacon) -- Relevant DataCon built_in -charTyConName = mkWiredInTyConName UserSyntax gHC_BASE FSLIT("Char") charTyConKey charTyCon -charDataConName = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("C#") charDataConKey charDataCon charTyConName -intTyConName = mkWiredInTyConName UserSyntax gHC_BASE FSLIT("Int") intTyConKey intTyCon -intDataConName = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("I#") intDataConKey intDataCon intTyConName - -boolTyConName = mkWiredInTyConName UserSyntax gHC_BASE FSLIT("Bool") boolTyConKey boolTyCon -falseDataConName = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("False") falseDataConKey falseDataCon boolTyConName -trueDataConName = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("True") trueDataConKey trueDataCon boolTyConName -listTyConName = mkWiredInTyConName BuiltInSyntax gHC_BASE FSLIT("[]") listTyConKey listTyCon -nilDataConName = mkWiredInDataConName BuiltInSyntax gHC_BASE FSLIT("[]") nilDataConKey nilDataCon listTyConName -consDataConName = mkWiredInDataConName BuiltInSyntax gHC_BASE FSLIT(":") consDataConKey consDataCon listTyConName - -floatTyConName = mkWiredInTyConName UserSyntax gHC_FLOAT FSLIT("Float") floatTyConKey floatTyCon -floatDataConName = mkWiredInDataConName UserSyntax gHC_FLOAT FSLIT("F#") floatDataConKey floatDataCon floatTyConName -doubleTyConName = mkWiredInTyConName UserSyntax gHC_FLOAT FSLIT("Double") doubleTyConKey doubleTyCon -doubleDataConName = mkWiredInDataConName UserSyntax gHC_FLOAT FSLIT("D#") doubleDataConKey doubleDataCon doubleTyConName - -parrTyConName = mkWiredInTyConName BuiltInSyntax gHC_PARR FSLIT("[::]") parrTyConKey parrTyCon -parrDataConName = mkWiredInDataConName UserSyntax gHC_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName - +charTyConName, charDataConName, intTyConName, intDataConName :: Name +charTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon +charDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon +intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyConKey intTyCon +intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon + +boolTyConName, falseDataConName, trueDataConName :: Name +boolTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon +falseDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") falseDataConKey falseDataCon +trueDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True") trueDataConKey trueDataCon + +listTyConName, nilDataConName, consDataConName :: Name +listTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon +nilDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon +consDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon + +floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name +floatTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Float") floatTyConKey floatTyCon +floatDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#") floatDataConKey floatDataCon +doubleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey doubleTyCon +doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") doubleDataConKey doubleDataCon + +parrTyConName, parrDataConName :: Name +parrTyConName = mkWiredInTyConName BuiltInSyntax + gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon +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, hetMetCodeTypeTyCon_RDR :: RdrName boolTyCon_RDR = nameRdrName boolTyConName false_RDR = nameRdrName falseDataConName true_RDR = nameRdrName trueDataConName @@ -172,16 +183,7 @@ intDataCon_RDR = nameRdrName intDataConName listTyCon_RDR = nameRdrName listTyConName consDataCon_RDR = nameRdrName consDataConName parrTyCon_RDR = nameRdrName parrTyConName -{- -tySuperKindTyCon_RDR = nameRdrName tySuperKindTyConName -coSuperKindTyCon_RDR = nameRdrName coSuperKindTyConName -liftedTypeKindTyCon_RDR = nameRdrName liftedTypeKindTyConName -openTypeKindTyCon_RDR = nameRdrName openTypeKindTyConName -unliftedTypeKindTyCon_RDR = nameRdrName unliftedTypeKindTyConName -ubxTupleKindTyCon_RDR = nameRdrName ubxTupleKindTyConName -argTypeKindTyCon_RDR = nameRdrName argTypeKindTyConName -funKindTyCon_RDR = nameRdrName funKindTyConName --} +hetMetCodeTypeTyCon_RDR = nameRdrName hetMetCodeTypeTyConName \end{code} @@ -192,21 +194,22 @@ funKindTyCon_RDR = nameRdrName funKindTyConName %************************************************************************ \begin{code} +pcNonRecDataTyCon :: Name -> [TyVar] -> [DataCon] -> TyCon pcNonRecDataTyCon = pcTyCon False NonRecursive +pcRecDataTyCon :: Name -> [TyVar] -> [DataCon] -> TyCon pcRecDataTyCon = pcTyCon False Recursive -pcTyCon is_enum is_rec name tyvars argvrcs cons +pcTyCon :: Bool -> RecFlag -> Name -> [TyVar] -> [DataCon] -> TyCon +pcTyCon is_enum is_rec name tyvars cons = tycon where tycon = mkAlgTyCon name (mkArrowKinds (map tyVarKind tyvars) liftedTypeKind) tyvars - argvrcs [] -- No stupid theta (DataTyCon cons is_enum) - [] -- No record selectors + NoParentTyCon is_rec - True -- All the wired-in tycons have generics False -- Not in GADT syntax pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon @@ -224,22 +227,23 @@ pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon = data_con where data_con = mkDataCon dc_name declared_infix - (map (const NotMarkedStrict) arg_tys) + (map (const HsNoBang) arg_tys) [] -- No labelled fields tyvars [] -- No existential type variables [] -- No equality spec [] -- No theta - arg_tys tycon + arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)) + tycon [] -- No stupid theta (mkDataConIds bogus_wrap_name wrk_name data_con) - mod = nameModule dc_name + modu = ASSERT( isExternalName dc_name ) + nameModule dc_name wrk_occ = mkDataConWorkerOcc (nameOccName dc_name) wrk_key = incrUnique (nameUnique dc_name) - wrk_name = mkWiredInName mod wrk_occ wrk_key - (Just (tyConName tycon)) + wrk_name = mkWiredInName modu wrk_occ wrk_key (AnId (dataConWorkId data_con)) UserSyntax bogus_wrap_name = pprPanic "Wired-in data wrapper id" (ppr dc_name) -- Wired-in types are too simple to need wrappers @@ -270,10 +274,10 @@ 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 - mod = mkTupleModule boxity arity - tc_name = mkWiredInName mod (mkTupleOcc tcName boxity arity) tc_uniq - Nothing (ATyCon tycon) BuiltInSyntax + 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 tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind res_kind | isBoxed boxity = liftedTypeKind | otherwise = ubxTupleKind @@ -283,26 +287,33 @@ mk_tuple boxity arity = (tycon, tuple_con) tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon tyvar_tys = mkTyVarTys tyvars - dc_name = mkWiredInName mod (mkTupleOcc dataName boxity arity) dc_uniq - (Just tc_name) (ADataCon tuple_con) BuiltInSyntax + dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq + (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 +unitDataCon :: DataCon unitDataCon = head (tyConDataCons unitTyCon) +unitDataConId :: Id unitDataConId = dataConWorkId unitDataCon +pairTyCon :: TyCon pairTyCon = tupleTyCon Boxed 2 +unboxedSingletonTyCon :: TyCon unboxedSingletonTyCon = tupleTyCon Unboxed 1 +unboxedSingletonDataCon :: DataCon unboxedSingletonDataCon = tupleCon Unboxed 1 +unboxedPairTyCon :: TyCon unboxedPairTyCon = tupleTyCon Unboxed 2 +unboxedPairDataCon :: DataCon unboxedPairDataCon = tupleCon Unboxed 2 \end{code} + %************************************************************************ %* * \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)} @@ -310,49 +321,57 @@ unboxedPairDataCon = tupleCon Unboxed 2 %************************************************************************ \begin{code} --- The Void type is represented as a data type with no constructors --- It's a built in type (i.e. there's no way to define it in Haskell; --- the nearest would be --- --- data Void = -- No constructors! --- --- ) It's lifted; there is only one value of this --- type, namely "void", whose semantics is just bottom. --- --- Haskell 98 drops the definition of a Void type, so we just 'simulate' --- voidTy using (). -voidTy = unitTy -\end{code} - - -\begin{code} +charTy :: Type charTy = mkTyConTy charTyCon -charTyCon = pcNonRecDataTyCon charTyConName [] [] [charDataCon] +charTyCon :: TyCon +charTyCon = pcNonRecDataTyCon charTyConName [] [charDataCon] +charDataCon :: DataCon charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon +stringTy :: Type stringTy = mkListTy charTy -- convenience only \end{code} \begin{code} +intTy :: Type intTy = mkTyConTy intTyCon -intTyCon = pcNonRecDataTyCon intTyConName [] [] [intDataCon] +intTyCon :: TyCon +intTyCon = pcNonRecDataTyCon intTyConName [] [intDataCon] +intDataCon :: DataCon intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon \end{code} \begin{code} +wordTy :: Type +wordTy = mkTyConTy wordTyCon + +wordTyCon :: TyCon +wordTyCon = pcNonRecDataTyCon wordTyConName [] [wordDataCon] +wordDataCon :: DataCon +wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon +\end{code} + +\begin{code} +floatTy :: Type floatTy = mkTyConTy floatTyCon -floatTyCon = pcNonRecDataTyCon floatTyConName [] [] [floatDataCon] +floatTyCon :: TyCon +floatTyCon = pcNonRecDataTyCon floatTyConName [] [floatDataCon] +floatDataCon :: DataCon floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon \end{code} \begin{code} +doubleTy :: Type doubleTy = mkTyConTy doubleTyCon -doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [] [doubleDataCon] -doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon +doubleTyCon :: TyCon +doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [doubleDataCon] + +doubleDataCon :: DataCon +doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon \end{code} @@ -405,14 +424,18 @@ primitive counterpart. {\em END IDLE SPECULATION BY SIMON} \begin{code} +boolTy :: Type boolTy = mkTyConTy boolTyCon +boolTyCon :: TyCon boolTyCon = pcTyCon True NonRecursive boolTyConName - [] [] [falseDataCon, trueDataCon] + [] [falseDataCon, trueDataCon] +falseDataCon, trueDataCon :: DataCon falseDataCon = pcDataCon falseDataConName [] [] boolTyCon trueDataCon = pcDataCon trueDataConName [] [] boolTyCon +falseDataConId, trueDataConId :: Id falseDataConId = dataConWorkId falseDataCon trueDataConId = dataConWorkId trueDataCon \end{code} @@ -436,10 +459,13 @@ data (,) a b = (,,) a b mkListTy :: Type -> Type mkListTy ty = mkTyConApp listTyCon [ty] -listTyCon = pcRecDataTyCon listTyConName - alpha_tyvar [(True,False)] [nilDataCon, consDataCon] +listTyCon :: TyCon +listTyCon = pcRecDataTyCon listTyConName alpha_tyvar [nilDataCon, consDataCon] +nilDataCon :: DataCon nilDataCon = pcDataCon nilDataConName alpha_tyvar [] listTyCon + +consDataCon :: DataCon consDataCon = pcDataConWithFixity True {- Declared infix -} consDataConName alpha_tyvar [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon @@ -495,10 +521,17 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}. \end{itemize} \begin{code} -mkTupleTy :: Boxity -> Int -> [Type] -> Type -mkTupleTy boxity arity tys = mkTyConApp (tupleTyCon boxity arity) tys +mkTupleTy :: Boxity -> [Type] -> Type +-- Special case for *boxed* 1-tuples, which are represented by the type itself +mkTupleTy boxity [ty] | Boxed <- boxity = ty +mkTupleTy boxity tys = mkTyConApp (tupleTyCon boxity (length tys)) tys + +-- | Build the type of a small tuple that holds the specified type of thing +mkBoxedTupleTy :: [Type] -> Type +mkBoxedTupleTy tys = mkTupleTy Boxed tys -unitTy = mkTupleTy Boxed 0 [] +unitTy :: Type +unitTy = mkTupleTy Boxed [] \end{code} %************************************************************************ @@ -510,22 +543,20 @@ unitTy = mkTupleTy Boxed 0 [] Special syntax for parallel arrays needs some wired in definitions. \begin{code} --- construct a type representing the application of the parallel array --- constructor --- +-- | Construct a type representing the application of the parallel array constructor mkPArrTy :: Type -> Type mkPArrTy ty = mkTyConApp parrTyCon [ty] --- represents the type constructor of parallel arrays +-- | Represents the type constructor of parallel arrays -- --- * this must match the definition in `PrelPArr' +-- * This must match the definition in @PrelPArr@ -- -- NB: Although the constructor is given here, it will not be accessible in -- user code as it is not in the environment of any compiled module except --- `PrelPArr'. +-- @PrelPArr@. -- parrTyCon :: TyCon -parrTyCon = pcNonRecDataTyCon parrTyConName alpha_tyvar [(True, False)] [parrDataCon] +parrTyCon = pcNonRecDataTyCon parrTyConName alpha_tyvar [parrDataCon] parrDataCon :: DataCon parrDataCon = pcDataCon @@ -537,14 +568,13 @@ parrDataCon = pcDataCon alpha_ty] parrTyCon --- check whether a type constructor is the constructor for parallel arrays --- +-- | Check whether a type constructor is the constructor for parallel arrays isPArrTyCon :: TyCon -> Bool isPArrTyCon tc = tyConName tc == parrTyConName --- fake array constructors +-- | Fake array constructors -- --- * these constructors are never really used to represent array values; +-- * These constructors are never really used to represent array values; -- however, they are very convenient during desugaring (and, in particular, -- in the pattern matching compiler) to treat array pattern just like -- yet another constructor pattern @@ -568,14 +598,37 @@ mkPArrFakeCon arity = data_con tyvar = head alphaTyVars tyvarTys = replicate arity $ mkTyVarTy tyvar nameStr = mkFastString ("MkPArr" ++ show arity) - name = mkWiredInName gHC_PARR (mkOccNameFS dataName nameStr) uniq - Nothing (ADataCon data_con) UserSyntax - uniq = mkPArrDataConUnique arity + name = mkWiredInName gHC_PARR' (mkDataOccFS nameStr) unique + (ADataCon data_con) UserSyntax + unique = mkPArrDataConUnique arity --- checks whether a data constructor is a fake constructor for parallel arrays --- +-- | Checks whether a data constructor is a fake constructor for parallel arrays 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}