X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsGRHSs.lhs;h=d3fcf76d1c6a86664993f051b67d601f9a0f6a5c;hp=83ceeca17bed2fcf544683a84750d3e77f0d0e84;hb=e2e0785eb7f4efd9f7791d913cdfdfd03148cd86;hpb=30c122df62ec75f9ed7f392f24c2925675bf1d06

diff --git a/compiler/deSugar/DsGRHSs.lhs b/compiler/deSugar/DsGRHSs.lhs
index 83ceeca..d3fcf76 100644
--- a/compiler/deSugar/DsGRHSs.lhs
+++ b/compiler/deSugar/DsGRHSs.lhs
@@ -21,18 +21,18 @@ import {-# SOURCE #-} DsExpr  ( dsLExpr, dsLocalBinds )
 import {-# SOURCE #-} Match   ( matchSinglePat )
 
 import HsSyn
+import MkCore
 import CoreSyn
 import Var
 import Type
 
 import DsMonad
 import DsUtils
-import PrelInfo
 import TysWiredIn
 import PrelNames
 import Name
 import SrcLoc
-
+import Outputable
 \end{code}
 
 @dsGuarded@ is used for both @case@ expressions and pattern bindings.
@@ -51,7 +51,7 @@ dsGuarded :: GRHSs Id -> Type -> DsM CoreExpr
 
 dsGuarded grhss rhs_ty = do
     match_result <- dsGRHSs PatBindRhs [] grhss rhs_ty
-    error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty ""
+    error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty empty
     extractMatchResult match_result error_expr
 \end{code}
 
@@ -75,7 +75,7 @@ dsGRHSs hs_ctx pats (GRHSs grhss binds) rhs_ty = do
 
 dsGRHS :: HsMatchContext Name -> [Pat Id] -> Type -> LGRHS Id -> DsM MatchResult
 dsGRHS hs_ctx _ rhs_ty (L _ (GRHS guards rhs))
-  = matchGuards (map unLoc guards) hs_ctx rhs rhs_ty
+  = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty
 \end{code}
 
 
@@ -87,7 +87,7 @@ dsGRHS hs_ctx _ rhs_ty (L _ (GRHS guards rhs))
 
 \begin{code}
 matchGuards :: [Stmt Id] 		-- Guard
-            -> HsMatchContext Name	-- Context
+            -> HsStmtContext Name	-- Context
 	    -> LHsExpr Id		-- RHS
 	    -> Type			-- Type of RHS of guard
 	    -> DsM MatchResult
@@ -106,11 +106,11 @@ matchGuards [] _ rhs _
 	-- NB:	The success of this clause depends on the typechecker not
 	-- 	wrapping the 'otherwise' in empty HsTyApp or HsWrap constructors
 	--	If it does, you'll get bogus overlap warnings
-matchGuards (ExprStmt e _ _ : stmts) ctx rhs rhs_ty
+matchGuards (ExprStmt e _ _ _ : stmts) ctx rhs rhs_ty
   | Just addTicks <- isTrueLHsExpr e = do
     match_result <- matchGuards stmts ctx rhs rhs_ty
     return (adjustMatchResultDs addTicks match_result)
-matchGuards (ExprStmt expr _ _ : stmts) ctx rhs rhs_ty = do
+matchGuards (ExprStmt expr _ _ _ : stmts) ctx rhs rhs_ty = do
     match_result <- matchGuards stmts ctx rhs rhs_ty
     pred_expr <- dsLExpr expr
     return (mkGuardedMatchResult pred_expr match_result)
@@ -126,7 +126,7 @@ matchGuards (LetStmt binds : stmts) ctx rhs rhs_ty = do
 matchGuards (BindStmt pat bind_rhs _ _ : stmts) ctx rhs rhs_ty = do
     match_result <- matchGuards stmts ctx rhs rhs_ty
     core_rhs <- dsLExpr bind_rhs
-    matchSinglePat core_rhs ctx pat rhs_ty match_result
+    matchSinglePat core_rhs (StmtCtxt ctx) pat rhs_ty match_result
 
 isTrueLHsExpr :: LHsExpr Id -> Maybe (CoreExpr -> DsM CoreExpr)