[project @ 2001-11-26 09:20:25 by simonpj]

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

diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs
index 008cebf..6b45c58 100644 (file)
--- 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