[project @ 2000-10-24 08:40:09 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index a24813d..1b34ec0 100644 (file)
@@ -5,29 +5,34 @@
 
 \begin{code}
 module HscTypes ( 
+       Finder, ModuleLocation(..),
+
        ModDetails(..), ModIface(..), GlobalSymbolTable, 
        HomeSymbolTable, PackageSymbolTable,
-       HomeIfaceTable, PackageIfaceTable,
+       HomeIfaceTable, PackageIfaceTable, 
+       lookupTable,
+
+       IfaceDecls(..), 
+
+       VersionInfo(..), initialVersionInfo,
 
        TyThing(..), groupTyThings,
 
        TypeEnv, extendTypeEnv, lookupTypeEnv, 
 
-       lookupFixityEnv,
-
-       WhetherHasOrphans, ImportVersion, ExportItem, WhatsImported(..),
+       WhetherHasOrphans, ImportVersion, WhatsImported(..),
        PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
-       IfaceInsts, IfaceRules, DeprecationEnv, 
+       IfaceInsts, IfaceRules, GatedDecl,
        OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
        AvailEnv, AvailInfo, GenAvailInfo(..),
        PersistentCompilerState(..),
 
+       Deprecations(..), lookupDeprec,
+
        InstEnv, ClsInstEnv, DFunId,
 
        GlobalRdrEnv, RdrAvailInfo,
 
-       CompResult(..), HscResult(..),
-
        -- Provenance
        Provenance(..), ImportReason(..), PrintUnqualified,
         pprNameProvenance, hasBetterProv
@@ -36,44 +41,67 @@ module HscTypes (
 
 #include "HsVersions.h"
 
+import RdrName         ( RdrNameEnv, emptyRdrEnv )
 import Name            ( Name, NameEnv, NamedThing,
-                         unitNameEnv, extendNameEnv, plusNameEnv, 
+                         emptyNameEnv, unitNameEnv, extendNameEnv, plusNameEnv, 
                          lookupNameEnv, emptyNameEnv, getName, nameModule,
                          nameSrcLoc )
-import Module          ( Module, ModuleName, ModuleEnv,
-                         extendModuleEnv, lookupModuleEnv )
-import Class           ( Class )
+import NameSet         ( NameSet )
 import OccName         ( OccName )
-import RdrName         ( RdrNameEnv, emptyRdrEnv )
-import Outputable      ( SDoc )
-import UniqFM          ( UniqFM )
-import FiniteMap       ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM )
-import Bag             ( Bag )
+import Module          ( Module, ModuleName, ModuleEnv,
+                         lookupModuleEnv )
+import VarSet          ( TyVarSet )
+import VarEnv          ( emptyVarEnv )
 import Id              ( Id )
-import VarEnv          ( IdEnv, emptyVarEnv )
-import BasicTypes      ( Version, Fixity, defaultFixity )
+import Class           ( Class )
 import TyCon           ( TyCon )
-import ErrUtils                ( ErrMsg, WarnMsg )
-import CmLink          ( Linkable )
-import RdrHsSyn                ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameHsDecl,
-                         RdrNameDeprecation, RdrNameFixitySig )
-import InterpSyn       ( UnlinkedIBind )
-import UniqSupply      ( UniqSupply )
-import HsDecls         ( DeprecTxt )
+
+import BasicTypes      ( Version, initialVersion, Fixity )
+
+import HsSyn           ( DeprecTxt )
+import RdrHsSyn                ( RdrNameHsDecl )
+import RnHsSyn         ( RenamedTyClDecl, RenamedIfaceSig, RenamedRuleDecl, RenamedInstDecl )
+
 import CoreSyn         ( CoreRule )
-import NameSet         ( NameSet )
 import Type            ( Type )
-import Name            ( emptyNameEnv )
-import VarSet          ( TyVarSet )
-import Panic           ( panic )
+
+import FiniteMap       ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM )
+import Bag             ( Bag )
+import Maybes          ( seqMaybe )
+import UniqFM          ( UniqFM )
 import Outputable
 import SrcLoc          ( SrcLoc, isGoodSrcLoc )
 import Util            ( thenCmp )
