X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsHsSyn.lhs;h=65911987f71b8f4510895866cc25208208e64b69;hb=531d0d264fafd66aece5ca38d2bfcd266a8fd3e5;hp=10cf88deb5b2bfc5d73013e94dacd524c640d133;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsHsSyn.lhs b/ghc/compiler/deSugar/DsHsSyn.lhs
index 10cf88d..6591198 100644
--- a/ghc/compiler/deSugar/DsHsSyn.lhs
+++ b/ghc/compiler/deSugar/DsHsSyn.lhs
@@ -14,11 +14,11 @@ import TcHsSyn		( TypecheckedPat,
 
 import Id		( idType, Id )
 import Type             ( Type )
-import TysWiredIn	( mkListTy, mkTupleTy, mkUnboxedTupleTy, unitTy )
-import Util		( panic )
+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,39 +37,40 @@ 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}
 
 
-Nota bene: DsBinds relies on the fact that at least for simple
+Nota bene: @DsBinds@ relies on the fact that at least for simple
 tuple patterns @collectTypedPatBinders@ returns the binders in
 the same order as they appear in the tuple.
 
-collectTypedBinders and collectedTypedPatBinders are the exportees.
+@collectTypedBinders@ and @collectedTypedPatBinders@ are the exportees.
 
 \begin{code}
 collectTypedMonoBinders :: TypecheckedMonoBinds -> [Id]
-collectTypedMonoBinders EmptyMonoBinds	      = []
-collectTypedMonoBinders (PatMonoBind pat _ _) = collectTypedPatBinders pat
-collectTypedMonoBinders (FunMonoBind f _ _ _) = [f]
-collectTypedMonoBinders (VarMonoBind v _)     = [v]
-collectTypedMonoBinders (CoreMonoBind v _)     = [v]
+collectTypedMonoBinders EmptyMonoBinds	        = []
+collectTypedMonoBinders (PatMonoBind pat _ _)   = collectTypedPatBinders pat
+collectTypedMonoBinders (FunMonoBind f _ _ _)   = [f]
+collectTypedMonoBinders (VarMonoBind v _)       = [v]
+collectTypedMonoBinders (CoreMonoBind v _)      = [v]
 collectTypedMonoBinders (AndMonoBinds bs1 bs2)
  = collectTypedMonoBinders bs1 ++ collectTypedMonoBinders bs2
-collectTypedMonoBinders (AbsBinds _ _ exports _)
+collectTypedMonoBinders (AbsBinds _ _ exports _ _)
   = [global | (_, global, local) <- exports]
 
 collectTypedPatBinders :: TypecheckedPat -> [Id]
-collectTypedPatBinders (VarPat var)	     = [var]
-collectTypedPatBinders (LazyPat pat)	     = collectTypedPatBinders pat
-collectTypedPatBinders (AsPat a pat)	     = a : collectTypedPatBinders pat
-collectTypedPatBinders (ConPat _ _ _ _ pats) = concat (map collectTypedPatBinders pats)
-collectTypedPatBinders (ListPat t pats)      = concat (map collectTypedPatBinders pats)
-collectTypedPatBinders (TuplePat pats _)     = concat (map collectTypedPatBinders pats)
+collectTypedPatBinders (VarPat var)	       = [var]
+collectTypedPatBinders (LazyPat pat)	       = collectTypedPatBinders pat
+collectTypedPatBinders (AsPat a pat)	       = a : collectTypedPatBinders pat
+collectTypedPatBinders (ConPat _ _ _ _ pats)   = concat (map collectTypedPatBinders pats)
+collectTypedPatBinders (ListPat t pats)        = concat (map collectTypedPatBinders pats)
+collectTypedPatBinders (TuplePat pats _)       = concat (map collectTypedPatBinders pats)
 collectTypedPatBinders (RecPat _ _ _ _ fields) = concat (map (\ (f,pat,_) -> collectTypedPatBinders pat)
-							fields)
-collectTypedPatBinders (DictPat ds ms)	     = ds ++ ms
-collectTypedPatBinders any_other_pat	     = [ {-no binders-} ]
+							  fields)
+collectTypedPatBinders (DictPat ds ms)	       = ds ++ ms
+collectTypedPatBinders (NPlusKPat var _ _ _ _) = [var]
+collectTypedPatBinders any_other_pat	       = [ {-no binders-} ]
 \end{code}