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
7ad0b09d
Commit
7ad0b09d
authored
Jan 13, 2015
by
Andrey Mokhov
Browse files
Clean up.
parent
5c01b64c
Changes
7
Hide whitespace changes
Inline
Side-by-side
src/Base.hs
View file @
7ad0b09d
...
...
@@ -27,6 +27,8 @@ data Stage = Stage0 | Stage1 | Stage2 | Stage3 deriving (Eq, Enum)
instance
Show
Stage
where
show
=
show
.
fromEnum
-- The returned list of strings is a list of arguments
-- to be passed to a Builder
type
Args
=
Action
[
String
]
type
Condition
=
Action
Bool
...
...
src/Oracles/Builder.hs
View file @
7ad0b09d
...
...
@@ -11,6 +11,9 @@ import Oracles.Base
import
Oracles.Flag
import
Oracles.Option
-- A Builder is an external command invoked in separate process
-- by calling 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
...
...
@@ -96,7 +99,8 @@ run :: Builder -> Args -> Action ()
run
builder
args
=
do
needBuilder
builder
[
exe
]
<-
showArgs
builder
cmd
[
exe
]
=<<
args
args'
<-
args
cmd
[
exe
]
args'
-- Run the builder with a given collection of arguments printing out a
-- terse commentary with only 'interesting' info for the builder.
...
...
@@ -106,9 +110,9 @@ terseRun builder args = do
needBuilder
builder
[
exe
]
<-
showArgs
builder
args'
<-
args
putNormal
$
"--------
\n
Running "
++
show
builder
++
" with arguments:"
mapM_
(
putNormal
.
(
"
"
++
))
$
interestingInfo
builder
args'
putNormal
"--------"
putNormal
$
"
|
--------
\n
|
Running "
++
show
builder
++
" with arguments:"
mapM_
(
putNormal
.
(
"
|
"
++
))
$
interestingInfo
builder
args'
putNormal
"
|
--------"
quietly
$
cmd
[
exe
]
args'
interestingInfo
::
Builder
->
[
String
]
->
[
String
]
...
...
src/Oracles/Option.hs
View file @
7ad0b09d
...
...
@@ -8,6 +8,10 @@ import Base
import
Oracles.Flag
import
Oracles.Base
-- For each Option the files {default.config, user.config} contain
-- a line of the form 'target-os = mingw32'.
-- (showArgs TargetOS) is an action that consults the config files
-- and returns ["mingw32"].
-- TODO: separate single string options from multiple string ones.
data
Option
=
TargetOS
|
TargetArch
...
...
src/Package.hs
View file @
7ad0b09d
...
...
@@ -11,9 +11,9 @@ import Package.Dependencies
-- These are the packages we build:
packages
::
[
Package
]
packages
=
[
libraryPackage
"array"
Stage1
defaultSettings
,
libraryPackage
"deepseq"
Stage1
defaultSettings
,
libraryPackage
"bin-package-db"
Stage1
defaultSettings
,
libraryPackage
"binary"
Stage1
defaultSettings
]
libraryPackage
"binary"
Stage1
defaultSettings
,
libraryPackage
"deepseq"
Stage1
defaultSettings
]
-- Rule buildPackageX is defined in module Package.X
buildPackage
::
Package
->
TodoItem
->
Rules
()
...
...
@@ -24,7 +24,7 @@ buildPackage = buildPackageData
packageRules
::
Rules
()
packageRules
=
do
-- TODO: control targets from comman
g
line arguments
-- TODO: control targets from comman
d
line arguments
forM_
packages
$
\
pkg
@
(
Package
name
path
todo
)
->
do
forM_
todo
$
\
todoItem
@
(
stage
,
dist
,
settings
)
->
do
...
...
src/Package/Compile.hs
View file @
7ad0b09d
...
...
@@ -32,7 +32,7 @@ suffixArgs way = arg ["-hisuf", hisuf way]
oRule
::
Package
->
TodoItem
->
Rules
()
oRule
(
Package
name
path
_
)
(
stage
,
dist
,
settings
)
=
let
buildDir
=
toStandard
$
path
</>
dist
</>
"build"
pkgData
=
toStandard
$
path
</>
dist
</>
"package-data.mk"
pkgData
=
path
</>
dist
</>
"package-data.mk"
depFile
=
buildDir
</>
name
<.>
"m"
in
(
buildDir
<//>
"*o"
)
%>
\
out
->
do
...
...
@@ -49,6 +49,7 @@ oRule (Package name path _) (stage, dist, settings) =
<>
packageArgs
stage
pkgData
<>
includeArgs
path
dist
<>
concatArgs
[
"-optP"
]
(
CppOpts
pkgData
)
-- TODO: use HC_OPTS from pkgData
-- TODO: now we have both -O and -O2
<>
arg
[
"-Wall"
,
"-XHaskell2010"
,
"-O2"
]
<>
productArgs
[
"-odir"
,
"-hidir"
,
"-stubdir"
]
buildDir
...
...
@@ -59,10 +60,10 @@ oRule (Package name path _) (stage, dist, settings) =
-- TODO: This rule looks hacky... combine it with the above?
hiRule
::
Package
->
TodoItem
->
Rules
()
hiRule
(
Package
name
path
_
)
(
stage
,
dist
,
settings
)
=
let
buildDir
=
toStandard
$
path
</>
dist
</>
"build"
let
buildDir
=
path
</>
dist
</>
"build"
in
(
buildDir
<//>
"*hi"
)
%>
\
out
->
do
let
way
=
detectWay
$
tail
$
takeExtension
out
let
way
=
detectWay
$
tail
$
takeExtension
out
oFile
=
out
-<.>
osuf
way
need
[
oFile
]
...
...
src/Package/Dependencies.hs
View file @
7ad0b09d
...
...
@@ -6,7 +6,7 @@ import Package.Base
buildPackageDependencies
::
Package
->
TodoItem
->
Rules
()
buildPackageDependencies
(
Package
name
path
_
)
(
stage
,
dist
,
settings
)
=
let
buildDir
=
toStandard
$
path
</>
dist
</>
"build"
pkgData
=
toStandard
$
path
</>
dist
</>
"package-data.mk"
pkgData
=
path
</>
dist
</>
"package-data.mk"
in
(
buildDir
</>
name
<.>
"m"
)
%>
\
out
->
do
need
[
"shake/src/Package/Dependencies.hs"
]
...
...
src/Package/Library.hs
View file @
7ad0b09d
...
...
@@ -7,7 +7,6 @@ import Data.List.Split
arRule
::
Package
->
TodoItem
->
Rules
()
arRule
(
Package
_
path
_
)
(
stage
,
dist
,
_
)
=
let
buildDir
=
path
</>
dist
</>
"build"
pkgData
=
path
</>
dist
</>
"package-data.mk"
in
(
buildDir
<//>
"*a"
)
%>
\
out
->
do
let
way
=
detectWay
$
tail
$
takeExtension
out
...
...
@@ -16,6 +15,8 @@ arRule (Package _ path _) (stage, dist, _) =
need
depObjs
libObjs
<-
pkgLibObjects
path
dist
stage
way
liftIO
$
removeFiles
"."
[
out
]
-- Splitting argument list into chunks as otherwise Ar chokes up
-- TODO: use simpler list notation for passing arguments
forM_
(
chunksOf
100
libObjs
)
$
\
os
->
do
terseRun
Ar
$
"q"
<+>
toStandard
out
<+>
os
...
...
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