[project @ 2001-01-18 12:54:16 by simonmar]

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

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index e6d1d4f..af9ccc6 100644 (file)
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -38,7 +38,7 @@ import RnEnv          ( availsToNameSet, availName, mkIfaceGlobalRdrEnv,
                        )
 import Module           ( Module, ModuleName, WhereFrom(..),
                          moduleNameUserString, moduleName,
-                         moduleEnvElts, lookupModuleEnv
+                         moduleEnvElts
                        )
 import Name            ( Name, NamedThing(..), getSrcLoc,
                          nameIsLocalOrFrom, nameOccName, nameModule,
@@ -74,6 +74,7 @@ import HscTypes               ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
                          Provenance(..), ImportReason(..), initialVersionInfo,
                          Deprecations(..), lookupDeprec, lookupIface
                         )
+import CmStaticInfo    ( GhciMode(..) )
 import List            ( partition, nub )
 \end{code}
 
@@ -125,7 +126,7 @@ renameExpr dflags hit hst pcs this_module expr
              print_unqual = unQualInScope rdr_env
          in 
  
-         initRnMS rdr_env emptyLocalFixityEnv SourceMode (rnExpr expr) 
+         initRnMS rdr_env emptyLocalFixityEnv CmdLineMode (rnExpr expr)        
                                                `thenRn` \ (e,fvs) -> 
 
          checkErrsRn                           `thenRn` \ no_errs_so_far ->
@@ -334,9 +335,8 @@ implicitFVs mod_name decls
     implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
 
 
-    get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
-       = concat (map get_deriv deriv_classes)
-    get other = []
+    get (TyClD (TyData {tcdDerivs = Just deriv_classes})) = concat (map get_deriv deriv_classes)
+    get other                                            = []
 
     get_deriv cls = case lookupUFM derivingOccurrences cls of
                        Nothing   -> []
@@ -395,7 +395,7 @@ fixitiesFromLocalDecls gbl_env decls
     getFixities acc (FixD fix)
       = fix_decl acc fix
 
-    getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
+    getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
                -- Get fixities from class decl sigs too.
     getFixities acc other_decl
@@ -453,7 +453,8 @@ rnDeprecs gbl_env Nothing decls
 %************************************************************************
 
 \begin{code}
-checkOldIface :: DynFlags
+checkOldIface :: GhciMode
+              -> DynFlags
              -> HomeIfaceTable -> HomeSymbolTable
              -> PersistentCompilerState
              -> FilePath
@@ -462,7 +463,14 @@ checkOldIface :: DynFlags
              -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
                                -- True <=> errors happened
 
-checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
+checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
+
+  -- If the source has changed and we're in interactive mode, avoid reading
+  -- an interface; just return the one we might have been supplied with.
+  | ghci_mode == Interactive && not source_unchanged
+  = return (pcs, False, (outOfDate, maybe_iface))
+
+  | otherwise
   = runRn dflags hit hst pcs (panic "Bogus module") $
     case maybe_iface of
        Just old_iface -> -- Use the one we already have
@@ -608,7 +616,9 @@ closeIfaceDecls dflags hit hst pcs
 
        -- Do the transitive closure
     lookupOrigNames implicit_occs      `thenRn` \ implicit_names ->
-    closeDecls decls (needed `plusFV` implicit_names)
+    closeDecls decls (needed `plusFV` implicit_names) `thenRn` \closed_decls ->
+    rnDump [] closed_decls `thenRn_`
+    returnRn closed_decls
   where
     implicit_occs = string_occs        -- Data type decls with record selectors,
                                -- which may appear in the decls, need unpackCString
@@ -716,7 +726,10 @@ reportUnusedNames my_mod_iface unqual imports avail_env
     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
     minimal_imports  = foldr add_inst_mod minimal_imports1 inst_mods
     
-    add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
+       -- We've carefully preserved the provenance so that we can
+       -- construct minimal imports that import the name by (one of)
+       -- the same route(s) as the programmer originally did.
+    add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName m)
                                                                (unitAvailEnv (mk_avail n))
     add_name (n,other_prov)                    acc = acc
 
@@ -759,22 +772,26 @@ warnDeprecations this_mod export_avails my_deprecs used_names
        pit     = iPIT ifaces
        deprecs = [ (n,txt)
                   | n <- nameSetToList used_names,
+                   not (nameIsLocalOrFrom this_mod n),
                     Just txt <- [lookup_deprec hit pit n] ]
+       -- nameIsLocalOrFrom: don't complain about locally defined names
+       -- For a start, we may be exporting a deprecated thing
+       -- Also we may use a deprecated thing in the defn of another
+       -- deprecated things.  We may even use a deprecated thing in
+       -- the defn of a non-deprecated thing, when changing a module's 
+       -- interface
     in                   
     mapRn_ warnDeprec deprecs
 
   where
-    export_mods = nub [ moduleName (nameModule name) 
+    export_mods = nub [ moduleName mod
                      | avail <- export_avails,
-                       let name = availName avail,
-                       not (nameIsLocalOrFrom this_mod name) ]
+                       let mod = nameModule (availName avail),
+                       mod /= this_mod ]
   
     load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
 
     lookup_deprec hit pit n
-       | nameIsLocalOrFrom this_mod n
-       = lookupDeprec my_deprecs n 
-       | otherwise
        = case lookupIface hit pit n of
                Just iface -> lookupDeprec (mi_deprecs iface) n
                Nothing    -> pprPanic "warnDeprecations:" (ppr n)