[project @ 2004-11-26 16:19:45 by simonmar]

Further integration with the new package story.  GHC now supports
pretty much everything in the package proposal.

  - GHC now works in terms of PackageIds (<pkg>-<version>) rather than
    just package names.  You can still specify package names without
    versions on the command line, as long as the name is unambiguous.

  - GHC understands hidden/exposed modules in a package, and will refuse
    to import a hidden module.  Also, the hidden/eposed status of packages
    is taken into account.

  - I had to remove the old package syntax from ghc-pkg, backwards
    compatibility isn't really practical.

  - All the package.conf.in files have been rewritten in the new syntax,
    and contain a complete list of modules in the package.  I've set all
    the versions to 1.0 for now - please check your package(s) and fix the
    version number & other info appropriately.

  - New options:

	-hide-package P    sets the expose flag on package P to False
	-ignore-package P  unregisters P for this compilation

	For comparison, -package P sets the expose flag on package P
        to True, and also causes P to be linked in eagerly.

        -package-name is no longer officially supported.  Unofficially, it's
	a synonym for -ignore-package, which has more or less the same effect
	as -package-name used to.

	Note that a package may be hidden and yet still be linked into
	the program, by virtue of being a dependency of some other package.
	To completely remove a package from the compiler's internal database,
        use -ignore-package.

	The compiler will complain if any two packages in the
        transitive closure of exposed packages contain the same
        module.

	You *must* use -ignore-package P when compiling modules for
        package P, if package P (or an older version of P) is already
        registered.  The compiler will helpfully complain if you don't.
	The fptools build system does this.

   - Note: the Cabal library won't work yet.  It still thinks GHC uses
     the old package config syntax.

