X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FModule.lhs;h=69521625b0568008780b72371c579ef7d8a6cc32;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=6e9a7d5f0af810ce14c8de94de9fe6a915e4b8af;hpb=2a5a41e367a7bd61aa9708746f74df8aa2a877e7;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 6e9a7d5..6952162 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -1,146 +1,100 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +% (c) The University of Glasgow, 2004 % -\section[Module]{The @Module@ module.} - -Representing modules and their flavours. - - -Notes on DLLs -~~~~~~~~~~~~~ -When compiling module A, which imports module B, we need to -know whether B will be in the same DLL as A. - If it's in the same DLL, we refer to B_f_closure - If it isn't, we refer to _imp__B_f_closure -When compiling A, we record in B's Module value whether it's -in a different DLL, by setting the DLL flag. - - +Module +~~~~~~~~~~ +Simply the name of a module, represented as a FastString. +These are Uniquable, hence we can build FiniteMaps with ModuleNames as +the keys. \begin{code} module Module ( - Module, moduleName, moduleKind - -- abstract, instance of Eq, Ord, Outputable - , ModuleName - , ModuleKind(..) - , isLocalModuleKind - - , moduleNameString -- :: ModuleName -> EncodedString - , moduleNameUserString -- :: ModuleName -> UserString - , moduleNameFS -- :: ModuleName -> EncodedFS - - , moduleString -- :: Module -> EncodedString - , moduleUserString -- :: Module -> UserString - , moduleName -- :: Module -> ModuleName - - , mkVanillaModule -- :: ModuleName -> Module --- , mkThisModule -- :: ModuleName -> Module - , mkPrelModule -- :: UserString -> Module - , mkModule -- :: ModuleName -> ModuleKind -> Module - , isLocalModule -- :: Module -> Bool + Module -- Abstract, instance of Eq, Ord, Outputable + , pprModule -- :: ModuleName -> SDoc --- , mkSrcModule + , ModLocation(..) + , addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn - , mkModuleName -- :: UserString -> ModuleName - , mkModuleNameFS -- :: UserFS -> ModuleName - , mkSysModuleNameFS -- :: EncodedFS -> ModuleName + , moduleString -- :: ModuleName -> String + , moduleFS -- :: ModuleName -> FastString - , pprModule, + , mkModule -- :: String -> ModuleName + , mkModuleFS -- :: FastString -> ModuleName - , PackageName - - -- Where to find a .hi file - , WhereFrom(..) - - , ModuleEnv, + , ModuleEnv , elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv - , rngModuleEnv, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv + , moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv + , extendModuleEnv_C, filterModuleEnv + + , ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet ) where #include "HsVersions.h" -import OccName import Outputable -import CmdLineOpts ( opt_InPackage ) -import FastString ( FastString, uniqueOfFS ) -import Unique ( Uniquable(..), mkUniqueGrimily ) +import Unique ( Uniquable(..) ) import UniqFM +import UniqSet +import Binary +import FastString \end{code} - %************************************************************************ %* * -\subsection{Interface file flavour} +\subsection{Module locations} %* * %************************************************************************ -A further twist to the tale is the support for dynamically linked libraries under -Win32. Here, dealing with the use of global variables that's residing in a DLL -requires special handling at the point of use (there's an extra level of indirection, -i.e., (**v) to get at v's value, rather than just (*v) .) When slurping in an -interface file we then record whether it's coming from a .hi corresponding to a -module that's packaged up in a DLL or not, so that we later can emit the -appropriate code. - -The logic for how an interface file is marked as corresponding to a module that's -hiding in a DLL is explained elsewhere (ToDo: give renamer href here.) - -@SourceOnly@ and @ObjectCode@ indicate a module from the same package -as the one being compiled, i.e. a home module. @InPackage@ means one -from a different package. - \begin{code} -data Module = Module ModuleName ModuleKind - -data ModuleKind - = SourceOnly FilePath -- .hs - | ObjectCode FilePath FilePath -- .o, .hi - | InPackage PackageName - -moduleName (Module m _) = m -moduleKind (Module _ k) = k - -isLocalModuleKind (InPackage _) = False -isLocalModuleKind _ = True - -type PackageName = FastString -- No encoding at all - -preludePackage :: ModuleKind -preludePackage = InPackage SLIT("std") - -instance Outputable ModuleKind where - ppr (SourceOnly path_hs) - = text "SourceOnly" <+> text (show path_hs) - ppr (ObjectCode path_o path_hi) - = text "ObjectCode" <+> text (show path_o) <+> text (show path_hi) - ppr (InPackage pkgname) - = text "InPackage" <+> text (show pkgname) +data ModLocation + = ModLocation { + ml_hs_file :: Maybe FilePath, + -- The source file, if we have one. Package modules + -- probably don't have source files. + + ml_hi_file :: FilePath, + -- Where the .hi file is, whether or not it exists + -- yet. Always of form foo.hi, even if there is an + -- hi-boot file (we add the -boot suffix later) + + ml_obj_file :: FilePath + -- Where the .o file is, whether or not it exists yet. + -- (might not exist either because the module hasn't + -- been compiled yet, or because it is part of a + -- package with a .a file) + } deriving Show + +instance Outputable ModLocation where + ppr = text . show \end{code} +For a module in another package, the hs_file and obj_file +components of ModLocation are undefined. -%************************************************************************ -%* * -\subsection{Where from} -%* * -%************************************************************************ - -The @WhereFrom@ type controls where the renamer looks for an interface file +The locations specified by a ModLocation may or may not +correspond to actual files yet: for example, even if the object +file doesn't exist, the ModLocation still contains the path to +where the object file will reside if/when it is created. \begin{code} -data WhereFrom = ImportByUser -- Ordinary user import: look for M.hi - | ImportByUserSource -- User {- SOURCE -}: look for M.hi-boot - | ImportBySystem -- Non user import. Look for M.hi if M is in - -- the module this module depends on, or is a system-ish module; - -- M.hi-boot otherwise - -instance Outputable WhereFrom where - ppr ImportByUser = empty - ppr ImportByUserSource = ptext SLIT("{- SOURCE -}") - ppr ImportBySystem = ptext SLIT("{- SYSTEM IMPORT -}") +addBootSuffix :: FilePath -> FilePath +-- Add the "-boot" suffix to .hs, .hi and .o files +addBootSuffix path = path ++ "-boot" + +addBootSuffix_maybe :: Bool -> FilePath -> FilePath +addBootSuffix_maybe is_boot path + | is_boot = addBootSuffix path + | otherwise = path + +addBootSuffixLocn :: ModLocation -> ModLocation +addBootSuffixLocn locn + = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) + , ml_hi_file = addBootSuffix (ml_hi_file locn) + , ml_obj_file = addBootSuffix (ml_obj_file locn) } \end{code} @@ -151,116 +105,49 @@ instance Outputable WhereFrom where %************************************************************************ \begin{code} -newtype ModuleName = ModuleName EncodedFS +newtype Module = Module FastString -- Haskell module names can include the quote character ', -- so the module names have the z-encoding applied to them -instance Uniquable ModuleName where - getUnique (ModuleName nm) = mkUniqueGrimily (uniqueOfFS nm) +instance Binary Module where + put_ bh (Module m) = put_ bh m + get bh = do m <- get bh; return (Module m) + +instance Uniquable Module where + getUnique (Module nm) = getUnique nm -instance Eq ModuleName where +instance Eq Module where nm1 == nm2 = getUnique nm1 == getUnique nm2 -- Warning: gives an ordering relation based on the uniques of the -- FastStrings which are the (encoded) module names. This is _not_ -- a lexicographical ordering. -instance Ord ModuleName where +instance Ord Module where nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2 -instance Outputable ModuleName where - ppr = pprModuleName - - -pprModuleName :: ModuleName -> SDoc -pprModuleName (ModuleName nm) = pprEncodedFS nm - -moduleNameFS :: ModuleName -> EncodedFS -moduleNameFS (ModuleName mod) = mod - -moduleNameString :: ModuleName -> EncodedString -moduleNameString (ModuleName mod) = _UNPK_ mod - -moduleNameUserString :: ModuleName -> UserString -moduleNameUserString (ModuleName mod) = decode (_UNPK_ mod) - --- used to be called mkSrcModule -mkModuleName :: UserString -> ModuleName -mkModuleName s = ModuleName (_PK_ (encode s)) - --- used to be called mkSrcModuleFS -mkModuleNameFS :: UserFS -> ModuleName -mkModuleNameFS s = ModuleName (encodeFS s) - --- used to be called mkSysModuleFS -mkSysModuleNameFS :: EncodedFS -> ModuleName -mkSysModuleNameFS s = ModuleName s -\end{code} - -\begin{code} instance Outputable Module where ppr = pprModule -instance Uniquable Module where - getUnique (Module nm _) = getUnique nm - --- Same if they have the same name. -instance Eq Module where - m1 == m2 = getUnique m1 == getUnique m2 - --- Warning: gives an ordering relation based on the uniques of the --- FastStrings which are the (encoded) module names. This is _not_ --- a lexicographical ordering. -instance Ord Module where - m1 `compare` m2 = getUnique m1 `compare` getUnique m2 -\end{code} +pprModule :: Module -> SDoc +pprModule (Module nm) = + getPprStyle $ \ sty -> + if codeStyle sty + then ftext (zEncodeFS nm) + else ftext nm +moduleFS :: Module -> FastString +moduleFS (Module mod) = mod -\begin{code} -pprModule :: Module -> SDoc -pprModule (Module mod p) = getPprStyle $ \ sty -> - if debugStyle sty then - -- Print the package too - ppr p <> dot <> pprModuleName mod - else - pprModuleName mod -\end{code} +moduleString :: Module -> String +moduleString (Module mod) = unpackFS mod +-- used to be called mkSrcModule +mkModule :: String -> Module +mkModule s = Module (mkFastString s) -\begin{code} -mkModule :: ModuleName -> ModuleKind -> Module -mkModule = Module --- I don't think anybody except the Finder should ever try to create a --- Module now, so this lot commented out pro tem (JRS) ---mkModule :: ModuleName -- Name of the module --- -> PackageName --- -> Module ---mkModule mod_nm pack_name --- = Module mod_nm pack_info --- where --- pack_info | pack_name == opt_InPackage = ThisPackage --- | otherwise = AnotherPackage pack_name - - --- Used temporarily when we first come across Foo.x in an interface --- file, but before we've opened Foo.hi. --- (Until we've opened Foo.hi we don't know what the PackageInfo is.) -mkVanillaModule :: ModuleName -> Module -mkVanillaModule name = Module name (panic "mkVanillaModule:unknown mod_kind field") - ---mkThisModule :: ModuleName -> Module -- The module being compiled ---mkThisModule name = Module name ThisPackage - -mkPrelModule :: ModuleName -> Module -mkPrelModule name = Module name preludePackage - -moduleString :: Module -> EncodedString -moduleString (Module (ModuleName fs) _) = _UNPK_ fs - -moduleUserString :: Module -> UserString -moduleUserString (Module mod _) = moduleNameUserString mod - -isLocalModule :: Module -> Bool -isLocalModule (Module nm kind) = isLocalModuleKind kind +-- used to be called mkSrcModuleFS +mkModuleFS :: FastString -> Module +mkModuleFS s = Module s \end{code} %************************************************************************ @@ -276,6 +163,7 @@ emptyModuleEnv :: ModuleEnv a mkModuleEnv :: [(Module, a)] -> ModuleEnv a unitModuleEnv :: Module -> a -> ModuleEnv a extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a +extendModuleEnv_C :: (a->a->a) -> ModuleEnv a -> Module -> a -> ModuleEnv a plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a @@ -283,16 +171,19 @@ delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b -rngModuleEnv :: ModuleEnv a -> [a] +moduleEnvElts :: ModuleEnv a -> [a] isEmptyModuleEnv :: ModuleEnv a -> Bool -lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a +lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a elemModuleEnv :: Module -> ModuleEnv a -> Bool foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b +filterModuleEnv :: (a -> Bool) -> ModuleEnv a -> ModuleEnv a +filterModuleEnv = filterUFM elemModuleEnv = elemUFM extendModuleEnv = addToUFM +extendModuleEnv_C = addToUFM_C extendModuleEnvList = addListToUFM plusModuleEnv_C = plusUFM_C delModuleEnvList = delListFromUFM @@ -303,8 +194,23 @@ lookupWithDefaultModuleEnv = lookupWithDefaultUFM mapModuleEnv = mapUFM mkModuleEnv = listToUFM emptyModuleEnv = emptyUFM -rngModuleEnv = eltsUFM +moduleEnvElts = eltsUFM unitModuleEnv = unitUFM isEmptyModuleEnv = isNullUFM foldModuleEnv = foldUFM \end{code} + +\begin{code} +type ModuleSet = UniqSet Module +mkModuleSet :: [Module] -> ModuleSet +extendModuleSet :: ModuleSet -> Module -> ModuleSet +emptyModuleSet :: ModuleSet +moduleSetElts :: ModuleSet -> [Module] +elemModuleSet :: Module -> ModuleSet -> Bool + +emptyModuleSet = emptyUniqSet +mkModuleSet = mkUniqSet +extendModuleSet = addOneToUniqSet +moduleSetElts = uniqSetToList +elemModuleSet = elementOfUniqSet +\end{code}