%
% (c) The University of Glasgow, 2004-2006
%

Module
~~~~~~~~~~
Simply the name of a module, represented as a FastString.
These are Uniquable, hence we can build FiniteMaps with Modules as
the keys.

\begin{code}
module Module 
    (
	-- * The ModuleName type
	ModuleName,
	pprModuleName,
	moduleNameFS,
	moduleNameString,
        moduleNameSlashes,
	mkModuleName,
	mkModuleNameFS,
	stableModuleNameCmp,

        -- * The PackageId type
        PackageId,
        fsToPackageId,
        packageIdFS,
        stringToPackageId,
        packageIdString,
	stablePackageIdCmp,

	-- * Wired-in PackageIds
	-- $wired_in_packages
	primPackageId,
	integerPackageId,
	basePackageId,
	rtsPackageId,
	haskell98PackageId,
	thPackageId,
        dphSeqPackageId,
        dphParPackageId,
	mainPackageId,

	-- * The Module type
	Module,
	modulePackageId, moduleName,
	pprModule,
	mkModule,
        stableModuleCmp,

	-- * The ModuleLocation type
	ModLocation(..),
	addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,

	-- * Module mappings
    	ModuleEnv,
	elemModuleEnv, extendModuleEnv, extendModuleEnvList, 
	extendModuleEnvList_C, plusModuleEnv_C,
	delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
	lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
	moduleEnvKeys, moduleEnvElts, moduleEnvToList,
        unitModuleEnv, isEmptyModuleEnv,
        foldModuleEnv, extendModuleEnv_C, filterModuleEnv,

	-- * ModuleName mappings
	ModuleNameEnv,

	-- * Sets of Modules
	ModuleSet, 
	emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
    ) where

import Config
import Outputable
import qualified Pretty
import Unique
import FiniteMap
import LazyUniqFM
import FastString
import Binary
import Util

import System.FilePath
\end{code}

%************************************************************************
%*									*
\subsection{Module locations}
%*									*
%************************************************************************

\begin{code}
-- | Where a module lives on the file system: the actual locations
-- of the .hs, .hi and .o files, if we have them
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.  

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}
addBootSuffix :: FilePath -> FilePath
-- ^ Add the @-boot@ suffix to .hs, .hi and .o files
addBootSuffix path = path ++ "-boot"

addBootSuffix_maybe :: Bool -> FilePath -> FilePath
-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
addBootSuffix_maybe is_boot path
 | is_boot   = addBootSuffix path
 | otherwise = path

addBootSuffixLocn :: ModLocation -> ModLocation
-- ^ Add the @-boot@ suffix to all file paths associated with the module
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}


%************************************************************************
%*									*
\subsection{The name of a module}
%*									*
%************************************************************************

\begin{code}
-- | A ModuleName is essentially a simple string, e.g. @Data.List@.
newtype ModuleName = ModuleName FastString

instance Uniquable ModuleName where
  getUnique (ModuleName nm) = getUnique nm

instance Eq ModuleName 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
  nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2

instance Outputable ModuleName where
  ppr = pprModuleName

instance Binary ModuleName where
  put_ bh (ModuleName fs) = put_ bh fs
  get bh = do fs <- get bh; return (ModuleName fs)

stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
-- ^ Compares module names lexically, rather than by their 'Unique's
stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2

pprModuleName :: ModuleName -> SDoc
pprModuleName (ModuleName nm) = 
    getPprStyle $ \ sty ->
    if codeStyle sty 
	then ftext (zEncodeFS nm)
	else ftext nm

moduleNameFS :: ModuleName -> FastString
moduleNameFS (ModuleName mod) = mod

moduleNameString :: ModuleName -> String
moduleNameString (ModuleName mod) = unpackFS mod

mkModuleName :: String -> ModuleName
mkModuleName s = ModuleName (mkFastString s)

mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS s = ModuleName s

-- | Returns the string version of the module name, with dots replaced by slashes
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes = dots_to_slashes . moduleNameString
  where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
\end{code}

