X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsUtils.lhs;h=6b45c58108ee6e528a0ce79af831661bce4c5fe0;hb=5e3f005d3012472e422d4ffd7dca5c21a80fca80;hp=008cebf6bf33c46077ecc97c7dac315a46654773;hpb=ab46fd8e68f10b6162e77cfc0b216510d9b1d933;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs
index 008cebf..6b45c58 100644
--- a/ghc/compiler/deSugar/DsUtils.lhs
+++ b/ghc/compiler/deSugar/DsUtils.lhs
@@ -63,6 +63,7 @@ import PrelNames	( unpackCStringName, unpackCStringUtf8Name,
 			  plusIntegerName, timesIntegerName )
 import Outputable
 import UnicodeUtil      ( stringToUtf8 )
+import Util             ( isSingleton )
 \end{code}
 
 
@@ -430,7 +431,7 @@ mkSelectorBinds (VarPat v) val_expr
   = returnDs [(v, val_expr)]
 
 mkSelectorBinds pat val_expr
-  | length binders == 1 || is_simple_pat pat
+  | isSingleton binders || is_simple_pat pat
   = newSysLocalDs (exprType val_expr)	`thenDs` \ val_var ->
 
 	-- For the error message we don't use mkErrorAppDs to avoid
@@ -448,15 +449,13 @@ mkSelectorBinds pat val_expr
 
 
   | otherwise
-  = mkErrorAppDs iRREFUT_PAT_ERROR_ID tuple_ty (showSDoc (ppr pat))
-    `thenDs` \ error_expr ->
-    matchSimply val_expr PatBindRhs pat local_tuple error_expr
-    `thenDs` \ tuple_expr ->
-    newSysLocalDs tuple_ty
-    `thenDs` \ tuple_var ->
+  = mkErrorAppDs iRREFUT_PAT_ERROR_ID 
+		 tuple_ty (showSDoc (ppr pat))			`thenDs` \ error_expr ->
+    matchSimply val_expr PatBindRhs pat local_tuple error_expr	`thenDs` \ tuple_expr ->
+    newSysLocalDs tuple_ty					`thenDs` \ tuple_var ->
     let
-	mk_tup_bind binder =
-	  (binder, mkTupleSelector binders binder tuple_var (Var tuple_var))
+	mk_tup_bind binder
+	  = (binder, mkTupleSelector binders binder tuple_var (Var tuple_var))
     in
     returnDs ( (tuple_var, tuple_expr) : map mk_tup_bind binders )
   where