[project @ 2000-02-25 14:55:31 by panne]

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

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index c96b6fa..b07ec92 100644 (file)
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -31,7 +31,7 @@ import IOExts         ( IORef, newIORef, readIORef, writeIORef, unsafePerformIO )
        
 import HsSyn           
 import RdrHsSyn
-import RnHsSyn         ( RenamedFixitySig )
+import RnHsSyn         ( RenamedFixitySig, RenamedDeprecation )
 import BasicTypes      ( Version )
 import SrcLoc          ( noSrcLoc )
 import ErrUtils                ( addShortErrLocLine, addShortWarnLocLine,
@@ -132,8 +132,9 @@ data SDown = SDown {
                        --   we can look up record field names
 
                  rn_fixenv :: FixityEnv        -- Local fixities
-                                               -- The global ones are held in the
-                                               -- rn_ifaces field
+                       -- The global fixities are held in the
+                       -- rn_ifaces field.  Why?  See the comments
+                       -- with RnIfaces.lookupFixity
                }
 
 data RnMode    = SourceMode                    -- Renaming source code
@@ -192,6 +193,9 @@ type FixityEnv = NameEnv RenamedFixitySig
        -- We keep the whole fixity sig so that we
        -- can report line-number info when there is a duplicate
        -- fixity declaration
+
+--------------------------------
+type DeprecationEnv = NameEnv DeprecTxt
 \end{code}
 
 \begin{code}
@@ -214,11 +218,16 @@ type RnNameSupply
 
    , FiniteMap (ModuleName, OccName) Name
        -- Ensures that one (module,occname) pair gets one unique
+   , FiniteMap OccName Name
+       -- Ensures that one implicit parameter name gets one unique
    )
 
 
 --------------------------------
-data ExportEnv   = ExportEnv Avails Fixities
+data ExportEnv   = ExportEnv Avails Fixities [ModuleName]
+                       -- The list of modules is the modules exported
+                       -- with 'module M' in the export list
+
 type Avails      = [AvailInfo]
 type Fixities    = [(Name, Fixity)]
 
@@ -277,17 +286,20 @@ data ParsedIface
       pi_exports   :: [ExportItem],                    -- Exports
       pi_decls    :: [(Version, RdrNameHsDecl)],       -- Local definitions
       pi_insts    :: [RdrNameInstDecl],                -- Local instance declarations
-      pi_rules    :: [RdrNameRuleDecl]                 -- Rules
+      pi_rules    :: [RdrNameRuleDecl],                -- Rules
+      pi_deprecs   :: [RdrNameDeprecation]             -- Deprecations
     }
 
-type InterfaceDetails = (WhetherHasOrphans,
-                        VersionInfo Name, -- Version information for what this module imports
-                        ExportEnv)        -- What modules this one depends on
+data InterfaceDetails
+   = InterfaceDetails WhetherHasOrphans
+                     (VersionInfo Name)   -- Version information for what this module imports
+                     ExportEnv            -- What modules this one depends on
+                     [Deprecation Name]
 
 
 -- needed by Main to fish out the fixities assoc list.
 getIfaceFixities :: InterfaceDetails -> Fixities
-getIfaceFixities (_, _, ExportEnv _ fs) = fs
+getIfaceFixities (InterfaceDetails _ _ (ExportEnv _ fs _) _) = fs
 
 
 type RdrNamePragma = ()                                -- Fudge for now