%************************************************************************
%*									*
\subsection{A fully qualified module}
%*									*
%************************************************************************

\begin{code}
-- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
data Module = Module {
   modulePackageId :: !PackageId,  -- pkg-1.0
   moduleName      :: !ModuleName  -- A.B.C
  }
  deriving (Eq, Ord)

instance Uniquable Module where
  getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)

instance Outputable Module where
  ppr = pprModule

instance Binary Module where
  put_ bh (Module p n) = put_ bh p >> put_ bh n
  get bh = do p <- get bh; n <- get bh; return (Module p n)

-- | This gives a stable ordering, as opposed to the Ord instance which
-- gives an ordering based on the 'Unique's of the components, which may
-- not be stable from run to run of the compiler.
stableModuleCmp :: Module -> Module -> Ordering
stableModuleCmp (Module p1 n1) (Module p2 n2) 
   = (p1 `stablePackageIdCmp`  p2) `thenCmp`
     (n1 `stableModuleNameCmp` n2)

mkModule :: PackageId -> ModuleName -> Module
mkModule = Module

pprModule :: Module -> SDoc
pprModule mod@(Module p n)  = pprPackagePrefix p mod <> pprModuleName n

pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
pprPackagePrefix p mod = getPprStyle doc
 where
   doc sty
       | codeStyle sty = 
          if p == mainPackageId 
                then empty -- never qualify the main package in code
                else ftext (zEncodeFS (packageIdFS p)) <> char '_'
       | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
                -- the PrintUnqualified tells us which modules have to
                -- be qualified with package names
       | otherwise = empty
\end{code}

%************************************************************************
%*                                                                      *
\subsection{PackageId}
%*                                                                      *
%************************************************************************

\begin{code}
-- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
newtype PackageId = PId FastString deriving( Eq )
    -- here to avoid module loops with PackageConfig

instance Uniquable PackageId where
 getUnique pid = getUnique (packageIdFS pid)

-- Note: *not* a stable lexicographic ordering, a faster unique-based
-- ordering.
instance Ord PackageId where
  nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2

stablePackageIdCmp :: PackageId -> PackageId -> Ordering
-- ^ Compares package ids lexically, rather than by their 'Unique's
stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2

instance Outputable PackageId where
   ppr pid = text (packageIdString pid)

instance Binary PackageId where
  put_ bh pid = put_ bh (packageIdFS pid)
  get bh = do { fs <- get bh; return (fsToPackageId fs) }

fsToPackageId :: FastString -> PackageId
fsToPackageId = PId

packageIdFS :: PackageId -> FastString
packageIdFS (PId fs) = fs

stringToPackageId :: String -> PackageId
stringToPackageId = fsToPackageId . mkFastString

packageIdString :: PackageId -> String
packageIdString = unpackFS . packageIdFS


-- -----------------------------------------------------------------------------
-- $wired_in_packages
-- Certain packages are known to the compiler, in that we know about certain
-- entities that reside in these packages, and the compiler needs to 
-- declare static Modules and Names that refer to these packages.  Hence
-- the wired-in packages can't include version numbers, since we don't want
-- to bake the version numbers of these packages into GHC.
--
-- So here's the plan.  Wired-in packages are still versioned as
-- normal in the packages database, and you can still have multiple
-- versions of them installed.  However, for each invocation of GHC,
-- only a single instance of each wired-in package will be recognised
-- (the desired one is selected via @-package@\/@-hide-package@), and GHC
-- will use the unversioned 'PackageId' below when referring to it,
-- including in .hi files and object file symbols.  Unselected
-- versions of wired-in packages will be ignored, as will any other
-- package that depends directly or indirectly on it (much as if you
-- had used @-ignore-package@).

-- Make sure you change 'Packages.findWiredInPackages' if you add an entry here

integerPackageId, primPackageId,
  basePackageId, rtsPackageId, haskell98PackageId,
  thPackageId, dphSeqPackageId, dphParPackageId,
  mainPackageId  :: PackageId
