From: sewardj Date: Wed, 11 Oct 2000 15:31:27 +0000 (+0000) Subject: [project @ 2000-10-11 15:31:27 by sewardj] X-Git-Tag: Approximately_9120_patches~3636 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=91ae421fb750ff5f5616394e36e1ed44d3b5e112;p=ghc-hetmet.git [project @ 2000-10-11 15:31:27 by sewardj] Move @compile@-related types to HscTypes. --- diff --git a/ghc/compiler/ghci/CmCompile.lhs b/ghc/compiler/ghci/CmCompile.lhs index 50f2cd0..efab1ea 100644 --- a/ghc/compiler/ghci/CmCompile.lhs +++ b/ghc/compiler/ghci/CmCompile.lhs @@ -16,24 +16,26 @@ where #include "HsVersions.h" -import CmLink ( Linkable(..) ) -import Outputable ( SDoc ) -import CmFind ( Finder ) -import CmSummarise ( ModSummary, name_of_summary ) -import FiniteMap ( FiniteMap, emptyFM ) - -import Module ( Module ) -import RnMonad ( Avails, GlobalRdrEnv, DeclsMap, - WhetherHasOrphans, ImportVersion, - IfaceInsts, IfaceRules, ExportItem ) -import TcEnv ( TyThing, InstEnv ) -import Name ( Name, OccName ) -import BasicTypes ( Fixity, Version ) -import Id ( Id ) -import CoreSyn ( CoreRule ) -import RdrHsSyn ( RdrNameDeprecation, RdrNameRuleDecl, RdrNameFixitySig, - RdrNameHsDecl, RdrNameInstDecl ) - +-- many of these need to be moved to HscTypes +--import CmLink ( Linkable(..) ) +--import Outputable ( SDoc ) +--import CmFind ( Finder ) +--import CmSummarise ( ModSummary, name_of_summary ) +--import FiniteMap ( FiniteMap, emptyFM ) + +--import Module ( Module ) +--import RnMonad ( Avails, GlobalRdrEnv, DeclsMap, +-- WhetherHasOrphans, ImportVersion, +-- IfaceInsts, IfaceRules, ExportItem ) +--import TcEnv ( TyThing, InstEnv ) +--import Name ( Name, OccName ) +--import BasicTypes ( Fixity, Version ) +--import Id ( Id ) +--import CoreSyn ( CoreRule ) +--import RdrHsSyn ( RdrNameDeprecation, RdrNameRuleDecl, RdrNameFixitySig, +-- RdrNameHsDecl, RdrNameInstDecl ) + +import HscTypes ( ) \end{code} @@ -65,124 +67,5 @@ cmCompile finder summary old_iface hst pcs pcs [] ) - -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 - [SDoc] -- warnings - - | CompErrs PersistentCompilerState -- updated PCS - [SDoc] -- errors - [SDoc] -- warnings - - --- These two are only here to avoid recursion between CmCompile and --- CompManager. They really ought to be in the latter. -type ModuleEnv a = UniqFM a -- Domain is Module - -type HomeModMap = FiniteMap ModuleName Module -- domain: home mods only -type HomeSymbolTable = ModuleEnv ModDetails -- ditto -type HomeInterfaceTable = ModuleEnv ModIFace -\end{code} - - -%************************************************************************ -%* * -\subsection{Module details} -%* * -%************************************************************************ - -A @ModDetails@ summarises everything we know about a compiled module - -\begin{code} -data ModDetails - = ModDetails { - moduleExports :: Avails, -- What it exports - moduleEnv :: GlobalRdrEnv, -- Its top level environment - - fixityEnv :: NameEnv Fixity, - deprecEnv :: NameEnv DeprecTxt, - typeEnv :: NameEnv TyThing, -- TyThing is in TcEnv.lhs - - instEnv :: InstEnv, - ruleEnv :: IdEnv [CoreRule] -- Domain includes Ids from other modules - } -\end{code} - -Auxiliary definitions - -\begin{code} -type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation - -type GlobalRdrEnv = RdrNameEnv [Name] -- The list is because there may be name clashes - -- These only get reported on lookup, - -- not on construction - -data GenAvailInfo name = Avail name -- An ordinary identifier - | AvailTC name -- The name of the type or class - [name] -- The available pieces of type/class. - -- NB: If the type or class is itself - -- to be in scope, it must be in this list. - -- Thus, typically: AvailTC Eq [Eq, ==, /=] - deriving( Eq ) - -- Equality used when deciding if the interface has changed - -type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it -type AvailInfo = GenAvailInfo Name -type RdrAvailInfo = GenAvailInfo OccName -type Avails = [AvailInfo] \end{code} - -%************************************************************************ -%* * -\subsection{The persistent compiler state} -%* * -%************************************************************************ - -\begin{code} -data PersistentCompilerState - = PCS { - pcsPST :: PackageSymbolTable, -- Domain = non-home-package modules - pcsHP :: HoldingPen, -- Pre-slurped interface bits and pieces - pcsNS :: NameSupply -- Allocate uniques for names - } - -type PackageSymbolTable = ModuleEnv ModDetails - -data NameSupply - = NS { nsUniqs :: UniqSupply, - nsNames :: FiniteMap (Module,OccName) Name -- Ensures that one original name gets one unique - nsIParam :: FiniteMap OccName Name -- Ensures that one implicit parameter name gets one unique - } -\end{code} - - -%************************************************************************ -%* * -\subsection{ModIface} -%* * -%************************************************************************ - -\begin{code} --- ModIFace is nearly the same as RnMonad.ParsedIface. --- Right now it's identical :) -data ModIFace - = ModIFace { - mi_mod :: Module, -- Complete with package info - mi_vers :: Version, -- Module version number - mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans - mi_usages :: [ImportVersion OccName], -- Usages - mi_exports :: [ExportItem], -- Exports - mi_insts :: [RdrNameInstDecl], -- Local instance declarations - mi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions - mi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, - -- with their version - mi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version - mi_deprecs :: [RdrNameDeprecation] -- Deprecations - } - -\end{code} diff --git a/ghc/compiler/ghci/CmFind.lhs b/ghc/compiler/ghci/CmFind.lhs index 96f0aff..02f0e93 100644 --- a/ghc/compiler/ghci/CmFind.lhs +++ b/ghc/compiler/ghci/CmFind.lhs @@ -4,8 +4,7 @@ \section[CmFind]{Module finder for GHCI} \begin{code} -module CmFind ( Path, ModName, PkgName, - ModLocation(..), ml_modname, isPackageLoc, +module CmFind ( ModLocation(..), ml_modname, isPackageLoc, Finder, newFinder ) where @@ -18,15 +17,16 @@ import Time ( ClockTime ) import Directory ( doesFileExist, getModificationTime ) import Outputable -import Module ( Module ) -import CmStaticInfo ( PCI(..), Package(..), Path, ModName, PkgName ) +import Module ( Module, ModuleName, PackageName ) +import CmStaticInfo ( PCI(..), Package(..) ) \end{code} \begin{code} +-- make a product type, with Maybe return --> Module,lhs data ModLocation - = SourceOnly ModName Path -- .hs - | ObjectCode ModName Path Path -- .o, .hi - | InPackage ModName PkgName + = SourceOnly ModuleName Path -- .hs + | ObjectCode ModuleName Path Path -- .o, .hi + | InPackage ModuleName PackageName | NotFound instance Outputable ModLocation where @@ -40,7 +40,7 @@ instance Outputable ModLocation where -type Finder = ModName -> IO ModLocation +type Finder = ModuleName -> IO ModLocation ml_modname (SourceOnly nm _) = nm ml_modname (ObjectCode nm _ _) = nm @@ -49,7 +49,7 @@ ml_modname (InPackage nm _) = nm isPackageLoc (InPackage _ _) = True isPackageLoc _ = False -mkFinder :: [(ModName,PkgName,Path)] -> [Path] -> Finder +mkFinder :: [(ModuleName,PackageName,FilePath)] -> [FilePath] -> Finder mkFinder pkg_ifaces home_dirs modnm = do found <- mkFinderX pkg_ifaces home_dirs modnm putStrLn ("FINDER: request = " ++ modnm ++ "\n" ++ @@ -57,7 +57,7 @@ mkFinder pkg_ifaces home_dirs modnm return found -mkFinderX :: [(ModName,PkgName,Path)] -> [Path] -> Finder +mkFinderX :: [(ModuleName,PackageName,FilePath)] -> [FilePath] -> Finder mkFinderX pkg_ifaces home_dirs modnm -- If the module exists both as package and home, emit a warning -- and (arbitrarily) choose the user's one. @@ -86,7 +86,7 @@ mkFinderX pkg_ifaces home_dirs modnm -- See if a .hs or (.hi, .o) pair exist on the given path, -- and return a ModLocation for whichever is younger -homeModuleExists :: ModName -> Path -> IO (Maybe (ModLocation, ClockTime)) +homeModuleExists :: ModuleName -> FilePath -> IO (Maybe (ModLocation, ClockTime)) homeModuleExists modname path = do m_ths <- maybeTime nm_hs m_thi <- maybeTime nm_hi @@ -121,7 +121,7 @@ homeModuleExists modname path -newFinder :: String{-temp debugging hack-} +newFinder :: FilePath{-temp debugging hack-} -> PCI -> IO Finder newFinder path pci = return (mkFinder (module_table pci) [path]) diff --git a/ghc/compiler/ghci/CmStaticInfo.lhs b/ghc/compiler/ghci/CmStaticInfo.lhs index 90fdb5b..8c4507f 100644 --- a/ghc/compiler/ghci/CmStaticInfo.lhs +++ b/ghc/compiler/ghci/CmStaticInfo.lhs @@ -4,8 +4,7 @@ \section[CmStaticInfo]{Session-static info for the Compilation Manager} \begin{code} -module CmStaticInfo ( Path, ModName, PkgName, - Package(..), PCI(..), mkPCI ) +module CmStaticInfo ( Package(..), PCI(..), mkPCI ) where #include "HsVersions.h" @@ -13,18 +12,16 @@ where import List ( nub ) import Char ( isUpper ) import Directory ( getDirectoryContents ) + +import Module ( ModuleName, PackageName ) \end{code} \begin{code} -type Path = String -type ModName = String -type PkgName = String - -data PCI - = PCI { - raw_package_info :: [Package], -- contents of packages.conf - module_table :: [(ModName, PkgName, Path)] - -- maps each available module to pkg and path +data PackageConfigInfo + = PackageConfigInfo { + pci_rawinfo :: [Package], -- contents of packages.conf + pci_modtable :: [(ModuleName, PackageName, FilePath)] + -- maps each available module to pkg and path } -- copied from the driver @@ -47,29 +44,31 @@ data Package mkPCI :: [Package] -> IO PCI mkPCI raw_package_info = do mtab <- mk_module_table raw_package_info - return (PCI { raw_package_info = raw_package_info, - module_table = mtab }) + return (PCI { pci_rawinfo = raw_package_info, + pci_modtable = mtab }) -mk_module_table :: [Package] -> IO [(ModName,PkgName,Path)] +mk_module_table :: [Package] -> IO [(ModuleName,PackageName,FilePath)] mk_module_table raw_info = do -- the list of directories where package interfaces are - let p_i_dirs :: [(PkgName,Path)] + let -- p_i_dirs :: [(PkgName,Path)] p_i_dirs = concatMap nm_and_paths raw_info -- interface names in each directory ifacess <- mapM ifaces_in_dir p_i_dirs - let iface_table :: [(ModName,PkgName,Path)] - iface_table = concat ifacess + let -- iface_table :: [(ModName,PkgName,Path)] + iface_table = map fsifyStrings (concat ifacess) -- ToDo: allow a range of home package directories return iface_table where - nm_and_paths :: Package -> [(PkgName,Path)] + fsifyStrings (mod_str, pkg_str, path_str) + = (mkFastString mod_str, mkFastString pkg_str, path_str) + -- nm_and_paths :: Package -> [(PkgName,Path)] nm_and_paths package = [(name package, path) | path <- nub (import_dirs package)] - ifaces_in_dir :: (PkgName,Path) -> IO [(ModName,PkgName,Path)] + -- ifaces_in_dir :: (PkgName,Path) -> IO [(ModName,PkgName,Path)] ifaces_in_dir (pkgname,path) = getDirectoryContents path >>= \ entries -> return [(zap_hi if_nm, pkgname, path) diff --git a/ghc/compiler/ghci/CompManager.lhs b/ghc/compiler/ghci/CompManager.lhs index 775abc0..90bdf44 100644 --- a/ghc/compiler/ghci/CompManager.lhs +++ b/ghc/compiler/ghci/CompManager.lhs @@ -55,24 +55,23 @@ type ModHandle = String -- ToDo: do better? -- Persistent state just for CM, excluding link & compile subsystems -data PCMS - = PCMS { - hst :: HST, -- home symbol table - hit :: HIT, -- home interface table - ui :: UI, -- the unlinked images - mg :: MG -- the module graph +data PersistentCMState + = PersistentCMState { + hst :: HomeSymbolTable, -- home symbol table + hit :: HomeInterfaceTable, -- home interface table + ui :: UnlinkedImages, -- the unlinked images + mg :: ModuleGraph -- the module graph } -emptyPCMS :: PCMS -emptyPCMS = PCMS { hst = emptyHST, - hit = emptyHIT, - ui = emptyUI, - mg = emptyMG } +emptyPCMS :: PersistentCMState +emptyPCMS = PersistentCMState + { hmm = emptyHMM, + hst = emptyHST, hit = emptyHIT, + ui = emptyUI, mg = emptyMG } -emptyHIT :: HIT +emptyHIT :: HomeInterfaceTable emptyHIT = emptyFM - -emptyHST :: HST +emptyHST :: HomeSymbolTable emptyHST = emptyFM @@ -80,11 +79,11 @@ emptyHST = emptyFM -- Persistent state for the entire system data CmState = CmState { - pcms :: PCMS, -- CM's persistent state - pcs :: PCS, -- compile's persistent state - pls :: PLS, -- link's persistent state - pci :: PCI, -- package config info, never changes - finder :: Finder -- the module finder + pcms :: PersistentCMState, -- CM's persistent state + pcs :: PersistentCompilerState, -- compile's persistent state + pls :: PersistentLinkerState, -- link's persistent state + pci :: PackageConfigInfo, -- package config info, never changes + finder :: Finder -- the module finder } emptyCmState :: String{-temp debugging hack-} @@ -102,13 +101,12 @@ emptyCmState path_TMP_DEBUGGING_HACK raw_package_info finder = finder }) -- CM internal types -type UI = [Linkable] -- the unlinked images (should be a set, really) -emptyUI :: UI +type UnlinkedImage = [Linkable] -- the unlinked images (should be a set, really) +emptyUI :: UnlinkedImage emptyUI = [] - -type MG = [SCC ModSummary] -- the module graph, topologically sorted -emptyMG :: MG +type ModuleGraph = [SCC ModSummary] -- the module graph, topologically sorted +emptyMG :: ModuleGraph emptyMG = [] \end{code} diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs new file mode 100644 index 0000000..3894df9 --- /dev/null +++ b/ghc/compiler/main/HscTypes.lhs @@ -0,0 +1,139 @@ +% +% (c) The University of Glasgow, 2000 +% +\section[HscTypes]{Types for the per-module compiler} + +\begin{code} +module HscTypes ( ) +where + +#include "HsVersions.h" + +\end{code} + +%************************************************************************ +%* * +\subsection{Module details} +%* * +%************************************************************************ + +A @ModDetails@ summarises everything we know about a compiled module + +\begin{code} +data ModDetails + = ModDetails { + moduleExports :: Avails, -- What it exports + moduleEnv :: GlobalRdrEnv, -- Its top level environment + + fixityEnv :: NameEnv Fixity, + deprecEnv :: NameEnv DeprecTxt, + typeEnv :: NameEnv TyThing, -- TyThing is in TcEnv.lhs + + instEnv :: InstEnv, + ruleEnv :: IdEnv [CoreRule] -- Domain includes Ids from other modules + } +\end{code} + +Auxiliary definitions + +\begin{code} +type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation + +type GlobalRdrEnv = RdrNameEnv [Name] -- The list is because there may be name clashes + -- These only get reported on lookup, + -- not on construction + +data GenAvailInfo name = Avail name -- An ordinary identifier + | AvailTC name -- The name of the type or class + [name] -- The available pieces of type/class. + -- NB: If the type or class is itself + -- to be in scope, it must be in this list. + -- Thus, typically: AvailTC Eq [Eq, ==, /=] + deriving( Eq ) + -- Equality used when deciding if the interface has changed + +type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it +type AvailInfo = GenAvailInfo Name +type RdrAvailInfo = GenAvailInfo OccName +type Avails = [AvailInfo] +\end{code} + + +%************************************************************************ +%* * +\subsection{ModIface} +%* * +%************************************************************************ + +\begin{code} +-- ModIFace is nearly the same as RnMonad.ParsedIface. +-- Right now it's identical :) +data ModIFace + = ModIFace { + mi_mod :: Module, -- Complete with package info + mi_vers :: Version, -- Module version number + mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans + mi_usages :: [ImportVersion OccName], -- Usages + mi_exports :: [ExportItem], -- Exports + mi_insts :: [RdrNameInstDecl], -- Local instance declarations + mi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions + mi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, + -- with their version + mi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version + mi_deprecs :: [RdrNameDeprecation] -- Deprecations + } +\end{code} + +%************************************************************************ +%* * +\subsection{The persistent compiler state} +%* * +%************************************************************************ + +\begin{code} +data PersistentCompilerState + = PCS { + pcsPST :: PackageSymbolTable, -- Domain = non-home-package modules + pcsHP :: HoldingPen, -- Pre-slurped interface bits and pieces + pcsNS :: NameSupply -- Allocate uniques for names + } + +type PackageSymbolTable = ModuleEnv ModDetails + +data NameSupply + = NS { nsUniqs :: UniqSupply, + nsNames :: FiniteMap (Module,OccName) Name -- Ensures that one original name gets one unique + nsIParam :: FiniteMap OccName Name -- Ensures that one implicit parameter name gets one unique + } +\end{code} + +%************************************************************************ +%* * +\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 + [SDoc] -- warnings + + | CompErrs PersistentCompilerState -- updated PCS + [SDoc] -- errors + [SDoc] -- warnings + + +-- These two are only here to avoid recursion between CmCompile and +-- CompManager. They really ought to be in the latter. +type ModuleEnv a = UniqFM a -- Domain is Module + +type HomeModMap = FiniteMap ModuleName Module -- domain: home mods only +type HomeSymbolTable = ModuleEnv ModDetails -- ditto +type HomeInterfaceTable = ModuleEnv ModIFace + +\end{code} + +