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
098d9c1e
Commit
098d9c1e
authored
Aug 05, 2015
by
Andrey Mokhov
Browse files
Implement compilePackage build rule.
parent
12cecf14
Changes
8
Hide whitespace changes
Inline
Side-by-side
src/Package/Compile.hs
deleted
100644 → 0
View file @
12cecf14
{-# LANGUAGE NoImplicitPrelude #-}
module
Package.Compile
(
buildPackageCompile
)
where
import
Package.Base
argListDir
::
FilePath
argListDir
=
"shake/arg/buildPackageCompile"
suffixArgs
::
Way
->
Args
suffixArgs
way
=
return
[
"-hisuf"
,
hisuf
way
,
"-osuf"
,
osuf
way
,
"-hcsuf"
,
hcsuf
way
]
ghcArgs
::
Package
->
TodoItem
->
Way
->
[
FilePath
]
->
FilePath
->
Args
ghcArgs
(
Package
_
path
_
_
)
(
stage
,
dist
,
_
)
way
srcs
result
=
let
pathDist
=
path
</>
dist
buildDir
=
unifyPath
$
pathDist
</>
"build"
in
args
[
suffixArgs
way
,
wayHcArgs
way
,
args
SrcHcArgs
,
packageArgs
stage
pathDist
,
includeGhcArgs
path
dist
,
concatArgs
[
"-optP"
]
$
CppArgs
pathDist
,
args
$
HsArgs
pathDist
-- TODO: now we have both -O and -O2
-- <> arg ["-O2"]
,
productArgs
[
"-odir"
,
"-hidir"
,
"-stubdir"
]
[
buildDir
]
,
when
(
splitObjects
stage
)
$
arg
"-split-objs"
,
args
(
"-c"
:
srcs
)
,
args
[
"-o"
,
result
]
]
gccArgs
::
Package
->
TodoItem
->
[
FilePath
]
->
FilePath
->
Args
gccArgs
(
Package
_
path
_
_
)
(
_
,
dist
,
settings
)
srcs
result
=
let
pathDist
=
path
</>
dist
in
args
[
args
$
CcArgs
pathDist
,
commonCcArgs
,
customCcArgs
settings
,
commonCcWarninigArgs
,
includeGccArgs
path
dist
,
args
(
"-c"
:
srcs
)
,
args
[
"-o"
,
result
]
]
compileC
::
Package
->
TodoItem
->
[
FilePath
]
->
FilePath
->
Action
()
compileC
pkg
todo
@
(
stage
,
_
,
_
)
deps
obj
=
do
need
deps
let
srcs
=
filter
(
"//*.c"
?==
)
deps
run
(
Gcc
stage
)
$
gccArgs
pkg
todo
srcs
obj
compileHaskell
::
Package
->
TodoItem
->
FilePath
->
Way
->
Action
()
compileHaskell
pkg
@
(
Package
_
path
_
_
)
todo
@
(
stage
,
dist
,
_
)
obj
way
=
do
let
buildDir
=
unifyPath
$
path
</>
dist
</>
"build"
-- TODO: keep only vanilla dependencies in 'haskell.deps'
deps
<-
args
$
DependencyList
(
buildDir
</>
"haskell.deps"
)
obj
let
srcs
=
filter
(
"//*hs"
?==
)
deps
need
deps
run
(
Ghc
stage
)
$
ghcArgs
pkg
todo
way
srcs
obj
buildRule
::
Package
->
TodoItem
->
Rules
()
buildRule
pkg
@
(
Package
name
path
_
_
)
todo
@
(
stage
,
dist
,
_
)
=
let
buildDir
=
unifyPath
$
path
</>
dist
</>
"build"
cDepFile
=
buildDir
</>
"c.deps"
in
forM_
allWays
$
\
way
->
do
-- TODO: optimise (too many ways in allWays)
let
oPattern
=
"*."
++
osuf
way
let
hiPattern
=
"*."
++
hisuf
way
(
buildDir
<//>
hiPattern
)
%>
\
hi
->
do
let
obj
=
hi
-<.>
osuf
way
-- TODO: Understand why 'need [obj]' doesn't work, leading to
-- recursive rules error. Below is a workaround.
-- putColoured Yellow $ "Hi " ++ hi
compileHaskell
pkg
todo
obj
way
(
buildDir
<//>
oPattern
)
%>
\
obj
->
do
let
vanillaObjName
=
takeFileName
obj
-<.>
"o"
cDeps
<-
args
$
DependencyList
cDepFile
vanillaObjName
if
null
cDeps
then
compileHaskell
pkg
todo
obj
way
else
compileC
pkg
todo
cDeps
obj
-- Finally, record the argument list
need
[
argListPath
argListDir
pkg
stage
]
argListRule
::
Package
->
TodoItem
->
Rules
()
argListRule
pkg
todo
@
(
stage
,
_
,
settings
)
=
(
argListPath
argListDir
pkg
stage
)
%>
\
out
->
do
need
$
[
"shake/src/Package/Compile.hs"
]
++
sourceDependecies
ways'
<-
ways
settings
ghcList
<-
forM
ways'
$
\
way
->
argListWithComment
(
"way '"
++
tag
way
++
"'"
)
(
Ghc
stage
)
(
ghcArgs
pkg
todo
way
[
"input.hs"
]
$
"output"
<.>
osuf
way
)
gccList
<-
forM
ways'
$
\
way
->
argListWithComment
(
"way '"
++
tag
way
++
"'"
)
(
Gcc
stage
)
(
gccArgs
pkg
todo
[
"input.c"
]
$
"output"
<.>
osuf
way
)
writeFileChanged
out
$
unlines
ghcList
++
"
\n
"
++
unlines
gccList
buildPackageCompile
::
Package
->
TodoItem
->
Rules
()
buildPackageCompile
=
argListRule
<>
buildRule
src/Rules/Compile.hs
0 → 100644
View file @
098d9c1e
module
Rules.Compile
(
compilePackage
)
where
import
Way
import
Base
import
Util
import
Builder
import
Expression
import
qualified
Target
import
Oracles.DependencyList
import
Settings.Ways
import
Settings.TargetDirectory
import
Rules.Actions
import
Rules.Resources
compilePackage
::
Resources
->
StagePackageTarget
->
Rules
()
compilePackage
_
target
=
do
let
stage
=
Target
.
stage
target
pkg
=
Target
.
package
target
path
=
targetPath
stage
pkg
buildPath
=
path
-/-
"build"
cDepsFile
=
buildPath
-/-
"c.deps"
hDepsFile
=
buildPath
-/-
"haskell.deps"
forM_
knownWays
$
\
way
->
do
(
buildPath
<//>
"*."
++
hisuf
way
)
%>
\
hi
->
do
let
obj
=
hi
-<.>
osuf
way
need
[
obj
]
(
buildPath
<//>
"*."
++
osuf
way
)
%>
\
obj
->
do
let
vanillaObjName
=
takeFileName
obj
-<.>
"o"
cDeps
<-
dependencyList
cDepsFile
vanillaObjName
hDeps
<-
dependencyList
hDepsFile
obj
let
hSrcDeps
=
filter
(
"//*hs"
?==
)
hDeps
when
(
null
cDeps
&&
null
hDeps
)
$
putError_
$
"Cannot determine sources for '"
++
obj
++
"'."
if
null
cDeps
then
build
$
fullTargetWithWay
target
hSrcDeps
(
Ghc
stage
)
way
[
obj
]
else
build
$
fullTarget
target
cDeps
(
Gcc
stage
)
[
obj
]
src/Rules/Package.hs
View file @
098d9c1e
...
...
@@ -3,8 +3,9 @@ module Rules.Package (buildPackage) where
import
Base
import
Expression
import
Rules.Data
import
Rules.Compile
import
Rules.Resources
import
Rules.Dependencies
buildPackage
::
Resources
->
StagePackageTarget
->
Rules
()
buildPackage
=
buildPackageData
<>
buildPackageDependencies
buildPackage
=
buildPackageData
<>
buildPackageDependencies
<>
compilePackage
src/Settings/Gcc.hs
0 → 100644
View file @
098d9c1e
module
Settings.Gcc
(
gccArgs
,
includeGccArgs
)
where
import
Base
import
Util
import
Builder
import
Expression
import
Oracles.PackageData
import
Settings.Util
gccArgs
::
Args
gccArgs
=
stagedBuilder
Gcc
?
do
path
<-
getTargetPath
file
<-
getFile
deps
<-
getDependencies
ccArgs
<-
getPkgDataList
CcArgs
mconcat
[
append
ccArgs
,
includeGccArgs
,
arg
"-c"
,
append
$
filter
(
"//*.c"
?==
)
deps
,
arg
"-o"
,
arg
file
]
includeGccArgs
::
Args
includeGccArgs
=
do
path
<-
getTargetPath
pkgPath
<-
getPackagePath
pkg
<-
getPackage
iDirs
<-
getPkgDataList
IncludeDirs
dDirs
<-
getPkgDataList
DepIncludeDirs
mconcat
[
arg
$
"-I"
++
path
-/-
"build/autogen"
,
append
.
map
(
\
dir
->
"-I"
++
pkgPath
-/-
dir
)
$
iDirs
++
dDirs
]
src/Settings/GccM.hs
View file @
098d9c1e
module
Settings.GccM
(
gccMArgs
)
where
import
Util
import
Builder
import
Expression
import
Oracles.PackageData
import
Settings.Gcc
import
Settings.Util
-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
...
...
@@ -23,14 +23,3 @@ gccMArgs = stagedBuilder GccM ? do
,
arg
"-x"
,
arg
"c"
,
arg
src
]
includeGccArgs
::
Args
includeGccArgs
=
do
path
<-
getTargetPath
pkgPath
<-
getPackagePath
pkg
<-
getPackage
iDirs
<-
getPkgDataList
IncludeDirs
dDirs
<-
getPkgDataList
DepIncludeDirs
mconcat
[
arg
$
"-I"
++
path
-/-
"build/autogen"
,
append
.
map
(
\
dir
->
"-I"
++
pkgPath
-/-
dir
)
$
iDirs
++
dDirs
]
src/Settings/Ghc.hs
0 → 100644
View file @
098d9c1e
module
Settings.Ghc
(
ghcArgs
,
packageGhcArgs
,
includeGhcArgs
)
where
import
Way
import
Util
import
Stage
import
Builder
import
Switches
import
Expression
import
Oracles.Flag
import
Oracles.PackageData
import
Settings.Util
ghcArgs
::
Args
ghcArgs
=
stagedBuilder
Ghc
?
do
way
<-
getWay
hsArgs
<-
getPkgDataList
HsArgs
cppArgs
<-
getPkgDataList
CppArgs
srcs
<-
getDependencies
file
<-
getFile
path
<-
getTargetPath
let
buildPath
=
path
-/-
"build"
mconcat
[
arg
"-hisuf"
,
arg
$
hisuf
way
,
arg
"-osuf"
,
arg
$
osuf
way
,
arg
"-hcsuf"
,
arg
$
hcsuf
way
,
wayHcArgs
,
packageGhcArgs
,
includeGhcArgs
,
append
hsArgs
,
append
.
map
(
"-optP"
++
)
$
cppArgs
,
arg
"-odir"
,
arg
buildPath
,
arg
"-stubdir"
,
arg
buildPath
,
arg
"-hidir"
,
arg
buildPath
,
splitObjects
?
arg
"-split-objs"
,
arg
"-no-user-package-db"
-- TODO: is this needed?
,
arg
"-rtsopts"
-- TODO: is this needed?
,
arg
"-c"
,
append
srcs
,
arg
"-o"
,
arg
file
]
-- TODO: do '-ticky' in all debug ways?
wayHcArgs
::
Args
wayHcArgs
=
do
way
<-
getWay
mconcat
[
if
(
Dynamic
`
wayUnit
`
way
)
then
append
[
"-fPIC"
,
"-dynamic"
]
else
arg
"-static"
,
(
Threaded
`
wayUnit
`
way
)
?
arg
"-optc-DTHREADED_RTS"
,
(
Debug
`
wayUnit
`
way
)
?
arg
"-optc-DDEBUG"
,
(
Profiling
`
wayUnit
`
way
)
?
arg
"-prof"
,
(
Logging
`
wayUnit
`
way
)
?
arg
"-eventlog"
,
(
Parallel
`
wayUnit
`
way
)
?
arg
"-parallel"
,
(
GranSim
`
wayUnit
`
way
)
?
arg
"-gransim"
,
(
way
==
debug
||
way
==
debugDynamic
)
?
append
[
"-ticky"
,
"-DTICKY_TICKY"
]
]
packageGhcArgs
::
Args
packageGhcArgs
=
do
stage
<-
getStage
supportsPackageKey
<-
getFlag
SupportsPackageKey
pkgKey
<-
getPkgData
PackageKey
pkgDepKeys
<-
getPkgDataList
DepKeys
pkgDeps
<-
getPkgDataList
Deps
mconcat
[
arg
"-hide-all-packages"
,
arg
"-no-user-package-db"
,
arg
"-include-pkg-deps"
,
stage0
?
arg
"-package-db libraries/bootstrapping.conf"
,
if
supportsPackageKey
||
stage
/=
Stage0
then
mconcat
[
arg
$
"-this-package-key "
++
pkgKey
,
append
.
map
(
"-package-key "
++
)
$
pkgDepKeys
]
else
mconcat
[
arg
$
"-package-name"
++
pkgKey
,
append
.
map
(
"-package "
++
)
$
pkgDeps
]]
includeGhcArgs
::
Args
includeGhcArgs
=
do
path
<-
getTargetPath
pkgPath
<-
getPackagePath
srcDirs
<-
getPkgDataList
SrcDirs
incDirs
<-
getPkgDataList
IncludeDirs
cppArgs
<-
getPkgDataList
CppArgs
let
buildPath
=
path
-/-
"build"
autogenPath
=
buildPath
-/-
"autogen"
mconcat
[
arg
"-i"
,
append
.
map
(
\
dir
->
"-i"
++
pkgPath
-/-
dir
)
$
srcDirs
,
arg
$
"-i"
++
buildPath
,
arg
$
"-i"
++
autogenPath
,
arg
$
"-I"
++
buildPath
,
arg
$
"-I"
++
autogenPath
,
append
.
map
(
\
dir
->
"-I"
++
pkgPath
-/-
dir
)
$
incDirs
,
arg
"-optP-include"
,
arg
$
"-optP"
++
autogenPath
-/-
"cabal_macros.h"
,
append
.
map
(
"-optP"
++
)
$
cppArgs
]
src/Settings/GhcM.hs
View file @
098d9c1e
...
...
@@ -2,12 +2,10 @@ module Settings.GhcM (ghcMArgs) where
import
Way
import
Util
import
Stage
import
Builder
import
Switches
import
Expression
import
Oracles.Flag
import
Oracles.PackageData
import
Settings.Ghc
import
Settings.Util
import
Settings.Ways
...
...
@@ -23,52 +21,13 @@ ghcMArgs = stagedBuilder GhcM ? do
[
arg
"-M"
,
packageGhcArgs
,
includeGhcArgs
,
append
hsArgs
,
append
.
map
(
"-optP"
++
)
$
cppArgs
,
arg
"-odir"
,
arg
buildPath
,
arg
"-stubdir"
,
arg
buildPath
,
arg
"-hidir"
,
arg
buildPath
,
arg
"-dep-makefile"
,
arg
$
buildPath
-/-
"haskell.deps"
,
append
.
concatMap
(
\
way
->
[
"-dep-suffix"
,
wayPrefix
way
])
$
ways
,
append
hsArgs
,
arg
"-no-user-package-db"
-- TODO: is this needed?
,
arg
"-rtsopts"
-- TODO: is this needed?
,
append
hsSrcs
]
packageGhcArgs
::
Args
packageGhcArgs
=
do
stage
<-
getStage
supportsPackageKey
<-
getFlag
SupportsPackageKey
pkgKey
<-
getPkgData
PackageKey
pkgDepKeys
<-
getPkgDataList
DepKeys
pkgDeps
<-
getPkgDataList
Deps
mconcat
[
arg
"-hide-all-packages"
,
arg
"-no-user-package-db"
,
arg
"-include-pkg-deps"
,
stage0
?
arg
"-package-db libraries/bootstrapping.conf"
,
if
supportsPackageKey
||
stage
/=
Stage0
then
mconcat
[
arg
$
"-this-package-key "
++
pkgKey
,
append
.
map
(
"-package-key "
++
)
$
pkgDepKeys
]
else
mconcat
[
arg
$
"-package-name"
++
pkgKey
,
append
.
map
(
"-package "
++
)
$
pkgDeps
]]
includeGhcArgs
::
Args
includeGhcArgs
=
do
path
<-
getTargetPath
pkgPath
<-
getPackagePath
srcDirs
<-
getPkgDataList
SrcDirs
incDirs
<-
getPkgDataList
IncludeDirs
cppArgs
<-
getPkgDataList
CppArgs
let
buildPath
=
path
-/-
"build"
autogenPath
=
buildPath
-/-
"autogen"
mconcat
[
arg
"-i"
,
append
.
map
(
\
dir
->
"-i"
++
pkgPath
-/-
dir
)
$
srcDirs
,
arg
$
"-i"
++
buildPath
,
arg
$
"-i"
++
autogenPath
,
arg
$
"-I"
++
buildPath
,
arg
$
"-I"
++
autogenPath
,
append
.
map
(
\
dir
->
"-I"
++
pkgPath
-/-
dir
)
$
incDirs
,
arg
"-optP-include"
,
arg
$
"-optP"
++
autogenPath
-/-
"cabal_macros.h"
,
append
.
map
(
"-optP"
++
)
$
cppArgs
]
src/Settings/Util.hs
View file @
098d9c1e
...
...
@@ -146,18 +146,3 @@ needBuilder ghc @ (Ghc stage) = do
needBuilder
builder
=
do
path
<-
builderPath
builder
need
[
path
]
-- TODO: do '-ticky' in all debug ways?
-- wayHcArgs :: Way -> Args
-- wayHcArgs (Way _ units) = args
-- [ if (Dynamic `elem` units)
-- then args ["-fPIC", "-dynamic"]
-- else arg "-static"
-- , when (Threaded `elem` units) $ arg "-optc-DTHREADED_RTS"
-- , when (Debug `elem` units) $ arg "-optc-DDEBUG"
-- , when (Profiling `elem` units) $ arg "-prof"
-- , when (Logging `elem` units) $ arg "-eventlog"
-- , when (Parallel `elem` units) $ arg "-parallel"
-- , when (GranSim `elem` units) $ arg "-gransim"
-- , when (units == [Debug] || units == [Debug, Dynamic]) $
-- args ["-ticky", "-DTICKY_TICKY"] ]
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