X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FPackages.lhs;h=08e86f4199d668c2b921f17addcad1dd40d64da4;hb=8f0c89cbbbad60c4f05356fcb9053b7ed0c18075;hp=190a1f8a2b347476c02221d570721d05beb51c30;hpb=f58fd1c755e17002102c84436f9803c4a1c4c4d0;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Packages.lhs b/ghc/compiler/main/Packages.lhs
index 190a1f8..08e86f4 100644
--- a/ghc/compiler/main/Packages.lhs
+++ b/ghc/compiler/main/Packages.lhs
@@ -4,11 +4,18 @@
 \section{Package manipulation}
 
 \begin{code}
-module Packages ( PackageConfig(..), 
-		  defaultPackageConfig,
-		  mungePackagePaths,
-		  showPackages
-		)
+module Packages (
+	PackageConfig(..), 
+	defaultPackageConfig,
+	mungePackagePaths, packageDependents, 
+	showPackages,
+
+	PackageName,		-- Instance of Outputable
+	mkPackageName, packageNameString,
+	basePackage, rtsPackage, haskell98Package, thPackage,	-- :: PackageName
+
+	PackageConfigMap, emptyPkgMap, extendPkgMap, lookupPkg
+    )
 where
 
 #include "HsVersions.h"
@@ -19,8 +26,16 @@ import CmdLineOpts	( dynFlag, verbosity )
 import DriverUtil	( my_prefix_match )
 import ErrUtils		( dumpIfSet )
 import Outputable	( docToSDoc )
+import FastString
+import UniqFM
 \end{code}
 
+%*********************************************************
+%*						 	 *
+\subsection{Basic data types}
+%*							 *
+%*********************************************************
+
 \begin{code}
 #define WANT_PRETTY
 #define INTERNAL_PRETTY
@@ -29,9 +44,52 @@ import Outputable	( docToSDoc )
 
 -- There's a blob of code shared with ghc-pkg, 
 -- so we just include it from there 
+-- Primarily it defines
+--	PackageConfig (a record)
+--	PackageName   (FastString)
+
 #include "../utils/ghc-pkg/Package.hs"
 \end{code}
 
+\begin{code}
+type PackageName = FastString	-- No encoding at all
+
+mkPackageName :: String -> PackageName
+mkPackageName = mkFastString
+
+packageNameString :: PackageName -> String
+packageNameString = unpackFS
+
+rtsPackage, basePackage, haskell98Package, thPackage :: PackageName
+basePackage      = FSLIT("base")
+rtsPackage 	 = FSLIT("rts")
+haskell98Package = FSLIT("haskell98")
+thPackage        = FSLIT("haskell-src")	-- Template Haskell libraries in here
+
+packageDependents :: PackageConfig -> [PackageName]
+-- Impedence matcher, because PackageConfig has Strings 
+-- not PackageNames at the moment.  Sigh.
+packageDependents pkg = map mkPackageName (package_deps pkg)
+\end{code}
+
+A PackageConfigMap maps a PackageName to a PackageConfig
+
+\begin{code}
+type PackageConfigMap = UniqFM PackageConfig
+
+lookupPkg    :: PackageConfigMap -> PackageName -> Maybe PackageConfig
+emptyPkgMap  :: PackageConfigMap
+
+emptyPkgMap  = emptyUFM
+lookupPkg    = lookupUFM
+
+extendPkgMap :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
+extendPkgMap pkg_map new_pkgs 
+  = foldl add pkg_map new_pkgs
+  where
+    add pkg_map p = addToUFM pkg_map (mkFastString (name p)) p
+\end{code}
+
 %*********************************************************
 %*						 	 *
 \subsection{Load the config file}
@@ -64,11 +122,13 @@ mungePackagePaths top_dir ps = map munge_pkg ps
 %*********************************************************
 
 \begin{code}
-showPackages :: [PackageConfig] -> IO ()
+showPackages :: PackageConfigMap -> IO ()
 -- Show package info on console, if verbosity is >= 3
-showPackages ps
+showPackages pkg_map
   = do  { verb <- dynFlag verbosity
 	; dumpIfSet (verb >= 3) "Packages"
 	  	    (docToSDoc (vcat (map dumpPkgGuts ps)))
 	}
+  where
+    ps = eltsUFM pkg_map
 \end{code}