diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs
index 6cb80f97f6e35eddcf05aaecf23f2f8242d8d81c..b468e7a1e04d4621411d9ca90a091431947c3e6d 100644
--- a/ghc/driver/Main.hs
+++ b/ghc/driver/Main.hs
@@ -1,6 +1,6 @@
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.61 2000/09/25 12:30:44 simonmar Exp $
+-- $Id: Main.hs,v 1.62 2000/10/03 16:51:57 sewardj Exp $
--
-- GHC Driver program
--
@@ -73,7 +73,7 @@ cHaskell1Version = "5" -- i.e., Haskell 98
-----------------------------------------------------------------------------
-- Usage Message
-short_usage = "Usage: For basic information, try the `-help' option."
+short_usage = "Usage: For basic information, try the `--help' option."
long_usage = do
let usage_file = "ghc-usage.txt"
@@ -605,12 +605,12 @@ newPackage = do
details <- readIORef package_details
hPutStr stdout "Reading package info from stdin... "
stuff <- getContents
- let new_pkg = read stuff :: (String,Package)
+ let new_pkg = read stuff :: Package
catchAll new_pkg
(\_ -> throwDyn (OtherError "parse error in package info"))
hPutStrLn stdout "done."
- if (fst new_pkg `elem` map fst details)
- then throwDyn (OtherError ("package `" ++ fst new_pkg ++
+ if (name new_pkg `elem` map name details)
+ then throwDyn (OtherError ("package `" ++ name new_pkg ++
"' already installed"))
else do
conf_file <- readIORef package_config
@@ -623,13 +623,13 @@ deletePackage :: String -> IO ()
deletePackage pkg = do
checkConfigAccess
details <- readIORef package_details
- if (pkg `notElem` map fst details)
+ if (pkg `notElem` map name details)
then throwDyn (OtherError ("package `" ++ pkg ++ "' not installed"))
else do
conf_file <- readIORef package_config
savePackageConfig conf_file
maybeRestoreOldConfig conf_file $ do
- writeNewConfig conf_file (filter ((/= pkg) . fst))
+ writeNewConfig conf_file (filter ((/= pkg) . name))
exitWith ExitSuccess
checkConfigAccess :: IO ()
@@ -650,7 +650,7 @@ maybeRestoreOldConfig conf_file io
throw e
)
-writeNewConfig :: String -> ([(String,Package)] -> [(String,Package)]) -> IO ()
+writeNewConfig :: String -> ([Package] -> [Package]) -> IO ()
writeNewConfig conf_file fn = do
hPutStr stdout "Writing new package config file... "
old_details <- readIORef package_details
@@ -676,7 +676,7 @@ packages = global ["std", "rts", "gmp"] :: IORef [String]
addPackage :: String -> IO ()
addPackage package
= do pkg_details <- readIORef package_details
- case lookup package pkg_details of
+ case lookupPkg package pkg_details of
Nothing -> throwDyn (OtherError ("unknown package name: " ++ package))
Just details -> do
ps <- readIORef packages
@@ -741,9 +741,15 @@ getPackageExtraLdOpts = do
getPackageDetails :: [String] -> IO [Package]
getPackageDetails ps = do
pkg_details <- readIORef package_details
- return [ pkg | p <- ps, Just pkg <- [ lookup p pkg_details ] ]
+ return [ pkg | p <- ps, Just pkg <- [ lookupPkg p pkg_details ] ]
-GLOBAL_VAR(package_details, (error "package_details"), [(String,Package)])
+GLOBAL_VAR(package_details, (error "package_details"), [Package])
+
+lookupPkg :: String -> [Package] -> Maybe Package
+lookupPkg nm ps
+ = case [p | p <- ps, name p == nm] of
+ [] -> Nothing
+ (p:_) -> Just p
-----------------------------------------------------------------------------
-- Ways
@@ -1667,7 +1673,7 @@ run_phase Cpp _basename _suff input_fn output_fn
++ [ "-x", "c", input_fn, ">>", output_fn ]
))
else do
- run_something "Inefective C pre-processor"
+ run_something "Ineffective C pre-processor"
("echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}' > "
++ output_fn ++ " && cat " ++ input_fn
++ " >> " ++ output_fn)
diff --git a/ghc/driver/Package.hs b/ghc/driver/Package.hs
index 2a80e0828c4cc9d9b17d4790bb077be1c6d6d5da..d842d1224b770c67d724efd833e8f3aba0b2ef85 100644
--- a/ghc/driver/Package.hs
+++ b/ghc/driver/Package.hs
@@ -3,6 +3,7 @@ module Package where
import Pretty
data Package = Package {
+ name :: String,
import_dirs :: [String],
library_dirs :: [String],
hs_libraries :: [String],
@@ -16,21 +17,18 @@ data Package = Package {
}
deriving (Read, Show)
-listPkgs :: [(String,Package)] -> String
-listPkgs pkgs = render (fsep (punctuate comma (map (text . fst) pkgs)))
+listPkgs :: [Package] -> String
+listPkgs pkgs = render (fsep (punctuate comma (map (text . name) pkgs)))
-dumpPackages :: [(String,Package)] -> String
+dumpPackages :: [Package] -> String
dumpPackages pkgs =
- render (brackets (vcat (punctuate comma (map dumpPkg pkgs))))
-
-dumpPkg :: (String,Package) -> Doc
-dumpPkg (name, pkg) =
- parens (hang (text (show name) <> comma) 2 (dumpPkgGuts pkg))
+ render (brackets (vcat (punctuate comma (map dumpPkgGuts pkgs))))
dumpPkgGuts :: Package -> Doc
dumpPkgGuts pkg =
text "Package" $$ nest 3 (braces (
sep (punctuate comma [
+ text "name = " <> text (show (name pkg)),
dumpField "import_dirs" (import_dirs pkg),
dumpField "library_dirs" (library_dirs pkg),
dumpField "hs_libraries" (hs_libraries pkg),
diff --git a/ghc/driver/PackageSrc.hs b/ghc/driver/PackageSrc.hs
index 8c3e8591c792180cee0ef79fe22134d19624493c..22fbf4b454a3a52d1b9b310c5b2b969ada6a438c 100644
--- a/ghc/driver/PackageSrc.hs
+++ b/ghc/driver/PackageSrc.hs
@@ -14,11 +14,11 @@ main = do
_ -> do hPutStr stderr "usage: pkgconf (install | in-place)\n"
exitWith (ExitFailure 1)
-package_details :: Bool -> [(String,Package)]
+package_details :: Bool -> [Package]
package_details installing =
[
- ( "gmp", -- GMP is at the bottom of the heap
Package {
+ name = "gmp", -- GMP is at the bottom of the heap
import_dirs = [],
library_dirs = if cHaveLibGmp == "YES"
then []
@@ -33,11 +33,10 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = []
- }
- ),
+ },
- ( "rts", -- The RTS is just another package!
Package {
+ name = "rts", -- The RTS is just another package!
import_dirs = [],
library_dirs = if installing
then [ clibdir ]
@@ -85,12 +84,11 @@ package_details installing =
, "-u __init_Prelude"
, "-u __init_PrelMain"
]
- }
- ),
+ },
- ( "std", -- The Prelude & Standard Hs_libraries
Package {
- import_dirs = if installing
+ name = "std", -- The Prelude & Standard Hs_libraries
+ import_dirs = if installing
then [ clibdir ++ "/imports/std" ]
else [ ghc_src_dir cGHC_LIB_DIR ++ "/std" ],
library_dirs = if installing
@@ -107,12 +105,11 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = [ "-lm" ]
- }
- ),
+ },
- ( "lang",
Package {
- import_dirs = if installing
+ name = "lang",
+ import_dirs = if installing
then [ clibdir ++ "/imports/lang" ]
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/lang"
, cFPTOOLS_TOP_ABS ++ "/hslibs/lang/monads" ],
@@ -130,11 +127,10 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = []
- }
- ),
+ },
- ( "concurrent",
Package {
+ name = "concurrent",
import_dirs = if installing
then [ clibdir ++ "/imports/concurrent" ]
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/concurrent" ],
@@ -151,11 +147,10 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = []
- }
- ),
+ },
- ( "data",
Package {
+ name = "data",
import_dirs = if installing
then [ clibdir ++ "/imports/data" ]
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/data"
@@ -176,11 +171,10 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = []
- }
- ),
+ },
- ( "net",
Package {
+ name = "net",
import_dirs = if installing
then [ clibdir ++ "/imports/net" ]
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/net" ],
@@ -200,11 +194,10 @@ package_details installing =
extra_ld_opts = if postfixMatch "solaris2" cTARGETPLATFORM
then [ "-lnsl", "-lsocket" ]
else []
- }
- ),
+ },
- ( "posix",
Package {
+ name = "posix",
import_dirs = if installing
then [ clibdir ++ "/imports/posix" ]
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/posix" ],
@@ -222,11 +215,10 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = []
- }
- ),
+ },
- ( "text",
Package {
+ name = "text",
import_dirs = if installing
then [ clibdir ++ "/imports/text" ]
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/text"
@@ -247,11 +239,10 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = []
- }
- ),
+ },
- ( "util",
Package {
+ name = "util",
import_dirs = if installing
then [ clibdir ++ "/imports/util" ]
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/util"
@@ -270,13 +261,12 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = []
- }
- ),
+ },
-- no cbits at the moment, we'll need to add one if this library
-- ever calls out to any C libs.
- ( "hssource",
Package {
+ name = "hssource",
import_dirs = if installing
then [ clibdir ++ "/imports/hssource" ]
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/hssource" ],
@@ -291,12 +281,11 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = []
- }
- ),
+ },
- ( "win32",
Package {
- import_dirs = if installing
+ name = "win32",
+ import_dirs = if installing
then [ clibdir ++ "/imports/win32" ]
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/win32/src" ],
library_dirs = if installing
@@ -310,11 +299,10 @@ package_details installing =
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = [ "-luser32", "-lgdi32" ]
- }
- ),
+ },
- ( "com",
Package {
+ name = "com",
import_dirs = if installing
then [ clibdir ++ "/imports/com" ]
else [ cFPTOOLS_TOP_ABS ++ "/hdirect/lib" ],
@@ -330,7 +318,6 @@ package_details installing =
extra_cc_opts = [],
extra_ld_opts = [ "-luser32", "-lole32", "-loleaut32", "-ladvapi32" ]
}
- )
]
ghc_src_dir :: String -> String