-import RnHsSyn         ( RenamedHsDecl )
 \end{code}
 
 %************************************************************************
 %*                                                                     *
+\subsection{The Finder type}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+type Finder = ModuleName -> IO (Maybe (Module, ModuleLocation))
+
+data ModuleLocation
+   = ModuleLocation {
+       hs_file  :: FilePath,
+       hi_file  :: FilePath,
+       obj_file :: FilePath
+      }
+\end{code}
+
+For a module in another package, the hs_file and obj_file
+components of ModuleLocation are undefined.  
+
+The locations specified by a ModuleLocation may or may not
+correspond to actual files yet: for example, even if the object
+file doesn't exist, the ModuleLocation still contains the path to
+where the object file will reside if/when it is created.
+
+
+%************************************************************************
+%*                                                                     *
 \subsection{Symbol tables and Module details}
 %*                                                                     *
 %************************************************************************
@@ -89,18 +117,29 @@ data ModIface
         mi_module   :: Module,                 -- Complete with package info
         mi_version  :: VersionInfo,            -- Module version number
         mi_orphan   :: WhetherHasOrphans,       -- Whether this module has orphans
-        mi_usages   :: [ImportVersion Name],   -- Usages
+
+        mi_usages   :: [ImportVersion Name],   -- Usages; kept sorted so that it's easy
+                                               -- to decide whether to write a new iface file
+                                               -- (changing usages doesn't affect the version of
+                                               --  this module)
 
         mi_exports  :: Avails,                 -- What it exports
+                                               -- Kept sorted by (mod,occ),
+                                               -- to make version comparisons easier
+
         mi_globals  :: GlobalRdrEnv,           -- Its top level environment
 
         mi_fixities :: NameEnv Fixity,         -- Fixities
-       mi_deprecs  :: NameEnv DeprecTxt,       -- Deprecations
+       mi_deprecs  :: Deprecations,            -- Deprecations
 
-       mi_decls    :: [RenamedHsDecl]          -- types, classes 
-                                               -- inst decls, rules, iface sigs
+       mi_decls    :: IfaceDecls               -- The RnDecls form of ModDetails
      }
 
+data IfaceDecls = IfaceDecls { dcl_tycl  :: [RenamedTyClDecl], -- Sorted
+                              dcl_sigs  :: [RenamedIfaceSig],  -- Sorted
+                              dcl_rules :: [RenamedRuleDecl],  -- Sorted
+                              dcl_insts :: [RenamedInstDecl] } -- Unsorted
+
 -- typechecker should only look at this, not ModIface
 -- Should be able to construct ModDetails from mi_decls in ModIface
 data ModDetails
@@ -125,7 +164,7 @@ emptyModIface mod
   = ModIface { mi_module   = mod,
               mi_exports  = [],
               mi_globals  = emptyRdrEnv,
-              mi_deprecs  = emptyNameEnv,
+              mi_deprecs  = NoDeprecs
     }          
 \end{code}
 
@@ -146,12 +185,12 @@ type GlobalSymbolTable  = SymbolTable     -- Domain = all modules
 Simple lookups in the symbol table.
 
 \begin{code}
-lookupFixityEnv :: IfaceTable -> Name -> Maybe Fixity
-       -- Returns defaultFixity if there isn't an explicit fixity
-lookupFixityEnv tbl name
-  = case lookupModuleEnv tbl (nameModule name) of
-       Nothing      -> Nothing
-       Just details -> lookupNameEnv (mi_fixities details) name
+lookupTable :: ModuleEnv a -> ModuleEnv a -> Name -> Maybe a
+-- We often have two Symbol- or IfaceTables, and want to do a lookup
+lookupTable ht pt name
+  = lookupModuleEnv ht mod `seqMaybe` lookupModuleEnv pt mod
+  where
+    mod = nameModule name
 \end{code}
 
 
