floating-point fix for x86_64
[ghc-hetmet.git] / ghc / compiler / rename / RnNames.lhs
index 71073a2..4cdb241 100644 (file)
@@ -6,17 +6,18 @@
 \begin{code}
 module RnNames (
        rnImports, importsFromLocalDecls, 
+       rnExports,
        getLocalDeclBinders, extendRdrEnvRn,
        reportUnusedNames, reportDeprecations, 
-       mkModDeps, exportsFromAvail
+       mkModDeps
     ) where
 
 #include "HsVersions.h"
 
 import DynFlags                ( DynFlag(..), GhcMode(..) )
 import HsSyn           ( IE(..), ieName, ImportDecl(..), LImportDecl,
-                         ForeignDecl(..), HsGroup(..), HsBindGroup(..), 
-                         Sig(..), collectGroupBinders, tyClDeclNames 
+                         ForeignDecl(..), HsGroup(..), HsValBinds(..),
+                         Sig(..), collectHsBindLocatedBinders, tyClDeclNames 
                        )
 import RnEnv
 import IfaceEnv                ( ifaceExportNames )
@@ -25,15 +26,17 @@ import TcRnMonad
 
 import FiniteMap
 import PrelNames       ( pRELUDE, isUnboundName, main_RDR_Unqual )
-import Module          ( Module, moduleUserString, unitModuleEnv, 
+import Module          ( Module, moduleString, unitModuleEnv, 
                          lookupModuleEnv, moduleEnvElts, foldModuleEnv )
 import Name            ( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName,
                          nameParent, nameParent_maybe, isExternalName,
                          isBuiltInSyntax )
 import NameSet
 import NameEnv
-import OccName         ( srcDataName, isTcOcc, occNameFlavour, OccEnv, 
-                         mkOccEnv, lookupOccEnv, emptyOccEnv, extendOccEnv )
+import OccName         ( srcDataName, isTcOcc, pprNonVarNameSpace,
+                         occNameSpace,
+                         OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
+                         extendOccEnv )
 import HscTypes                ( GenAvailInfo(..), AvailInfo,
                          HomePackageTable, PackageIfaceTable, 
                          unQualInScope, 
@@ -220,11 +223,10 @@ importsFromImportDecl this_mod
                 ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
                 ([], pkg : dep_pkgs deps)
 
+       -- True <=> import M ()
        import_all = case imp_details of
-                       Just (is_hiding, ls)     -- Imports are spec'd explicitly
-                         | not is_hiding -> Just (not (null ls))
-                       _ -> Nothing            -- Everything is imported, 
-                                               -- (or almost everything [hiding])
+                       Just (is_hiding, ls) -> not is_hiding && null ls        
+                       other                -> False
 
        -- unqual_avails is the Avails that are visible in *unqualified* form
        -- We need to know this so we know what to export when we see
@@ -300,21 +302,21 @@ importsFromLocalDecls group
            ; this_mod = tcg_mod gbl_env
            ; imports = emptyImportAvails {
                          imp_env = unitModuleEnv this_mod $
-                                 mkNameSet filtered_names
+                                   mkNameSet filtered_names
                        }
            }
 
-       ; rdr_env' <- extendRdrEnvRn this_mod (tcg_rdr_env gbl_env) names
+       ; rdr_env' <- extendRdrEnvRn (tcg_rdr_env gbl_env) names
 
        ; returnM (gbl_env { tcg_rdr_env = rdr_env',
                             tcg_imports = imports `plusImportAvails` tcg_imports gbl_env }) 
        }
 
-extendRdrEnvRn :: Module -> GlobalRdrEnv -> [Name] -> RnM GlobalRdrEnv
+extendRdrEnvRn :: GlobalRdrEnv -> [Name] -> RnM GlobalRdrEnv
 -- Add the new locally-bound names one by one, checking for duplicates as
 -- we do so.  Remember that in Template Haskell the duplicates
 -- might *already be* in the GlobalRdrEnv from higher up the module
-extendRdrEnvRn mod rdr_env names
+extendRdrEnvRn rdr_env names
   = foldlM add_local rdr_env names
   where
     add_local rdr_env name
@@ -325,9 +327,7 @@ extendRdrEnvRn mod rdr_env names
        | otherwise
        = return (extendGlobalRdrEnv rdr_env new_gre)
        where
-         new_gre = GRE {gre_name = name, gre_prov = prov}
-
-    prov = LocalDef mod
+         new_gre = GRE {gre_name = name, gre_prov = LocalDef}
 \end{code}
 
 @getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
@@ -337,7 +337,7 @@ used for source code.
 
 \begin{code}
 getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [Name]
-getLocalDeclBinders gbl_env (HsGroup {hs_valds = val_decls, 
+getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, 
                                      hs_tyclds = tycl_decls, 
                                      hs_fords = foreign_decls })
   = do { tc_names_s <- mappM new_tc tycl_decls
@@ -353,9 +353,8 @@ getLocalDeclBinders gbl_env (HsGroup {hs_valds = val_decls,
 
     new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name
 
-    sig_hs_bndrs = [nm | HsBindGroup _ lsigs _  <- val_decls, 
-                        L _ (Sig nm _) <- lsigs]
-    val_hs_bndrs = collectGroupBinders val_decls
+    sig_hs_bndrs = [nm | L _ (TypeSig nm _) <- val_sigs]
+    val_hs_bndrs = collectHsBindLocatedBinders val_decls
     for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]
 
     new_tc tc_decl 
@@ -499,7 +498,7 @@ it re-exports @GHC@, which includes @takeMVar#@, whose type includes
 
 \begin{code}
 type ExportAccum       -- The type of the accumulating parameter of
-                       -- the main worker function in exportsFromAvail
+                       -- the main worker function in rnExports
      = ([Module],              -- 'module M's seen so far
        ExportOccMap,           -- Tracks exported occurrence names
        NameSet)                -- The accumulated exported stuff
@@ -512,14 +511,14 @@ type ExportOccMap = OccEnv (Name, IE RdrName)
        --   that have the same occurrence name
 
 
-exportsFromAvail :: Bool  -- False => no 'module M(..) where' header at all
-                -> Maybe [Located (IE RdrName)] -- Nothing => no explicit export list
-                -> RnM NameSet
+rnExports :: Bool  -- False => no 'module M(..) where' header at all
+         -> Maybe [Located (IE RdrName)] -- Nothing => no explicit export list
+         -> RnM NameSet
        -- Complains if two distinct exports have same OccName
         -- Warns about identical exports.
        -- Complains about exports items not in scope
 
-exportsFromAvail explicit_mod exports
+rnExports explicit_mod exports
  = do { TcGblEnv { tcg_rdr_env = rdr_env, 
                   tcg_imports = imports } <- getGblEnv ;
 
@@ -534,6 +533,7 @@ exportsFromAvail explicit_mod exports
                | explicit_mod             = exports
                | ghci_mode == Interactive = Nothing
                | otherwise                = Just [noLoc (IEVar main_RDR_Unqual)] } ;
+               -- ToDo: the 'noLoc' here is unhelpful if 'main' turns out to be out of scope
        exports_from_avail real_exports rdr_env imports }
 
 
@@ -672,6 +672,8 @@ reportDeprecations :: TcGblEnv -> RnM ()
 reportDeprecations tcg_env
   = ifOptM Opt_WarnDeprecations        $
     do { (eps,hpt) <- getEpsAndHpt
+               -- By this time, typechecking is complete, 
+               -- so the PIT is fully populated
        ; mapM_ (check hpt (eps_PIT eps)) all_gres }
   where
     used_names = allUses (tcg_dus tcg_env) 
@@ -683,7 +685,7 @@ reportDeprecations tcg_env
       ,        Just deprec_txt <- lookupDeprec hpt pit name
       = setSrcSpan (importSpecLoc imp_spec) $
        addWarn (sep [ptext SLIT("Deprecated use of") <+> 
-                       occNameFlavour (nameOccName name) <+> 
+                       pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
                        quotes (ppr name),
                      (parens imp_msg) <> colon,
                      (ppr deprec_txt) ])
@@ -731,7 +733,8 @@ gre_is_used used_names gre = gre_name gre `elemNameSet` used_names
 reportUnusedNames :: Maybe [Located (IE RdrName)]      -- Export list
                  -> TcGblEnv -> RnM ()
 reportUnusedNames export_decls gbl_env 
-  = do { warnUnusedTopBinds   unused_locals
+  = do { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
+       ; warnUnusedTopBinds   unused_locals
        ; warnUnusedModules    unused_imp_mods
        ; warnUnusedImports    unused_imports   
        ; warnDuplicateImports defined_and_used
@@ -844,7 +847,7 @@ reportUnusedNames export_decls gbl_env
    
     imports = tcg_imports gbl_env
 
-    direct_import_mods :: [(Module, Maybe Bool, SrcSpan)]
+    direct_import_mods :: [(Module, Bool, SrcSpan)]
        -- See the type of the imp_mods for this triple
     direct_import_mods = moduleEnvElts (imp_mods imports)
 
@@ -855,11 +858,11 @@ reportUnusedNames export_decls gbl_env
     --
     -- BUG WARNING: does not deal correctly with multiple imports of the same module
     --             becuase direct_import_mods has only one entry per module
-    unused_imp_mods = [(mod,loc) | (mod,imp,loc) <- direct_import_mods,
+    unused_imp_mods = [(mod,loc) | (mod,no_imp,loc) <- direct_import_mods,
                       not (mod `elemFM` minimal_imports1),
                       mod /= pRELUDE,
-                      imp /= Just False]
-       -- The Just False part is not to complain about
+                      not no_imp]
+       -- The not no_imp part is not to complain about
        -- import M (), which is an idiom for importing
        -- instance declarations
     
@@ -957,7 +960,7 @@ printMinimalImports imps
                                 (vcat (map ppr_mod_ie mod_ies)) })
    }
   where
-    mkFilename this_mod = moduleUserString this_mod ++ ".imports"
+    mkFilename this_mod = moduleString this_mod ++ ".imports"
     ppr_mod_ie (mod_name, ies) 
        | mod_name == pRELUDE 
        = empty