Separate the language flags from the other DynFlag's

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

diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index c06aa38..01f621b 100644 (file)
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -11,7 +11,7 @@ free variables.
 
 \begin{code}
 module RnPat (-- main entry points
-              rnPats, rnBindPat,
+              rnPat, rnPats, rnBindPat,
 
               NameMaker, applyNameMaker,     -- a utility for making names:
               localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,
@@ -22,9 +22,6 @@ module RnPat (-- main entry points
              -- Literals
              rnLit, rnOverLit,     
 
-             -- Quasiquotation
-             rnQuasiQuote,
-
              -- Pattern Error messages that are also used elsewhere
              checkTupSize, patSigErr
              ) where
@@ -43,13 +40,13 @@ import TcRnMonad
 import TcHsSyn         ( hsOverLitName )
 import RnEnv
 import RnTypes
-import DynFlags                ( DynFlag(..) )
+import DynFlags
 import PrelNames
 import Constants       ( mAX_TUPLE_SIZE )
 import Name
 import NameSet
-import Module
 import RdrName
+import BasicTypes
 import ListSetOps      ( removeDups, minusList )
 import Outputable
 import SrcLoc
@@ -138,15 +135,14 @@ data NameMaker
 
   | LetMk       -- Let bindings, incl top level
                -- Do *not* check for unused bindings
-      (Maybe Module)   -- Just m  => top level of module m
-                       -- Nothing => not top level
+      TopLevelFlag
       MiniFixityEnv
 
-topRecNameMaker :: Module -> MiniFixityEnv -> NameMaker
-topRecNameMaker mod fix_env = LetMk (Just mod) fix_env
+topRecNameMaker :: MiniFixityEnv -> NameMaker
+topRecNameMaker fix_env = LetMk TopLevel fix_env
 
 localRecNameMaker :: MiniFixityEnv -> NameMaker
-localRecNameMaker fix_env = LetMk Nothing fix_env 
+localRecNameMaker fix_env = LetMk NotTopLevel fix_env 
 
 matchNameMaker :: HsMatchContext a -> NameMaker
 matchNameMaker ctxt = LamMk report_unused
@@ -165,15 +161,17 @@ newName (LamMk report_unused) rdr_name
           ; when report_unused $ warnUnusedMatches [name] fvs
           ; return (res, name `delFV` fvs) })
 
-newName (LetMk mb_top fix_env) rdr_name
+newName (LetMk is_top fix_env) rdr_name
   = CpsRn (\ thing_inside -> 
-        do { name <- case mb_top of
-                       Nothing  -> newLocalBndrRn rdr_name
-                       Just mod -> newTopSrcBinder mod rdr_name
-          ; bindLocalNamesFV_WithFixities [name] fix_env $
+        do { name <- case is_top of
+                       NotTopLevel -> newLocalBndrRn rdr_name
+                       TopLevel    -> newTopSrcBinder rdr_name
+          ; bindLocalName name $       -- Do *not* use bindLocalNameFV here
+                                       -- See Note [View pattern usage]
+             addLocalFixities fix_env [name] $
             thing_inside name })
                          
-    -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious 
+    -- Note: the bindLocalName is somewhat suspicious
     --       because it binds a top-level name as a local name.
     --       however, this binding seems to work, and it only exists for
     --       the duration of the patterns and the continuation;
@@ -181,6 +179,14 @@ newName (LetMk mb_top fix_env) rdr_name
     --       before going on to the RHSes (see RnSource.lhs).
 \end{code}
 
+Note [View pattern usage]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+  let (r, (r -> x)) = x in ...
+Here the pattern binds 'r', and then uses it *only* in the view pattern.
+We want to "see" this use, and in let-bindings we collect all uses and
+report unused variables at the binding level. So we must use bindLocalName
+here, *not* bindLocalNameFV.  Trac #3943.
 
 %*********************************************************
 %*                                                     *
@@ -233,6 +239,13 @@ rnPats ctxt pats thing_inside
   where
     doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
 
+rnPat :: HsMatchContext Name -- for error messages
+      -> LPat RdrName 
+      -> (LPat Name -> RnM (a, FreeVars))
+      -> RnM (a, FreeVars)     -- Variables bound by pattern do not 
+                              -- appear in the result FreeVars 
+rnPat ctxt pat thing_inside 
+  = rnPats ctxt [pat] (\[pat'] -> thing_inside pat')
 
 applyNameMaker :: NameMaker -> Located RdrName -> RnM Name
 applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newName mk rdr); return n }
@@ -363,8 +376,7 @@ rnPatAndThen _ p@(QuasiQuotePat {})
   = pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
 #else
 rnPatAndThen mk (QuasiQuotePat qq)
-  = do { qq' <- liftCpsFV $ rnQuasiQuote qq
-       ; pat <- liftCps $ runQuasiQuotePat qq'
+  = do { pat <- liftCps $ runQuasiQuotePat qq
        ; L _ pat' <- rnLPatAndThen mk pat
        ; return pat' }
 #endif         /* GHCI */
@@ -565,27 +577,6 @@ rnOverLit lit@(OverLit {ol_val=val})
 
 %************************************************************************
 %*                                                                     *
-\subsubsection{Quasiquotation}
-%*                                                                     *
-%************************************************************************
-
-See Note [Quasi-quote overview] in TcSplice.
-
-\begin{code}
-rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
-rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
-  = do { loc  <- getSrcSpanM
-       ; n' <- newLocalBndrRn (L loc n)
-       ; quoter' <- lookupOccRn quoter
-               -- If 'quoter' is not in scope, proceed no further
-               -- Otherwise lookupOcc adds an error messsage and returns 
-               -- an "unubound name", which makes the subsequent attempt to
-               -- run the quote fail
-       ; return (HsQuasiQuote n' quoter' quoteSpan quote, unitFV quoter') }
-\end{code}
-
-%************************************************************************
-%*                                                                     *
 \subsubsection{Errors}
 %*                                                                     *
 %************************************************************************