Compiler changes for the new package.conf format.
#-----------------------------------------------------------------------------
# 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
import OccurAnal ( occurAnalyseBinds )
#endif
+import Distribution.Package ( showPackageId )
import PprC ( writeCs )
import CmmLint ( cmmLint )
import Packages
--
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
-- 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
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
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
-- 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
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
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
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
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
-----------------------------------------------------------------------------
{-# 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
--
)
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,
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
\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,
#include "HsVersions.h"
+import Distribution.InstalledPackageInfo
+import Distribution.Package
+import Data.Version
import CmdLineOpts ( dynFlag, verbosity )
import ErrUtils ( dumpIfSet )
import Outputable ( docToSDoc )
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
mkPackageName :: String -> PackageName
mkPackageName = mkFastString
+packageIdName :: PackageIdentifier -> PackageName
+packageIdName = mkPackageName . showPackageId
+
+packageConfigName :: PackageConfig -> PackageName
+packageConfigName = packageIdName . package
+
packageNameString :: PackageName -> String
packageNameString = unpackFS
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
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)
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
#include "HsVersions.h"
-import Packages ( PackageConfig(..), defaultPackageConfig )
+import Packages
import Lexer
import CmdLineOpts
import FastString
VARID { L _ (ITvarid $$) }
CONID { L _ (ITconid $$) }
STRING { L _ (ITstring $$) }
+ INT { L _ (ITinteger $$) }
%monad { P } { >>= } { return }
%lexer { lexer } { L _ ITeof }
| 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
projects / ghc-hetmet.git / commitdiff