From: simonpj <unknown>
Date: Thu, 14 Apr 2005 15:19:29 +0000 (+0000)
Subject: [project @ 2005-04-14 15:19:29 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~739
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=1ad59dbb1121bf3e779b1cf15f41ef08ad61bd3b;p=ghc-hetmet.git

[project @ 2005-04-14 15:19:29 by simonpj]
Fix TH handling of guards
---

diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs
index 8328783..35e9677 100644
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ b/ghc/compiler/deSugar/DsMeta.hs
@@ -514,13 +514,13 @@ repE (HsLet bs e)         = do { (ss,ds) <- repBinds bs
 -- FIXME: I haven't got the types here right yet
 repE (HsDo DoExpr sts body ty) 
  = do { (ss,zs) <- repLSts sts; 
-	body'	<- repLE body;
+	body'	<- addBinds ss $ repLE body;
 	ret	<- repNoBindSt body';	
         e       <- repDoE (nonEmptyCoreList (zs ++ [ret]));
         wrapGenSyns ss e }
 repE (HsDo ListComp sts body ty) 
  = do { (ss,zs) <- repLSts sts; 
-	body'	<- repLE body;
+	body'	<- addBinds ss $ repLE body;
 	ret	<- repNoBindSt body';	
         e       <- repComp (nonEmptyCoreList (zs ++ [ret]));
         wrapGenSyns ss e }
@@ -610,7 +610,7 @@ repGuards other
                   return ([], x) }
     process (L _ (GRHS ss rhs))
            = do (gs, ss') <- repLSts ss
-		rhs' <- repLE rhs
+		rhs' <- addBinds gs $ repLE rhs
                 g <- repPatGE (nonEmptyCoreList ss') rhs'
                 return (gs, g)
 
@@ -669,7 +669,7 @@ repSts (ExprStmt e _ _ : ss) =
       ; z <- repNoBindSt e2 
       ; (ss2,zs) <- repSts ss
       ; return (ss2, z : zs) }
-repSts [] = panic "repSts ran out of statements"      
+repSts [] = return ([],[])
 repSts other = panic "Exotic Stmt in meta brackets"