X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FTysWiredIn.lhs;h=4695c87e8681f7dd9bf9cc55b7e7ef4f2b680732;hp=cf54f26043eb68a538fccc14cb60e56d6b00c510;hb=215ce9f15215399ce30ae55c9521087847d78646;hpb=388e3356f71daffa62f1d4157e1e07e4c68f218a diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index cf54f26..4695c87 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, @@ -72,8 +72,7 @@ import TyCon ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons, mkTupleTyCon, mkAlgTyCon, tyConName, TyConParent(NoParentTyCon) ) -import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, - StrictnessMark(..) ) +import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, HsBang(..) ) import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys, TyThing(..) ) @@ -238,7 +237,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 @@ -534,11 +533,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 :: Type -unitTy = mkTupleTy Boxed 0 [] +unitTy = mkTupleTy Boxed [] \end{code} %************************************************************************