Skip to content
GitLab
Menu
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
1df54913
Commit
1df54913
authored
Aug 13, 2017
by
Andrey Mokhov
Browse files
Drop Oracles.Dependencies moving code to the library and Utilities (former Util)
parent
1a0a80ba
Changes
25
Hide whitespace changes
Inline
Side-by-side
hadrian.cabal
View file @
1df54913
...
...
@@ -5,7 +5,7 @@ license: BSD3
license-file: LICENSE
author: Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard
maintainer: Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard
copyright: Andrey Mokhov 2014-201
6
copyright: Andrey Mokhov 2014-201
7
category: Development
build-type: Simple
cabal-version: >=1.10
...
...
@@ -35,7 +35,6 @@ executable hadrian
, Hadrian.Utilities
, Oracles.Flag
, Oracles.Setting
, Oracles.Dependencies
, Oracles.ModuleFiles
, Oracles.PackageData
, Package
...
...
@@ -99,10 +98,11 @@ executable hadrian
, Stage
, Target
, UserSettings
, Util
, Util
ities
, Way
default-language: Haskell2010
default-extensions: RecordWildCards
, TupleSections
other-extensions: DeriveFunctor
, DeriveGeneric
, FlexibleInstances
...
...
src/Hadrian/Oracles/KeyValue.hs
View file @
1df54913
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module
Hadrian.Oracles.KeyValue
(
lookupValue
,
lookupValueOrEmpty
,
lookupValueOrError
,
lookupValues
,
lookupValuesOrEmpty
,
lookupValuesOrError
,
keyValueOracle
lookupValue
,
lookupValueOrEmpty
,
lookupValueOrError
,
lookupValues
,
lookupValuesOrEmpty
,
lookupValuesOrError
,
lookupDependencies
,
keyValueOracle
)
where
import
Control.Monad
...
...
@@ -49,6 +49,18 @@ lookupValuesOrError file key = (fromMaybe $ error msg) <$> lookupValues file key
where
msg
=
"Key "
++
quote
key
++
" not found in file "
++
quote
file
-- | The 'Action' @lookupDependencies depFile file@ looks up dependencies of a
-- @file@ in a (typically generated) dependency file @depFile@. The action
-- returns a pair @(source, files)@, such that the @file@ can be produced by
-- compiling @source@, which in turn also depends on a number of other @files@.
lookupDependencies
::
FilePath
->
FilePath
->
Action
(
FilePath
,
[
FilePath
])
lookupDependencies
depFile
file
=
do
deps
<-
lookupValues
depFile
file
case
deps
of
Nothing
->
error
$
"No dependencies found for file "
++
quote
file
Just
[]
->
error
$
"No source file found for file "
++
quote
file
Just
(
source
:
files
)
->
return
(
source
,
files
)
-- | This oracle reads and parses text files to answer 'lookupValue' and
-- 'lookupValues' queries, as well as their derivatives, tracking the results.
keyValueOracle
::
Rules
()
...
...
src/Oracles/Dependencies.hs
deleted
100644 → 0
View file @
1a0a80ba
{-# LANGUAGE GeneralizedNewtypeDeriving, TupleSections #-}
module
Oracles.Dependencies
(
fileDependencies
,
contextDependencies
,
libraryTargets
,
needLibrary
,
pkgDependencies
,
topsortPackages
)
where
import
Hadrian.Oracles.KeyValue
import
Base
import
Context
import
Expression
hiding
(
stage
)
import
Oracles.PackageData
import
Settings
import
Settings.Builders.GhcCabal
import
Settings.Path
-- | 'Action' @fileDependencies context file@ looks up dependencies of a @file@
-- in a generated dependency file @path/.dependencies@, where @path@ is the build
-- path of the given @context@. The action returns a pair @(source, files)@,
-- such that the @file@ can be produced by compiling @source@, which in turn
-- also depends on a number of other @files@.
fileDependencies
::
Context
->
FilePath
->
Action
(
FilePath
,
[
FilePath
])
fileDependencies
context
obj
=
do
let
path
=
buildPath
context
-/-
".dependencies"
deps
<-
lookupValues
path
obj
case
deps
of
Nothing
->
error
$
"No dependencies found for file "
++
obj
Just
[]
->
error
$
"No source file found for file "
++
obj
Just
(
source
:
files
)
->
return
(
source
,
files
)
-- | Given a 'Context' this 'Action' looks up its package dependencies in
-- 'Settings.Paths.packageDependencies' using 'packageDependenciesOracle', and
-- wraps found dependencies in appropriate contexts. The only subtlety here is
-- that we never depend on packages built in 'Stage2' or later, therefore the
-- stage of the resulting dependencies is bounded from above at 'Stage1'. To
-- compute package dependencies we scan package cabal files, see "Rules.Cabal".
contextDependencies
::
Context
->
Action
[
Context
]
contextDependencies
context
@
Context
{
..
}
=
do
let
pkgContext
=
\
pkg
->
Context
(
min
stage
Stage1
)
pkg
way
deps
<-
lookupValuesOrError
packageDependencies
(
pkgNameString
package
)
pkgs
<-
sort
<$>
interpretInContext
(
pkgContext
package
)
getPackages
return
.
map
pkgContext
$
intersectOrd
(
compare
.
pkgNameString
)
pkgs
deps
-- | Given a `Package`, this `Action` looks up its package dependencies
-- 'Settings.Paths.packageDependencies' using 'packageDependenciesOracle'
-- The context will be the vanilla context with stage equal to 1
pkgDependencies
::
Package
->
Action
[
Package
]
pkgDependencies
=
fmap
(
map
Context
.
package
)
.
contextDependencies
.
vanillaContext
Stage1
-- | Given a library 'Package' this action computes all of its targets.
libraryTargets
::
Context
->
Action
[
FilePath
]
libraryTargets
context
=
do
confFile
<-
pkgConfFile
context
libFile
<-
pkgLibraryFile
context
lib0File
<-
pkgLibraryFile0
context
lib0
<-
buildDll0
context
ghciLib
<-
pkgGhciLibraryFile
context
ghciFlag
<-
interpretInContext
context
$
getPkgData
BuildGhciLib
let
ghci
=
ghciFlag
==
"YES"
&&
(
stage
context
==
Stage1
||
stage1Only
)
return
$
[
confFile
,
libFile
]
++
[
lib0File
|
lib0
]
++
[
ghciLib
|
ghci
]
-- | Coarse-grain 'need': make sure all given libraries are fully built.
needLibrary
::
[
Context
]
->
Action
()
needLibrary
cs
=
need
=<<
concatMapM
libraryTargets
cs
-- | Topological sort of packages according to their dependencies.
-- HACK (izgzhen): See https://github.com/snowleopard/hadrian/issues/344 for details
topsortPackages
::
[
Package
]
->
Action
[
Package
]
topsortPackages
pkgs
=
do
elems
<-
mapM
(
\
p
->
(
p
,)
<$>
pkgDependencies
p
)
pkgs
return
$
map
fst
$
topSort
elems
where
annotateInDeg
es
e
=
(
foldr
(
\
e'
s
->
if
fst
e'
`
elem
`
snd
e
then
s
+
1
else
s
)
(
0
::
Int
)
es
,
e
)
topSort
[]
=
[]
topSort
es
=
let
annotated
=
map
(
annotateInDeg
es
)
es
inDegZero
=
map
snd
$
filter
((
==
0
)
.
fst
)
annotated
in
inDegZero
++
topSort
(
es
\\
inDegZero
)
src/Rules.hs
View file @
1df54913
...
...
@@ -12,7 +12,6 @@ import Context
import
Expression
import
Flavour
import
GHC
import
qualified
Oracles.Dependencies
import
qualified
Oracles.ModuleFiles
import
qualified
Rules.Compile
import
qualified
Rules.Data
...
...
@@ -30,6 +29,7 @@ import qualified Rules.Register
import
Settings
import
Settings.Path
import
Target
import
Utilities
allStages
::
[
Stage
]
allStages
=
[
minBound
..
]
...
...
@@ -61,7 +61,7 @@ packageTargets stage pkg = do
ways
<-
interpretInContext
context
getLibraryWays
libs
<-
mapM
(
pkgLibraryFile
.
Context
stage
pkg
)
ways
docs
<-
interpretInContext
context
$
buildHaddock
flavour
more
<-
Oracles
.
Dependencies
.
libraryTargets
context
more
<-
libraryTargets
context
return
$
[
pkgSetupConfigFile
context
|
nonCabalContext
context
]
++
[
pkgHaddockFile
context
|
docs
&&
stage
==
Stage1
]
++
libs
++
more
...
...
src/Rules/Clean.hs
View file @
1df54913
...
...
@@ -3,7 +3,7 @@ module Rules.Clean (clean, cleanSourceTree, cleanRules) where
import
Base
import
Settings.Path
import
UserSettings
import
Util
import
Util
ities
clean
::
Action
()
clean
=
do
...
...
src/Rules/Compile.hs
View file @
1df54913
module
Rules.Compile
(
compilePackage
)
where
import
Hadrian.Oracles.KeyValue
import
Base
import
Context
import
Expression
import
Oracles.Dependencies
import
Rules.Generate
import
Settings.Path
import
Target
import
Util
import
Util
ities
compilePackage
::
[(
Resource
,
Int
)]
->
Context
->
Rules
()
compilePackage
rs
context
@
Context
{
..
}
=
do
...
...
@@ -19,7 +20,7 @@ compilePackage rs context@Context {..} = do
needDependencies
context
src
$
obj
<.>
"d"
build
$
target
context
(
compiler
stage
)
[
src
]
[
obj
]
compileHs
=
\
[
obj
,
_hi
]
->
do
(
src
,
deps
)
<-
file
Dependencies
context
obj
(
src
,
deps
)
<-
lookup
Dependencies
(
path
-/-
".dependencies"
)
obj
need
$
src
:
deps
when
(
isLibrary
package
)
$
need
=<<
return
<$>
pkgConfFile
context
needLibrary
=<<
contextDependencies
context
...
...
src/Rules/Configure.hs
View file @
1df54913
...
...
@@ -8,7 +8,7 @@ import Context
import
GHC
import
Target
import
UserSettings
import
Util
import
Util
ities
configureRules
::
Rules
()
configureRules
=
do
...
...
src/Rules/Data.hs
View file @
1df54913
...
...
@@ -4,13 +4,12 @@ import Base
import
Context
import
Expression
import
GHC
import
Oracles.Dependencies
import
Oracles.Setting
import
Rules.Generate
import
Settings.Path
import
Target
import
UserSettings
import
Util
import
Util
ities
-- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files.
buildPackageData
::
Context
->
Rules
()
...
...
src/Rules/Dependencies.hs
View file @
1df54913
...
...
@@ -10,7 +10,7 @@ import Oracles.ModuleFiles
import
Rules.Generate
import
Settings.Path
import
Target
import
Util
import
Util
ities
buildPackageDependencies
::
[(
Resource
,
Int
)]
->
Context
->
Rules
()
buildPackageDependencies
rs
context
@
Context
{
..
}
=
...
...
src/Rules/Documentation.hs
View file @
1df54913
...
...
@@ -10,7 +10,7 @@ import Oracles.PackageData
import
Settings
import
Settings.Path
import
Target
import
Util
import
Util
ities
haddockHtmlLib
::
FilePath
haddockHtmlLib
=
"inplace/lib/html/haddock-util.js"
...
...
src/Rules/Generate.hs
View file @
1df54913
...
...
@@ -16,7 +16,7 @@ import Settings
import
Settings.Path
import
Target
import
UserSettings
import
Util
import
Util
ities
-- | Track this file to rebuild generated files whenever it changes.
trackGenerateHs
::
Expr
()
...
...
src/Rules/Gmp.hs
View file @
1df54913
...
...
@@ -7,7 +7,7 @@ import Settings.Packages.IntegerGmp
import
Settings.Path
import
Target
import
UserSettings
import
Util
import
Util
ities
gmpBase
::
FilePath
gmpBase
=
pkgPath
integerGmp
-/-
"gmp"
...
...
src/Rules/Install.hs
View file @
1df54913
...
...
@@ -8,7 +8,6 @@ import Base
import
Context
import
Expression
hiding
(
builder
)
import
GHC
import
Oracles.Dependencies
import
Oracles.Setting
import
Rules
import
Rules.Generate
...
...
@@ -18,7 +17,7 @@ import Settings
import
Settings.Packages.Rts
import
Settings.Path
import
Target
import
Util
import
Util
ities
{- | Install the built binaries etc. to the @destDir ++ prefix@.
...
...
src/Rules/Libffi.hs
View file @
1df54913
...
...
@@ -5,7 +5,7 @@ import Hadrian.Utilities
import
Settings.Builders.Common
import
Settings.Packages.Rts
import
Target
import
Util
import
Util
ities
libffiDependencies
::
[
FilePath
]
libffiDependencies
=
(
rtsBuildPath
-/-
)
<$>
[
"ffi.h"
,
"ffitarget.h"
]
...
...
src/Rules/Library.hs
View file @
1df54913
...
...
@@ -10,7 +10,6 @@ import Context
import
Expression
hiding
(
way
,
package
)
import
Flavour
import
GHC
import
Oracles.Dependencies
import
Oracles.ModuleFiles
import
Oracles.PackageData
import
Oracles.Setting
...
...
@@ -18,7 +17,7 @@ import Settings
import
Settings.Path
import
Target
import
UserSettings
import
Util
import
Util
ities
libraryObjects
::
Context
->
Action
[
FilePath
]
libraryObjects
context
@
Context
{
..
}
=
do
...
...
src/Rules/Perl.hs
View file @
1df54913
module
Rules.Perl
(
perlScriptRules
)
where
import
Base
import
Util
import
Util
ities
-- | Build Perl scripts, such as @ghc-split@, from their literate Perl sources.
perlScriptRules
::
Rules
()
...
...
src/Rules/Program.hs
View file @
1df54913
...
...
@@ -6,7 +6,6 @@ import Base
import
Context
import
Expression
hiding
(
stage
,
way
)
import
GHC
import
Oracles.Dependencies
import
Oracles.ModuleFiles
import
Oracles.PackageData
import
Oracles.Setting
...
...
@@ -15,7 +14,7 @@ import Settings
import
Settings.Path
import
Target
import
UserSettings
import
Util
import
Util
ities
buildProgram
::
[(
Resource
,
Int
)]
->
Context
->
Rules
()
buildProgram
rs
context
@
Context
{
..
}
=
when
(
isProgram
package
)
$
do
...
...
src/Rules/Register.hs
View file @
1df54913
...
...
@@ -6,7 +6,7 @@ import GHC
import
Settings.Path
import
Target
import
UserSettings
import
Util
import
Util
ities
-- | Build rules for registering packages and initialising package databases
-- by running the @ghc-pkg@ utility.
...
...
src/Rules/SourceDist.hs
View file @
1df54913
...
...
@@ -6,7 +6,7 @@ import Base
import
Oracles.Setting
import
Rules.Clean
import
UserSettings
import
Util
import
Util
ities
sourceDistRules
::
Rules
()
sourceDistRules
=
do
...
...
src/Rules/Test.hs
View file @
1df54913
...
...
@@ -9,7 +9,7 @@ import Oracles.Setting
import
Settings
import
Settings.Path
import
Target
import
Util
import
Util
ities
-- TODO: clean up after testing
testRules
::
Rules
()
...
...
Prev
1
2
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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