[commit: ghc] wip/nfs-locking: Complete first working version of buildPackageDeps rule. (d869302)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:01:09 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/d869302fcad9a124aa65c6075114a6f1f9c7c61d/ghc

>---------------------------------------------------------------

commit d869302fcad9a124aa65c6075114a6f1f9c7c61d
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Wed Dec 31 04:43:53 2014 +0000

    Complete first working version of buildPackageDeps rule.


>---------------------------------------------------------------

d869302fcad9a124aa65c6075114a6f1f9c7c61d
 src/Oracles.hs | 18 +++++++++++------
 src/Package.hs | 62 ++++++++++++++++++++++++++++++++++------------------------
 2 files changed, 48 insertions(+), 32 deletions(-)

diff --git a/src/Oracles.hs b/src/Oracles.hs
index 9b63c4f..4f4cd78 100644
--- a/src/Oracles.hs
+++ b/src/Oracles.hs
@@ -265,16 +265,22 @@ packagaDataOptionWithDefault file key defaultAction = do
         Just value -> return value
         Nothing    -> defaultAction
 
-data PackageDataKey = Modules | SrcDirs | PackageKey
+data PackageDataKey = Modules | SrcDirs | PackageKey | IncludeDirs | Deps | DepKeys
+                    deriving Show
 
 packagaDataOption :: FilePath -> PackageDataKey -> Action String
 packagaDataOption file key = do
-    let keyName = replaceIf isSlash '_' $ takeDirectory file ++ "_" ++ case key of
-           Modules    -> "MODULES"
-           SrcDirs    -> "HS_SRC_DIRS" -- TODO: add "." as a default?
-           PackageKey -> "PACKAGE_KEY"
-    packagaDataOptionWithDefault file keyName $
+    let (keyName, ifEmpty) = case key of
+           Modules     -> ("MODULES"     , "" )
+           SrcDirs     -> ("HS_SRC_DIRS" , ".")
+           PackageKey  -> ("PACKAGE_KEY" , "" )
+           IncludeDirs -> ("INCLUDE_DIRS", ".")
+           Deps        -> ("DEPS"        , "" )
+           DepKeys     -> ("DEP_KEYS"    , "" )
+        keyFullName = replaceSeparators '_' $ takeDirectory file ++ "_" ++ keyName
+    res <- packagaDataOptionWithDefault file keyFullName $
         error $ "\nCannot find key '" ++ keyName ++ "' in " ++ file ++ "."
+    return $ if res == "" then ifEmpty else res
 
 oracleRules :: Rules ()
 oracleRules = do
diff --git a/src/Package.hs b/src/Package.hs
index ba77bdf..98558e9 100644
--- a/src/Package.hs
+++ b/src/Package.hs
@@ -214,42 +214,52 @@ buildPackageData pkg @ (Package name path _) (stage, dist, settings) =
 --  $$(SRC_HC_WARNING_OPTS) \
 --  $$(EXTRA_HC_OPTS)
 
--- TODO: double-check that ignoring SrcDirs ($1_$2_HS_SRC_DIRS) is safe
+-- TODO: make sure SrcDirs ($1_$2_HS_SRC_DIRS) is not empty ('.' by default)
 -- TODO: add $1_HC_OPTS
 -- TODO: check that the package is not a program ($1_$2_PROG == "")
--- TODO: handle empty $1_PACKAGE
+-- TODO: handle empty $1_PACKAGE (can it be empty?)
+-- TODO: $1_$2_INCLUDE appears to be not set. Safe to skip?
 -- Option CONF_HC_OPTS is skipped
 buildPackageDeps :: Package -> TodoItem -> Rules ()
 buildPackageDeps pkg @ (Package name path _) (stage, dist, settings) =
     let buildDir = path </> dist
     in
     (buildDir </> "build" </> name <.> "m") %> \out -> do
-        let pkgData    = buildDir </> "package-data.mk"
-            autogen    = dist </> "build" </> "autogen"
-        mods    <- words <$> packagaDataOption pkgData Modules
-        srcDirs <- words <$> packagaDataOption pkgData SrcDirs
-        src  <- getDirectoryFiles "" $ do
-                    start <- map (replaceEq '.' '/') mods
-                    end   <- [".hs", ".lhs"]
-                    return $ path ++ "//" ++ start ++ end
+        let pkgData = buildDir </> "package-data.mk"
+        usePackageKey <- SupportsPackageKey || stage /= Stage0 -- TODO: check reasoning (distdir-way-opts)
+        [mods, srcDirs, includeDirs, deps, depKeys] <-
+            mapM ((fmap words) . (packagaDataOption pkgData))
+            [Modules, SrcDirs, IncludeDirs, Deps, DepKeys]
+        srcs <- getDirectoryFiles "" $ do
+            dir       <- srcDirs
+            modPath   <- map (replaceEq '.' pathSeparator) mods
+            extension <- ["hs", "lhs"]
+            return $ path </> dir </> modPath <.> extension
         packageKey <- packagaDataOption pkgData PackageKey
         run (Ghc stage) $ mconcat
-                [ arg ["-M"]
-                , wayHcOpts vanilla -- TODO: is this needed? shall we run GHC -M multiple times?
-                , splitArgs $ argOption SrcHcOpts
-                , when (stage == Stage0) $ arg ["-package-db libraries/bootstrapping.conf"]
-                , when (not SupportsPackageKey && stage == Stage0) $ arg ["-package-name"]
-                , when (    SupportsPackageKey || stage /= Stage0) $ arg ["-this-package-key"]
-                , arg [packageKey]
-                , arg ["-hide-all-packages"]
-                , arg $ map (\d -> "-i" ++ path ++ "/" ++ d) srcDirs
-                , arg $ do
-                    prefix <- ["-i", "-I"]
-                    suffix <- ["build", "build/autogen"]
-                    return $ prefix ++ path </> dist </> suffix
-                , arg ["-dep-makefile", out, "-dep-suffix", "", "-include-pkg-deps"]
-                , arg [unwords src]
-                ]
+            [ arg ["-M"]
+            , wayHcOpts vanilla -- TODO: i) is this needed? ii) shall we run GHC -M multiple times?
+            , splitArgs $ argOption SrcHcOpts
+            , when (stage == Stage0) $ arg ["-package-db libraries/bootstrapping.conf"]
+            , arg [if usePackageKey then "-this-package-key" else "-package-name"]
+            , arg [packageKey] -- TODO: check reasoning ($$($4_THIS_PACKAGE_KEY) $$($1_$2_PACKAGE_KEY))
+            , arg ["-hide-all-packages"]
+            , arg ["-i"] -- resets the search path to nothing; TODO: check if really needed
+            , arg $ map (\d -> "-i" ++ path </> d) srcDirs
+            , arg $ do
+                prefix <- ["-i", "-I"] -- 'import' and '#include' search paths
+                suffix <- ["build", "build/autogen"]
+                return $ prefix ++ buildDir </> suffix
+            , arg $ map (\d -> "-I" ++ path </> d) $ filter isRelative includeDirs
+            , arg $ map (\d -> "-I" ++          d) $ filter isAbsolute includeDirs
+            , arg ["-optP-include"]
+            , arg ["-optP" ++ buildDir </> "build/autogen/cabal_macros.h"]
+            , if usePackageKey 
+              then arg $ concatMap (\d -> ["-package-key", d]) depKeys
+              else arg $ concatMap (\d -> ["-package"    , d]) deps
+            , arg ["-dep-makefile", out, "-dep-suffix", "", "-include-pkg-deps"]
+            , arg $ map normalise srcs
+            ]
 
 -- $1_$2_MKDEPENDHS_FLAGS = -dep-makefile $$($1_$2_depfile_haskell).tmp $$(foreach way,$$($1_$2_WAYS),-dep-suffix "$$(-- patsubst %o,%,$$($$(way)_osuf))")
 -- $1_$2_MKDEPENDHS_FLAGS += -include-pkg-deps



More information about the ghc-commits mailing list