Convert more UniqFM's back to LazyUniqFM's

[ghc-hetmet.git] / compiler / rename / RnExpr.lhs

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index a496c66..a73d1a8 100644 (file)
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -23,6 +23,10 @@ module RnExpr (
 
 #include "HsVersions.h"
 
+#ifdef GHCI
+import {-# SOURCE #-} TcSplice( runQuasiQuoteExpr )
+#endif         /* GHCI */
+
 import RnSource  ( rnSrcDecls, rnSplice, checkTH ) 
 import RnBinds   ( rnLocalBindsAndThen, rnValBindsLHS, rnValBindsRHS,
                    rnMatchGroup, makeMiniFixityEnv) 
@@ -33,7 +37,7 @@ import HscTypes         ( availNames )
 import RnNames         ( getLocalDeclBinders, extendRdrEnvRn )
 import RnTypes         ( rnHsTypeFVs, 
                          mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
-import RnPat            (rnOverLit, rnPatsAndThen_LocalRightwards, rnBindPat, 
+import RnPat            (rnQuasiQuote, rnOverLit, rnPatsAndThen_LocalRightwards, rnBindPat,
                          localRecNameMaker, rnLit,
                         rnHsRecFields_Con, rnHsRecFields_Update, checkTupSize)
 import RdrName      ( mkRdrUnqual )
@@ -46,11 +50,10 @@ import PrelNames    ( thFAKE, hasKey, assertIdKey, assertErrorName,
 
 import Name            ( Name, nameOccName, nameModule, nameIsLocalOrFrom )
 import NameSet
-import UniqFM
+import LazyUniqFM
 import RdrName         ( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals )
 import LoadIface       ( loadInterfaceForName )
-import UniqFM          ( isNullUFM )
-import UniqSet         ( emptyUniqSet )
+import UniqSet         ( isEmptyUniqSet, emptyUniqSet )
 import List            ( nub )
 import Util            ( isSingleton )
 import ListSetOps      ( removeDups )
@@ -60,9 +63,31 @@ import SrcLoc                ( Located(..), unLoc, getLoc, noLoc )
 import FastString
 
 import List            ( unzip4 )
+import Control.Monad
 \end{code}
 
 
+\begin{code}
+-- XXX
+thenM :: Monad a => a b -> (b -> a c) -> a c
+thenM = (>>=)
+
+thenM_ :: Monad a => a b -> a c -> a c
+thenM_ = (>>)
+
+returnM :: Monad m => a -> m a
+returnM = return
+
+mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
+mappM = mapM
+
+mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
+mappM_ = mapM_
+
+checkM :: Monad m => Bool -> m () -> m ()
+checkM = unless
+\end{code}
+
 %************************************************************************
 %*                                                                     *
 \subsubsection{Expressions}
@@ -86,7 +111,7 @@ rnExprs ls = rnExprs' ls emptyUniqSet
     returnM (expr':exprs', fvExprs)
 
 -- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
-grubby_seqNameSet ns result | isNullUFM ns = result
+grubby_seqNameSet ns result | isEmptyUniqSet ns = result
                            | otherwise    = result
 \end{code}
 
@@ -175,6 +200,16 @@ rnExpr e@(HsSpliceE splice)
   = rnSplice splice            `thenM` \ (splice', fvs) ->
     returnM (HsSpliceE splice', fvs)
 
+#ifndef GHCI
+rnExpr e@(HsQuasiQuoteE _) = pprPanic "Cant do quasiquotation without GHCi" (ppr e)
+#else
+rnExpr e@(HsQuasiQuoteE qq)
+  = rnQuasiQuote qq            `thenM` \ (qq', fvs_qq) ->
+    runQuasiQuoteExpr qq'      `thenM` \ (L _ expr') ->
+    rnExpr expr'               `thenM` \ (expr'', fvs_expr) ->
+    returnM (expr'', fvs_qq `plusFV` fvs_expr)
+#endif         /* GHCI */
+
 rnExpr section@(SectionL expr op)
   = rnLExpr expr               `thenM` \ (expr', fvs_expr) ->
     rnLExpr op                 `thenM` \ (op', fvs_op) ->
@@ -278,6 +313,7 @@ We return a (bogus) EWildPat in each case.
 \begin{code}
 rnExpr e@EWildPat      = patSynErr e
 rnExpr e@(EAsPat {})   = patSynErr e
+rnExpr e@(EViewPat {}) = patSynErr e
 rnExpr e@(ELazyPat {}) = patSynErr e
 \end{code}
 
@@ -957,7 +993,7 @@ rn_rec_stmts_lhs fix_env stmts =
      -- First do error checking: we need to check for dups here because we
      -- don't bind all of the variables from the Stmt at once
      -- with bindLocatedLocals.
-     checkDupNames doc boundNames
+     checkDupRdrNames doc boundNames
      mappM (rn_rec_stmt_lhs fix_env) stmts `thenM` \ ls -> returnM (concat ls)