Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
e8b62f7e
Commit
e8b62f7e
authored
Feb 12, 2016
by
Andrey Mokhov
Browse files
Factor out Context from Target.
See
#207
.
parent
2c219087
Changes
20
Hide whitespace changes
Inline
Side-by-side
shaking-up-ghc.cabal
View file @
e8b62f7e
...
...
@@ -20,6 +20,7 @@ executable ghc-shake
other-modules: Base
, Builder
, CmdLineFlag
, Context
, Environment
, Expression
, GHC
...
...
src/Context.hs
0 → 100644
View file @
e8b62f7e
{-# LANGUAGE DeriveGeneric #-}
module
Context
(
Context
(
..
),
vanillaContext
,
stageContext
)
where
import
GHC.Generics
(
Generic
)
import
Base
import
Package
import
Stage
import
Way
-- | Build context for a currently built 'Target'. We generate potentially
-- different build rules for each 'Context'.
data
Context
=
Context
{
stage
::
Stage
-- ^ Currently build Stage
,
package
::
Package
-- ^ Currently build Package
,
way
::
Way
-- ^ Currently build Way (usually 'vanilla')
}
deriving
(
Show
,
Eq
,
Generic
)
-- | Most targets are built only one way, hence the notion of 'vanillaContext'.
vanillaContext
::
Stage
->
Package
->
Context
vanillaContext
s
p
=
Context
s
p
vanilla
stageContext
::
Stage
->
Context
stageContext
s
=
vanillaContext
s
$
error
"stageContext: package not set"
instance
Binary
Context
instance
NFData
Context
instance
Hashable
Context
src/Expression.hs
View file @
e8b62f7e
...
...
@@ -6,13 +6,13 @@ module Expression (
apply
,
append
,
arg
,
remove
,
removePair
,
appendSub
,
appendSubD
,
filterSub
,
removeSub
,
-- ** Evaluation
interpret
,
interpret
Partial
,
interpretWithStage
,
interpretDiff
,
interpret
,
interpret
InContext
,
interpretDiff
,
-- ** Predicates
Predicate
,
(
?
),
applyPredicate
,
-- ** Common expressions
Args
,
Ways
,
Packages
,
-- ** Target
s
Target
,
PartialTarget
(
..
),
unsafeFromPartial
,
full
Target
,
full
Target
WithWay
,
-- **
Context and
Target
Context
,
vanillaContext
,
stageContext
,
Target
,
dummy
Target
,
-- * Convenient accessors
getStage
,
getPackage
,
getBuilder
,
getOutputs
,
getInputs
,
getWay
,
...
...
@@ -30,6 +30,7 @@ import Control.Monad.Trans.Reader
import
Data.Monoid
import
Base
import
Context
import
Package
import
Builder
import
Stage
...
...
@@ -146,16 +147,13 @@ filterSub prefix p = apply $ map filterSubstr
removeSub
::
String
->
[
String
]
->
Args
removeSub
prefix
xs
=
filterSub
prefix
(`
notElem
`
xs
)
-- | Interpret a given expression
in a given environment
.
-- | Interpret a given expression
according to the given 'Target'
.
interpret
::
Target
->
Expr
a
->
Action
a
interpret
=
flip
runReaderT
interpretPartial
::
PartialTarget
->
Expr
a
->
Action
a
interpretPartial
=
interpret
.
unsafeFromPartial
interpretWithStage
::
Stage
->
Expr
a
->
Action
a
interpretWithStage
s
=
interpretPartial
$
PartialTarget
s
(
error
"interpretWithStage: package not set"
)
-- | Interpret a given expression by looking only at the given 'Context'.
interpretInContext
::
Context
->
Expr
a
->
Action
a
interpretInContext
=
interpret
.
dummyTarget
-- | Extract an expression from a difference expression.
fromDiffExpr
::
Monoid
a
=>
DiffExpr
a
->
Expr
a
...
...
@@ -167,11 +165,11 @@ interpretDiff target = interpret target . fromDiffExpr
-- | Convenient getters for target parameters.
getStage
::
Expr
Stage
getStage
=
asks
stage
getStage
=
stage
<$>
asks
context
-- | Get the 'Package' of the current 'Target'.
getPackage
::
Expr
Package
getPackage
=
asks
package
getPackage
=
package
<$>
asks
context
-- | Get the 'Builder' for the current 'Target'.
getBuilder
::
Expr
Builder
...
...
@@ -179,7 +177,7 @@ getBuilder = asks builder
-- | Get the 'Way' of the current 'Target'.
getWay
::
Expr
Way
getWay
=
asks
way
getWay
=
way
<$>
asks
context
-- | Get the input files of the current 'Target'.
getInputs
::
Expr
[
FilePath
]
...
...
src/Oracles/PackageDb.hs
View file @
e8b62f7e
...
...
@@ -3,6 +3,7 @@ module Oracles.PackageDb (packageDbOracle) where
import
qualified
System.Directory
as
IO
import
Base
import
Context
hiding
(
stage
)
import
Builder
import
GHC
import
Rules.Actions
...
...
@@ -16,8 +17,7 @@ packageDbOracle = do
let
dir
=
packageDbDirectory
stage
file
=
dir
-/-
"package.cache"
unlessM
(
liftIO
$
IO
.
doesFileExist
file
)
$
do
let
target
=
PartialTarget
stage
ghcPkg
removeDirectoryIfExists
dir
build
$
full
Target
ta
r
ge
t
(
GhcPkg
stage
)
[]
[
dir
]
build
$
Target
(
vanillaContext
s
tage
ghcPkg
)
(
GhcPkg
stage
)
[]
[
dir
]
putSuccess
$
"| Successfully initialised "
++
dir
return
()
src/Rules.hs
View file @
e8b62f7e
...
...
@@ -3,7 +3,7 @@ module Rules (topLevelTargets, packageRules) where
import
Base
import
Data.Foldable
import
Expression
import
GHC
import
GHC
hiding
(
haddock
)
import
qualified
Rules.Generate
import
Rules.Package
import
Rules.Resources
...
...
@@ -27,14 +27,14 @@ topLevelTargets = do
for_
allStages
$
\
stage
->
for_
(
knownPackages
\\
[
rts
,
libffi
])
$
\
pkg
->
action
$
do
let
target
=
PartialTarge
t
stage
pkg
activePackages
<-
interpret
Partial
targe
t
getPackages
let
context
=
vanillaContex
t
stage
pkg
activePackages
<-
interpret
InContext
contex
t
getPackages
when
(
pkg
`
elem
`
activePackages
)
$
if
isLibrary
pkg
then
do
-- build a library
ways
<-
interpret
Partial
targe
t
getLibraryWays
ways
<-
interpret
InContext
contex
t
getLibraryWays
libs
<-
traverse
(
pkgLibraryFile
stage
pkg
)
ways
haddock
<-
interpret
Partial
targe
t
buildHaddock
haddock
<-
interpret
InContext
contex
t
buildHaddock
need
$
libs
++
[
pkgHaddockFile
pkg
|
haddock
&&
stage
==
Stage1
]
else
do
-- otherwise build a program
need
[
fromJust
$
programPath
stage
pkg
]
-- TODO: drop fromJust
...
...
@@ -44,4 +44,4 @@ packageRules = do
resources
<-
resourceRules
for_
allStages
$
\
stage
->
for_
knownPackages
$
\
pkg
->
buildPackage
resources
$
PartialTarge
t
stage
pkg
buildPackage
resources
$
vanillaContex
t
stage
pkg
src/Rules/Actions.hs
View file @
e8b62f7e
...
...
@@ -11,20 +11,20 @@ import qualified Control.Exception.Base as IO
import
Base
import
CmdLineFlag
import
Context
import
Expression
import
Oracles.ArgsHash
import
Oracles.WindowsPath
import
Settings
import
Settings.Args
import
Settings.Builders.Ar
import
qualified
Target
import
Target
-- Build a given target using an appropriate builder and acquiring necessary
-- resources. Force a rebuilt if the argument list has changed since the last
-- built (that is, track changes in the build system).
buildWithResources
::
[(
Resource
,
Int
)]
->
Target
->
Action
()
buildWithResources
rs
target
=
do
let
builder
=
Target
.
builder
target
buildWithResources
rs
target
@
Target
{
..
}
=
do
needBuilder
laxDependencies
builder
path
<-
builderPath
builder
argList
<-
interpret
target
getArgs
...
...
@@ -160,15 +160,15 @@ makeExecutable file = do
quietly
$
cmd
"chmod +x "
[
file
]
-- Print out key information about the command being executed
putInfo
::
Target
.
Target
->
Action
()
putInfo
Target
.
Target
{
..
}
=
putProgressInfo
$
renderAction
(
"Run "
++
show
builder
++
" ("
++
stageInfo
++
"package = "
++
pkgNameString
package
++
wayInfo
++
")"
)
(
digest
inputs
)
(
digest
outputs
)
putInfo
::
Target
->
Action
()
putInfo
Target
{
..
}
=
putProgressInfo
$
renderAction
(
"Run "
++
show
builder
++
contextInfo
)
(
digest
inputs
)
(
digest
outputs
)
where
stageInfo
=
if
isStaged
builder
then
""
else
"stage = "
++
show
stage
++
", "
wayInfo
=
if
way
==
vanilla
then
""
else
", way = "
++
show
way
contextInfo
=
concat
$
[
" ("
]
++
[
"stage = "
++
show
(
stage
context
)
]
++
[
", package = "
++
pkgNameString
(
package
context
)
]
++
[
", way = "
++
show
(
way
context
)
|
way
context
/=
vanilla
]
++
[
")"
]
digest
[]
=
"none"
digest
[
x
]
=
x
digest
(
x
:
xs
)
=
x
++
" (and "
++
show
(
length
xs
)
++
" more)"
...
...
src/Rules/Cabal.hs
View file @
e8b62f7e
...
...
@@ -14,7 +14,7 @@ cabalRules :: Rules ()
cabalRules
=
do
-- Cache boot package constraints (to be used in cabalArgs)
bootPackageConstraints
%>
\
out
->
do
bootPkgs
<-
interpret
WithStage
Stage0
getPackages
bootPkgs
<-
interpret
InContext
(
stageContext
Stage0
)
getPackages
let
pkgs
=
filter
(
\
p
->
p
/=
compiler
&&
isLibrary
p
)
bootPkgs
constraints
<-
forM
(
sort
pkgs
)
$
\
pkg
->
do
need
[
pkgCabalFile
pkg
]
...
...
@@ -27,7 +27,7 @@ cabalRules = do
-- Cache package dependencies
packageDependencies
%>
\
out
->
do
pkgs
<-
interpret
WithStage
Stage1
getPackages
pkgs
<-
interpret
InContext
(
stageContext
Stage1
)
getPackages
pkgDeps
<-
forM
(
sort
pkgs
)
$
\
pkg
->
if
pkg
==
rts
then
return
$
pkgNameString
pkg
...
...
src/Rules/Compile.hs
View file @
e8b62f7e
{-# LANGUAGE RecordWildCards #-}
module
Rules.Compile
(
compilePackage
)
where
import
Base
import
Context
import
Expression
import
Oracles.Dependencies
import
Rules.Actions
import
Rules.Resources
import
Settings
import
Target
hiding
(
context
)
compilePackage
::
Resources
->
PartialTarget
->
Rules
()
compilePackage
rs
target
@
(
PartialTarget
stage
pkg
)
=
do
let
buildPath
=
targetPath
stage
pkg
-/-
"build"
-- TODO: Use way from Context, #207
compilePackage
::
Resources
->
Context
->
Rules
()
compilePackage
rs
context
@
(
Context
{
..
})
=
do
let
buildPath
=
targetPath
stage
package
-/-
"build"
matchBuildResult
buildPath
"hi"
?>
\
hi
->
if
compileInterfaceFilesSeparately
&&
not
(
"//HpcParser.*"
?==
hi
)
then
do
let
w
ay
=
detectWay
hi
(
src
,
deps
)
<-
dependencies
buildPath
$
hi
-<.>
osuf
w
ay
let
w
=
detectWay
hi
(
src
,
deps
)
<-
dependencies
buildPath
$
hi
-<.>
osuf
w
need
$
src
:
deps
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
full
Target
WithWay
target
(
Ghc
stage
)
way
[
src
]
[
hi
]
Target
(
context
{
way
=
w
})
(
Ghc
stage
)
[
src
]
[
hi
]
else
need
[
hi
-<.>
osuf
(
detectWay
hi
)
]
matchBuildResult
buildPath
"hi-boot"
?>
\
hiboot
->
if
compileInterfaceFilesSeparately
then
do
let
w
ay
=
detectWay
hiboot
(
src
,
deps
)
<-
dependencies
buildPath
$
hiboot
-<.>
obootsuf
w
ay
let
w
=
detectWay
hiboot
(
src
,
deps
)
<-
dependencies
buildPath
$
hiboot
-<.>
obootsuf
w
need
$
src
:
deps
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
full
Target
WithWay
target
(
Ghc
stage
)
way
[
src
]
[
hiboot
]
Target
(
context
{
way
=
w
})
(
Ghc
stage
)
[
src
]
[
hiboot
]
else
need
[
hiboot
-<.>
obootsuf
(
detectWay
hiboot
)
]
-- TODO: add dependencies for #include of .h and .hs-incl files (gcc -MM?)
...
...
@@ -37,21 +41,21 @@ compilePackage rs target @ (PartialTarget stage pkg) = do
if
(
"//*.c"
?==
src
)
then
do
need
$
src
:
deps
build
$
full
Target
targe
t
(
Gcc
stage
)
[
src
]
[
obj
]
build
$
Target
contex
t
(
Gcc
stage
)
[
src
]
[
obj
]
else
do
let
w
ay
=
detectWay
obj
let
w
=
detectWay
obj
if
compileInterfaceFilesSeparately
&&
"//*.hs"
?==
src
&&
not
(
"//HpcParser.*"
?==
src
)
then
need
$
(
obj
-<.>
hisuf
(
detectWay
obj
))
:
src
:
deps
else
need
$
src
:
deps
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
full
Target
WithWay
target
(
Ghc
stage
)
way
[
src
]
[
obj
]
Target
(
context
{
way
=
w
})
(
Ghc
stage
)
[
src
]
[
obj
]
-- TODO: get rid of these special cases
matchBuildResult
buildPath
"o-boot"
?>
\
obj
->
do
(
src
,
deps
)
<-
dependencies
buildPath
obj
let
w
ay
=
detectWay
obj
let
w
=
detectWay
obj
if
compileInterfaceFilesSeparately
then
need
$
(
obj
-<.>
hibootsuf
(
detectWay
obj
))
:
src
:
deps
else
need
$
src
:
deps
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
full
Target
WithWay
target
(
Ghc
stage
)
way
[
src
]
[
obj
]
Target
(
context
{
way
=
w
})
(
Ghc
stage
)
[
src
]
[
obj
]
src/Rules/Data.hs
View file @
e8b62f7e
{-# LANGUAGE RecordWildCards #-}
module
Rules.Data
(
buildPackageData
)
where
import
qualified
System.Directory
as
IO
import
Base
import
Context
import
Expression
import
GHC
import
Oracles.Config.Setting
...
...
@@ -13,26 +15,27 @@ import Rules.Libffi
import
Rules.Resources
import
Settings
import
Settings.Builders.Common
import
Target
-- Build package-data.mk by using GhcCabal to process pkgCabal file
buildPackageData
::
Resources
->
PartialTarge
t
->
Rules
()
buildPackageData
_
target
@
(
PartialTarget
stage
pkg
)
=
do
let
cabalFile
=
pkgCabalFile
p
kg
configure
=
pkgPath
p
kg
-/-
"configure"
dataFile
=
pkgDataFile
stage
p
kg
oldPath
=
pkgPath
p
kg
-/-
targetDirectory
stage
p
kg
-- TODO: remove, #113
buildPackageData
::
Resources
->
Contex
t
->
Rules
()
buildPackageData
_
context
@
(
Context
{
..
}
)
=
do
let
cabalFile
=
pkgCabalFile
p
ackage
configure
=
pkgPath
p
ackage
-/-
"configure"
dataFile
=
pkgDataFile
stage
p
ackage
oldPath
=
pkgPath
p
ackage
-/-
targetDirectory
stage
p
ackage
-- TODO: remove, #113
[
dataFile
,
oldPath
-/-
"package-data.mk"
]
&%>
\
_
->
do
-- The first thing we do with any package is make sure all generated
-- dependencies are in place before proceeding.
orderOnly
$
generatedDependencies
stage
p
kg
orderOnly
$
generatedDependencies
stage
p
ackage
-- GhcCabal may run the configure script, so we depend on it
whenM
(
doesFileExist
$
configure
<.>
"ac"
)
$
need
[
configure
]
-- Before we configure a package its dependencies need to be registered
deps
<-
packageDeps
p
kg
pkgs
<-
interpret
Partial
targe
t
getPackages
deps
<-
packageDeps
p
ackage
pkgs
<-
interpret
InContext
contex
t
getPackages
let
depPkgs
=
matchPackageNames
(
sort
pkgs
)
deps
need
=<<
traverse
(
pkgConfFile
stage
)
depPkgs
...
...
@@ -40,24 +43,24 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
let
inTreeMk
=
oldPath
-/-
takeFileName
dataFile
need
[
cabalFile
]
build
$
full
Target
targe
t
GhcCabal
[
cabalFile
]
[
inTreeMk
]
build
$
Target
contex
t
GhcCabal
[
cabalFile
]
[
inTreeMk
]
-- TODO: get rid of this, see #113
liftIO
$
IO
.
copyFile
inTreeMk
dataFile
autogenFiles
<-
getDirectoryFiles
oldPath
[
"build/autogen/*"
]
createDirectory
$
targetPath
stage
p
kg
-/-
"build/autogen"
createDirectory
$
targetPath
stage
p
ackage
-/-
"build/autogen"
forM_
autogenFiles
$
\
file
->
do
copyFile
(
oldPath
-/-
file
)
(
targetPath
stage
p
kg
-/-
file
)
copyFile
(
oldPath
-/-
file
)
(
targetPath
stage
p
ackage
-/-
file
)
let
haddockPrologue
=
"haddock-prologue.txt"
copyFile
(
oldPath
-/-
haddockPrologue
)
(
targetPath
stage
p
kg
-/-
haddockPrologue
)
copyFile
(
oldPath
-/-
haddockPrologue
)
(
targetPath
stage
p
ackage
-/-
haddockPrologue
)
postProcessPackageData
stage
p
kg
dataFile
postProcessPackageData
stage
p
ackage
dataFile
-- TODO: PROGNAME was $(CrossCompilePrefix)hp2ps
priority
2.0
$
do
when
(
p
kg
==
hp2ps
)
$
dataFile
%>
\
mk
->
do
includes
<-
interpret
Partial
targe
t
$
fromDiffExpr
includesArgs
let
prefix
=
fixKey
(
targetPath
stage
p
kg
)
++
"_"
when
(
p
ackage
==
hp2ps
)
$
dataFile
%>
\
mk
->
do
includes
<-
interpret
InContext
contex
t
$
fromDiffExpr
includesArgs
let
prefix
=
fixKey
(
targetPath
stage
p
ackage
)
++
"_"
cSrcs
=
[
"AreaBelow.c"
,
"Curves.c"
,
"Error.c"
,
"Main.c"
,
"Reorder.c"
,
"TopTwenty.c"
,
"AuxFile.c"
,
"Deviation.c"
,
"HpFile.c"
,
"Marks.c"
,
"Scale.c"
...
...
@@ -71,8 +74,8 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
writeFileChanged
mk
contents
putSuccess
$
"| Successfully generated '"
++
mk
++
"'."
when
(
p
kg
==
unlit
)
$
dataFile
%>
\
mk
->
do
let
prefix
=
fixKey
(
targetPath
stage
p
kg
)
++
"_"
when
(
p
ackage
==
unlit
)
$
dataFile
%>
\
mk
->
do
let
prefix
=
fixKey
(
targetPath
stage
p
ackage
)
++
"_"
contents
=
unlines
$
map
(
prefix
++
)
[
"PROGNAME = unlit"
,
"C_SRCS = unlit.c"
...
...
@@ -80,8 +83,8 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
writeFileChanged
mk
contents
putSuccess
$
"| Successfully generated '"
++
mk
++
"'."
when
(
p
kg
==
touchy
)
$
dataFile
%>
\
mk
->
do
let
prefix
=
fixKey
(
targetPath
stage
p
kg
)
++
"_"
when
(
p
ackage
==
touchy
)
$
dataFile
%>
\
mk
->
do
let
prefix
=
fixKey
(
targetPath
stage
p
ackage
)
++
"_"
contents
=
unlines
$
map
(
prefix
++
)
[
"PROGNAME = touchy"
,
"C_SRCS = touchy.c"
]
...
...
@@ -91,8 +94,8 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
-- Bootstrapping `ghcCabal`: although `ghcCabal` is a proper cabal
-- package, we cannot generate the corresponding `package-data.mk` file
-- by running by running `ghcCabal`, because it has not yet been built.
when
(
p
kg
==
ghcCabal
&&
stage
==
Stage0
)
$
dataFile
%>
\
mk
->
do
let
prefix
=
fixKey
(
targetPath
stage
p
kg
)
++
"_"
when
(
p
ackage
==
ghcCabal
&&
stage
==
Stage0
)
$
dataFile
%>
\
mk
->
do
let
prefix
=
fixKey
(
targetPath
stage
p
ackage
)
++
"_"
contents
=
unlines
$
map
(
prefix
++
)
[
"PROGNAME = ghc-cabal"
,
"MODULES = Main"
...
...
@@ -101,24 +104,24 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
writeFileChanged
mk
contents
putSuccess
$
"| Successfully generated '"
++
mk
++
"'."
when
(
p
kg
==
rts
&&
stage
==
Stage1
)
$
do
when
(
p
ackage
==
rts
&&
stage
==
Stage1
)
$
do
dataFile
%>
\
mk
->
do
orderOnly
$
generatedDependencies
stage
p
kg
orderOnly
$
generatedDependencies
stage
p
ackage
windows
<-
windowsHost
let
prefix
=
fixKey
(
targetPath
stage
p
kg
)
++
"_"
let
prefix
=
fixKey
(
targetPath
stage
p
ackage
)
++
"_"
dirs
=
[
"."
,
"hooks"
,
"sm"
,
"eventlog"
]
++
[
"posix"
|
not
windows
]
++
[
"win32"
|
windows
]
-- TODO: rts/dist/build/sm/Evac_thr.c, rts/dist/build/sm/Scav_thr.c
-- TODO: adding cmm/S sources to C_SRCS is a hack; rethink after #18
cSrcs
<-
getDirectoryFiles
(
pkgPath
p
kg
)
(
map
(
-/-
"*.c"
)
dirs
)
cmmSrcs
<-
getDirectoryFiles
(
pkgPath
p
kg
)
[
"*.cmm"
]
cSrcs
<-
getDirectoryFiles
(
pkgPath
p
ackage
)
(
map
(
-/-
"*.c"
)
dirs
)
cmmSrcs
<-
getDirectoryFiles
(
pkgPath
p
ackage
)
[
"*.cmm"
]
buildAdjustor
<-
anyTargetArch
[
"i386"
,
"powerpc"
,
"powerpc64"
]
buildStgCRunAsm
<-
anyTargetArch
[
"powerpc64le"
]
let
sSrcs
=
[
"AdjustorAsm.S"
|
buildAdjustor
]
++
[
"StgCRunAsm.S"
|
buildStgCRunAsm
]
extraSrcs
=
[
rtsBuildPath
-/-
"AutoApply.cmm"
]
includes
<-
interpret
Partial
targe
t
$
fromDiffExpr
includesArgs
includes
<-
interpret
InContext
contex
t
$
fromDiffExpr
includesArgs
let
contents
=
unlines
$
map
(
prefix
++
)
[
"C_SRCS = "
++
unwords
(
cSrcs
++
cmmSrcs
++
sSrcs
++
extraSrcs
)
...
...
@@ -137,16 +140,16 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
-- is replaced by libraries_deepseq_dist-install_VERSION = 1.4.0.0
-- Reason: Shake's built-in makefile parser doesn't recognise slashes
postProcessPackageData
::
Stage
->
Package
->
FilePath
->
Action
()
postProcessPackageData
stage
p
kg
file
=
fixFile
file
fixPackageData
postProcessPackageData
stage
p
ackage
file
=
fixFile
file
fixPackageData
where
fixPackageData
=
unlines
.
map
processLine
.
filter
(
not
.
null
)
.
filter
(
'$'
`
notElem
`)
.
lines
processLine
line
=
fixKey
fixedPrefix
++
suffix
where
(
prefix
,
suffix
)
=
break
(
==
'='
)
line
-- Change p
kg
/path/targetDir to takeDirectory file
-- Change p
ackage
/path/targetDir to takeDirectory file
-- This is a temporary hack until we get rid of ghc-cabal
fixedPrefix
=
takeDirectory
file
++
drop
len
prefix
len
=
length
(
pkgPath
p
kg
-/-
targetDirectory
stage
p
kg
)
len
=
length
(
pkgPath
p
ackage
-/-
targetDirectory
stage
p
ackage
)
-- TODO: remove, see #113
fixKey
::
String
->
String
...
...
src/Rules/Dependencies.hs
View file @
e8b62f7e
{-# LANGUAGE RecordWildCards #-}
module
Rules.Dependencies
(
buildPackageDependencies
)
where
import
Development.Shake.Util
(
parseMakefile
)
import
Base
import
Context
import
Expression
import
Oracles.PackageData
import
Rules.Actions
import
Rules.Resources
import
Settings
import
Development.Shake.Util
(
parseMakefile
)
import
Target
-- TODO: simplify handling of AutoApply.cmm
buildPackageDependencies
::
Resources
->
PartialTarge
t
->
Rules
()
buildPackageDependencies
rs
target
@
(
PartialTarget
stage
pkg
)
=
let
path
=
targetPath
stage
p
kg
buildPackageDependencies
::
Resources
->
Contex
t
->
Rules
()
buildPackageDependencies
rs
context
@
(
Context
{
..
}
)
=
let
path
=
targetPath
stage
p
ackage
buildPath
=
path
-/-
"build"
dropBuild
=
(
pkgPath
p
kg
++
)
.
drop
(
length
buildPath
)
dropBuild
=
(
pkgPath
p
ackage
++
)
.
drop
(
length
buildPath
)
hDepFile
=
buildPath
-/-
".hs-dependencies"
in
do
fmap
(
buildPath
++
)
...
...
@@ -22,15 +26,15 @@ buildPackageDependencies rs target @ (PartialTarget stage pkg) =
then
dropExtension
out
else
dropBuild
.
dropExtension
$
out
need
[
srcFile
]
build
$
full
Target
targe
t
(
GccM
stage
)
[
srcFile
]
[
out
]
build
$
Target
contex
t
(
GccM
stage
)
[
srcFile
]
[
out
]
hDepFile
%>
\
out
->
do
srcs
<-
interpret
Partial
targe
t
getPackageSources
srcs
<-
interpret
InContext
contex
t
getPackageSources
need
srcs
if
srcs
==
[]
then
writeFileChanged
out
""
else
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
full
Target
targe
t
(
GhcM
stage
)
srcs
[
out
]
Target
contex
t
(
GhcM
stage
)
srcs
[
out
]
removeFileIfExists
$
out
<.>
"bak"
-- TODO: don't accumulate *.deps into .dependencies
...
...
src/Rules/Documentation.hs
View file @
e8b62f7e
{-# LANGUAGE RecordWildCards #-}
module
Rules.Documentation
(
buildPackageDocumentation
)
where
import
Base
import
Context
import
Expression
import
GHC
import
Oracles.PackageData
import
Rules.Actions
import
Rules.Resources
import
Settings
import
Target
haddockHtmlLib
::
FilePath
haddockHtmlLib
=
"inplace/lib/html/haddock-util.js"
...
...
@@ -14,14 +17,14 @@ haddockHtmlLib = "inplace/lib/html/haddock-util.js"
-- Note: this build rule creates plenty of files, not just the .haddock one.
-- All of them go into the 'doc' subdirectory. Pedantically tracking all built
-- files in the Shake databases seems fragile and unnecesarry.
buildPackageDocumentation
::
Resources
->
PartialTarge
t
->
Rules
()
buildPackageDocumentation
_
target
@
(
PartialTarget
stage
pkg
)
=
let
cabalFile
=
pkgCabalFile
p
kg
haddockFile
=
pkgHaddockFile
p
kg
buildPackageDocumentation
::
Resources
->
Contex
t
->
Rules
()
buildPackageDocumentation
_
context
@
(
Context
{
..
}
)
=
let
cabalFile
=
pkgCabalFile
p
ackage
haddockFile
=
pkgHaddockFile
p
ackage
in
when
(
stage
==
Stage1
)
$
do
haddockFile
%>
\
file
->
do
srcs
<-
interpret
Partial
targe
t
getPackageSources
deps
<-
map
PackageName
<$>
interpret
Partial
targe
t
(
getPkgDataList
DepNames
)
srcs
<-
interpret
InContext
contex
t
getPackageSources
deps
<-
map
PackageName
<$>
interpret
InContext
contex
t
(
getPkgDataList
DepNames
)
let
haddocks
=
[
pkgHaddockFile
depPkg
|
Just
depPkg
<-
map
findKnownPackage
deps
,
depPkg
/=
rts
]
...
...
@@ -30,15 +33,15 @@ buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
-- HsColour sources
-- TODO: what is the output of GhcCabalHsColour?
whenM
(
specified
HsColour
)
$
do
pkgConf
<-
pkgConfFile
stage
p
kg
pkgConf
<-
pkgConfFile
stage
p
ackage
need
[
cabalFile
,
pkgConf
]
-- TODO: check if need pkgConf
build
$
full
Target
targe
t
GhcCabalHsColour
[
cabalFile
]
[]
build
$
Target
contex
t
GhcCabalHsColour
[
cabalFile
]
[]
-- Build Haddock documentation
let
haddockWay
=
if
dynamicGhcPrograms
then
dynamic
else
vanilla
build
$
full
Target
WithWay
target
Haddock
h
addock
Way
srcs
[
file
]
build
$
Target
(
context
{
way
=
haddockWay
})
H
addock
srcs
[
file
]
when
(
p
kg
==
haddock
)
$
haddockHtmlLib
%>
\
_
->
do
when
(
p
ackage
==
haddock
)
$
haddockHtmlLib
%>
\
_
->
do
let
dir
=
takeDirectory
haddockHtmlLib
liftIO
$
removeFiles
dir
[
"//*"
]
copyDirectory
"utils/haddock/haddock-api/resources/html"
dir
...
...
src/Rules/Generate.hs
View file @
e8b62f7e
...
...
@@ -6,6 +6,7 @@ module Rules.Generate (
import
qualified
System.Directory
as
IO
import
Base
import
Context
hiding
(
stage
)
import
Expression
import
GHC
import
Rules.Generators.ConfigHs
...
...
@@ -21,6 +22,7 @@ import Rules.Gmp
import
Rules.Libffi
import
Rules.Resources
(
Resources
)
import
Settings
import
Target
hiding
(
builder
,
context
)
installTargets
::
[
FilePath
]
installTargets
=
[
"inplace/lib/ghc-usage.txt"
...
...
@@ -106,18 +108,18 @@ determineBuilder file = fmap fst $ find (\(_, e) -> e == ext) knownGenerators
where
ext
=
takeExtension
file
generate
::
FilePath
->
PartialTarge
t
->
Expr
String
->
Action
()
generate
file
targe
t
expr
=
do
contents
<-
interpret
Partial
targe
t
expr
generate
::
FilePath
->
Contex
t
->
Expr
String
->
Action
()
generate
file
contex
t
expr
=
do
contents
<-
interpret
InContext
contex
t
expr
writeFileChanged
file
contents
putSuccess
$
"| Successfully generated '"
++
file
++
"'."
generatePackageCode
::
Resources
->
PartialTarge
t
->
Rules
()
generatePackageCode
_
target
@
(
PartialTarge
t
stage
pkg
)
=
generatePackageCode
::
Resources
->
Contex
t
->
Rules
()
generatePackageCode
_
context
@
(
Contex
t
stage
pkg
_
)
=
let
buildPath
=
targetPath
stage
pkg
-/-
"build"
dropBuild
=
drop
(
length
buildPath
+
1
)
generated
f
=
(
buildPath
++
"//*.hs"
)
?==
f
&&
not
(
"//autogen/*"
?==
f
)
file
<~
gen
=
generate
file
targe
t
gen
file
<~
gen
=
generate
file
contex
t
gen
in
do
generated
?>
\
file
->
do