@@ -303,6 +315,7 @@ data Ifaces = Ifaces {
                iDecls :: DeclsMap,     -- A single, global map of Names to decls
 
                iFixes :: FixityEnv,    -- A single, global map of Names to fixities
+                                       -- See comments with RnIfaces.lookupFixity
 
                iSlurp :: NameSet,
                -- All the names (whether "big" or "small", whether wired-in or not,
@@ -320,8 +333,10 @@ data Ifaces = Ifaces {
                -- Each is 'gated' by the names that must be available before
                -- this instance decl is needed.
 
-               iRules :: Bag GatedDecl
+               iRules :: Bag GatedDecl,
                        -- Ditto transformation rules
+
+               iDeprecs :: DeprecationEnv
        }
 
 type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
@@ -367,7 +382,7 @@ initRn :: ModuleName -> UniqSupply -> SearchPath -> SrcLoc
 
 initRn mod us dirs loc do_rn = do
   himaps    <- mkModuleHiMaps dirs
-  names_var <- newIORef (us, emptyFM, builtins)
+  names_var <- newIORef (us, emptyFM, builtins, emptyFM)
   errs_var  <- newIORef (emptyBag,emptyBag)
   iface_var <- newIORef emptyIfaces 
   let
@@ -409,7 +424,8 @@ emptyIfaces = Ifaces { iImpModInfo = emptyFM,
                        -- and we don't want thereby to try to suck it in!
                       iVSlurp = [],
                       iInsts = emptyBag,
-                      iRules = emptyBag
+                      iRules = emptyBag,
+                      iDeprecs = emptyNameEnv
              }
 
 -- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
@@ -453,7 +469,9 @@ renameSourceCode mod_name name_supply m
        let
            rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
                               rn_errs = errs_var, rn_hi_maps = himaps,
-                              rn_mod = mod_name }
+                              rn_mod = mod_name, 
+                              rn_ifaces = panic "rnameSourceCode: rn_ifaces"  -- Not required
+                            }
            s_down = SDown { rn_mode = InterfaceMode,
                               -- So that we can refer to PrelBase.True etc
                             rn_genv = emptyRdrEnv, rn_lenv = emptyRdrEnv,
@@ -489,6 +507,7 @@ andRn    :: (a -> a -> a) -> RnM d a -> RnM d a -> RnM d a
 mapRn    :: (a -> RnM d b) -> [a] -> RnM d [b]
 mapRn_   :: (a -> RnM d b) -> [a] -> RnM d ()
 mapMaybeRn :: (a -> RnM d (Maybe b)) -> [a] -> RnM d [b]
+flatMapRn  :: (a -> RnM d [b])       -> [a] -> RnM d [b]
 sequenceRn :: [RnM d a] -> RnM d [a]
 foldlRn :: (b  -> a -> RnM d b) -> b -> [a] -> RnM d b
 mapAndUnzipRn :: (a -> RnM d (b,c)) -> [a] -> RnM d ([b],[c])
@@ -541,6 +560,11 @@ mapMaybeRn f (x:xs) = f x          `thenRn` \ maybe_r ->
                      case maybe_r of
                        Nothing -> returnRn rs
                        Just r  -> returnRn (r:rs)
+
+flatMapRn f []     = returnRn []
+flatMapRn f (x:xs) = f x               `thenRn` \ r ->
+                    flatMapRn f xs     `thenRn` \ rs ->
+                    returnRn (r ++ rs)
 \end{code}
 
 
@@ -624,23 +648,23 @@ setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
 -- See comments with RnNameSupply above.
 newInstUniq :: String -> RnM d Int
 newInstUniq key (RnDown {rn_ns = names_var}) l_down
-  = readIORef names_var                                >>= \ (us, mapInst, cache) ->
+  = readIORef names_var                                >>= \ (us, mapInst, cache, ipcache) ->
     let
        uniq = case lookupFM mapInst key of
                   Just x  -> x+1
                   Nothing -> 0
        mapInst' = addToFM mapInst key uniq
     in
-    writeIORef names_var (us, mapInst', cache) >>
+    writeIORef names_var (us, mapInst', cache, ipcache) >>
     return uniq
 
 getUniqRn :: RnM d Unique
 getUniqRn (RnDown {rn_ns = names_var}) l_down
- = readIORef names_var >>= \ (us, mapInst, cache) ->
+ = readIORef names_var >>= \ (us, mapInst, cache, ipcache) ->
    let
      (us1,us') = splitUniqSupply us
    in
-   writeIORef names_var (us', mapInst, cache)  >>
+   writeIORef names_var (us', mapInst, cache, ipcache)  >>
    return (uniqFromSupply us1)
 \end{code}