primPackageId      = fsToPackageId (fsLit "ghc-prim")
integerPackageId   = fsToPackageId (fsLit cIntegerLibrary)
basePackageId      = fsToPackageId (fsLit "base")
rtsPackageId	   = fsToPackageId (fsLit "rts")
haskell98PackageId = fsToPackageId (fsLit "haskell98")
thPackageId        = fsToPackageId (fsLit "template-haskell")
dphSeqPackageId    = fsToPackageId (fsLit "dph-seq")
dphParPackageId    = fsToPackageId (fsLit "dph-par")

-- | This is the package Id for the current program.  It is the default
-- package Id if you don't specify a package name.  We don't add this prefix
-- to symbol names, since there can be only one main package per program.
mainPackageId	   = fsToPackageId (fsLit "main")
\end{code}

%************************************************************************
%*                                                                      *
\subsection{@ModuleEnv@s}
%*                                                                      *
%************************************************************************

\begin{code}
-- | A map keyed off of 'Module's
newtype ModuleEnv elt = ModuleEnv (FiniteMap Module elt)

filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
filterModuleEnv f (ModuleEnv e) = ModuleEnv (filterFM f e)

elemModuleEnv :: Module -> ModuleEnv a -> Bool
elemModuleEnv m (ModuleEnv e) = elemFM m e

extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ModuleEnv e) m x = ModuleEnv (addToFM e m x)

extendModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv_C f (ModuleEnv e) m x = ModuleEnv (addToFM_C f e m x)

extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (addListToFM e xs)

extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
                      -> ModuleEnv a
extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (addListToFM_C f e xs)

plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM_C f e1 e2)

delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
delModuleEnvList (ModuleEnv e) ms = ModuleEnv (delListFromFM e ms)

delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
delModuleEnv (ModuleEnv e) m = ModuleEnv (delFromFM e m)

plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM e1 e2)

lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
lookupModuleEnv (ModuleEnv e) m = lookupFM e m

lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
lookupWithDefaultModuleEnv (ModuleEnv e) x m = lookupWithDefaultFM e x m

mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv f (ModuleEnv e) = ModuleEnv (mapFM (\_ v -> f v) e)

mkModuleEnv :: [(Module, a)] -> ModuleEnv a
mkModuleEnv xs = ModuleEnv (listToFM xs)

emptyModuleEnv :: ModuleEnv a
emptyModuleEnv = ModuleEnv emptyFM

moduleEnvKeys :: ModuleEnv a -> [Module]
moduleEnvKeys (ModuleEnv e) = keysFM e

moduleEnvElts :: ModuleEnv a -> [a]
moduleEnvElts (ModuleEnv e) = eltsFM e

moduleEnvToList :: ModuleEnv a -> [(Module, a)]
moduleEnvToList (ModuleEnv e) = fmToList e

unitModuleEnv :: Module -> a -> ModuleEnv a
unitModuleEnv m x = ModuleEnv (unitFM m x)

isEmptyModuleEnv :: ModuleEnv a -> Bool
isEmptyModuleEnv (ModuleEnv e) = isEmptyFM e

foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
foldModuleEnv f x (ModuleEnv e) = foldFM (\_ v -> f v) x e
\end{code}

\begin{code}
-- | A set of 'Module's
type ModuleSet = FiniteMap Module ()

mkModuleSet	:: [Module] -> ModuleSet
extendModuleSet :: ModuleSet -> Module -> ModuleSet
emptyModuleSet  :: ModuleSet
moduleSetElts   :: ModuleSet -> [Module]
elemModuleSet   :: Module -> ModuleSet -> Bool

emptyModuleSet    = emptyFM
mkModuleSet ms    = listToFM [(m,()) | m <- ms ]
extendModuleSet s m = addToFM s m ()
moduleSetElts     = keysFM
elemModuleSet     = elemFM
\end{code}

A ModuleName has a Unique, so we can build mappings of these using
UniqFM.

\begin{code}
-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
type ModuleNameEnv elt = UniqFM elt
\end{code}