[commit: ghc] wip/nfs-locking: Add generatePackageCode rule, alexArgs, happyArgs and Hsc2Hs builder. (fdbc3fb)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 00:07:01 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/fdbc3fba223a2d437954bd0908fdb839fe836ac8/ghc
>---------------------------------------------------------------
commit fdbc3fba223a2d437954bd0908fdb839fe836ac8
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Sun Sep 20 02:22:46 2015 +0100
Add generatePackageCode rule, alexArgs, happyArgs and Hsc2Hs builder.
>---------------------------------------------------------------
fdbc3fba223a2d437954bd0908fdb839fe836ac8
cfg/system.config.in | 2 ++
doc/demo.txt | 5 ++++
src/Builder.hs | 2 ++
src/Rules/Documentation.hs | 6 ++---
src/Rules/Generate.hs | 55 ++++++++++++++++++++++++++++++++++++++++++
src/Rules/Package.hs | 2 ++
src/Settings/Args.hs | 20 +++++++++------
src/Settings/Builders/Alex.hs | 14 +++++++++++
src/Settings/Builders/Happy.hs | 13 ++++++++++
9 files changed, 108 insertions(+), 11 deletions(-)
diff --git a/cfg/system.config.in b/cfg/system.config.in
index a274e84..b92b6ba 100644
--- a/cfg/system.config.in
+++ b/cfg/system.config.in
@@ -19,6 +19,8 @@ ghc-cabal = @hardtop@/inplace/bin/ghc-cabal
haddock = @hardtop@/inplace/bin/haddock
+hsc2hs = @hardtop@/inplace/bin/hsc2hs
+
ld = @LdCmd@
ar = @ArCmd@
alex = @AlexCmd@
diff --git a/doc/demo.txt b/doc/demo.txt
index 7acd27d..28b3689 100644
--- a/doc/demo.txt
+++ b/doc/demo.txt
@@ -12,3 +12,8 @@
* https://mail.haskell.org/pipermail/ghc-commits/2013-May/001712.html
* see ghc.mk, comment about parallel ghc-pkg invokations
+
+5. Discovered dead code in the old build system, e.g:
+
+* Alex3 variable not needed as Alex 3.1 is required.
+* There are no generated *.y/*.ly files, hence they can never be in the build directory.
\ No newline at end of file
diff --git a/src/Builder.hs b/src/Builder.hs
index 8e5f639..3a24df3 100644
--- a/src/Builder.hs
+++ b/src/Builder.hs
@@ -26,6 +26,7 @@ data Builder = Alex
| Haddock
| Happy
| HsColour
+ | Hsc2Hs
| Ld
deriving (Show, Eq, Generic)
@@ -49,6 +50,7 @@ builderKey builder = case builder of
Happy -> "happy"
Haddock -> "haddock"
HsColour -> "hscolour"
+ Hsc2Hs -> "hsc2hs"
Ld -> "ld"
builderPath :: Builder -> Action FilePath
diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs
index 5978cfd..2ebaa59 100644
--- a/src/Rules/Documentation.hs
+++ b/src/Rules/Documentation.hs
@@ -10,9 +10,9 @@ import Settings
-- All of them go into the 'doc' subdirectory. Pedantically tracking all built
-- files in the Shake databases seems fragile and unnecesarry.
buildPackageDocumentation :: Resources -> PartialTarget -> Rules ()
-buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
- let cabalFile = pkgCabalFile pkg
- haddockFile = pkgHaddockFile pkg
+buildPackageDocumentation _ target @ (PartialTarget stage package) =
+ let cabalFile = pkgCabalFile package
+ haddockFile = pkgHaddockFile package
in when (stage == Stage1) $ do
haddockFile %> \file -> do
whenM (specified HsColour) $ do
diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
new file mode 100644
index 0000000..055dccb
--- /dev/null
+++ b/src/Rules/Generate.hs
@@ -0,0 +1,55 @@
+module Rules.Generate (generatePackageCode) where
+
+import Expression
+import Oracles
+import Rules.Actions
+import Rules.Resources
+import Settings
+
+-- The following generators and corresponding source extensions are supported:
+knownGenerators :: [ (Builder, String) ]
+knownGenerators = [ (Alex , ".x" )
+ , (Happy , ".y" )
+ , (Happy , ".ly" )
+ , (Hsc2Hs , ".hsc") ]
+
+determineBuilder :: FilePath -> Maybe Builder
+determineBuilder file = fmap fst $ find (\(_, e) -> e == ext) knownGenerators
+ where
+ ext = takeExtension file
+
+generatePackageCode :: Resources -> PartialTarget -> Rules ()
+generatePackageCode _ target @ (PartialTarget stage package) =
+ let path = targetPath stage package
+ packagePath = pkgPath package
+ buildPath = path -/- "build"
+ in do
+ buildPath </> "*.hs" %> \file -> do
+ dirs <- interpretPartial target $ getPkgDataList SrcDirs
+ files <- getDirectoryFiles "" $
+ [ packagePath </> d </> takeBaseName file <.> "*" | d <- dirs ]
+ let gens = [ (f, b) | f <- files, Just b <- [determineBuilder f] ]
+ (src, builder) = head gens
+ when (length gens /= 1) . putError $
+ "Exactly one generator expected for " ++ file
+ ++ "(found: " ++ show gens ++ ")."
+ need [src]
+ build $ fullTarget target builder [src] [file]
+
+-- $1/$2/build/%.hs : $1/$3/%.ly | $$$$(dir $$$$@)/.
+-- $$(call cmd,HAPPY) $$($1_$2_ALL_HAPPY_OPTS) $$< -o $$@
+
+-- $1/$2/build/%.hs : $1/$3/%.y | $$$$(dir $$$$@)/.
+-- $$(call cmd,HAPPY) $$($1_$2_ALL_HAPPY_OPTS) $$< -o $$@
+
+-- $1/$2/build/%_hsc.c $1/$2/build/%_hsc.h $1/$2/build/%.hs : $1/$3/%.hsc $$$$(hsc2hs_INPLACE) | $$$$(dir $$$$@)/.
+-- $$(call cmd,hsc2hs_INPLACE) $$($1_$2_ALL_HSC2HS_OPTS) $$< -o $$@
+
+-- # Now the rules for hs-boot files.
+
+-- $1/$2/build/%.hs-boot : $1/$3/%.hs-boot
+-- "$$(CP)" $$< $$@
+
+-- $1/$2/build/%.lhs-boot : $1/$3/%.lhs-boot
+-- "$$(CP)" $$< $$@
+
diff --git a/src/Rules/Package.hs b/src/Rules/Package.hs
index dfc15e8..9da4f8b 100644
--- a/src/Rules/Package.hs
+++ b/src/Rules/Package.hs
@@ -5,6 +5,7 @@ import Rules.Compile
import Rules.Data
import Rules.Dependencies
import Rules.Documentation
+import Rules.Generate
import Rules.Library
import Rules.Resources
import Target
@@ -13,6 +14,7 @@ buildPackage :: Resources -> PartialTarget -> Rules ()
buildPackage = mconcat
[ buildPackageData
, buildPackageDependencies
+ , generatePackageCode
, compilePackage
, buildPackageLibrary
, buildPackageDocumentation ]
diff --git a/src/Settings/Args.hs b/src/Settings/Args.hs
index 5a8c63a..2e2f379 100644
--- a/src/Settings/Args.hs
+++ b/src/Settings/Args.hs
@@ -1,12 +1,14 @@
module Settings.Args (getArgs) where
import Expression
+import Settings.Builders.Alex
import Settings.Builders.Ar
import Settings.Builders.Gcc
import Settings.Builders.Ghc
import Settings.Builders.GhcCabal
import Settings.Builders.GhcPkg
import Settings.Builders.Haddock
+import Settings.Builders.Happy
import Settings.Builders.Ld
import Settings.User
@@ -23,14 +25,16 @@ getArgs = fromDiffExpr $ defaultArgs <> userArgs
-- TODO: is GhcHcOpts=-Rghc-timing needed?
defaultArgs :: Args
defaultArgs = mconcat
- [ cabalArgs
- , ghcPkgArgs
- , ghcMArgs
- , gccMArgs
- , ghcArgs
- , gccArgs
+ [ alexArgs
, arArgs
- , ldArgs
+ , cabalArgs
+ , customPackageArgs
+ , ghcArgs
, ghcCabalHsColourArgs
+ , ghcMArgs
+ , ghcPkgArgs
+ , gccArgs
+ , gccMArgs
, haddockArgs
- , customPackageArgs ]
+ , happyArgs
+ , ldArgs ]
diff --git a/src/Settings/Builders/Alex.hs b/src/Settings/Builders/Alex.hs
new file mode 100644
index 0000000..6aedcdb
--- /dev/null
+++ b/src/Settings/Builders/Alex.hs
@@ -0,0 +1,14 @@
+module Settings.Builders.Alex (alexArgs) where
+
+import Expression
+import GHC (compiler)
+import Predicates (builder, package)
+
+alexArgs :: Args
+alexArgs = builder Alex ? do
+ file <- getFile
+ src <- getSource
+ mconcat [ arg "-g"
+ , package compiler ? arg "--latin1"
+ , arg src
+ , arg "-o", arg file ]
diff --git a/src/Settings/Builders/Happy.hs b/src/Settings/Builders/Happy.hs
new file mode 100644
index 0000000..fcd962a
--- /dev/null
+++ b/src/Settings/Builders/Happy.hs
@@ -0,0 +1,13 @@
+module Settings.Builders.Happy (happyArgs) where
+
+import Expression
+import Predicates (builder)
+
+happyArgs :: Args
+happyArgs = builder Happy ? do
+ file <- getFile
+ src <- getSource
+ mconcat [ arg "-agc"
+ , arg "--strict"
+ , arg src
+ , arg "-o", arg file ]
More information about the ghc-commits
mailing list