X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FPackages.lhs;h=ef4a6e4b8e7ba4d10070425290a55f663cc53e30;hb=70b6c54b3c140d96b69287f8f400f88a0b7e9c18;hp=d049dd43d81297a68914bec2093d71f3034d0265;hpb=6d07d7864cd539c34a6bdf5b298a091b31aaea5b;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Packages.lhs b/ghc/compiler/main/Packages.lhs
index d049dd4..ef4a6e4 100644
--- a/ghc/compiler/main/Packages.lhs
+++ b/ghc/compiler/main/Packages.lhs
@@ -7,36 +7,33 @@
 module Packages (
 	PackageConfig(..), 
 	defaultPackageConfig,
-	mungePackagePaths, packageDependents, 
+	packageDependents, 
 	showPackages,
 
 	PackageName,		-- Instance of Outputable
 	mkPackageName, packageNameString,
-	preludePackage, rtsPackage, stdPackage, haskell98Package,	-- :: PackageName
+	basePackage, rtsPackage, haskell98Package, thPackage, -- :: PackageName
 
-	PackageConfigMap, emptyPkgMap, extendPkgMap, lookupPkg
+	PackageConfigMap, emptyPkgMap, lookupPkg,
+	extendPackageConfigMap, getPackageDetails, getPackageConfigMap,
     )
 where
 
 #include "HsVersions.h"
 
-import Pretty
-
 import CmdLineOpts	( dynFlag, verbosity )
-import DriverUtil	( my_prefix_match )
 import ErrUtils		( dumpIfSet )
 import Outputable	( docToSDoc )
 import FastString
 import UniqFM
-\end{code}
+import Util
+import Pretty
 
-%*********************************************************
-%*						 	 *
-\subsection{Basic data types}
-%*							 *
-%*********************************************************
+import DATA_IOREF
+
+-- -----------------------------------------------------------------------------
+-- The PackageConfig type
 
-\begin{code}
 #define WANT_PRETTY
 #define INTERNAL_PRETTY
 -- Yes, do generate pretty-printing stuff for packages, and use our
@@ -44,14 +41,13 @@ import UniqFM
 
 -- 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)
+-- Primarily it defines	PackageConfig (a record)
 
 #include "../utils/ghc-pkg/Package.hs"
-\end{code}
 
-\begin{code}
+-- -----------------------------------------------------------------------------
+-- Package names
+
 type PackageName = FastString	-- No encoding at all
 
 mkPackageName :: String -> PackageName
@@ -60,23 +56,24 @@ mkPackageName = mkFastString
 packageNameString :: PackageName -> String
 packageNameString = unpackFS
 
-rtsPackage, preludePackage, haskell98Package :: PackageName
-preludePackage   = FSLIT("base")
+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
+-- -----------------------------------------------------------------------------
+-- A PackageConfigMap maps a PackageName to a PackageConfig
 
-\begin{code}
 type PackageConfigMap = UniqFM PackageConfig
 
 lookupPkg    :: PackageConfigMap -> PackageName -> Maybe PackageConfig
+
 emptyPkgMap  :: PackageConfigMap
 
 emptyPkgMap  = emptyUFM
@@ -87,40 +84,26 @@ 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}
-%*							 *
-%*********************************************************
+GLOBAL_VAR(v_Package_details, emptyPkgMap, PackageConfigMap)
 
-\begin{code}
-mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
--- Replace the string "$libdir" at the beginning of a path
--- with the current libdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
- where 
-  munge_pkg p = p{ import_dirs  = munge_paths (import_dirs p),
-		   include_dirs = munge_paths (include_dirs p),
-    		   library_dirs = munge_paths (library_dirs p),
-		   framework_dirs = munge_paths (framework_dirs p) }
-
-  munge_paths = map munge_path
-
-  munge_path p 
-	  | Just p' <- my_prefix_match "$libdir" p = top_dir ++ p'
-	  | otherwise				   = p
-\end{code}
+getPackageConfigMap :: IO PackageConfigMap
+getPackageConfigMap = readIORef v_Package_details
 
+extendPackageConfigMap :: [PackageConfig] -> IO ()
+extendPackageConfigMap pkg_configs = do
+  old_pkg_map <- readIORef v_Package_details
+  writeIORef v_Package_details (extendPkgMap old_pkg_map pkg_configs)
 
-%*********************************************************
-%*						 	 *
-\subsection{Display results}
-%*							 *
-%*********************************************************
+getPackageDetails :: [PackageName] -> IO [PackageConfig]
+getPackageDetails ps = do
+  pkg_details <- getPackageConfigMap
+  return [ pkg | Just pkg <- map (lookupPkg pkg_details) ps ]
+
+
+-- -----------------------------------------------------------------------------
+-- Displaying packages
 
-\begin{code}
 showPackages :: PackageConfigMap -> IO ()
 -- Show package info on console, if verbosity is >= 3
 showPackages pkg_map
@@ -130,4 +113,5 @@ showPackages pkg_map
 	}
   where
     ps = eltsUFM pkg_map
+
 \end{code}