Fix Trac #3966: warn about useless UNPACK pragmas

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

diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 16ebf58..4695c87 100644 (file)
--- 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
@@ -539,6 +538,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}