@@ -225,19 +264,39 @@ but they are mostly elaborated elsewhere
 \begin{code}
 data VersionInfo 
   = VersionInfo {
-       modVers  :: Version,
-       fixVers  :: Version,
-       ruleVers :: Version,
-       declVers :: NameEnv Version
+       vers_module  :: Version,        -- Changes when anything changes
+       vers_exports :: Version,        -- Changes when export list changes
+       vers_rules   :: Version,        -- Changes when any rule changes
+       vers_decls   :: NameEnv Version
+               -- Versions for "big" names only (not data constructors, class ops)
+               -- The version of an Id changes if its fixity changes
+               -- Ditto data constructors, class operations, except that the version of
+               -- the parent class/tycon changes
     }
 
-type DeprecationEnv = NameEnv DeprecTxt                -- Give reason for deprecation
+initialVersionInfo :: VersionInfo
+initialVersionInfo = VersionInfo { vers_module  = initialVersion,
+                                  vers_exports = initialVersion,
+                                  vers_rules   = initialVersion,
+                                  vers_decls   = emptyNameEnv }
+
+data Deprecations = NoDeprecs
+                 | DeprecAll DeprecTxt                 -- Whole module deprecated
+                 | DeprecSome (NameEnv DeprecTxt)      -- Some things deprecated
+                                                       -- Just "big" names
+
+lookupDeprec :: ModIface -> Name -> Maybe DeprecTxt
+lookupDeprec iface name
+  = case mi_deprecs iface of
+       NoDeprecs      -> Nothing
+       DeprecAll txt  -> Just txt
+       DeprecSome env -> lookupNameEnv env name
 
 type InstEnv    = UniqFM ClsInstEnv            -- Maps Class to instances for that class
 type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
 type DFunId    = Id
 
-type RuleEnv    = IdEnv [CoreRule]
+type RuleEnv    = NameEnv [CoreRule]
 
 emptyRuleEnv    = emptyVarEnv
 \end{code}
@@ -268,14 +327,6 @@ type AvailEnv        = NameEnv AvailInfo   -- Maps a Name to the AvailInfo that contain
 %************************************************************************
 
 \begin{code}
-type ExportItem                 = (ModuleName, [RdrAvailInfo])
-
-type ImportVersion name  = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name)
-
-type ModVersionInfo    = (Version,             -- Version of the whole module
-                          Version,             -- Version number for all fixity decls together
-                          Version)             -- ...ditto all rules together
-
 type WhetherHasOrphans   = Bool
        -- An "orphan" is 
        --      * an instance decl in a module other than the defn module for 
@@ -285,25 +336,31 @@ type WhetherHasOrphans   = Bool
 
 type IsBootInterface     = Bool
 
+type ImportVersion name  = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name)
+
 data WhatsImported name  = NothingAtAll                                -- The module is below us in the
                                                                -- hierarchy, but we import nothing
 
-                        | Everything Version                   -- The module version
+                        | Everything Version           -- Used for modules from other packages;
+                                                       -- we record only the module's version number
+
+                        | Specifically 
+                               Version                 -- Module version
+                               (Maybe Version)         -- Export-list version, if we depend on it
+                               [(name,Version)]        -- List guaranteed non-empty
+                               Version                 -- Rules version
 
-                        | Specifically Version                 -- Module version
-                                       Version                 -- Fixity version
-                                       Version                 -- Rules version
-                                       [(name,Version)]        -- List guaranteed non-empty
                         deriving( Eq )
-       -- 'Specifically' doesn't let you say "I imported f but none of the fixities in
-       -- the module". If you use anything in the module you get its fixity and rule version
-       -- So if the fixities or rules change, you'll recompile, even if you don't use either.
+       -- 'Specifically' doesn't let you say "I imported f but none of the rules in
+       -- the module". If you use anything in the module you get its rule version
+       -- So if the rules change, you'll recompile, even if you don't use them.
        -- This is easy to implement, and it's safer: you might not have used the rules last
        -- time round, but if someone has added a new rule you might need it this time
 
