remove empty dir
[ghc-hetmet.git] / ghc / compiler / basicTypes / Module.lhs
index 6e9a7d5..6952162 100644 (file)
 %
-% (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}