[project @ 2004-11-11 16:07:40 by simonmar]

Compiler changes for the new package.conf format.

7 files changed, 121 insertions, 78 deletions

diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
index 1cf49d91a9..9a1dee6599 100644
--- a/ghc/compiler/Makefile
+++ b/ghc/compiler/Makefile
@@ -507,8 +507,8 @@ primop-usage.hs-incl: prelude/primops.txt
 #-----------------------------------------------------------------------------
 # 		Linking
 
-# Include libghccompat in stage1.  In stage2 onwards, all these libraries
-# will be available from the main libraries.
+# Include libghccompat in stage1 only.  In stage2 onwards, all these
+# libraries will be available from the main libraries.
 ifeq "$(stage)" "1"
 SRC_HC_OPTS += -i$(GHC_LIB_COMPAT_DIR)
 SRC_LD_OPTS += -L$(GHC_LIB_COMPAT_DIR) -lghccompat
diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index a1e4a08bf2..695162cdf1 100644
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -24,6 +24,7 @@ import qualified PrintJava
 import OccurAnal	( occurAnalyseBinds )
 #endif
 
+import Distribution.Package	( showPackageId )
 import PprC		( writeCs )
 import CmmLint		( cmmLint )
 import Packages
@@ -125,7 +126,7 @@ outputC dflags filenm flat_absC
        --
        let packages = dep_pkgs dependencies
        pkg_configs <- getExplicitPackagesAnd packages
-       let pkg_names = map name pkg_configs
+       let pkg_names = map (showPackageId.package) pkg_configs
 
        c_includes <- getPackageCIncludes pkg_configs
        let cmdline_includes = cmdlineHcIncludes dflags -- -#include options
@@ -244,7 +245,7 @@ outputForeignStubs dflags (ForeignStubs h_code c_code _ _)
 
 	-- we need the #includes from the rts package for the stub files
 	rts_pkgs <- getPackageDetails [rtsPackage]
- 	let rts_includes = concatMap mk_include (concatMap c_includes rts_pkgs)
+ 	let rts_includes = concatMap mk_include (concatMap includes rts_pkgs)
 	    mk_include i = "#include \"" ++ i ++ "\"\n"
 
 	stub_h_file_exists
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 4e9e25295c..f4ec7877bf 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1066,8 +1066,8 @@ staticLink o_files dep_packages = do
 
     let extra_os = if static || no_hs_main
                    then []