-       -- 'Everything' means there was a "module M" in 
-       -- this module's export list, so we just have to go by M's version,
-       -- not the list of (name,version) pairs
+       -- The export list field is (Just v) if we depend on the export list:
+       --      we imported the module without saying exactly what we imported
+       -- We need to recompile if the module exports changes, because we might
+       -- now have a name clash in the importing module.
 \end{code}
 
 
@@ -316,6 +373,8 @@ data WhatsImported name  = NothingAtAll                             -- The module is below us in the
 \begin{code}
 data PersistentCompilerState 
    = PCS {
+        pcs_PIT :: PackageIfaceTable,  -- Domain = non-home-package modules
+                                       --   the mi_decls component is empty
         pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules
                                        --   except that the InstEnv components is empty
        pcs_insts :: InstEnv,           -- The total InstEnv accumulated from all
@@ -395,47 +454,6 @@ type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
 
 %************************************************************************
 %*                                                                     *
-\subsection{The result of compiling one module}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-data CompResult
-   = CompOK   ModDetails  -- new details (HST additions)
-              (Maybe (ModIface, Linkable))
-                       -- summary and code; Nothing => compilation not reqd
-                       -- (old summary and code are still valid)
-              PersistentCompilerState  -- updated PCS
-              (Bag WarnMsg)            -- warnings
-
-   | CompErrs PersistentCompilerState  -- updated PCS
-              (Bag ErrMsg)             -- errors
-              (Bag WarnMsg)             -- warnings
-
-
--- The driver sits between 'compile' and 'hscMain', translating calls
--- to the former into calls to the latter, and results from the latter
--- into results from the former.  It does things like preprocessing
--- the .hs file if necessary, and compiling up the .stub_c files to
--- generate Linkables.
-
-data HscResult
-   = HscOK   ModDetails             -- new details (HomeSymbolTable additions)
-            (Maybe ModIface)        -- new iface (if any compilation was done)
-            (Maybe String)          -- generated stub_h filename (in /tmp)
-            (Maybe String)          -- generated stub_c filename (in /tmp)
-            (Maybe [UnlinkedIBind]) -- interpreted code, if any
-             PersistentCompilerState -- updated PCS
-             (Bag WarnMsg)             -- warnings
-
-   | HscErrs PersistentCompilerState -- updated PCS
-             (Bag ErrMsg)              -- errors
-             (Bag WarnMsg)             -- warnings
-\end{code}
-
-
-%************************************************************************
-%*                                                                     *
 \subsection{Provenance and export info}
 %*                                                                     *
 %************************************************************************
@@ -482,16 +500,6 @@ instance Ord ImportReason where
       = (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
 
 
-{-
-Moved here from Name.
-pp_prov (LocalDef _ Exported)          = char 'x'
-pp_prov (LocalDef _ NotExported)       = char 'l'
-pp_prov (NonLocalDef ImplicitImport _) = char 'j'
-pp_prov (NonLocalDef (UserImport _ _ True ) _) = char 'I'      -- Imported by name
-pp_prov (NonLocalDef (UserImport _ _ False) _) = char 'i'      -- Imported by ..
-pp_prov SystemProv                    = char 's'
--}
-
 data ImportReason
   = UserImport Module SrcLoc Bool      -- Imported from module M on line L
                                        -- Note the M may well not be the defining module
@@ -524,7 +532,7 @@ hasBetterProv (NonLocalDef (UserImport _ _ _   ) _) (NonLocalDef ImplicitImport
 hasBetterProv _                                            _                              = False
 
 pprNameProvenance :: Name -> Provenance -> SDoc
-pprNameProvenance name LocalDef               = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
+pprNameProvenance name LocalDef           = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
 pprNameProvenance name (NonLocalDef why _) = sep [ppr_reason why, 
                                              nest 2 (parens (ppr_defn (nameSrcLoc name)))]