X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsHsSyn.lhs;h=8fae20c9e89e47f3ea169d6919ad08d66d6ca575;hp=3d1205982d6857de3a878c676ee8a5592e9ce707;hb=f01a8e8c9c53bfb5ab3393ed3457ebf25390efa1;hpb=cc051dd76d01b61caae6f4e1fc177c9815716961

diff --git a/ghc/compiler/deSugar/DsHsSyn.lhs b/ghc/compiler/deSugar/DsHsSyn.lhs
index 3d12059..8fae20c 100644
--- a/ghc/compiler/deSugar/DsHsSyn.lhs
+++ b/ghc/compiler/deSugar/DsHsSyn.lhs
@@ -36,10 +36,12 @@ outPatType (TuplePat pats)	= mkTupleTy (length pats) (map outPatType pats)
 outPatType (RecPat _ ty _)      = ty
 outPatType (LitPat lit ty)	= ty
 outPatType (NPat lit ty _)	= ty
-outPatType (DictPat ds ms)      = case (length ds + length ms) of
+outPatType (DictPat ds ms)      = case (length ds_ms) of
 				    0 -> unitTy
-				    1 -> idType (head (ds ++ ms))
-				    n -> mkTupleTy n (map idType (ds ++ ms))
+				    1 -> idType (head ds_ms)
+				    n -> mkTupleTy n (map idType ds_ms)
+				   where
+				    ds_ms = ds ++ ms
 \end{code}
 
 
@@ -71,6 +73,7 @@ collectTypedPatBinders (ConPat _ _ pats)    = concat (map collectTypedPatBinders
 collectTypedPatBinders (ConOpPat p1 _ p2 _) = collectTypedPatBinders p1 ++ collectTypedPatBinders p2
 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-} ]
 \end{code}