[commit: ghc] wip/nfs-locking: Simplify, remove old hacks (4fd513a)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:45:13 UTC 2017


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

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

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

commit 4fd513a325e1689e971f72941975ee20912bd647
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Oct 31 23:52:34 2016 +0000

    Simplify, remove old hacks


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

4fd513a325e1689e971f72941975ee20912bd647
 src/Rules/Generate.hs | 39 +++++++++++++--------------------------
 1 file changed, 13 insertions(+), 26 deletions(-)

diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
index 0141f29..d13d2bb 100644
--- a/src/Rules/Generate.hs
+++ b/src/Rules/Generate.hs
@@ -3,8 +3,6 @@ module Rules.Generate (
     installTargets, copyRules, includesDependencies, generatedDependencies
     ) where
 
-import qualified System.Directory as IO
-
 import Base
 import Context hiding (package)
 import Expression
@@ -110,21 +108,27 @@ generatePackageCode :: Context -> Rules ()
 generatePackageCode context@(Context stage pkg _) =
     let path        = buildPath context
         generated f = (path ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
-        file <~ gen = generate file context gen
+        go gen file = generate file context gen
     in do
         generated ?> \file -> do
             let unpack = fromMaybe . error $ "No generator for " ++ file ++ "."
             (src, builder) <- unpack <$> findGenerator context file
             need [src]
             build $ Target context builder [src] [file]
-            let srcBoot = src -<.> "hs-boot"
-            whenM (doesFileExist srcBoot) $
-                copyFile srcBoot $ file -<.> "hs-boot"
+            let boot = src -<.> "hs-boot"
+            whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot"
+
+        priority 2.0 $ do
+            when (pkg == compiler) $ path -/- "Config.hs" %> go generateConfigHs
+            when (pkg == ghcPkg) $ path -/- "Version.hs" %> go generateVersionHs
 
         -- TODO: needing platformH is ugly and fragile
-        when (pkg == compiler) $ primopsTxt stage %> \file -> do
-            need $ [platformH stage, primopsSource] ++ includesDependencies
-            build $ Target context HsCpp [primopsSource] [file]
+        when (pkg == compiler) $ do
+            primopsTxt stage %> \file -> do
+                need $ [platformH stage, primopsSource] ++ includesDependencies
+                build $ Target context HsCpp [primopsSource] [file]
+
+            platformH stage %> go generateGhcBootPlatformH
 
         -- TODO: why different folders for generated files?
         fmap (path -/-)
@@ -133,26 +137,10 @@ generatePackageCode context@(Context stage pkg _) =
             , "*.hs-incl" ] |%> \file -> do
                 need [primopsTxt stage]
                 build $ Target context GenPrimopCode [primopsTxt stage] [file]
-                -- TODO: this is temporary hack, get rid of this (#113)
-                let oldPath = pkgPath pkg -/- stageDirectory stage -/- "build"
-                    newFile = oldPath ++ (drop (length path) file)
-                createDirectory $ takeDirectory newFile
-                liftIO $ IO.copyFile file newFile
-                putBuild $ "| Duplicate file " ++ file ++ " -> " ++ newFile
 
         when (pkg == rts) $ path -/- "cmm/AutoApply.cmm" %> \file ->
             build $ Target context GenApply [] [file]
 
-        priority 2.0 $ do
-            when (pkg == compiler) $ path -/- "Config.hs" %> \file -> do
-                file <~ generateConfigHs
-
-            when (pkg == compiler) $ platformH stage %> \file -> do
-                file <~ generateGhcBootPlatformH
-
-            when (pkg == ghcPkg) $ path -/- "Version.hs" %> \file -> do
-                file <~ generateVersionHs
-
 copyRules :: Rules ()
 copyRules = do
     "inplace/lib/ghc-usage.txt"      <~ "driver"
@@ -179,7 +167,6 @@ generateRules = do
     generatedPath ++ "//*" %> \file -> do
         withTempDir $ \dir -> build $
             Target rtsContext DeriveConstants [] [file, dir]
-
   where
     file <~ gen = file %> \out -> generate out emptyTarget gen
 



More information about the ghc-commits mailing list