From 72a42bd77936ad0edd7426a33b323e60323e9684 Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 11 Nov 2004 16:07:49 +0000 Subject: [PATCH] [project @ 2004-11-11 16:07:40 by simonmar] Compiler changes for the new package.conf format. --- ghc/compiler/Makefile | 4 +- ghc/compiler/main/CodeOutput.lhs | 5 +- ghc/compiler/main/DriverPipeline.hs | 8 +-- ghc/compiler/main/DriverState.hs | 31 +++++------ ghc/compiler/main/Main.hs | 9 +-- ghc/compiler/main/Packages.lhs | 37 ++++++------ ghc/compiler/main/ParsePkgConf.y | 105 +++++++++++++++++++++++++---------- 7 files changed, 121 insertions(+), 78 deletions(-) diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index 1cf49d9..9a1dee6 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 a1e4a08..695162c 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 4e9e252..f4ec787 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 468fc76..58c85a4 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 336cbee..91d6094 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 72b3cf8..43cd04d 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 beb6e54..1a4795e 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 -- 1.7.10.4