[project @ 2001-06-25 08:09:57 by simonpj]

[ghc-hetmet.git] / ghc / compiler / deSugar / DsHsSyn.lhs

diff --git a/ghc/compiler/deSugar/DsHsSyn.lhs b/ghc/compiler/deSugar/DsHsSyn.lhs
index 498ffcc..43bb8c7 100644 (file)
--- a/ghc/compiler/deSugar/DsHsSyn.lhs
+++ b/ghc/compiler/deSugar/DsHsSyn.lhs
@@ -13,12 +13,12 @@ import TcHsSyn              ( TypecheckedPat,
                          TypecheckedMonoBinds )
 
 import Id              ( idType, Id )
-import Type             ( Type )
-import TysWiredIn      ( mkListTy, mkTupleTy, mkUnboxedTupleTy, unitTy )
-import Panic           ( panic )
+import TcType           ( Type )
+import TysWiredIn      ( mkListTy, mkTupleTy, unitTy )
+import BasicTypes      ( Boxity(..) )
 \end{code}
 
-Note: If @outPatType@ doesn't bear a strong resemblance to @coreExprType@,
+Note: If @outPatType@ doesn't bear a strong resemblance to @exprType@,
 then something is wrong.
 \begin{code}
 outPatType :: TypecheckedPat -> Type
@@ -29,8 +29,7 @@ outPatType (LazyPat pat)      = outPatType pat
 outPatType (AsPat var pat)     = idType var
 outPatType (ConPat _ ty _ _ _) = ty
 outPatType (ListPat ty _)      = mkListTy ty
-outPatType (TuplePat pats True)        = mkTupleTy (length pats) (map outPatType pats)
-outPatType (TuplePat pats False)= mkUnboxedTupleTy (length pats) (map outPatType pats)
+outPatType (TuplePat pats box) = mkTupleTy box (length pats) (map outPatType pats)
 outPatType (RecPat _ ty _ _ _)  = ty
 outPatType (LitPat lit ty)     = ty
 outPatType (NPat lit ty _)     = ty
@@ -38,7 +37,7 @@ outPatType (NPlusKPat _ _ ty _ _) = ty
 outPatType (DictPat ds ms)      = case (length ds_ms) of
                                    0 -> unitTy
                                    1 -> idType (head ds_ms)
-                                   n -> mkTupleTy n (map idType ds_ms)
+                                   n -> mkTupleTy Boxed n (map idType ds_ms)
                                   where
                                    ds_ms = ds ++ ms
 \end{code}