Internal changes/cleanups:

   - The ModuleName type has gone away.  Modules are now just (a
     newtype of) FastStrings, and don't contain any package information.
     All the package-related knowledge is in DynFlags, which is passed
     down to where it is needed.

   - DynFlags manipulation has been cleaned up somewhat: there are no
     global variables holding DynFlags any more, instead the DynFlags
     are passed around properly.

   - There are a few less global variables in GHC.  Lots more are
     scheduled for removal.

   - -i is now a dynamic flag, as are all the package-related flags (but
     using them in {-# OPTIONS #-} is Officially Not Recommended).

   - make -j now appears to work under fptools/libraries/.  Probably
     wouldn't take much to get it working for a whole build.

3 files changed, 71 insertions, 301 deletions

diff --git a/ghc/utils/ghc-pkg/Main.hs b/ghc/utils/ghc-pkg/Main.hs
index b83dd8eb3c..5be72dcb84 100644
--- a/ghc/utils/ghc-pkg/Main.hs
+++ b/ghc/utils/ghc-pkg/Main.hs
@@ -19,8 +19,8 @@ module Main (main) where
 import Version	( version, targetOS, targetARCH )
 import Distribution.InstalledPackageInfo
 import Distribution.Compat.ReadP
+import Distribution.ParseUtils	( showError )
 import Distribution.Package
-import Distribution.License
 import Distribution.Version
 import Compat.Directory 	( getAppUserDataDirectory )
 import Control.Exception	( evaluate )
@@ -28,8 +28,6 @@ import qualified Control.Exception as Exception
 
 import Prelude
 
-import Package -- the old package config type
-
 #if __GLASGOW_HASKELL__ < 603
 #include "config.h"
 #endif
@@ -47,15 +45,13 @@ import qualified Exception
 import Data.Char	( isSpace )
 import Monad
 import Directory
-import System	( getEnv, getArgs, getProgName,
+import System	( getArgs, getProgName,
 		  system, exitWith,
 		  ExitCode(..)
 		)
 import IO
 import List ( isPrefixOf, isSuffixOf )
 
-import ParsePkgConfLite
-
 #include "../../includes/ghcconfig.h"
 
 #ifdef mingw32_HOST_OS
@@ -319,14 +315,14 @@ registerPackage input defines db_stack auto_ghci_libs update force = do
 	putStr "Reading package info from stdin... "
         getContents
       f   -> do
-        putStr ("Reading package info from " ++ show f)
+        putStr ("Reading package info from " ++ show f ++ " ")
 	readFile f
 
   pkg <- parsePackageInfo s defines force
   putStrLn "done."
 
   validatePackageConfig pkg db_stack auto_ghci_libs update force
-  new_details <- updatePackageDB (snd db_to_operate_on) pkg
+  new_details <- updatePackageDB db_stack (snd db_to_operate_on) pkg
   savePackageConfig db_filename
   maybeRestoreOldConfig db_filename $
     writeNewConfig db_filename new_details
@@ -339,67 +335,11 @@ parsePackageInfo
 parsePackageInfo str defines force =
   case parseInstalledPackageInfo str of
     Right ok -> return ok
-    Left err -> do
-	old_pkg <- evaluate (parseOnePackageConfig str)
-		 	    `Exception.catch` \_ -> parse_failed
-	putStr "Expanding embedded variables... "
-	new_old_pkg <- expandEnvVars old_pkg defines force
-	return (convertOldPackage old_pkg)
- where
-   parse_failed = die "parse error in package info\n"
-
-convertOldPackage :: PackageConfig -> InstalledPackageInfo
-convertOldPackage
-   Package {
-	name 		= name,
-	auto 		= auto,
-	import_dirs     = import_dirs,
-	source_dirs     = source_dirs,
-	library_dirs    = library_dirs,
-	hs_libraries    = hs_libraries,
-	extra_libraries = extra_libraries,
-	include_dirs    = include_dirs,
-	c_includes      = c_includes,
-	package_deps    = package_deps,
-	extra_ghc_opts  = extra_ghc_opts,
-	extra_cc_opts   = extra_cc_opts,
-	extra_ld_opts   = extra_ld_opts,
-	framework_dirs  = framework_dirs,
-	extra_frameworks= extra_frameworks
-    }
-   = InstalledPackageInfo {
-        package          = pkgNameToId name,
-        license          = AllRightsReserved,
-        copyright        = "",
-        maintainer       = "",
-	author		 = "",
-        stability        = "",
-	homepage	 = "",
-	pkgUrl		 = "",
-	description	 = "",
-	category	 = "",
-        exposed          = auto,
-	exposedModules	 = [],
-	hiddenModules    = [],
-        importDirs       = import_dirs,
-        libraryDirs      = library_dirs,
-        hsLibraries      = hs_libraries,
-        extraLibraries   = extra_libraries,
-        includeDirs      = include_dirs,
-        includes	 = c_includes,
-        depends          = map pkgNameToId package_deps,
-        extraHugsOpts    = [],
-        extraCcOpts      = extra_cc_opts,
-        extraLdOpts      = extra_ld_opts,
-        frameworkDirs    = framework_dirs,
-        extraFrameworks  = extra_frameworks,
-	haddockInterfaces = [],
-	haddockHTMLs      = []
-    }
-
-
--- Used for converting old versionless package names to new PackageIdentifiers.
--- "Version [] []" is special: it means "no version" or "any version"
+    Left err -> die (showError err ++ "\n")
+
+-- Used for converting versionless package names to new
+-- PackageIdentifiers.  "Version [] []" is special: it means "no
+-- version" or "any version"
 pkgNameToId :: String -> PackageIdentifier
 pkgNameToId name = PackageIdentifier name (Version [] [])
 
@@ -603,12 +543,15 @@ checkDep db_stack force pkgid
   where
 	-- for backwards compat, we treat 0.0 as a special version,
 	-- and don't check that it actually exists.
- 	real_version = versionBranch (pkgVersion pkgid) /= []
+ 	real_version = realVersion pkgid
 	
 	all_pkgs = concat (map snd db_stack)
 	pkgids = map package all_pkgs
 	pkg_names = map pkgName pkgids
 
+realVersion :: PackageIdentifier -> Bool
+realVersion pkgid = versionBranch (pkgVersion pkgid) /= []
+
 checkHSLib :: [String] -> Bool -> Bool -> String -> IO ()
 checkHSLib dirs auto_ghci_libs force lib = do
   let batch_lib_file = "lib" ++ lib ++ ".a"
@@ -660,11 +603,25 @@ autoBuildGHCiLib dir batch_file ghci_file = do
 -- Updating the DB with the new package.
 
 updatePackageDB
-	:: [InstalledPackageInfo]
+	:: PackageDBStack
+	-> [InstalledPackageInfo]
 	-> InstalledPackageInfo
 	-> IO [InstalledPackageInfo]
-updatePackageDB pkgs new_pkg = do
+updatePackageDB db_stack pkgs new_pkg = do
   let
+	-- we update dependencies without version numbers to
+	-- match the actual versions of the relevant packages instaled.
+	updateDeps p = p{depends = map resolveDep (depends p)}
+
+	resolveDep pkgid
+	   | realVersion pkgid  = pkgid
+	   | otherwise		= lookupDep (pkgName pkgid)
+	
+	lookupDep name
+	   = head [ pid | p <- concat (map snd db_stack), 
+			  let pid = package p,
+			  pkgName pid == name ]
+
 	is_exposed = exposed new_pkg
 	pkgid      = package new_pkg
 	name       = pkgName pkgid
@@ -679,7 +636,45 @@ updatePackageDB pkgs new_pkg = do
 	  | is_exposed && pkgName (package p) == name = p{ exposed = False }
 	  | otherwise = p
   --
-  return (pkgs'++[new_pkg])
+  return (pkgs'++[updateDeps new_pkg])
+
+-- -----------------------------------------------------------------------------
+-- Searching for modules
+
+#if not_yet
+
+findModules :: [FilePath] -> IO [String]
+findModules paths = 
+  mms <- mapM searchDir paths
+  return (concat mms)
+
+searchDir path prefix = do
+  fs <- getDirectoryEntries path `catch` \_ -> return []
+  searchEntries path prefix fs
+
+searchEntries path prefix [] = return []
+searchEntries path prefix (f:fs)
+  | looks_like_a_module  =  do
+	ms <- searchEntries path prefix fs
+	return (prefix `joinModule` f : ms)
+  | looks_like_a_component  =  do
+        ms <- searchDir (path `joinFilename` f) (prefix `joinModule` f)
+        ms' <- searchEntries path prefix fs
+	return (ms ++ ms')	
+  | otherwise
+	searchEntries path prefix fs
+
+  where
+	(base,suffix) = splitFileExt f
+	looks_like_a_module = 
+		suffix `elem` haskell_suffixes && 
+		all okInModuleName base
+	looks_like_a_component =
+		null suffix && all okInModuleName base
+
+okInModuleName c
+
+#endif
 
 -- -----------------------------------------------------------------------------
 -- The old command-line syntax, supported for backwards compatibility
@@ -776,6 +771,8 @@ oldRunit clis = do
 
 -- ---------------------------------------------------------------------------
 
+#ifdef OLD_STUFF
+-- ToDo: reinstate
 expandEnvVars :: PackageConfig -> [(String, String)]
 	-> Bool -> IO PackageConfig
 expandEnvVars pkg defines force = do
@@ -859,6 +856,7 @@ wordsBy :: (Char -> Bool) -> String -> [String]
 wordsBy p s = case dropWhile p s of
   "" -> []
   s' -> w : wordsBy p s'' where (w,s'') = break p s'
+#endif
 
 -----------------------------------------------------------------------------
 
diff --git a/ghc/utils/ghc-pkg/Package.hs b/ghc/utils/ghc-pkg/Package.hs
deleted file mode 100644
index c43fd6e4e5..0000000000
--- a/ghc/utils/ghc-pkg/Package.hs
+++ /dev/null
@@ -1,100 +0,0 @@
------------------------------------------------------------------------------
---
--- (c) The University of Glasgow 2004
---
--- BACKWARDS COMPATIBILITY only.  This is the old (pre-6.4) package
--- configuration type, which is still accepted by ghc-pkg for
--- compatibility.  The new type is InstalledPackageInfo from the
--- Distribution.InstalledPackageInfo module.
---
------------------------------------------------------------------------------
-
-module Package ( 
-	PackageConfig(..), defaultPackageConfig
-	, listPkgs	 	-- :: [PackageConfig] -> String
-	, dumpPackages		-- :: [PackageConfig] -> String
-	, dumpPkgGuts		-- :: PackageConfig -> Doc
-	, dumpFieldContents	-- :: [String] -> Doc
- ) where
-
-#if __GLASGOW_HASKELL__ >= 504 && !defined(INTERNAL_PRETTY)
-import Text.PrettyPrint
-#else
-import Pretty
-#endif
-
-data PackageConfig
-   = Package {
-	name            :: String,
-	auto		:: Bool,
-	import_dirs     :: [String],
-	source_dirs     :: [String],
-	library_dirs    :: [String],
-	hs_libraries    :: [String],
-	extra_libraries :: [String],
-	include_dirs    :: [String],
-	c_includes      :: [String],
-	package_deps    :: [String],
-	extra_ghc_opts  :: [String],
-	extra_cc_opts   :: [String],
-	extra_ld_opts   :: [String],
-	framework_dirs  :: [String], -- ignored everywhere but on Darwin/MacOS X
-	extra_frameworks:: [String]  -- ignored everywhere but on Darwin/MacOS X
-     }
-
-defaultPackageConfig
-   = Package {
-	name = error "defaultPackage",
-	auto = False,
-	import_dirs     = [],
-	source_dirs     = [],
-	library_dirs    = [],
-	hs_libraries    = [],
-	extra_libraries = [],
-	include_dirs    = [],
-	c_includes      = [],
-	package_deps    = [],
-	extra_ghc_opts  = [],
-	extra_cc_opts   = [],
-	extra_ld_opts   = [],
-	framework_dirs  = [],
-	extra_frameworks= []
-    }
-
------------------------------------------------------------------------------
--- Pretty printing package info
-
-listPkgs :: [PackageConfig] -> String
-listPkgs pkgs = render (fsep (punctuate comma (map (text . name) pkgs)))
-
-dumpPackages :: [PackageConfig] -> String
-dumpPackages pkgs = 
-   render (brackets (vcat (punctuate comma (map dumpPkgGuts pkgs))))
-
-dumpPkgGuts :: PackageConfig -> Doc
-dumpPkgGuts pkg =
-   text "Package" $$ nest 3 (braces (
-      sep (punctuate comma [
-         text "name = " <> text (show (name pkg)),
-	 text "auto = " <> text (show (auto pkg)),
-         dumpField "import_dirs"     (import_dirs     pkg),
-         dumpField "source_dirs"     (source_dirs     pkg),
-         dumpField "library_dirs"    (library_dirs    pkg),
-         dumpField "hs_libraries"    (hs_libraries    pkg),
-         dumpField "extra_libraries" (extra_libraries pkg),
-         dumpField "include_dirs"    (include_dirs    pkg),
-         dumpField "c_includes"      (c_includes      pkg),
-         dumpField "package_deps"    (package_deps    pkg),
-         dumpField "extra_ghc_opts"  (extra_ghc_opts  pkg),
-         dumpField "extra_cc_opts"   (extra_cc_opts   pkg),
-         dumpField "extra_ld_opts"   (extra_ld_opts   pkg),
-         dumpField "framework_dirs"  (framework_dirs   pkg),
-         dumpField "extra_frameworks"(extra_frameworks pkg)
-      ])))
-
-dumpField :: String -> [String] -> Doc
-dumpField name val = hang (text name <+> equals) 2  (dumpFieldContents val)
-
-dumpFieldContents :: [String] -> Doc
-dumpFieldContents val = brackets (sep (punctuate comma (map (text . show) val)))
-
diff --git a/ghc/utils/ghc-pkg/ParsePkgConfLite.y b/ghc/utils/ghc-pkg/ParsePkgConfLite.y
deleted file mode 100644
index d4d8ddbf6a..0000000000
--- a/ghc/utils/ghc-pkg/ParsePkgConfLite.y
+++ /dev/null
@@ -1,128 +0,0 @@
-{
--- This parser is based on ParsedPkgConf.y in compiler/main/
--- It's supposed to do the same thing, but without depending on other GHC modules.
--- The disadvantage is the less sophisticated error reporting, and it's probably
--- slower because it doesn't use FastStrings.
-
-module ParsePkgConfLite{- ( parsePackageConfig, parseOnePackageConfig ) -}where
-
-import Package  ( PackageConfig(..), defaultPackageConfig )
-import Char(isSpace, isAlpha, isAlphaNum, isUpper)
-import List(break)
-}
-
-%token
- '{'		{ ITocurly }
- '}'		{ ITccurly }
- '['		{ ITobrack }
- ']'		{ ITcbrack }
- ','		{ ITcomma }
- '='		{ ITequal }
- VARID   	{ ITvarid    $$ }
- CONID   	{ ITconid    $$ }
- STRING		{ ITstring   $$ }
-
-%name parse pkgconf
-%name parseOne pkg
-%tokentype { Token }
-%%
-
-pkgconf :: { [ PackageConfig ] }
-	: '[' ']'			{ [] }
-	| '[' pkgs ']'			{ reverse $2 }
-
-pkgs 	:: { [ PackageConfig ] }
-	: pkg 				{ [ $1 ] }
-	| pkgs ',' pkg			{ $3 : $1 }
-
-pkg 	:: { PackageConfig }
-	: CONID '{' fields '}'		{ $3 defaultPackageConfig }
-
-fields  :: { PackageConfig -> PackageConfig }
-	: field				{ \p -> $1 p }
-	| fields ',' field		{ \p -> $1 ($3 p) }
-
-field	:: { PackageConfig -> PackageConfig }
-	: VARID '=' STRING		
-                 {\p -> case $1 of
-		   "name" -> p{name = $3}
-		   _      -> error "unknown key in config file" }
-			
-        | VARID '=' bool
-		{\p -> case $1 of {
-		   	"auto" -> p{auto = $3};
-		   	_      -> p } }
-
-	| VARID '=' strlist		
-		{\p -> case $1 of
-		        "import_dirs"     -> p{import_dirs     = $3}
-		        "library_dirs"    -> p{library_dirs    = $3}
-		        "hs_libraries"    -> p{hs_libraries    = $3}
-		        "extra_libraries" -> p{extra_libraries = $3}
-		        "include_dirs"    -> p{include_dirs    = $3}
-		        "c_includes"      -> p{c_includes      = $3}
-		        "package_deps"    -> p{package_deps    = $3}
-		        "extra_ghc_opts"  -> p{extra_ghc_opts  = $3}
-		        "extra_cc_opts"   -> p{extra_cc_opts   = $3}
-		        "extra_ld_opts"   -> p{extra_ld_opts   = $3}
-		        "framework_dirs"  -> p{framework_dirs  = $3}
-		        "extra_frameworks"-> p{extra_frameworks= $3}
-			_other            -> p
-		}
-
-strlist :: { [String] }
-        : '[' ']'			{ [] }
-	| '[' strs ']'			{ reverse $2 }
-
-strs	:: { [String] }
-	: STRING			{ [ $1 ] }
-	| strs ',' STRING		{ $3 : $1 }
-
-bool    :: { Bool }
-	: CONID				{% case $1 of {
-					    "True"  -> True;
-					    "False" -> False;
-					    _       -> error ("unknown constructor in config file: " ++ $1) } }
-{
-data Token =
-	ITocurly
-    |	ITccurly
-    |	ITobrack
-    |	ITcbrack
-    |	ITcomma
-    |	ITequal
-    |	ITvarid String
-    |	ITconid String
-    |	ITstring String
-
-lexer :: String -> [Token]
-
-lexer [] = []
-lexer ('{':cs) = ITocurly : lexer cs
-lexer ('}':cs) = ITccurly : lexer cs
-lexer ('[':cs) = ITobrack : lexer cs
-lexer (']':cs) = ITcbrack : lexer cs
-lexer (',':cs) = ITcomma : lexer cs
-lexer ('=':cs) = ITequal : lexer cs
-lexer ('"':cs) = lexString cs ""
-lexer (c:cs)
-    | isSpace c = lexer cs
-    | isAlpha c = lexID (c:cs) where
-lexer _ = error "Unexpected token"
-
-lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest
-    where
-	(id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs
-
-lexString ('"':cs) s = ITstring (reverse s) : lexer cs
-lexString ('\\':c:cs) s = lexString cs (c:s)
-lexString (c:cs) s = lexString cs (c:s)
-
-happyError _ = error "Couldn't parse package configuration."
-
-parsePackageConfig :: String -> [PackageConfig]
-parsePackageConfig = parse . lexer
-
-parseOnePackageConfig :: String -> PackageConfig
-parseOnePackageConfig = parseOne . lexer
-}