Commit fdbc3fba authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add generatePackageCode rule, alexArgs, happyArgs and Hsc2Hs builder.

parent a9adcf31
......@@ -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@
......
......@@ -11,4 +11,9 @@
4. Limit parallelism of ghc-cabal & ghc-pkg
* https://mail.haskell.org/pipermail/ghc-commits/2013-May/001712.html
* see ghc.mk, comment about parallel ghc-pkg invokations
\ No newline at end of file
* 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
......@@ -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
......
......@@ -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
......
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)" $$< $$@
......@@ -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 ]
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 ]
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 ]
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 ]
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