Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
2fc7bd3e
Commit
2fc7bd3e
authored
Feb 15, 2016
by
Andrey Mokhov
Browse files
Drop Rules.Resources, move packageDb resource to buildRules.
parent
6a9772a1
Changes
6
Hide whitespace changes
Inline
Side-by-side
shaking-up-ghc.cabal
View file @
2fc7bd3e
...
...
@@ -61,7 +61,6 @@ executable ghc-shake
, Rules.Perl
, Rules.Program
, Rules.Register
, Rules.Resources
, Rules.Selftest
, Rules.Setup
, Rules.Test
...
...
src/Rules.hs
View file @
2fc7bd3e
...
...
@@ -10,7 +10,6 @@ import Rules.Data
import
Rules.Dependencies
import
Rules.Documentation
import
Rules.Generate
import
Rules.Resources
import
Rules.Cabal
import
Rules.Gmp
import
Rules.Libffi
...
...
@@ -53,18 +52,25 @@ topLevelTargets = do
packageRules
::
Rules
()
packageRules
=
do
resources
<-
resourceRules
-- We cannot register multiple packages in parallel. Also we cannot run GHC
-- when the package database is being mutated by "ghc-pkg". This is a
-- classic concurrent read exclusive write (CREW) conflict.
let
maxConcurrentReaders
=
1000
packageDb
<-
newResource
"package-db"
maxConcurrentReaders
let
readPackageDb
=
[(
packageDb
,
1
)]
writePackageDb
=
[(
packageDb
,
maxConcurrentReaders
)]
for_
allStages
$
\
stage
->
for_
knownPackages
$
\
package
->
do
let
context
=
vanillaContext
stage
package
compilePackage
re
sources
context
buildPackageData
context
buildPackageDependencies
re
sources
context
buildPackageDocumentation
context
generatePackageCode
context
buildPackageLibrary
context
buildProgram
context
registerPackage
resources
context
compilePackage
re
adPackageDb
context
buildPackageData
context
buildPackageDependencies
re
adPackageDb
context
buildPackageDocumentation
context
generatePackageCode
context
buildPackageLibrary
context
buildProgram
context
registerPackage
writePackageDb
context
buildRules
::
Rules
()
buildRules
=
do
...
...
src/Rules/Compile.hs
View file @
2fc7bd3e
...
...
@@ -6,12 +6,11 @@ import Context
import
Expression
import
Oracles.Dependencies
import
Rules.Actions
import
Rules.Resources
import
Settings
import
Target
hiding
(
context
)
-- TODO: Use way from Context, #207
compilePackage
::
Resource
s
->
Context
->
Rules
()
compilePackage
::
[(
Resource
,
Int
)]
->
Context
->
Rules
()
compilePackage
rs
context
@
(
Context
{
..
})
=
do
let
buildPath
=
targetPath
stage
package
-/-
"build"
...
...
@@ -21,7 +20,7 @@ compilePackage rs context @ (Context {..}) = do
let
w
=
detectWay
hi
(
src
,
deps
)
<-
dependencies
buildPath
$
hi
-<.>
osuf
w
need
$
src
:
deps
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
buildWithResources
rs
$
Target
(
context
{
way
=
w
})
(
Ghc
stage
)
[
src
]
[
hi
]
else
need
[
hi
-<.>
osuf
(
detectWay
hi
)
]
...
...
@@ -31,7 +30,7 @@ compilePackage rs context @ (Context {..}) = do
let
w
=
detectWay
hiboot
(
src
,
deps
)
<-
dependencies
buildPath
$
hiboot
-<.>
obootsuf
w
need
$
src
:
deps
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
buildWithResources
rs
$
Target
(
context
{
way
=
w
})
(
Ghc
stage
)
[
src
]
[
hiboot
]
else
need
[
hiboot
-<.>
obootsuf
(
detectWay
hiboot
)
]
...
...
@@ -47,7 +46,7 @@ compilePackage rs context @ (Context {..}) = do
if
compileInterfaceFilesSeparately
&&
"//*.hs"
?==
src
&&
not
(
"//HpcParser.*"
?==
src
)
then
need
$
(
obj
-<.>
hisuf
(
detectWay
obj
))
:
src
:
deps
else
need
$
src
:
deps
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
buildWithResources
rs
$
Target
(
context
{
way
=
w
})
(
Ghc
stage
)
[
src
]
[
obj
]
-- TODO: get rid of these special cases
...
...
@@ -57,5 +56,5 @@ compilePackage rs context @ (Context {..}) = do
if
compileInterfaceFilesSeparately
then
need
$
(
obj
-<.>
hibootsuf
(
detectWay
obj
))
:
src
:
deps
else
need
$
src
:
deps
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
buildWithResources
rs
$
Target
(
context
{
way
=
w
})
(
Ghc
stage
)
[
src
]
[
obj
]
src/Rules/Dependencies.hs
View file @
2fc7bd3e
...
...
@@ -8,12 +8,11 @@ import Context
import
Expression
import
Oracles.PackageData
import
Rules.Actions
import
Rules.Resources
import
Settings
import
Target
-- TODO: simplify handling of AutoApply.cmm
buildPackageDependencies
::
Resource
s
->
Context
->
Rules
()
buildPackageDependencies
::
[(
Resource
,
Int
)]
->
Context
->
Rules
()
buildPackageDependencies
rs
context
@
(
Context
{
..
})
=
let
path
=
targetPath
stage
package
buildPath
=
path
-/-
"build"
...
...
@@ -33,7 +32,7 @@ buildPackageDependencies rs context @ (Context {..}) =
need
srcs
if
srcs
==
[]
then
writeFileChanged
out
""
else
buildWithResources
[(
resPackageDb
rs
,
1
)]
$
else
buildWithResources
rs
$
Target
context
(
GhcM
stage
)
srcs
[
out
]
removeFileIfExists
$
out
<.>
"bak"
...
...
src/Rules/Register.hs
View file @
2fc7bd3e
...
...
@@ -9,14 +9,13 @@ import Expression
import
GHC
import
Rules.Actions
import
Rules.Libffi
import
Rules.Resources
import
Settings
import
Settings.Packages.Rts
import
Target
-- TODO: Use way from Context, #207
-- Build package-data.mk by using GhcCabal to process pkgCabal file
registerPackage
::
Resource
s
->
Context
->
Rules
()
registerPackage
::
[(
Resource
,
Int
)]
->
Context
->
Rules
()
registerPackage
rs
context
@
(
Context
{
..
})
=
do
let
oldPath
=
pkgPath
package
-/-
targetDirectory
stage
package
-- TODO: remove, #113
pkgConf
=
packageDbDirectory
stage
-/-
pkgNameString
package
...
...
@@ -38,13 +37,13 @@ registerPackage rs context @ (Context {..}) = do
fixFile
pkgConfig
fixPkgConf
buildWithResources
[(
resPackageDb
rs
,
resPackageDbLimit
)]
$
buildWithResources
rs
$
Target
context
(
GhcPkg
stage
)
[
pkgConfig
]
[
conf
]
when
(
package
==
rts
&&
stage
==
Stage1
)
$
do
packageDbDirectory
Stage1
-/-
"rts.conf"
%>
\
conf
->
do
need
[
rtsConf
]
buildWithResources
[(
resPackageDb
rs
,
resPackageDbLimit
)]
$
buildWithResources
rs
$
Target
context
(
GhcPkg
stage
)
[
rtsConf
]
[
conf
]
rtsConf
%>
\
_
->
do
...
...
src/Rules/Resources.hs
deleted
100644 → 0
View file @
6a9772a1
module
Rules.Resources
(
resourceRules
,
Resources
(
..
),
resPackageDbLimit
)
where
import
Base
data
Resources
=
Resources
{
resPackageDb
::
Resource
}
-- We cannot register multiple packages in parallel. Also we cannot run GHC
-- when the package database is being mutated by "ghc-pkg". This is a classic
-- concurrent read exclusive write (CREW) conflict.
resourceRules
::
Rules
Resources
resourceRules
=
Resources
<$>
newResource
"package-db"
resPackageDbLimit
resPackageDbLimit
::
Int
resPackageDbLimit
=
1000
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment