X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsUtils.lhs;h=29e7773bb8c49bdc0838970314fd51999aa00ed4;hb=3c245de9199f522f75ace92219256badbd928bd6;hp=5472d7b8fd2d27736829b27649024f2bf44d210c;hpb=ac10f8408520a30e8437496d320b8b86afda2e8f;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs
index 5472d7b..29e7773 100644
--- a/ghc/compiler/deSugar/DsUtils.lhs
+++ b/ghc/compiler/deSugar/DsUtils.lhs
@@ -27,11 +27,11 @@ module DsUtils (
 
 	mkSelectorBinds, mkTupleExpr, mkTupleSelector, 
 	mkTupleType, mkTupleCase, mkBigCoreTup,
-	mkCoreTup, mkCoreTupTy,
+	mkCoreTup, mkCoreTupTy, seqVar,
 	
 	dsSyntaxTable, lookupEvidence,
 
-	selectSimpleMatchVarL, selectMatchVars
+	selectSimpleMatchVarL, selectMatchVars, selectMatchVar
     ) where
 
 #include "HsVersions.h"
@@ -169,6 +169,7 @@ selectMatchVars (p:ps) (ty:tys) = do { v  <- selectMatchVar  p  ty
 				     ; vs <- selectMatchVars ps tys
 				     ; return (v:vs) }
 
+selectMatchVar (BangPat pat)   pat_ty  = selectMatchVar (unLoc pat) pat_ty
 selectMatchVar (LazyPat pat)   pat_ty  = selectMatchVar (unLoc pat) pat_ty
 selectMatchVar (VarPat var)    pat_ty  = try_for var 	     pat_ty
 selectMatchVar (AsPat var pat) pat_ty  = try_for (unLoc var) pat_ty
@@ -255,6 +256,10 @@ wrapBind new old body
   | isTyVar new = App (Lam new body) (Type (mkTyVarTy old))
   | otherwise   = Let (NonRec new (Var old)) body
 
+seqVar :: Var -> CoreExpr -> CoreExpr
+seqVar var body = Case (Var var) var (exprType body)
+			[(DEFAULT, [], body)]
+
 mkCoLetMatchResult :: CoreBind -> MatchResult -> MatchResult
 mkCoLetMatchResult bind match_result
   = adjustMatchResult (mkDsLet bind) match_result
@@ -586,7 +591,7 @@ mkSelectorBinds pat val_expr
 
     is_simple_lpat p = is_simple_pat (unLoc p)
 
-    is_simple_pat (TuplePat ps Boxed)      = all is_triv_lpat ps
+    is_simple_pat (TuplePat ps Boxed _)    = all is_triv_lpat ps
     is_simple_pat (ConPatOut _ _ _ _ ps _) = all is_triv_lpat (hsConArgs ps)
     is_simple_pat (VarPat _)	       	   = True
     is_simple_pat (ParPat p)		   = is_simple_lpat p