From b2d52fc99933253305c2ec7bba71fa743f2bc0b8 Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 5 Jul 2000 17:01:59 +0000 Subject: [PATCH] [project @ 2000-07-05 17:01:59 by simonmar] Packages can now be added/removed from an installed GHC as follows: $ ./ghc-inplace --list-packages gmp, rts, std, lang, concurrent, data, net, posix, text, util, hssource, win32, com, std2 $ ./ghc-inplace --add-package throwDyn (OtherError "parse error in package info")) + hPutStrLn stdout "done." + conf_file <- readIORef package_config + savePackageConfig conf_file + maybeRestoreOldConfig conf_file $ do + writeNewConfig conf_file ( ++ [new_pkg]) + exitWith ExitSuccess + +maybeRestoreOldConfig :: String -> IO () -> IO () +maybeRestoreOldConfig conf_file io + = catchAllIO io (\e -> do + hPutStr stdout "\nWARNING: an error was encountered while the new \n\ + \configuration was being written. Attempting to \n\ + \restore the old configuration... " + system ("cp " ++ conf_file ++ ".old " ++ conf_file) + hPutStrLn stdout "done." + throw e + ) + +writeNewConfig :: String -> ([(String,Package)] -> [(String,Package)]) -> IO () +writeNewConfig conf_file fn = do + hPutStr stdout "Writing new package config file... " + old_details <- readIORef package_details + h <- openFile conf_file WriteMode + hPutStr h (dumpPackages (fn old_details)) + hClose h + hPutStrLn stdout "done." + +savePackageConfig :: String -> IO () +savePackageConfig conf_file = do + hPutStr stdout "Saving old package config file... " + -- mv rather than cp because we've already done an hGetContents + -- on this file so we won't be able to open it for writing + -- unless we move the old one out of the way... + system ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old") + hPutStrLn stdout "done." + +deletePackage :: String -> IO () +deletePackage pkg = do + conf_file <- readIORef package_config + savePackageConfig conf_file + maybeRestoreOldConfig conf_file $ do + writeNewConfig conf_file (filter ((/= pkg) . fst)) + exitWith ExitSuccess + -- package list is maintained in dependency order packages = global ["std", "rts", "gmp"] :: IORef [String] -- comma in value, so can't use macro, grrr @@ -1025,8 +1090,8 @@ main = argv' <- setTopDir argv -- read the package configuration - let conf = findFile "package.conf" (cGHC_DRIVER_DIR++"/package.conf.inplace") - contents <- readFile conf + conf_file <- readIORef package_config + contents <- readFile conf_file writeIORef package_details (read contents) -- find the phase to stop after (i.e. -E, -C, -c, -S flags) @@ -1039,6 +1104,11 @@ main = more_opts <- findBuildTag _ <- processArgs more_opts [] + -- get the -v flag + verb <- readIORef verbose + + when verb (hPutStrLn stderr ("Using package config file: " ++ conf_file)) + if stop_phase == MkDependHS -- mkdependHS is special then do_mkdependHS flags2 srcs else do @@ -1700,6 +1770,10 @@ opts = , ( "package" , HasArg (addPackage) ) , ( "syslib" , HasArg (addPackage) ) -- for compatibility w/ old vsns + , ( "-list-packages" , NoArg (listPackages) ) + , ( "-add-package" , NoArg (newPackage) ) + , ( "-delete-package" , SepArg (deletePackage) ) + ------- Specific phases -------------------------------------------- , ( "pgmdep" , HasArg (writeIORef pgm_dep) ) , ( "pgmL" , HasArg (writeIORef pgm_L) ) diff --git a/ghc/driver/Package.hs b/ghc/driver/Package.hs index f064f62..92525f6 100644 --- a/ghc/driver/Package.hs +++ b/ghc/driver/Package.hs @@ -15,10 +15,17 @@ data Package = Package { } deriving (Read, Show) -pprPackage :: [(String,Package)] -> String -pprPackage pkgs = render (brackets (vcat (punctuate comma (map pprPkg pkgs)))) +listPkgs :: [(String,Package)] -> String +listPkgs pkgs = render (fsep (punctuate comma (map (text . fst) pkgs))) -pprPkg (name, (Package +dumpPackages :: [(String,Package)] -> String +dumpPackages pkgs = + render (brackets (vcat (punctuate comma (map dumpPkg pkgs)))) + +dumpPkg (name, pkg) = parens (hang (text (show name) <> comma) + 2 (dumpPkgGuts pkg)) + +dumpPkgGuts (Package { import_dirs = import_dirs , library_dirs = library_dirs , libraries = libraries @@ -27,19 +34,18 @@ pprPkg (name, (Package , package_deps = package_deps , extra_ghc_opts = extra_ghc_opts , extra_cc_opts = extra_cc_opts - , extra_ld_opts = extra_ld_opts })) - = parens ( - text (show name) <> comma - <+> text "Package" <+> braces ( - vcat [ - text "import_dirs = " <> text (show import_dirs) <> comma, - text "library_dirs = " <> text (show library_dirs) <> comma, - text "libraries = " <> text (show libraries) <> comma, - text "include_dir = " <> text (show include_dir) <> comma, - text "c_include = " <> text (show c_include) <> comma, - text "package_deps = " <> text (show package_deps) <> comma, - text "extra_ghc_opts = " <> text (show extra_ghc_opts) <> comma, - text "extra_cc_opts = " <> text (show extra_cc_opts) <> comma, - text "extra_ld_opts = " <> text (show extra_ld_opts) - ]) - ) + , extra_ld_opts = extra_ld_opts }) + = text "Package" $$ nest 3 (braces ( + sep (punctuate comma [ + hang (text "import_dirs =" ) 2 (pprStrs import_dirs), + hang (text "library_dirs = " ) 2 (pprStrs library_dirs), + hang (text "libraries = " ) 2 (pprStrs libraries), + hang (text "include_dir = " ) 2 (text (show include_dir)), + hang (text "c_include = " ) 2 (text (show c_include)), + hang (text "package_deps = " ) 2 (pprStrs package_deps), + hang (text "extra_ghc_opts = " ) 2 (text (show extra_ghc_opts)), + hang (text "extra_cc_opts = " ) 2 (text (show extra_cc_opts)), + hang (text "extra_ld_opts = " ) 2 (text (show extra_ld_opts)) + ]))) + +pprStrs strs = brackets (sep (punctuate comma (map (text . show) strs))) diff --git a/ghc/driver/PackageSrc.hs b/ghc/driver/PackageSrc.hs index 242b423..845748c 100644 --- a/ghc/driver/PackageSrc.hs +++ b/ghc/driver/PackageSrc.hs @@ -9,8 +9,8 @@ import Package main = do args <- getArgs case args of - [ "install" ] -> do { putStr (pprPackage (package_details True)) } - [ "in-place" ] -> do { putStr (pprPackage (package_details False)) } + [ "install" ] -> do { putStr (dumpPackages (package_details True)) } + [ "in-place" ] -> do { putStr (dumpPackages (package_details False)) } _ -> do hPutStr stderr "usage: pkgconf (install | in-place)\n" exitWith (ExitFailure 1) @@ -74,11 +74,11 @@ package_details installing = "-u PrelBase_False_closure", "-u PrelBase_True_closure", "-u PrelPack_unpackCString_closure", - "-u PrelException_stackOverflow_closure", - "-u PrelException_heapOverflow_closure", - "-u PrelException_NonTermination_closure", - "-u PrelException_PutFullMVar_closure", - "-u PrelException_BlockedOnDeadMVar_closure", + "-u PrelIOBase_stackOverflow_closure", + "-u PrelIOBase_heapOverflow_closure", + "-u PrelIOBase_NonTermination_closure", + "-u PrelIOBase_PutFullMVar_closure", + "-u PrelIOBase_BlockedOnDeadMVar_closure", "-u PrelWeak_runFinalizzerBatch_closure", "-u __init_Prelude", "-u __init_PrelMain" @@ -263,6 +263,26 @@ package_details installing = } ), + -- no cbits at the moment, we'll need to add one if this library + -- ever calls out to any C libs. + ( "hssource", + Package { + import_dirs = if installing + then [ clibdir ++ "/imports/hssource" ] + else [ cFPTOOLS_TOP_ABS ++ "/hslibs/hssource" ], + library_dirs = if installing + then [ clibdir ] + else [ cFPTOOLS_TOP_ABS ++ "/hslibs/hssource" ], + libraries = [ "HShssource" ], + include_dir = "", + c_include = "", + package_deps = ["text"], + extra_ghc_opts = "", + extra_cc_opts = "", + extra_ld_opts = "" + } + ), + ( "win32", Package { import_dirs = if installing -- 1.7.10.4