Commit ac476ed9 authored by panne's avatar panne
Browse files

[project @ 2000-07-08 23:06:46 by panne]

Generalized the package file format a little bit: include directories,
include files, and options are now lists of Strings.
parent ec491e5f
......@@ -645,14 +645,14 @@ getPackageIncludePath :: IO [String]
getPackageIncludePath = do
ps <- readIORef packages
ps' <- getPackageDetails ps
return (nub (filter (not.null) (map include_dir ps')))
return (nub (filter (not.null) (concatMap include_dirs ps')))
-- includes are in reverse dependency order (i.e. rts first)
getPackageCIncludes :: IO [String]
getPackageCIncludes = do
ps <- readIORef packages
ps' <- getPackageDetails ps
return (reverse (nub (filter (not.null) (map c_include ps'))))
return (reverse (nub (filter (not.null) (concatMap c_includes ps'))))
getPackageLibraryPath :: IO [String]
getPackageLibraryPath = do
......@@ -672,26 +672,24 @@ getPackageExtraGhcOpts :: IO [String]
getPackageExtraGhcOpts = do
ps <- readIORef packages
ps' <- getPackageDetails ps
return (map extra_ghc_opts ps')
return (concatMap extra_ghc_opts ps')
getPackageExtraCcOpts :: IO [String]
getPackageExtraCcOpts = do
ps <- readIORef packages
ps' <- getPackageDetails ps
return (map extra_cc_opts ps')
return (concatMap extra_cc_opts ps')
getPackageExtraLdOpts :: IO [String]
getPackageExtraLdOpts = do
ps <- readIORef packages
ps' <- getPackageDetails ps
return (map extra_ld_opts ps')
return (concatMap extra_ld_opts ps')
getPackageDetails :: [String] -> IO [Package]
getPackageDetails ps = do
pkg_details <- readIORef package_details
let getDetails p = case lookup p pkg_details of
Just details -> return details
Nothing -> error "getPackageDetails"
mapM getDetails ps
return [ pkg | p <- ps, Just pkg <- [ lookup p pkg_details ] ]
GLOBAL_VAR(package_details, (error "package_details"), [(String,Package)])
......
......@@ -6,12 +6,12 @@ data Package = Package {
import_dirs :: [String],
library_dirs :: [String],
libraries :: [String],
include_dir :: String,
c_include :: String,
include_dirs :: [String],
c_includes :: [String],
package_deps :: [String],
extra_ghc_opts :: String,
extra_cc_opts :: String,
extra_ld_opts :: String
extra_ghc_opts :: [String],
extra_cc_opts :: [String],
extra_ld_opts :: [String]
}
deriving (Read, Show)
......@@ -22,30 +22,26 @@ 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))
dumpPkg :: (String,Package) -> Doc
dumpPkg (name, pkg) =
parens (hang (text (show name) <> comma) 2 (dumpPkgGuts pkg))
dumpPkgGuts (Package
{ import_dirs = import_dirs
, library_dirs = library_dirs
, libraries = libraries
, include_dir = include_dir
, c_include = c_include
, package_deps = package_deps
, extra_ghc_opts = extra_ghc_opts
, extra_cc_opts = extra_cc_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))
])))
dumpPkgGuts :: Package -> Doc
dumpPkgGuts pkg =
text "Package" $$ nest 3 (braces (
sep (punctuate comma [
dumpField "import_dirs" (import_dirs pkg),
dumpField "library_dirs" (library_dirs pkg),
dumpField "libraries" (libraries pkg),
dumpField "include_dirs" (include_dirs pkg),
dumpField "c_includes" (c_includes pkg),
dumpField "package_deps" (package_deps pkg),
dumpField "extra_ghc_opts" (extra_ghc_opts pkg),
dumpField "extra_cc_opts" (extra_cc_opts pkg),
dumpField "extra_ld_opts" (extra_ld_opts pkg)
])))
pprStrs strs = brackets (sep (punctuate comma (map (text . show) strs)))
dumpField :: String -> [String] -> Doc
dumpField name val =
hang (text name <+> equals) 2
(brackets (sep (punctuate comma (map (text . show) val))))
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment