[Git][ghc/ghc][master] Refactor the rules for .hi and .o into a single rule using `&%>` #16764
Marge Bot
gitlab at gitlab.haskell.org
Tue Jun 11 03:52:55 UTC 2019
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
58a5d728 by David Eichmann at 2019-06-11T03:52:50Z
Refactor the rules for .hi and .o into a single rule using `&%>` #16764
Currently the rule for .hi files just triggers (via need) the rule
for the .o file, and .o rule generates both the .o and .hi file.
Likewise for .o-boot and .hi-boot files. This is a bit of an abuse
of Shake, and in fact shake supports rules with multiple output
with the &%> function. This exact use case appears in Neil
Mitchell's paper *Shake Before Building* section 6.3.
- - - - -
1 changed file:
- hadrian/src/Rules/Compile.hs
Changes:
=====================================
hadrian/src/Rules/Compile.hs
=====================================
@@ -4,7 +4,7 @@ import Hadrian.BuildPath
import Hadrian.Oracles.TextFile
import Base
-import Context
+import Context as C
import Expression
import Rules.Generate
import Settings
@@ -30,16 +30,29 @@ compilePackage rs = do
--
-- and parse the information we need (stage, package path, ...) from
-- the path and figure out the suitable way to produce that object file.
- objectFilesUnder root |%> \path -> do
- obj <- parsePath (parseBuildObject root) "<object file path parser>" path
- compileObject rs path obj
+ alternatives $ do
+ -- Language is identified by subdirectory under /build.
+ -- These are non-haskell files so only have a .o or .<way>_o suffix.
+ [ root -/- "**/build/c/**/*." ++ wayPat ++ "o"
+ | wayPat <- wayPats] |%> compileNonHsObject rs C
+
+ [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o"
+ | wayPat <- wayPats] |%> compileNonHsObject rs Cmm
+
+ [ root -/- "**/build/s/**/*." ++ wayPat ++ "o"
+ | wayPat <- wayPats] |%> compileNonHsObject rs Asm
+
+ -- All else is haskell.
+ -- This comes last as it overlaps with the above rules' file patterns.
+ forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) ->
+ [ root -/- "**/build/**/*." ++ wayPat ++ oExt
+ , root -/- "**/build/**/*." ++ wayPat ++ hiExt ]
+ &%> \ [o, _hi] -> compileHsObjectAndHi rs o
where
- objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat)
- | pat <- extensionPats ]
-
- exts = [ "o", "hi", "o-boot", "hi-boot" ]
- patternsFor e = [ "." ++ e, ".*_" ++ e ]
- extensionPats = concatMap patternsFor exts
+ hsExts = [ ("o", "hi")
+ , ("o-boot", "hi-boot")
+ ]
+ wayPats = [ "", "*_" ]
-- * Object file paths types and parsers
@@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) =
-- * Building an object
-compileHsObject
- :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action ()
-compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj =
- case hsobj of
- HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way]
- HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way]
- HsObject _basename (Extension way suf) -> do
- let ctx = objectContext b
- ctxPath <- contextPath ctx
- (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
- need (src:deps)
- needLibrary =<< contextDependencies ctx
-
- -- The .dependencies files only lists shallow dependencies. ghc will
- -- generally read more *.hi and *.hi-boot files (deep dependencies).
- -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build)
- -- Note that this may allow too many *.hi and *.hi-boot files, but
- -- calculating the exact set of deep dependencies is not feasible.
- trackAllow [ "//*." ++ hisuf way
- , "//*." ++ hibootsuf way
- ]
-
- buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]
- -- Andrey: It appears that the previous refactoring has broken
- -- multiple-output build rules. Ideally, we should bring multiple-output
- -- rules back, see: https://github.com/snowleopard/hadrian/issues/216.
- -- As a temporary solution, I'm using Shake's new 'produces' feature to
- -- record that this rule also produces a corresponding interface file.
- let hi | suf == O = objpath -<.> hisuf way
- | suf == OBoot = objpath -<.> hibootsuf way
- | otherwise = error "Internal error: unknown Haskell object extension"
- produces [hi]
-
-compileNonHsObject
- :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject
- -> Action ()
-compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj =
- case nonhsobj of
- NonHsObject lang _basename _way ->
- go (builderFor lang) (toSrcFor lang)
-
- where builderFor C = Ghc CompileCWithGhc
- builderFor _ = Ghc CompileHs
-
- toSrcFor Asm = obj2src "S" (const False)
- toSrcFor C = obj2src "c" (const False)
- toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile
-
- go builder tosrc = do
- let ctx = objectContext b
- src <- tosrc ctx objpath
- need [src]
- needDependencies ctx src (objpath <.> "d")
- buildWithResources rs $ target ctx (builder stage) [src] [objpath]
-
-compileObject
- :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action ()
-compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) =
- compileHsObject rs objpath b o
-compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) =
- compileNonHsObject rs objpath b o
+compileHsObjectAndHi
+ :: [(Resource, Int)] -> FilePath -> Action ()
+compileHsObjectAndHi rs objpath = do
+ root <- buildRoot
+ b@(BuildPath _root stage _path _o)
+ <- parsePath (parseBuildObject root) "<object file path parser>" objpath
+ let ctx = objectContext b
+ way = C.way ctx
+ ctxPath <- contextPath ctx
+ (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
+ need (src:deps)
+ needLibrary =<< contextDependencies ctx
+
+ -- The .dependencies file lists indicating inputs. ghc will
+ -- generally read more *.hi and *.hi-boot files (direct inputs).
+ -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs)
+ -- Note that this may allow too many *.hi and *.hi-boot files, but
+ -- calculating the exact set of direct inputs is not feasible.
+ trackAllow [ "//*." ++ hisuf way
+ , "//*." ++ hibootsuf way
+ ]
+
+ buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]
+
+compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action ()
+compileNonHsObject rs lang path = do
+ root <- buildRoot
+ b@(BuildPath _root stage _path _o)
+ <- parsePath (parseBuildObject root) "<object file path parser>" path
+ let
+ ctx = objectContext b
+ builder = case lang of
+ C -> Ghc CompileCWithGhc
+ _ -> Ghc CompileHs
+ src <- case lang of
+ Asm -> obj2src "S" (const False) ctx path
+ C -> obj2src "c" (const False) ctx path
+ Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path
+ need [src]
+ needDependencies ctx src (path <.> "d")
+ buildWithResources rs $ target ctx (builder stage) [src] [path]
-- * Helpers
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/58a5d728d0293110d7e80aa1f067721447b20882
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/58a5d728d0293110d7e80aa1f067721447b20882
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190610/23c245cf/attachment-0001.html>
More information about the ghc-commits
mailing list