do not link with -lrt on Solaris for threaded way
[ghc.git] / compiler / rename / RnEnv.lhs
index c11cca0..f333a23 100644 (file)
@@ -4,6 +4,8 @@
 \section[RnEnv]{Environment manipulation for the renamer monad}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module RnEnv (
         newTopSrcBinder,
         lookupLocatedTopBndrRn, lookupTopBndrRn,
@@ -38,10 +40,7 @@ module RnEnv (
         warnUnusedMatches,
         warnUnusedTopBinds, warnUnusedLocalBinds,
         dataTcOccs, kindSigErr, perhapsForallMsg,
-        HsDocContext(..), docOfHsDocContext, 
-
-        -- FsEnv
-        FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv
+        HsDocContext(..), docOfHsDocContext
     ) where
 
 #include "HsVersions.h"
@@ -59,12 +58,12 @@ import NameSet
 import NameEnv
 import Avail
 import Module
-import UniqFM
+import ConLike
 import DataCon          ( dataConFieldLabels, dataConTyCon )
 import TyCon            ( isTupleTyCon, tyConArity )
 import PrelNames        ( mkUnboundName, isUnboundName, rOOT_MAIN, forall_tv_RDR )
 import ErrUtils         ( MsgDoc )
-import BasicTypes       ( Fixity(..), FixityDirection(..), minPrecedence )
+import BasicTypes       ( Fixity(..), FixityDirection(..), minPrecedence, defaultFixity )
 import SrcLoc
 import Outputable
 import Util
@@ -233,9 +232,9 @@ lookupExactOcc :: Name -> RnM Name
 lookupExactOcc name
   | Just thing <- wiredInNameTyThing_maybe name
   , Just tycon <- case thing of
-                    ATyCon tc   -> Just tc
-                    ADataCon dc -> Just (dataConTyCon dc)
-                    _           -> Nothing
+                    ATyCon tc                 -> Just tc
+                    AConLike (RealDataCon dc) -> Just (dataConTyCon dc)
+                    _                         -> Nothing
   , isTupleTyCon tycon
   = do { checkTupSize (tyConArity tycon)
        ; return name }
@@ -269,14 +268,29 @@ lookupExactOcc name
                        ; return name
                        }
 
-           [gre] -> return (gre_name gre)
-           _     -> pprPanic "lookupExactOcc" (ppr name $$ ppr gres) }
+           [gre]   -> return (gre_name gre)
+           (gre:_) -> do {addErr dup_nm_err
+                         ; return (gre_name gre)
+                         }
+           -- We can get more than one GRE here, if there are multiple 
+           -- bindings for the same name. Sometimes they are caught later
+           -- by findLocalDupsRdrEnv, like in this example (Trac #8932):
+           --    $( [d| foo :: a->a; foo x = x |])
+           --    foo = True
+           -- But when the names are totally identical, we panic (Trac #7241):
+           --    $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]])
+           -- So, let's emit an error here, even if it will lead to duplication in some cases.
+       }
 
   where
     exact_nm_err = hang (ptext (sLit "The exact Name") <+> quotes (ppr name) <+> ptext (sLit "is not in scope"))
                       2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ")
                               , ptext (sLit "perhaps via newName, but did not bind it")
                               , ptext (sLit "If that's it, then -ddump-splices might be useful") ])
+    dup_nm_err   = hang (ptext (sLit "Duplicate exact Name") <+> quotes (ppr $ nameOccName name))
+                      2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ")
+                              , ptext (sLit "perhaps via newName, but bound it multiple times")
+                              , ptext (sLit "If that's it, then -ddump-splices might be useful") ])
 
 -----------------------------------------------
 lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
@@ -449,7 +463,7 @@ Thus:
       data G a
     instance C S where
       data G S = Y1 | Y2
-Even though there are two G's in scope (M.G and Blib.G), the occurence
+Even though there are two G's in scope (M.G and Blib.G), the occurrence
 of 'G' in the 'instance C S' decl is unambiguous, because C has only
 one associated type called G. This is exactly what happens for methods,
 and it is only consistent to do the same thing for types. That's the
@@ -610,7 +624,7 @@ When the user writes:
 'Zero' in the type signature of 'foo' is parsed as:
   HsTyVar ("Zero", TcClsName)
 
-When the renamer hits this occurence of 'Zero' it's going to realise
+When the renamer hits this occurrence of 'Zero' it's going to realise
 that it's not in scope. But because it is renaming a type, it knows
 that 'Zero' might be a promoted data constructor, so it will demote
 its namespace to DataName and do a second lookup.
@@ -829,7 +843,7 @@ as if there was an "import qualified M" declaration for every
 module.
 
 If we fail we just return Nothing, rather than bleating
-about "attempting to use module â\80\9bD’ (./D.hs) which is not loaded"
+about "attempting to use module â\80\98D’ (./D.hs) which is not loaded"
 which is what loadSrcInterface does.
 
 Note [Safe Haskell and GHCi]
@@ -1071,20 +1085,6 @@ deprecation declarations, and lookup of names in GHCi.
 
 \begin{code}
 --------------------------------
-type FastStringEnv a = UniqFM a         -- Keyed by FastString
-
-
-emptyFsEnv  :: FastStringEnv a
-lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a
-extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a
-mkFsEnv     :: [(FastString,a)] -> FastStringEnv a
-
-emptyFsEnv  = emptyUFM
-lookupFsEnv = lookupUFM
-extendFsEnv = addToUFM
-mkFsEnv     = listToUFM
-
---------------------------------
 type MiniFixityEnv = FastStringEnv (Located Fixity)
         -- Mini fixity env for the names we're about
         -- to bind, in a single binding group
@@ -1102,7 +1102,7 @@ type MiniFixityEnv = FastStringEnv (Located Fixity)
 
 addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
 addLocalFixities mini_fix_env names thing_inside
-  = extendFixityEnv (mapCatMaybes find_fixity names) thing_inside
+  = extendFixityEnv (mapMaybe find_fixity names) thing_inside
   where
     find_fixity name
       = case lookupFsEnv mini_fix_env (occNameFS occ) of
@@ -1136,17 +1136,18 @@ lookupFixityRn name
     -- where 'foo' is not in scope, should not give an error (Trac #7937)
 
   | otherwise
-  = do { this_mod <- getModule
-       ; if nameIsLocalOrFrom this_mod name
-         then lookup_local
-         else lookup_imported }
+  = do { local_fix_env <- getFixityEnv
+       ; case lookupNameEnv local_fix_env name of {
+           Just (FixItem _ fix) -> return fix ;
+           Nothing ->
+
+    do { this_mod <- getModule
+       ; if nameIsLocalOrFrom this_mod name || isInteractiveModule (nameModule name)
+               -- Interactive modules are all in the fixity env,
+               -- and don't have entries in the HPT
+         then return defaultFixity
+         else lookup_imported } } }
   where
-    lookup_local   -- It's defined in this module
-      = do { local_fix_env <- getFixityEnv
-           ; traceRn (text "lookupFixityRn: looking up name in local environment:" <+>
-                     vcat [ppr name, ppr local_fix_env])
-           ; return (lookupFixity local_fix_env name) }
-
     lookup_imported
       -- For imported names, we have to get their fixities by doing a
       -- loadInterfaceForName, and consulting the Ifaces that comes back
@@ -1451,7 +1452,7 @@ unknownNameSuggestErr where_look tried_rdr_name
              all_possibilities
                 =  [ (showPpr dflags r, (r, Left loc))
                    | (r,loc) <- local_possibilities local_env ]
-                ++ [ (showPpr dflags r, rp) | (r,rp) <- global_possibilities global_env ]
+                ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]
 
              suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities
              perhaps = ptext (sLit "Perhaps you meant")
@@ -1463,19 +1464,24 @@ unknownNameSuggestErr where_look tried_rdr_name
        ; return extra_err }
   where
     pp_item :: (RdrName, HowInScope) -> SDoc
-    pp_item (rdr, Left loc) = quotes (ppr rdr) <+> loc' -- Locally defined
+    pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined
         where loc' = case loc of
                      UnhelpfulSpan l -> parens (ppr l)
                      RealSrcSpan l -> parens (ptext (sLit "line") <+> int (srcSpanStartLine l))
-    pp_item (rdr, Right is) = quotes (ppr rdr) <+>   -- Imported
+    pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+>   -- Imported
                               parens (ptext (sLit "imported from") <+> ppr (is_mod is))
 
+    pp_ns :: RdrName -> SDoc
+    pp_ns rdr | ns /= tried_ns = pprNameSpace ns
+              | otherwise      = empty
+      where ns = rdrNameSpace rdr
+
     tried_occ     = rdrNameOcc tried_rdr_name
     tried_is_sym  = isSymOcc tried_occ
     tried_ns      = occNameSpace tried_occ
     tried_is_qual = isQual tried_rdr_name
 
-    correct_name_space occ =  occNameSpace occ == tried_ns
+    correct_name_space occ =  nameSpacesRelated (occNameSpace occ) tried_ns
                            && isSymOcc occ == tried_is_sym
         -- Treat operator and non-operators as non-matching
         -- This heuristic avoids things like