Remove a redundant parameter for mkTupleTy (the arity)

diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index f67c78a..789abe4 100644 (file)
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -348,9 +348,7 @@ mkCoreTup cs  = mkConApp (tupleCon Boxed (length cs))
 
 -- | Build the type of a small tuple that holds the specified type of thing
 mkCoreTupTy :: [Type] -> Type
-mkCoreTupTy [ty] = ty
-mkCoreTupTy tys  = mkTupleTy Boxed (length tys) tys
-
+mkCoreTupTy tys  = mkTupleTy Boxed tys
 
 -- | Build a big tuple holding the specified variables
 mkBigCoreVarTup :: [Id] -> CoreExpr

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 6ff3916..25366fa 100644 (file)
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -604,7 +604,7 @@ mkLHsVarPatTup bs  = mkLHsPatTup (map nlVarPat bs)
 mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id
 -- A vanilla tuple pattern simply gets its type from its sub-patterns
 mkVanillaTuplePat pats box 
-  = TuplePat pats box (mkTupleTy box (length pats) (map hsLPatType pats))
+  = TuplePat pats box (mkTupleTy box (map hsLPatType pats))
 
 -- The Big equivalents for the source tuple expressions
 mkBigLHsVarTup :: [Id] -> LHsExpr Id

diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index cf54f26..16ebf58 100644 (file)
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -534,11 +534,13 @@ 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
 
 unitTy :: Type
-unitTy = mkTupleTy Boxed 0 []
+unitTy = mkTupleTy Boxed []
 \end{code}
 
 %************************************************************************

diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index 74dbd5a..2f7a287 100644 (file)
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -662,8 +662,7 @@ ppType (TyApp "MVar#" [x,y])     = "mkMVarPrimTy " ++ ppType x
                                    ++ " " ++ ppType y
 ppType (TyApp "TVar#" [x,y])     = "mkTVarPrimTy " ++ ppType x 
                                    ++ " " ++ ppType y
-ppType (TyUTup ts)               = "(mkTupleTy Unboxed " ++ show (length ts)
-                                   ++ " "
+ppType (TyUTup ts)               = "(mkTupleTy Unboxed " 
                                    ++ listify (map ppType ts) ++ ")"
 
 ppType (TyF s d) = "(mkFunTy (" ++ ppType s ++ ") (" ++ ppType d ++ "))"