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
b6f224c4
Commit
b6f224c4
authored
May 22, 2016
by
Andrey Mokhov
Browse files
Refactor dependency oracles
parent
2c74f92c
Changes
22
Hide whitespace changes
Inline
Side-by-side
hadrian.cabal
View file @
b6f224c4
...
...
@@ -33,7 +33,6 @@ executable hadrian
, Oracles.ModuleFiles
, Oracles.PackageData
, Oracles.PackageDb
, Oracles.PackageDeps
, Oracles.WindowsPath
, Package
, Predicate
...
...
src/Oracles/Config.hs
View file @
b6f224c4
...
...
@@ -7,7 +7,7 @@ import Development.Shake.Config
import
Base
newtype
ConfigKey
=
ConfigKey
String
deriving
(
Show
,
Typeable
,
Eq
,
Hashable
,
Binary
,
NFData
)
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
askConfig
::
String
->
Action
String
askConfig
key
=
askConfigWithDefault
key
.
error
...
...
src/Oracles/Config/Flag.hs
View file @
b6f224c4
module
Oracles.Config.Flag
(
Flag
(
..
),
flag
,
getFlag
,
crossCompiling
,
platformSupportsSharedLibs
,
ghcWithSMP
,
ghcWithNativeCodeGen
,
supportsSplitObjects
Flag
(
..
),
flag
,
getFlag
,
crossCompiling
,
platformSupportsSharedLibs
,
ghcWithSMP
,
ghcWithNativeCodeGen
,
supportsSplitObjects
)
where
import
Control.Monad.Trans.Reader
...
...
src/Oracles/Config/Setting.hs
View file @
b6f224c4
module
Oracles.Config.Setting
(
Setting
(
..
),
SettingList
(
..
),
setting
,
settingList
,
getSetting
,
getSettingList
,
anyTargetPlatform
,
anyTargetOs
,
anyTargetArch
,
anyHostOs
,
Setting
(
..
),
SettingList
(
..
),
setting
,
settingList
,
getSetting
,
getSettingList
,
anyTargetPlatform
,
anyTargetOs
,
anyTargetArch
,
anyHostOs
,
ghcWithInterpreter
,
ghcEnableTablesNextToCode
,
useLibFFIForAdjustors
,
ghcCanonVersion
,
cmdLineLengthLimit
,
iosHost
,
osxHost
,
windowsHost
)
where
...
...
@@ -12,13 +11,12 @@ import Base
import
Oracles.Config
import
Stage
-- TODO: reduce the variety of similar flags (e.g. CPP and non-CPP versions).
-- Each Setting comes from the system.config file, e.g. 'target-os = mingw32'.
-- setting TargetOs looks up the config file and returns "mingw32".
--
-- SettingList is used for multiple string values separated by spaces, such
-- as 'gmp-include-dirs = a b'.
-- settingList GmpIncludeDirs therefore returns a list of strings ["a", "b"].
-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
-- | Each 'Setting' comes from @system.config@ file, e.g. 'target-os = mingw32'.
-- @setting TargetOs@ looks up the config file and returns "mingw32".
-- 'SettingList' is used for multiple string values separated by spaces, such
-- as @gmp-include-dirs = a b@.
-- @settingList GmpIncludeDirs@ therefore returns a list of strings ["a", "b"].
data
Setting
=
BuildArch
|
BuildOs
|
BuildPlatform
...
...
@@ -150,7 +148,7 @@ ghcEnableTablesNextToCode = notM $ anyTargetArch ["ia64", "powerpc64", "powerpc6
useLibFFIForAdjustors
::
Action
Bool
useLibFFIForAdjustors
=
notM
$
anyTargetArch
[
"i386"
,
"x86_64"
]
-- Canonicalised GHC version number, used for integer version comparisons. We
--
|
Canonicalised GHC version number, used for integer version comparisons. We
-- expand GhcMinorVersion to two digits by adding a leading zero if necessary.
ghcCanonVersion
::
Action
String
ghcCanonVersion
=
do
...
...
@@ -159,7 +157,7 @@ ghcCanonVersion = do
let
leadingZero
=
[
'0'
|
length
ghcMinorVersion
==
1
]
return
$
ghcMajorVersion
++
leadingZero
++
ghcMinorVersion
-- Command lines have limited size on Windows. Since Windows 7 the limit is
--
|
Command lines have limited size on Windows. Since Windows 7 the limit is
-- 32768 characters (theoretically). In practice we use 31000 to leave some
-- breathing space for the builder's path & name, auxiliary flags, and other
-- overheads. Use this function to set limits for other OSs if necessary.
...
...
@@ -168,11 +166,10 @@ cmdLineLengthLimit = do
windows
<-
windowsHost
osx
<-
osxHost
return
$
case
(
windows
,
osx
)
of
--
w
indows
--
W
indows
:
(
True
,
False
)
->
31000
-- osx 262144 is ARG_MAX
-- yet when using `xargs` on osx this is reduced by over 20 000.
-- 200 000 seems like a sensible limit.
-- On Mac OSX ARG_MAX is 262144, yet when using @xargs@ on OSX this is
-- reduced by over 20 000. Hence, 200 000 seems like a sensible limit.
(
False
,
True
)
->
200000
-- On all other systems, we try this:
_
->
4194304
-- Cabal needs a bit more than 2MB!
_
->
4194304
-- Cabal
library
needs a bit more than 2MB!
src/Oracles/Dependencies.hs
View file @
b6f224c4
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module
Oracles.Dependencies
(
dependencies
,
dependenciesOracle
)
where
module
Oracles.Dependencies
(
fileDependencies
,
contextDependencies
,
needContext
,
dependenciesOracles
)
where
import
Control.Monad.Trans.Maybe
import
qualified
Data.HashMap.Strict
as
Map
import
Base
import
Context
import
Expression
import
Oracles.PackageData
import
Settings
import
Settings.Builders.GhcCabal
newtype
DependenciesKey
=
DependenciesKey
(
FilePath
,
FilePath
)
deriving
(
Show
,
Typeable
,
Eq
,
Hashable
,
Binary
,
NFData
)
-- dependencies path obj is an action that looks up dependencies of an object
-- file in a generated dependecy file 'path/.dependencies'.
-- If the dependencies cannot be determined, an appropriate error is raised.
-- Otherwise, a pair (source, depFiles) is returned, such that obj can be
-- produced by compiling 'source'; the latter can also depend on a number of
-- other dependencies listed in depFiles.
dependencies
::
FilePath
->
FilePath
->
Action
(
FilePath
,
[
FilePath
])
dependencies
path
obj
=
do
let
depFile
=
path
-/-
".dependencies"
-- if no dependencies found then attempt to drop the way prefix (for *.c sources)
res
<-
runMaybeT
$
msum
$
map
(
\
obj'
->
MaybeT
$
askOracle
$
DependenciesKey
(
depFile
,
obj'
))
[
obj
,
obj
-<.>
"o"
]
case
res
of
Nothing
->
error
$
"No dependencies found for "
++
obj
Just
[]
->
error
$
"Empty dependency list for "
++
obj
Just
(
src
:
depFiles
)
->
return
(
src
,
depFiles
)
-- Oracle for 'path/dist/.dependencies' files
dependenciesOracle
::
Rules
()
dependenciesOracle
=
void
$
do
newtype
ObjDepsKey
=
ObjDepsKey
(
FilePath
,
FilePath
)
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
-- | 'Action' @fileDependencies context file@ looks up dependencies of a @file@
-- in a generated dependecy 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"
-- If no dependencies found, try to drop the way suffix (for *.c sources).
deps
<-
listToMaybe
.
catMaybes
<$>
mapM
(
askOracle
.
ObjDepsKey
.
(,)
path
)
[
obj
,
obj
-<.>
"o"
]
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
)
newtype
PkgDepsKey
=
PkgDepsKey
String
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
-- | 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
maybeDeps
<-
askOracle
.
PkgDepsKey
$
pkgNameString
package
deps
<-
case
maybeDeps
of
Nothing
->
error
$
"Context dependencies not found for "
++
show
context
Just
ds
->
return
$
map
PackageName
ds
let
pkgContext
=
\
pkg
->
Context
(
min
stage
Stage1
)
pkg
way
pkgs
<-
interpretInContext
(
pkgContext
package
)
getPackages
return
.
map
pkgContext
$
matchPackageNames
(
sort
pkgs
)
deps
-- | Given a sorted list of packages and a sorted list of package names, returns
-- packages whose names appear in the list of names.
matchPackageNames
::
[
Package
]
->
[
PackageName
]
->
[
Package
]
matchPackageNames
=
intersectOrd
(
\
pkg
name
->
compare
(
pkgName
pkg
)
name
)
-- | Coarse-grain 'need': make sure given contexts are fully built.
needContext
::
[
Context
]
->
Action
()
needContext
cs
=
do
libs
<-
fmap
concat
.
forM
cs
$
\
context
->
do
libFile
<-
pkgLibraryFile
context
lib0File
<-
pkgLibraryFile0
context
lib0
<-
buildDll0
context
ghciLib
<-
pkgGhciLibraryFile
context
ghciFlag
<-
interpretInContext
context
$
getPkgData
BuildGhciLib
let
ghci
=
ghciFlag
==
"YES"
&&
stage
context
==
Stage1
return
$
[
libFile
]
++
[
lib0File
|
lib0
]
++
[
ghciLib
|
ghci
]
confs
<-
mapM
pkgConfFile
cs
need
$
libs
++
confs
-- | Oracles for the package dependencies and 'path/dist/.dependencies' files.
dependenciesOracles
::
Rules
()
dependenciesOracles
=
do
deps
<-
newCache
$
\
file
->
do
putLoud
$
"Reading dependencies from "
++
file
++
"..."
contents
<-
map
words
<$>
readFileLines
file
return
.
Map
.
fromList
$
map
(
\
(
x
:
xs
)
->
(
x
,
xs
))
contents
addOracle
$
\
(
DependenciesKey
(
file
,
obj
))
->
Map
.
lookup
obj
<$>
deps
file
void
$
addOracle
$
\
(
ObjDepsKey
(
file
,
obj
))
->
Map
.
lookup
obj
<$>
deps
file
pkgDeps
<-
newCache
$
\
_
->
do
putLoud
$
"Reading package dependencies..."
contents
<-
readFileLines
packageDependencies
return
$
Map
.
fromList
[
(
p
,
ps
)
|
s
<-
contents
,
let
p
:
ps
=
words
s
]
void
$
addOracle
$
\
(
PkgDepsKey
pkg
)
->
Map
.
lookup
pkg
<$>
pkgDeps
()
src/Oracles/LookupInPath.hs
View file @
b6f224c4
...
...
@@ -6,7 +6,7 @@ import System.Directory
import
Base
newtype
LookupInPath
=
LookupInPath
String
deriving
(
Show
,
Typeable
,
Eq
,
Hashable
,
Binary
,
NFData
)
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
-- | Lookup an executable in @PATH@.
lookupInPath
::
FilePath
->
Action
FilePath
...
...
src/Oracles/PackageData.hs
View file @
b6f224c4
...
...
@@ -34,7 +34,7 @@ data PackageDataList = CcArgs FilePath
|
TransitiveDepNames
FilePath
newtype
PackageDataKey
=
PackageDataKey
(
FilePath
,
String
)
deriving
(
Show
,
Typeable
,
Eq
,
Hashable
,
Binary
,
NFData
)
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
askPackageData
::
FilePath
->
String
->
Action
String
askPackageData
path
key
=
do
...
...
src/Oracles/PackageDeps.hs
deleted
100644 → 0
View file @
2c74f92c
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module
Oracles.PackageDeps
(
packageDeps
,
packageDepsOracle
)
where
import
qualified
Data.HashMap.Strict
as
Map
import
Base
import
Package
import
Settings.Paths
newtype
PackageDepsKey
=
PackageDepsKey
String
deriving
(
Show
,
Typeable
,
Eq
,
Hashable
,
Binary
,
NFData
)
-- @packageDeps name@ is an action that given a 'Package' looks up its
-- dependencies in 'Base.packageDependencies' file. The dependencies need to be
-- computed by scanning package cabal files (see Rules.Cabal).
packageDeps
::
Package
->
Action
[
PackageName
]
packageDeps
pkg
=
do
res
<-
askOracle
.
PackageDepsKey
$
pkgNameString
pkg
return
.
map
PackageName
$
fromMaybe
[]
res
-- Oracle for the package dependencies file
packageDepsOracle
::
Rules
()
packageDepsOracle
=
do
deps
<-
newCache
$
\
_
->
do
putLoud
$
"Reading package dependencies..."
contents
<-
readFileLines
packageDependencies
return
.
Map
.
fromList
$
[
(
p
,
ps
)
|
line
<-
contents
,
let
p
:
ps
=
words
line
]
_
<-
addOracle
$
\
(
PackageDepsKey
pkg
)
->
Map
.
lookup
pkg
<$>
deps
()
return
()
src/Oracles/WindowsPath.hs
View file @
b6f224c4
...
...
@@ -9,12 +9,11 @@ import Base
import
Oracles.Config.Setting
newtype
WindowsPath
=
WindowsPath
FilePath
deriving
(
Show
,
Typeable
,
Eq
,
Hashable
,
Binary
,
NFData
)
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
-- | Path to the GHC source tree.
topDirectory
::
Action
FilePath
topDirectory
=
do
ghcSourcePath
<-
setting
GhcSourcePath
fixAbsolutePathOnWindows
ghcSourcePath
topDirectory
=
fixAbsolutePathOnWindows
=<<
setting
GhcSourcePath
-- | Fix an absolute path on Windows:
-- * "/c/" => "C:/"
...
...
src/Package.hs
View file @
b6f224c4
{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
module
Package
(
Package
(
..
),
PackageName
(
..
),
PackageType
(
..
),
-- * Queries
pkgNameString
,
pkgCabalFile
,
matchPackageNames
,
pkgNameString
,
pkgCabalFile
,
-- * Helpers for constructing and using 'Package's
setPath
,
topLevel
,
library
,
utility
,
setType
,
isLibrary
,
isProgram
)
where
...
...
@@ -15,25 +12,24 @@ import GHC.Generics (Generic)
import
Base
-- | The name of a Cabal package
-- | The name of a Cabal package
.
newtype
PackageName
=
PackageName
{
fromPackageName
::
String
}
deriving
(
Eq
,
Ord
,
IsString
,
Generic
,
Binary
,
Hashable
,
Typeable
,
NFData
)
deriving
(
Binary
,
Eq
,
Generic
,
Hashable
,
IsString
,
NFData
,
Ord
,
Typeable
)
-- TODO: Make PackageType more precise, #12
-- TODO: Make PackageType more precise, #12
.
-- TODO: Turn Program to Program FilePath thereby getting rid of programPath
-- | We regard packages as either being libraries or programs. This is
-- bit of a convenient lie as Cabal packages can be both, but it works
-- for now.
data
PackageType
=
Program
|
Library
deriving
Generic
-- | We regard packages as either being libraries or programs. This is bit of a
-- convenient lie as Cabal packages can be both, but it works for now.
data
PackageType
=
Library
|
Program
deriving
Generic
data
Package
=
Package
{
pkgName
::
PackageName
-- ^ Examples: "ghc", "Cabal"
,
pkgPath
::
FilePath
-- ^ pkgPath is the path to the source code relative
to the root.
-- e.g. "compiler", "libraries/Cabal/Cabal"
,
pkgType
::
PackageType
{
pkgName
::
PackageName
-- ^ Examples: "ghc", "Cabal"
.
,
pkgPath
::
FilePath
-- ^ pkgPath is the path to the source code relative
--
to the root,
e.g. "compiler", "libraries/Cabal/Cabal"
.
,
pkgType
::
PackageType
-- ^ A library or a program.
}
deriving
Generic
-- | Prettyprint Package name.
-- | Prettyprint
'
Package
'
name.
pkgNameString
::
Package
->
String
pkgNameString
=
fromPackageName
.
pkgName
...
...
@@ -81,12 +77,7 @@ instance Eq Package where
instance
Ord
Package
where
compare
=
compare
`
on
`
pkgName
-- | Given a sorted list of packages and a sorted list of package names, returns
-- packages whose names appear in the list of names.
matchPackageNames
::
[
Package
]
->
[
PackageName
]
->
[
Package
]
matchPackageNames
=
intersectOrd
(
\
pkg
name
->
compare
(
pkgName
pkg
)
name
)
-- Instances for storing in the Shake database
-- | Instances for storing in the Shake database.
instance
Binary
Package
instance
Hashable
Package
where
hashWithSalt
salt
=
hashWithSalt
salt
.
show
...
...
src/Rules/Cabal.hs
View file @
b6f224c4
...
...
@@ -13,7 +13,7 @@ import Settings
cabalRules
::
Rules
()
cabalRules
=
do
-- Cache boot package constraints (to be used in cabalArgs)
-- Cache boot package constraints (to be used in cabalArgs)
.
bootPackageConstraints
%>
\
out
->
do
bootPkgs
<-
interpretInContext
(
stageContext
Stage0
)
getPackages
let
pkgs
=
filter
(
\
p
->
p
/=
compiler
&&
isLibrary
p
)
bootPkgs
...
...
@@ -26,11 +26,10 @@ cabalRules = do
return
$
name
++
" == "
++
version
writeFileChanged
out
.
unlines
$
constraints
-- Cache package dependencies
-- Cache package dependencies
.
packageDependencies
%>
\
out
->
do
let
pkgs
=
knownPackages
\\
[
hp2ps
,
libffi
,
touchy
,
unlit
]
pkgDeps
<-
forM
(
sort
pkgs
)
$
\
pkg
->
if
pkg
==
rts
pkgDeps
<-
forM
(
sort
knownPackages
)
$
\
pkg
->
if
pkg
`
elem
`
[
hp2ps
,
libffi
,
rts
,
touchy
,
unlit
]
then
return
$
pkgNameString
pkg
else
do
need
[
pkgCabalFile
pkg
]
...
...
src/Rules/Compile.hs
View file @
b6f224c4
...
...
@@ -16,19 +16,26 @@ compilePackage rs context@Context {..} = do
path
<//>
"*"
<.>
hibootsuf
way
%>
\
hiboot
->
need
[
hiboot
-<.>
obootsuf
way
]
-- TODO:
a
dd dependencies for #include of .h and .hs-incl files (gcc -MM?)
-- TODO:
A
dd dependencies for #include of .h and .hs-incl files (gcc -MM?)
.
path
<//>
"*"
<.>
osuf
way
%>
\
obj
->
do
(
src
,
deps
)
<-
d
ependencies
path
obj
(
src
,
deps
)
<-
fileD
ependencies
context
obj
if
(
"//*.c"
?==
src
)
then
do
need
$
src
:
deps
build
$
Target
context
(
Cc
Compile
stage
)
[
src
]
[
obj
]
else
do
need
$
src
:
deps
needCompileDependencies
context
buildWithResources
rs
$
Target
context
(
Ghc
Compile
stage
)
[
src
]
[
obj
]
-- TODO:
g
et rid of these special cases
-- TODO:
G
et rid of these special cases
.
path
<//>
"*"
<.>
obootsuf
way
%>
\
obj
->
do
(
src
,
deps
)
<-
d
ependencies
path
obj
(
src
,
deps
)
<-
fileD
ependencies
context
obj
need
$
src
:
deps
needCompileDependencies
context
buildWithResources
rs
$
Target
context
(
Ghc
Compile
stage
)
[
src
]
[
obj
]
needCompileDependencies
::
Context
->
Action
()
needCompileDependencies
context
@
Context
{
..
}
=
do
when
(
isLibrary
package
)
$
need
=<<
return
<$>
pkgConfFile
context
needContext
=<<
contextDependencies
context
src/Rules/Data.hs
View file @
b6f224c4
...
...
@@ -5,7 +5,7 @@ import Context
import
Expression
import
GHC
import
Oracles.Config.Setting
import
Oracles.
PackageDep
s
import
Oracles.
Dependencie
s
import
Rules.Actions
import
Rules.Generate
import
Rules.Libffi
...
...
@@ -13,7 +13,7 @@ import Settings
import
Settings.Builders.Common
import
Target
-- Build package-data.mk by using
G
hc
C
abal to process
pkgC
abal file
--
|
Build
@
package-data.mk
@
by using
g
hc
-c
abal
utility
to process
.c
abal file
s.
buildPackageData
::
Context
->
Rules
()
buildPackageData
context
@
Context
{
..
}
=
do
let
cabalFile
=
pkgCabalFile
package
...
...
@@ -23,25 +23,19 @@ buildPackageData context@Context {..} = do
inTreeMk
=
oldPath
-/-
takeFileName
dataFile
-- TODO: remove, #113
inTreeMk
%>
\
mk
->
do
-- The first thing we do with any package is make sure all generated
-- dependencies are in place before proceeding.
-- Make sure all generated dependencies are in place before proceeding.
orderOnly
$
generatedDependencies
stage
package
-- GhcCabal may run the configure script, so we depend on it
-- 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
let
depStage
=
min
stage
Stage1
-- dependencies come from Stage0/1
depContext
=
vanillaContext
depStage
deps
<-
packageDeps
package
pkgs
<-
interpretInContext
(
depContext
package
)
getPackages
let
depPkgs
=
matchPackageNames
(
sort
pkgs
)
deps
need
=<<
traverse
(
pkgConfFile
.
depContext
)
depPkgs
-- Before we configure a package its dependencies need to be registered.
need
=<<
mapM
pkgConfFile
=<<
contextDependencies
context
need
[
cabalFile
]
build
$
Target
context
GhcCabal
[
cabalFile
]
[
mk
]
-- TODO:
g
et rid of this, see #113
-- TODO:
G
et rid of this, see #113
.
dataFile
%>
\
mk
->
do
copyFile
inTreeMk
mk
autogenFiles
<-
getDirectoryFiles
(
oldPath
-/-
"build"
)
[
"autogen/*"
]
...
...
@@ -53,7 +47,7 @@ buildPackageData context@Context {..} = do
copyFile
(
oldPath
-/-
haddockPrologue
)
(
buildPath
context
-/-
haddockPrologue
)
postProcessPackageData
context
mk
-- TODO: PROGNAME was $(CrossCompilePrefix)hp2ps
-- TODO: PROGNAME was $(CrossCompilePrefix)hp2ps
.
priority
2.0
$
do
when
(
package
==
hp2ps
)
$
dataFile
%>
\
mk
->
do
orderOnly
$
generatedDependencies
stage
package
...
...
@@ -111,9 +105,8 @@ buildPackageData context@Context {..} = do
windows
<-
windowsHost
let
prefix
=
fixKey
(
buildPath
context
)
++
"_"
dirs
=
[
"."
,
"hooks"
,
"sm"
,
"eventlog"
]
++
[
"posix"
|
not
windows
]
++
[
"win32"
|
windows
]
-- TODO: adding cmm/S sources to C_SRCS is a hack; rethink after #18
++
[
if
windows
then
"win32"
else
"posix"
]
-- TODO: Adding cmm/S sources to C_SRCS is a hack -- refactor.
cSrcs
<-
map
unifyPath
<$>
getDirectoryFiles
(
pkgPath
package
)
(
map
(
-/-
"*.c"
)
dirs
)
cmmSrcs
<-
getDirectoryFiles
(
pkgPath
package
)
[
"*.cmm"
]
...
...
@@ -153,6 +146,6 @@ postProcessPackageData context@Context {..} file = fixFile file fixPackageData
fixedPrefix
=
takeDirectory
file
++
drop
len
prefix
len
=
length
(
pkgPath
package
-/-
contextDirectory
context
)
-- TODO:
r
emove, see #113
-- TODO:
R
emove, see #113
.
fixKey
::
String
->
String
fixKey
=
replaceSeparators
'_'
src/Rules/Generators/GhcBootPlatformH.hs
View file @
b6f224c4
module
Rules.Generators.GhcBootPlatformH
(
generateGhcBootPlatformH
)
where
import
Base
import
Expression
import
Oracles.Config.Setting
import
Rules.Generators.Common
...
...
src/Rules/Generators/GhcPlatformH.hs
View file @
b6f224c4
module
Rules.Generators.GhcPlatformH
(
generateGhcPlatformH
)
where
import
Base
import
Expression
import
Oracles.Config.Flag
import
Oracles.Config.Setting
...
...
src/Rules/Generators/VersionHs.hs
View file @
b6f224c4
module
Rules.Generators.VersionHs
(
generateVersionHs
)
where
import
Base
import
Expression
import
Oracles.Config.Setting
import
Rules.Generators.Common
...
...
src/Rules/Oracles.hs
View file @
b6f224c4
...
...
@@ -5,7 +5,6 @@ import qualified Oracles.Config
import
qualified
Oracles.Dependencies
import
qualified
Oracles.LookupInPath
import
qualified
Oracles.PackageData
import
qualified
Oracles.PackageDeps
import
qualified
Oracles.WindowsPath
import
qualified
Oracles.ArgsHash
import
qualified
Oracles.ModuleFiles
...
...
@@ -15,10 +14,9 @@ oracleRules :: Rules ()
oracleRules
=
do
Oracles
.
ArgsHash
.
argsHashOracle
Oracles
.
Config
.
configOracle
Oracles
.
Dependencies
.
dependenciesOracle
Oracles
.
Dependencies
.
dependenciesOracle
s
Oracles
.
LookupInPath
.
lookupInPathOracle
Oracles
.
ModuleFiles
.
moduleFilesOracle
Oracles
.
PackageData
.
packageDataOracle
Oracles
.
PackageDb
.
packageDbOracle
Oracles
.
PackageDeps
.
packageDepsOracle
Oracles
.
WindowsPath
.
windowsPathOracle
src/Rules/Program.hs
View file @
b6f224c4
...
...
@@ -7,24 +7,24 @@ import Context
import
Expression
import
GHC
import
Oracles.Config.Setting
import
Oracles.Dependencies
import
Oracles.PackageData
import
Rules.Actions
import
Rules.Library
import
Rules.Wrappers.Ghc
import
Rules.Wrappers.GhcPkg
import
Settings
import
Settings.Builders.GhcCabal
import
Target
-- TODO:
m
ove to buildRootPath, see #113
-- Directory for wrapped binaries
-- TODO:
M
ove to buildRootPath, see #113
.
--
|
Directory for wrapped binaries
.
programInplaceLibPath
::
FilePath
programInplaceLibPath
=
"inplace/lib/bin"
-- Wrapper is parameterised by the path to the wrapped binary
--
|
Wrapper is parameterised by the path to the wrapped binary
.
type
Wrapper
=
FilePath
->
Expr
String
-- List of wrappers we build
--
|
List of wrappers we build
.
wrappers
::
[(
Context
,
Wrapper
)]
wrappers
=
[
(
vanillaContext
Stage0
ghc
,
ghcWrapper
)
,
(
vanillaContext
Stage1
ghc
,
ghcWrapper
)
...
...
@@ -54,7 +54,7 @@ buildProgram rs context@Context {..} = do
matchWrapped
?>
\
bin
->
buildBinary
rs
context
bin
-- Replace programInplacePath with programInplaceLibPath in a given path
--
|
Replace
'
programInplacePath
'
with
'
programInplaceLibPath
'
in a given path
.
computeWrappedPath
::
FilePath
->
Maybe
FilePath
computeWrappedPath
=
fmap
(
programInplaceLibPath
++
)
.
stripPrefix
programInplacePath
...
...
@@ -70,35 +70,21 @@ buildWrapper context@Context {..} wrapper wrapperPath binPath = do
-- TODO: Get rid of the Paths_hsc2hs.o hack.
-- TODO: Do we need to consider other ways when building programs?
buildBinary
::
[(
Resource
,
Int
)]
->
Context
->
FilePath
->
Action
()
buildBinary
rs
context
@
(
Context
stage
package
_
)
bin
=
do
let
path
=
buildPath
context
cSrcs
<-
cSources
context
-- TODO: remove code duplication (Library.hs)
hSrcs
<-
hSources
context
let
cObjs
=
[
path
-/-
src
-<.>
osuf
vanilla
|
src
<-
cSrcs
]
hObjs
=
[
path
-/-
src
<.>
osuf
vanilla
|
src
<-
hSrcs
]
++
[
path
-/-
"Paths_hsc2hs.o"
|
package
==
hsc2hs
]
++
[
path
-/-
"Paths_haddock.o"
|
package
==
haddock
]
objs
=
cObjs
++
hObjs
ways
<-
interpretInContext
context
getLibraryWays
depNames
<-
interpretInContext
context
$
getPkgDataList
TransitiveDepNames
let
libStage
=
min
stage
Stage1
-- libraries are built only in Stage0/1
libContext
=
vanillaContext
libStage
package
pkgs
<-
interpretInContext
libContext
getPackages
let
deps
=
matchPackageNames
(
sort
pkgs
)
(
map
PackageName
$
sort
depNames
)
libs
<-
fmap
concat
.
forM
deps
$
\
dep
->
do
let
depContext
=
vanillaContext
libStage
dep
ghciFlag
<-
interpretInContext
depContext
$
getPkgData
BuildGhciLib
libFiles
<-
fmap
concat
.
forM
ways
$
\
way
->
do
libFile
<-
pkgLibraryFile
$
Context
libStage
dep
way
lib0File
<-
pkgLibraryFile0
$
Context
libStage
dep
way
dll0
<-
needDll0
libStage
dep
return
$
libFile
:
[
lib0File
|
dll0
]
ghciLib
<-
pkgGhciLibraryFile
$
vanillaContext
libStage
dep
return
$
libFiles
++
[
ghciLib
|
ghciFlag
==
"YES"
&&
stage
==
Stage1
]
let
binDeps
=
if
package
==
ghcCabal
&&
stage
==
Stage0
then
[
pkgPath
package
-/-
src
<.>
"hs"
|
src
<-
hSrcs
]
else
objs
need
$
binDeps
++
libs
buildBinary
rs
context
@
Context
{
..
}
bin
=
do
hSrcs
<-
hSources
context
binDeps
<-
if
stage
==
Stage0
&&
package
==
ghcCabal
then
return
[
pkgPath
package
-/-
src
<.>
"hs"
|
src
<-
hSrcs
]
else
do
ways
<-
interpretInContext
context
getLibraryWays
deps
<-
contextDependencies
context
needContext
[
dep
{
way
=
w
}
|
dep
<-
deps
,
w
<-
ways
]
cSrcs
<-
cSources
context
-- TODO: Drop code duplication (Library.hs).
let
path
=
buildPath
context
return
$
[
path
-/-
src
-<.>
osuf
vanilla
|
src
<-
cSrcs
]
++
[
path
-/-
src
<.>
osuf
vanilla
|
src
<-
hSrcs
]
++
[
path
-/-
"Paths_hsc2hs.o"
|
package
==
hsc2hs
]
++
[
path
-/-
"Paths_haddock.o"
|
package
==
haddock
]
need
binDeps
buildWithResources
rs
$
Target
context
(
Ghc
Link
stage
)
binDeps
[
bin
]
synopsis
<-
interpretInContext
context
$
getPkgData
Synopsis
putSuccess
$
renderProgram
...
...
src/Rules/Register.hs
View file @
b6f224c4
...
...
@@ -21,7 +21,7 @@ registerPackage rs context@Context {..} = do
-- This produces inplace-pkg-config. TODO: Add explicit tracking.
need
[
pkgDataFile
context
]
-- Post-process inplace-pkg-config. TODO: remove, see #113, #148
-- Post-process inplace-pkg-config. TODO: remove, see #113, #148
.