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
897ba61d
Commit
897ba61d
authored
Apr 15, 2016
by
Andrey Mokhov
Browse files
Add CompilerMode to Cc and Ghc builders.
See
#223
.
parent
96dec149
Changes
15
Hide whitespace changes
Inline
Side-by-side
src/Builder.hs
View file @
897ba61d
{-# LANGUAGE DeriveGeneric, LambdaCase #-}
module
Builder
(
Builder
(
..
),
isStaged
,
builderPath
,
getBuilderPath
,
specified
,
needBuilder
CompilerMode
(
..
),
Builder
(
..
),
isStaged
,
builderPath
,
getBuilderPath
,
specified
,
needBuilder
)
where
import
Control.Monad.Trans.Reader
...
...
@@ -14,27 +15,28 @@ import Oracles.LookupInPath
import
Oracles.WindowsPath
import
Stage
-- TODO: Add Link mode?
-- | A C or Haskell compiler can be used in two modes: for compiling sources
-- into object files, or for extracting source dependencies, e.g. by passing -M
-- command line option.
data
CompilerMode
=
Compile
|
FindDependencies
deriving
(
Show
,
Eq
,
Generic
)
-- TODO: Do we really need HsCpp builder? Can't we use Cc instead?
-- | A 'Builder' is an external command invoked in separate process using 'Shake.cmd'
--
-- @Ghc Stage0@ is the bootstrapping compiler
-- @Ghc StageN@, N > 0, is the one built on stage (N - 1)
-- @GhcPkg Stage0@ is the bootstrapping @GhcPkg@
-- @GhcPkg StageN@, N > 0, is the one built in Stage0 (TODO: need only Stage1?)
-- TODO: Do we really need HsCpp builder? Can't we use a generic Cpp
-- builder instead? It would also be used instead of CcM.
-- TODO: why are Cc/CcM staged?
-- TODO: use Cc CcMode, where CcMode = Compile | FindDeps instead of Cc & CcM.
data
Builder
=
Alex
|
Ar
|
DeriveConstants
|
Cc
Stage
|
CcM
Stage
-- synonym for 'Cc -MM'
|
Cc
CompilerMode
Stage
|
GenApply
|
GenPrimopCode
|
Ghc
Stage
|
Ghc
CompilerMode
Stage
|
GhcCabal
|
GhcCabalHsColour
-- synonym for 'GhcCabal hscolour'
|
GhcM
Stage
-- synonym for 'Ghc -M'
|
GhcPkg
Stage
|
Haddock
|
Happy
...
...
@@ -61,8 +63,8 @@ builderProvenance = \case
DeriveConstants
->
context
Stage0
deriveConstants
GenApply
->
context
Stage0
genapply
GenPrimopCode
->
context
Stage0
genprimopcode
Ghc
s
tage
->
if
stage
==
Stage0
then
Nothing
else
context
(
pred
stage
)
ghc
Ghc
M
stage
->
builderProvenance
$
Ghc
stage
Ghc
_
S
tage
0
->
Nothing
Ghc
_
stage
->
context
(
pred
stage
)
ghc
GhcCabal
->
context
Stage0
ghcCabal
GhcCabalHsColour
->
builderProvenance
$
GhcCabal
GhcPkg
stage
->
if
stage
>
Stage0
then
context
Stage0
ghcPkg
else
Nothing
...
...
@@ -79,12 +81,10 @@ isInternal = isJust . builderProvenance
isStaged
::
Builder
->
Bool
isStaged
=
\
case
(
Cc
_
)
->
True
(
CcM
_
)
->
True
(
Ghc
_
)
->
True
(
GhcM
_
)
->
True
(
GhcPkg
_
)
->
True
_
->
False
(
Cc
_
_
)
->
True
(
Ghc
_
_
)
->
True
(
GhcPkg
_
)
->
True
_
->
False
-- TODO: Some builders are required only on certain platforms. For example,
-- Objdump is only required on OpenBSD and AIX, as mentioned in #211. Add
...
...
@@ -103,26 +103,23 @@ builderPath builder = case builderProvenance builder of
Just
context
->
return
.
fromJust
$
programPath
context
Nothing
->
do
let
builderKey
=
case
builder
of
Alex
->
"alex"
Ar
->
"ar"
Cc
Stage0
->
"system-cc"
Cc
_
->
"cc"
CcM
Stage0
->
"system-cc"
CcM
_
->
"cc"
Ghc
Stage0
->
"system-ghc"
GhcM
Stage0
->
"system-ghc"
GhcPkg
Stage0
->
"system-ghc-pkg"
Happy
->
"happy"
HsColour
->
"hscolour"
HsCpp
->
"hs-cpp"
Ld
->
"ld"
Make
->
"make"
Nm
->
"nm"
Objdump
->
"objdump"
Patch
->
"patch"
Perl
->
"perl"
Ranlib
->
"ranlib"
Tar
->
"tar"
Alex
->
"alex"
Ar
->
"ar"
Cc
_
Stage0
->
"system-cc"
Cc
_
_
->
"cc"
Ghc
_
Stage0
->
"system-ghc"
GhcPkg
Stage0
->
"system-ghc-pkg"
Happy
->
"happy"
HsColour
->
"hscolour"
HsCpp
->
"hs-cpp"
Ld
->
"ld"
Make
->
"make"
Nm
->
"nm"
Objdump
->
"objdump"
Patch
->
"patch"
Perl
->
"perl"
Ranlib
->
"ranlib"
Tar
->
"tar"
_
->
error
$
"Cannot determine builderKey for "
++
show
builder
path
<-
askConfigWithDefault
builderKey
.
putError
$
"
\n
Cannot find path to '"
++
builderKey
...
...
@@ -155,11 +152,14 @@ needBuilder laxDependencies builder = when (isInternal builder) $ do
where
allowOrderOnlyDependency
::
Builder
->
Bool
allowOrderOnlyDependency
=
\
case
Ghc
_
->
True
GhcM
_
->
True
_
->
False
Ghc
_
_
->
True
_
->
False
-- Instances for storing in the Shake database
instance
Binary
CompilerMode
instance
Hashable
CompilerMode
instance
NFData
CompilerMode
instance
Binary
Builder
instance
Hashable
Builder
instance
NFData
Builder
src/Predicates.hs
View file @
897ba61d
{-# LANGUAGE LambdaCase #-}
-- | Convenient predicates
module
Predicates
(
stage
,
package
,
builder
,
stagedBuilder
,
builderCc
,
builderGhc
,
file
,
way
,
...
...
@@ -19,17 +20,23 @@ package p = (p ==) <$> getPackage
builder
::
Builder
->
Predicate
builder
b
=
(
b
==
)
<$>
getBuilder
-- TODO: Use type classes to unify various builder predicates (also needBuilder,
-- builderPath, etc).
-- | Is a certain builder used in the current stage?
stagedBuilder
::
(
Stage
->
Builder
)
->
Predicate
stagedBuilder
stageBuilder
=
builder
.
stageBuilder
=<<
getStage
-- | Are we building with
GCC
?
-- | Are we building with
a C compiler
?
builderCc
::
Predicate
builderCc
=
stagedBuilder
Cc
||^
stagedBuilder
CcM
builderCc
=
getBuilder
>>=
\
case
Cc
_
_
->
return
True
_
->
return
False
-- | Are we building with GHC?
builderGhc
::
Predicate
builderGhc
=
stagedBuilder
Ghc
||^
stagedBuilder
GhcM
builderGhc
=
getBuilder
>>=
\
case
Ghc
_
_
->
return
True
_
->
return
False
-- | Does any of the output files match a given pattern?
file
::
FilePattern
->
Predicate
...
...
src/Rules/Compile.hs
View file @
897ba61d
...
...
@@ -17,7 +17,7 @@ compilePackage rs context@Context {..} = do
then
do
(
src
,
deps
)
<-
dependencies
path
$
hi
-<.>
osuf
way
need
$
src
:
deps
buildWithResources
rs
$
Target
context
(
Ghc
stage
)
[
src
]
[
hi
]
buildWithResources
rs
$
Target
context
(
Ghc
Compile
stage
)
[
src
]
[
hi
]
else
need
[
hi
-<.>
osuf
way
]
path
<//>
"*"
<.>
hibootsuf
way
%>
\
hiboot
->
...
...
@@ -25,7 +25,7 @@ compilePackage rs context@Context {..} = do
then
do
(
src
,
deps
)
<-
dependencies
path
$
hiboot
-<.>
obootsuf
way
need
$
src
:
deps
buildWithResources
rs
$
Target
context
(
Ghc
stage
)
[
src
]
[
hiboot
]
buildWithResources
rs
$
Target
context
(
Ghc
Compile
stage
)
[
src
]
[
hiboot
]
else
need
[
hiboot
-<.>
obootsuf
way
]
-- TODO: add dependencies for #include of .h and .hs-incl files (gcc -MM?)
...
...
@@ -34,12 +34,12 @@ compilePackage rs context@Context {..} = do
if
(
"//*.c"
?==
src
)
then
do
need
$
src
:
deps
build
$
Target
context
(
Cc
stage
)
[
src
]
[
obj
]
build
$
Target
context
(
Cc
Compile
stage
)
[
src
]
[
obj
]
else
do
if
compileInterfaceFilesSeparately
&&
"//*.hs"
?==
src
then
need
$
(
obj
-<.>
hisuf
way
)
:
src
:
deps
else
need
$
src
:
deps
buildWithResources
rs
$
Target
context
(
Ghc
stage
)
[
src
]
[
obj
]
buildWithResources
rs
$
Target
context
(
Ghc
Compile
stage
)
[
src
]
[
obj
]
-- TODO: get rid of these special cases
path
<//>
"*"
<.>
obootsuf
way
%>
\
obj
->
do
...
...
@@ -47,4 +47,4 @@ compilePackage rs context@Context {..} = do
if
compileInterfaceFilesSeparately
then
need
$
(
obj
-<.>
hibootsuf
way
)
:
src
:
deps
else
need
$
src
:
deps
buildWithResources
rs
$
Target
context
(
Ghc
stage
)
[
src
]
[
obj
]
buildWithResources
rs
$
Target
context
(
Ghc
Compile
stage
)
[
src
]
[
obj
]
src/Rules/Dependencies.hs
View file @
897ba61d
...
...
@@ -20,14 +20,15 @@ buildPackageDependencies rs context@Context {..} =
[
"//*.c.deps"
,
"//*.cmm.deps"
,
"//*.S.deps"
]
|%>
\
out
->
do
let
src
=
dep2src
context
out
need
[
src
]
build
$
Target
context
(
Cc
M
stage
)
[
src
]
[
out
]
build
$
Target
context
(
Cc
FindDependencies
stage
)
[
src
]
[
out
]
hDepFile
%>
\
out
->
do
srcs
<-
haskellSources
context
need
srcs
if
srcs
==
[]
then
writeFileChanged
out
""
else
buildWithResources
rs
$
Target
context
(
GhcM
stage
)
srcs
[
out
]
else
buildWithResources
rs
$
Target
context
(
Ghc
FindDependencies
stage
)
srcs
[
out
]
removeFileIfExists
$
out
<.>
"bak"
-- TODO: don't accumulate *.deps into .dependencies
...
...
src/Rules/Gmp.hs
View file @
897ba61d
...
...
@@ -37,7 +37,7 @@ gmpPatches = (gmpBase -/-) <$> ["gmpsrc.patch", "tarball/gmp-5.0.4.patch"]
-- TODO: See Libffi.hs about removing code duplication.
configureEnvironment
::
Action
[
CmdOption
]
configureEnvironment
=
do
sequence
[
builderEnv
"CC"
$
Cc
Stage1
sequence
[
builderEnv
"CC"
$
Cc
Compile
Stage1
,
builderEnv
"AR"
Ar
,
builderEnv
"NM"
Nm
]
where
...
...
src/Rules/Libffi.hs
View file @
897ba61d
...
...
@@ -43,8 +43,8 @@ configureEnvironment = do
[
cArgs
,
argStagedSettingList
ConfCcArgs
]
ldFlags
<-
interpretInContext
libffiContext
$
fromDiffExpr
ldArgs
sequence
[
builderEnv
"CC"
$
Cc
Stage0
,
builderEnv
"CXX"
$
Cc
Stage0
sequence
[
builderEnv
"CC"
$
Cc
Compile
Stage0
,
builderEnv
"CXX"
$
Cc
Compile
Stage0
,
builderEnv
"LD"
Ld
,
builderEnv
"AR"
Ar
,
builderEnv
"NM"
Nm
...
...
src/Rules/Program.hs
View file @
897ba61d
...
...
@@ -99,7 +99,8 @@ buildBinary rs context@(Context stage package _) bin = do
then
[
pkgPath
package
-/-
src
<.>
"hs"
|
src
<-
hSrcs
]
else
objs
need
$
binDeps
++
libs
buildWithResources
rs
$
Target
context
(
Ghc
stage
)
binDeps
[
bin
]
-- TODO: Use Link mode instead of Compile.
buildWithResources
rs
$
Target
context
(
Ghc
Compile
stage
)
binDeps
[
bin
]
synopsis
<-
interpretInContext
context
$
getPkgData
Synopsis
putSuccess
$
renderProgram
(
"'"
++
pkgNameString
package
++
"' ("
++
show
stage
++
")."
)
...
...
src/Rules/Test.hs
View file @
897ba61d
...
...
@@ -15,7 +15,7 @@ import Settings.User
testRules
::
Rules
()
testRules
=
do
"validate"
~>
do
needBuilder
False
$
Ghc
Stage2
-- TODO: get rid of False
parameters
needBuilder
False
$
Ghc
Compile
Stage2
-- TODO: get rid of False
needBuilder
False
$
GhcPkg
Stage1
needBuilder
False
$
Hpc
runMakeVerbose
"testsuite/tests"
[
"fast"
]
...
...
@@ -28,7 +28,7 @@ testRules = do
|
pkg
<-
pkgs
,
isLibrary
pkg
,
pkg
/=
rts
,
pkg
/=
libffi
]
windows
<-
windowsHost
top
<-
topDirectory
compiler
<-
builderPath
$
Ghc
Stage2
compiler
<-
builderPath
$
Ghc
Compile
Stage2
ghcPkg
<-
builderPath
$
GhcPkg
Stage1
haddock
<-
builderPath
Haddock
threads
<-
shakeThreads
<$>
getShakeOptions
...
...
src/Settings/Args.hs
View file @
897ba61d
...
...
@@ -51,7 +51,6 @@ defaultBuilderArgs = mconcat
[
alexBuilderArgs
,
arBuilderArgs
,
ccBuilderArgs
,
ccMBuilderArgs
,
deriveConstantsBuilderArgs
,
genApplyBuilderArgs
,
genPrimopCodeBuilderArgs
...
...
src/Settings/Builders/Cc.hs
View file @
897ba61d
module
Settings.Builders.Cc
(
ccBuilderArgs
,
ccMBuilderArgs
)
where
module
Settings.Builders.Cc
(
ccBuilderArgs
)
where
import
Development.Shake.FilePath
import
Expression
...
...
@@ -8,26 +8,26 @@ import Predicates (stagedBuilder)
import
Settings
import
Settings.Builders.Common
(
cIncludeArgs
)
-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
ccBuilderArgs
::
Args
ccBuilderArgs
=
stagedBuilder
Cc
?
mconcat
[
commonCcArgs
,
arg
"-c"
,
arg
=<<
getInput
,
arg
"-o"
,
arg
=<<
getOutput
]
ccBuilderArgs
=
mconcat
[
stagedBuilder
(
Cc
Compile
)
?
mconcat
[
commonCcArgs
,
arg
"-c"
,
arg
=<<
getInput
,
arg
"-o"
,
arg
=<<
getOutput
]
-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
ccMBuilderArgs
::
Args
ccMBuilderArgs
=
stagedBuilder
CcM
?
do
output
<-
getOutput
mconcat
[
arg
"-E"
,
arg
"-MM"
,
commonCcArgs
,
arg
"-MF"
,
arg
output
,
arg
"-MT"
,
arg
$
dropExtension
output
-<.>
"o"
,
arg
"-x"
,
arg
"c"
,
arg
=<<
getInput
]
,
stagedBuilder
(
Cc
FindDependencies
)
?
do
output
<-
getOutput
mconcat
[
arg
"-E"
,
arg
"-MM"
,
commonCcArgs
,
arg
"-MF"
,
arg
output
,
arg
"-MT"
,
arg
$
dropExtension
output
-<.>
"o"
,
arg
"-x"
,
arg
"c"
,
arg
=<<
getInput
]
]
commonCcArgs
::
Args
commonCcArgs
=
mconcat
[
append
=<<
getPkgDataList
CcArgs
...
...
src/Settings/Builders/DeriveConstants.hs
View file @
897ba61d
...
...
@@ -20,7 +20,7 @@ deriveConstantsBuilderArgs = builder DeriveConstants ? do
,
file
"//GHCConstantsHaskellExports.hs"
?
arg
"--gen-haskell-exports"
,
arg
"-o"
,
arg
output
,
arg
"--tmpdir"
,
arg
tempDir
,
arg
"--gcc-program"
,
arg
=<<
getBuilderPath
(
Cc
Stage1
)
,
arg
"--gcc-program"
,
arg
=<<
getBuilderPath
(
Cc
Compile
Stage1
)
,
append
.
concat
$
map
(
\
a
->
[
"--gcc-flag"
,
a
])
cFlags
,
arg
"--nm-program"
,
arg
=<<
getBuilderPath
Nm
,
specified
Objdump
?
mconcat
[
arg
"--objdump-program"
...
...
src/Settings/Builders/Ghc.hs
View file @
897ba61d
...
...
@@ -18,7 +18,7 @@ import Settings.Builders.Common (cIncludeArgs)
-- $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno
-- $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@)))
ghcBuilderArgs
::
Args
ghcBuilderArgs
=
stagedBuilder
Ghc
?
do
ghcBuilderArgs
=
stagedBuilder
(
Ghc
Compile
)
?
do
output
<-
getOutput
stage
<-
getStage
way
<-
getWay
...
...
@@ -61,7 +61,7 @@ splitObjectsArgs = splitObjects ? do
arg
"-split-objs"
ghcMBuilderArgs
::
Args
ghcMBuilderArgs
=
stagedBuilder
Ghc
M
?
do
ghcMBuilderArgs
=
stagedBuilder
(
Ghc
FindDependencies
)
?
do
ways
<-
getLibraryWays
mconcat
[
arg
"-M"
,
commonGhcArgs
...
...
src/Settings/Builders/GhcCabal.hs
View file @
897ba61d
...
...
@@ -25,14 +25,14 @@ ghcCabalBuilderArgs = builder GhcCabal ? do
,
arg
path
,
arg
dir
,
dll0Args
,
withStaged
Ghc
,
withStaged
$
Ghc
Compile
,
withStaged
GhcPkg
,
bootPackageDbArgs
,
libraryArgs
,
with
HsColour
,
configureArgs
,
packageConstraints
,
withStaged
Cc
,
withStaged
$
Cc
Compile
,
notStage0
?
with
Ld
,
with
Ar
,
with
Alex
...
...
@@ -85,7 +85,7 @@ configureArgs = do
,
conf
"--with-gmp-includes"
$
argSetting
GmpIncludeDir
,
conf
"--with-gmp-libraries"
$
argSetting
GmpLibDir
,
crossCompiling
?
(
conf
"--host"
$
argSetting
TargetPlatformFull
)
,
conf
"--with-cc"
$
argStagedBuilderPath
Cc
]
,
conf
"--with-cc"
$
argStagedBuilderPath
(
Cc
Compile
)
]
newtype
PackageDbKey
=
PackageDbKey
Stage
deriving
(
Show
,
Typeable
,
Eq
,
Hashable
,
Binary
,
NFData
)
...
...
@@ -114,8 +114,8 @@ withBuilderKey :: Builder -> String
withBuilderKey
b
=
case
b
of
Ar
->
"--with-ar="
Ld
->
"--with-ld="
Cc
_
->
"--with-gcc="
Ghc
_
->
"--with-ghc="
Cc
_
_
->
"--with-gcc="
Ghc
_
_
->
"--with-ghc="
Alex
->
"--with-alex="
Happy
->
"--with-happy="
GhcPkg
_
->
"--with-ghc-pkg="
...
...
src/Settings/Builders/Hsc2Hs.hs
View file @
897ba61d
...
...
@@ -18,7 +18,7 @@ templateHsc = "inplace/lib/template-hsc.h"
hsc2hsBuilderArgs
::
Args
hsc2hsBuilderArgs
=
builder
Hsc2Hs
?
do
stage
<-
getStage
ccPath
<-
getBuilderPath
$
Cc
stage
ccPath
<-
getBuilderPath
$
Cc
Compile
stage
gmpDir
<-
getSetting
GmpIncludeDir
cFlags
<-
getCFlags
lFlags
<-
getLFlags
...
...
src/Settings/Packages/Directory.hs
View file @
897ba61d
...
...
@@ -2,7 +2,7 @@ module Settings.Packages.Directory (directoryPackageArgs) where
import
Expression
import
GHC
(
directory
)
import
Predicates
(
stagedB
uilder
,
package
)
import
Predicates
(
b
uilder
Cc
,
package
)
-- TODO: I had to define symbol __GLASGOW_HASKELL__ as otherwise directory.c is
-- effectively empty. I presume it was expected that GHC will be used for
...
...
@@ -10,4 +10,4 @@ import Predicates (stagedBuilder, package)
-- only file which requires special treatment when using GCC.
directoryPackageArgs
::
Args
directoryPackageArgs
=
package
directory
?
stagedB
uilder
Cc
?
arg
"-D__GLASGOW_HASKELL__"
b
uilderCc
?
arg
"-D__GLASGOW_HASKELL__"
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