-                   else [ head (library_dirs rts_pkg) ++ "/Main.dll_o",
-                          head (library_dirs std_pkg) ++ "/PrelMain.dll_o" ]
+                   else [ head (libraryDirs rts_pkg) ++ "/Main.dll_o",
+                          head (libraryDirs std_pkg) ++ "/PrelMain.dll_o" ]
 
     (md_c_flags, _) <- machdepCCOpts
     SysTools.runLink ( [ SysTools.Option verb
@@ -1132,8 +1132,8 @@ doMkDLL o_files dep_packages = do
 
     let extra_os = if static || no_hs_main
                    then []
-                   else [ head (library_dirs rts_pkg) ++ "/Main.dll_o",
-                          head (library_dirs std_pkg) ++ "/PrelMain.dll_o" ]
+                   else [ head (libraryDirs rts_pkg) ++ "/Main.dll_o",
+                          head (libraryDirs std_pkg) ++ "/PrelMain.dll_o" ]
 
     (md_c_flags, _) <- machdepCCOpts
     SysTools.runMkDLL
diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index 468fc76b11..58c85a4abe 100644
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -295,10 +295,10 @@ mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
 -- 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_pkg p = p{ importDirs  = munge_paths (importDirs p),
+		   includeDirs = munge_paths (includeDirs p),
+    		   libraryDirs = munge_paths (libraryDirs p),
+		   frameworkDirs = munge_paths (frameworkDirs p) }
 
   munge_paths = map munge_path
 
@@ -361,22 +361,22 @@ getPackageImportPath = do
   ps <- getExplicitAndAutoPackageConfigs
 		  -- import dirs are always derived from the 'auto' 
 		  -- packages as well as the explicit ones
-  return (nub (filter notNull (concatMap import_dirs ps)))
+  return (nub (filter notNull (concatMap importDirs ps)))
 
 getPackageIncludePath :: [PackageName] -> IO [String]
 getPackageIncludePath pkgs = do
   ps <- getExplicitPackagesAnd pkgs
-  return (nub (filter notNull (concatMap include_dirs ps)))
+  return (nub (filter notNull (concatMap includeDirs ps)))
 
 	-- includes are in reverse dependency order (i.e. rts first)
 getPackageCIncludes :: [PackageConfig] -> IO [String]
 getPackageCIncludes pkg_configs = do
-  return (reverse (nub (filter notNull (concatMap c_includes pkg_configs))))
+  return (reverse (nub (filter notNull (concatMap includes pkg_configs))))
 
 getPackageLibraryPath :: [PackageName] -> IO [String]
 getPackageLibraryPath pkgs = do 
   ps <- getExplicitPackagesAnd pkgs
-  return (nub (filter notNull (concatMap library_dirs ps)))
+  return (nub (filter notNull (concatMap libraryDirs ps)))
 
 getPackageLinkOpts :: [PackageName] -> IO [String]
 getPackageLinkOpts pkgs = do
@@ -386,9 +386,9 @@ getPackageLinkOpts pkgs = do
   static <- readIORef v_Static
   let 
 	imp        = if static then "" else "_imp"
-      	libs p     = map addSuffix (hACK (hs_libraries p)) ++ extra_libraries p
+      	libs p     = map addSuffix (hACK (hsLibraries p)) ++ extraLibraries p
 	imp_libs p = map (++imp) (libs p)
-	all_opts p = map ("-l" ++) (imp_libs p) ++ extra_ld_opts p
+	all_opts p = map ("-l" ++) (imp_libs p) ++ extraLdOpts p
 
 	suffix     = if null tag then "" else  '_':tag
 	rts_suffix = if null rts_tag then "" else  '_':rts_tag
@@ -429,21 +429,16 @@ getPackageLinkOpts pkgs = do
          libs
 #      endif
 
-getPackageExtraGhcOpts :: IO [String]
-getPackageExtraGhcOpts = do
-  ps <- getExplicitAndAutoPackageConfigs
-  return (concatMap extra_ghc_opts ps)
-
 getPackageExtraCcOpts :: [PackageName] -> IO [String]
 getPackageExtraCcOpts pkgs = do
   ps <- getExplicitPackagesAnd pkgs
-  return (concatMap extra_cc_opts ps)
+  return (concatMap extraCcOpts ps)
 
 #ifdef darwin_TARGET_OS
 getPackageFrameworkPath  :: [PackageName] -> IO [String]
 getPackageFrameworkPath pkgs = do
   ps <- getExplicitPackagesAnd pkgs
-  return (nub (filter notNull (concatMap framework_dirs ps)))
+  return (nub (filter notNull (concatMap frameworkDirs ps)))
 
 getPackageFrameworks  :: [PackageName] -> IO [String]
 getPackageFrameworks pkgs = do
@@ -465,7 +460,7 @@ getExplicitPackagesAnd pkg_names = do
 getExplicitAndAutoPackageConfigs :: IO [PackageConfig]
 getExplicitAndAutoPackageConfigs = do
   pkg_map <- getPackageConfigMap
-  let auto_packages = [ mkPackageName (name p) | p <- eltsUFM pkg_map, auto p ]
+  let auto_packages = [ packageConfigName p | p <- eltsUFM pkg_map, exposed p ]
   getExplicitPackagesAnd auto_packages
 
 -----------------------------------------------------------------------------
diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 336cbee22d..91d60941a6 100644
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.139 2004/09/30 10:37:17 simonpj Exp $
+-- $Id: Main.hs,v 1.140 2004/11/11 16:07:46 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -32,8 +32,7 @@ import Packages		( showPackages, getPackageConfigMap, basePackage,
 			)
 import DriverPipeline	( staticLink, doMkDLL, runPipeline )
 import DriverState	( buildStgToDo,
-			  findBuildTag, 
-			  getPackageExtraGhcOpts, unregFlags, 
+			  findBuildTag, unregFlags, 
 			  v_GhcMode, v_GhcModeFlag, GhcMode(..),
 			  v_Keep_tmp_files, v_Ld_inputs, v_Ways, 
 			  v_Output_file, v_Output_hi, 
@@ -151,9 +150,7 @@ main =
    way_opts <- findBuildTag
    let unreg_opts | cGhcUnregisterised == "YES" = unregFlags
 		  | otherwise = []
-   pkg_extra_opts <- getPackageExtraGhcOpts
-   extra_non_static <- processArgs static_flags 
-			   (unreg_opts ++ way_opts ++ pkg_extra_opts) []
+   extra_non_static <- processArgs static_flags (unreg_opts ++ way_opts) []
 
 	-- Give the static flags to hsc
    static_opts <- buildStaticHscOpts
diff --git a/ghc/compiler/main/Packages.lhs b/ghc/compiler/main/Packages.lhs
index 72b3cf8d47..43cd04d983 100644
--- a/ghc/compiler/main/Packages.lhs
+++ b/ghc/compiler/main/Packages.lhs
@@ -5,13 +5,16 @@
 
 \begin{code}
 module Packages (
-	PackageConfig(..), 
+	PackageConfig,
+	InstalledPackageInfo(..),
+	Version(..),
+	PackageIdentifier(..),
 	defaultPackageConfig,
 	packageDependents, 
 	showPackages,
 
 	PackageName,		-- Instance of Outputable
-	mkPackageName, packageNameString,
+	mkPackageName, packageIdName, packageConfigName, packageNameString,
 	basePackage, rtsPackage, haskell98Package, thPackage, -- :: PackageName
 
 	PackageConfigMap, emptyPkgMap, lookupPkg,
@@ -21,6 +24,9 @@ where
 
 #include "HsVersions.h"
 
+import Distribution.InstalledPackageInfo
+import Distribution.Package
+import Data.Version
 import CmdLineOpts	( dynFlag, verbosity )
 import ErrUtils		( dumpIfSet )
 import Outputable	( docToSDoc )
@@ -32,18 +38,11 @@ import Pretty
 import DATA_IOREF
 
 -- -----------------------------------------------------------------------------
--- The PackageConfig type
+-- Our PackageConfig type is just InstalledPackageInfo from Cabal.  Later we
+-- might need to extend it with some GHC-specific stuff, but for now it's fine.
 
-#define WANT_PRETTY
-#define INTERNAL_PRETTY
--- Yes, do generate pretty-printing stuff for packages, and use our
--- own Pretty library rather than Text.PrettyPrint
-
--- There's a blob of code shared with ghc-pkg, 
--- so we just include it from there 
--- Primarily it defines	PackageConfig (a record)
-
-#include "../utils/ghc-pkg/Package.hs"
+type PackageConfig = InstalledPackageInfo
+defaultPackageConfig = emptyInstalledPackageInfo
 
 -- -----------------------------------------------------------------------------
 -- Package names
@@ -53,6 +52,12 @@ type PackageName = FastString	-- No encoding at all
 mkPackageName :: String -> PackageName
 mkPackageName = mkFastString
 
+packageIdName :: PackageIdentifier -> PackageName
+packageIdName = mkPackageName . showPackageId
+
+packageConfigName :: PackageConfig -> PackageName
+packageConfigName = packageIdName . package
+
 packageNameString :: PackageName -> String
 packageNameString = unpackFS
 
@@ -65,7 +70,7 @@ thPackage        = FSLIT("template-haskell")	-- Template Haskell libraries in he
 packageDependents :: PackageConfig -> [PackageName]
 -- Impedence matcher, because PackageConfig has Strings 
 -- not PackageNames at the moment.  Sigh.
-packageDependents pkg = map mkPackageName (package_deps pkg)
+packageDependents pkg = map packageIdName (depends pkg)
 
 -- -----------------------------------------------------------------------------
 -- A PackageConfigMap maps a PackageName to a PackageConfig
@@ -83,7 +88,7 @@ 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
+    add pkg_map p = addToUFM pkg_map (packageConfigName p) p
 
 GLOBAL_VAR(v_Package_details, emptyPkgMap, PackageConfigMap)
 
@@ -109,7 +114,7 @@ showPackages :: PackageConfigMap -> IO ()
 showPackages pkg_map
   = do  { verb <- dynFlag verbosity
 	; dumpIfSet (verb >= 3) "Packages"
-	  	    (docToSDoc (vcat (map dumpPkgGuts ps)))
+	  	    (docToSDoc (vcat (map (text.showInstalledPackageInfo) ps)))
 	}
   where
     ps = eltsUFM pkg_map
diff --git a/ghc/compiler/main/ParsePkgConf.y b/ghc/compiler/main/ParsePkgConf.y
index beb6e540e7..1a4795e8a7 100644
--- a/ghc/compiler/main/ParsePkgConf.y
+++ b/ghc/compiler/main/ParsePkgConf.y
@@ -3,7 +3,7 @@ module ParsePkgConf( loadPackageConfig ) where
 
 #include "HsVersions.h"
 
-import Packages  ( PackageConfig(..), defaultPackageConfig )
+import Packages
 import Lexer
 import CmdLineOpts
 import FastString
@@ -26,6 +26,7 @@ import EXCEPTION ( throwDyn )
  VARID   	{ L _ (ITvarid    $$) }
  CONID   	{ L _ (ITconid    $$) }
  STRING		{ L _ (ITstring   $$) }
+ INT		{ L _ (ITinteger  $$) }
 
 %monad { P } { >>= } { return }
 %lexer { lexer } { L _ ITeof }
@@ -49,46 +50,90 @@ fields  :: { PackageConfig -> PackageConfig }
 	| fields ',' field		{ \p -> $1 ($3 p) }
 
 field	:: { PackageConfig -> PackageConfig }
-	: VARID '=' STRING		
-                 {% case unpackFS $1 of { 
-		   "name" -> return (\ p -> p{name = unpackFS $3});
-		   _      -> happyError } }
+	: VARID '=' pkgid
+		{% case unpackFS $1 of
+		        "package"     -> return (\p -> p{package = $3})
+			_other        -> happyError
+		}
+
+	| VARID '=' STRING		{ id }
+		-- we aren't interested in the string fields, they're all
+		-- boring (copyright, maintainer etc.)
 			
-        | VARID '=' bool
-		{\p -> case unpackFS $1 of {
-		   	"auto" -> p{auto = $3};
-		   	_      -> p } }
+        | VARID '=' CONID
+		{% case unpackFS $1 of {
+		   	"exposed" -> 
+			   case unpackFS $3 of {
+				"True"  -> return (\p -> p{exposed=True});
+				"False" -> return (\p -> p{exposed=False});
+				_       -> happyError };
+		   	"license" -> return id; -- not interested
+		   	_         -> happyError }
+		}
+
+	| VARID '=' CONID STRING	{ id }
+		-- another case of license
 
 	| VARID '=' strlist		
 		{\p -> case unpackFS $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
+		        "exposedModules"    -> p{exposedModules    = $3}
+		        "hiddenModules"     -> p{hiddenModules     = $3}
+		        "importDirs"        -> p{importDirs        = $3}
+		        "libraryDirs"       -> p{libraryDirs       = $3}
+		        "hsLibraries"       -> p{hsLibraries       = $3}
+		        "extraLibraries"    -> p{extraLibraries    = $3}
+		        "includeDirs"       -> p{includeDirs       = $3}
+		        "includes"          -> p{includes          = $3}
+		        "extraHugsOpts"     -> p{extraHugsOpts     = $3}
+		        "extraCcOpts"       -> p{extraCcOpts       = $3}
+		        "extraLdOpts"       -> p{extraLdOpts       = $3}
+		        "frameworkDirs"     -> p{frameworkDirs     = $3}
+		        "extraFrameworks"   -> p{extraFrameworks   = $3}
+		        "haddockInterfaces" -> p{haddockInterfaces = $3}
+		        "haddockHTMLs"      -> p{haddockHTMLs      = $3}
+		        "depends"     	    -> p{depends = []}
+				-- empty list only, non-empty handled below
+			other -> p
 		}
 
+	| VARID '=' pkgidlist
+		{% case unpackFS $1 of
+		        "depends"     -> return (\p -> p{depends = $3})
+			_other        -> happyError
+		}
+
+pkgid	:: { PackageIdentifier }
+	: CONID '{' VARID '=' STRING ',' VARID '=' version '}'
+			{ PackageIdentifier{ pkgName = unpackFS $5, 
+					     pkgVersion = $9 } }
+
+version :: { Version }
+	: CONID '{' VARID '=' intlist ',' VARID '=' strlist '}'
+			{ Version{ versionBranch=$5, versionTags=$9 } }
+
+pkgidlist :: { [PackageIdentifier] }
+	: '[' pkgids ']'		{ $2 }
+	-- empty list case is covered by strlist, to avoid conflicts
+
+pkgids	:: { [PackageIdentifier] }
+	: pkgid				{ [ $1 ] }
+	| pkgid ',' pkgids		{ $1 : $3 }
+
+intlist :: { [Int] }
+        : '[' ']'			{ [] }
+	| '[' ints ']'			{ $2 }
+
+ints	:: { [Int] }
+	: INT				{ [ fromIntegral $1 ] }
+	| INT ',' ints			{ fromIntegral $1 : $3 }
+
 strlist :: { [String] }
         : '[' ']'			{ [] }
-	| '[' strs ']'			{ reverse $2 }
+	| '[' strs ']'			{ $2 }
 
 strs	:: { [String] }
 	: STRING			{ [ unpackFS $1 ] }
-	| strs ',' STRING		{ unpackFS $3 : $1 }
-
-bool    :: { Bool }
-	: CONID				{% case unpackFS $1 of {
-					    "True"  -> return True;
-					    "False" -> return False;
-					    _       -> happyError } }
+	| STRING ',' strs 		{ unpackFS $1 : $3 }
 
 {
 happyError :: P a