X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnBinds.lhs;h=13035e72e2831185bc58ee74c632c381ac49b151;hb=876b4ef2093cb9c104db33c7db1200b941b6d079;hp=1ea8f61ffc7f1ed9a015f8502b74f403057f8213;hpb=ac10f8408520a30e8437496d320b8b86afda2e8f;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index 1ea8f61..13035e7 100644
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -44,7 +44,7 @@ import BasicTypes	( RecFlag(..) )
 import Digraph		( SCC(..), stronglyConnComp )
 import Bag
 import Outputable
-import Maybes		( orElse, fromJust, isJust )
+import Maybes		( orElse, isJust )
 import Util		( filterOut )
 import Monad		( foldM )
 \end{code}
@@ -315,9 +315,8 @@ depAnalBinds binds_w_dus
 
     keyd_nodes = bagToList binds_w_dus `zip` [0::Int ..]
 
-    edges = [ (node, key, [fromJust mb_key | n <- nameSetToList uses,
-			   let mb_key = lookupNameEnv key_map n,
-			   isJust mb_key ])
+    edges = [ (node, key, [key | n <- nameSetToList uses,
+			         Just key <- [lookupNameEnv key_map n] ])
 	    | (node@(_,_,uses), key) <- keyd_nodes ]
 
     key_map :: NameEnv Int	-- Which binding it comes from
@@ -604,11 +603,12 @@ rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
 
 rnGRHS' ctxt (GRHS guards rhs)
   = do	{ opt_GlasgowExts <- doptM Opt_GlasgowExts
-	; checkM (opt_GlasgowExts || is_standard_guard guards)
-	  	 (addWarn (nonStdGuardErr guards))
-
 	; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $
 				    rnLExpr rhs
+
+	; checkM (opt_GlasgowExts || is_standard_guard guards')
+	  	 (addWarn (nonStdGuardErr guards'))
+
 	; return (GRHS guards' rhs', fvs) }
   where
 	-- Standard Haskell 1.4 guards are just a single boolean
@@ -654,8 +654,7 @@ bindsInHsBootFile mbinds
   = hang (ptext SLIT("Bindings in hs-boot files are not allowed"))
        2 (ppr mbinds)
 
-nonStdGuardErr guard
-  = hang (ptext
-    SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
-    ) 4 (ppr guard)
+nonStdGuardErr guards
+  = hang (ptext SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)"))
+       4 (interpp'SP guards)
 \end{code}