X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FTysWiredIn.lhs;h=9f5f369a996605d7a6ef2279cb681c9a3f2b9144;hp=16ebf58e5120d5aba13c91dfb375f3eeba870c51;hb=fdf8656855d26105ff36bdd24d41827b05037b91;hpb=69f8ed93800605d8df011388450d6d3bb9ca6071 diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index 16ebf58..9f5f369 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -38,7 +38,7 @@ module TysWiredIn ( mkListTy, -- * Tuples - mkTupleTy, + mkTupleTy, mkBoxedTupleTy, tupleTyCon, tupleCon, unitTyCon, unitDataCon, unitDataConId, pairTyCon, unboxedSingletonTyCon, unboxedSingletonDataCon, @@ -64,24 +64,14 @@ import TysPrim -- 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, - 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 BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, HsBang(..) ) +import Unique ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique, mkPArrDataConUnique ) import Data.Array import FastString @@ -125,12 +115,6 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because , intTyCon , listTyCon , parrTyCon - , unsafeCoercionTyCon - , symCoercionTyCon - , transCoercionTyCon - , leftCoercionTyCon - , rightCoercionTyCon - , instCoercionTyCon ] \end{code} @@ -154,9 +138,9 @@ intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyCo intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon boolTyConName, falseDataConName, trueDataConName :: Name -boolTyConName = mkWiredInTyConName UserSyntax gHC_BOOL (fsLit "Bool") boolTyConKey boolTyCon -falseDataConName = mkWiredInDataConName UserSyntax gHC_BOOL (fsLit "False") falseDataConKey falseDataCon -trueDataConName = mkWiredInDataConName UserSyntax gHC_BOOL (fsLit "True") trueDataConKey trueDataCon +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 @@ -170,8 +154,10 @@ doubleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Double") 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 +parrTyConName = mkWiredInTyConName BuiltInSyntax + gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon +parrDataConName = mkWiredInDataConName UserSyntax + gHC_PARR' (fsLit "PArr") parrDataConKey parrDataCon boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR, intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR:: RdrName @@ -184,16 +170,6 @@ 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 --} \end{code} @@ -238,7 +214,7 @@ 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 @@ -539,6 +515,10 @@ mkTupleTy :: Boxity -> [Type] -> Type 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 :: Type unitTy = mkTupleTy Boxed [] \end{code} @@ -607,7 +587,7 @@ mkPArrFakeCon arity = data_con tyvar = head alphaTyVars tyvarTys = replicate arity $ mkTyVarTy tyvar nameStr = mkFastString ("MkPArr" ++ show arity) - name = mkWiredInName gHC_PARR (mkDataOccFS nameStr) unique + name = mkWiredInName gHC_PARR' (mkDataOccFS nameStr) unique (ADataCon data_con) UserSyntax unique = mkPArrDataConUnique arity @@ -615,5 +595,3 @@ mkPArrFakeCon arity = data_con isPArrFakeCon :: DataCon -> Bool isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon) \end{code} - -