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
c41e156c
Commit
c41e156c
authored
Jul 15, 2015
by
Andrey Mokhov
Browse files
Add support to multiple files in Target, implement registerPackage predicate.
parent
37262111
Changes
5
Hide whitespace changes
Inline
Side-by-side
src/Expression.hs
View file @
c41e156c
...
...
@@ -140,7 +140,7 @@ builder :: Builder -> Predicate
builder
b
=
liftM
(
b
==
)
(
asks
getBuilder
)
file
::
FilePattern
->
Predicate
file
f
=
liftM
(
f
?==
)
(
asks
getFile
)
file
f
=
liftM
(
any
(
f
?==
)
)
(
asks
getFile
s
)
way
::
Way
->
Predicate
way
w
=
liftM
(
w
==
)
(
asks
getWay
)
...
...
src/Rules/Actions.hs
View file @
c41e156c
module
Rules.Actions
(
build
,
run
,
verboseRun
,
build
,
buildWhen
,
run
,
verboseRun
,
)
where
import
Base
...
...
@@ -21,6 +21,11 @@ build target = do
argsHash
<-
askArgsHash
target
run
(
getBuilder
target
)
argList
buildWhen
::
Predicate
->
FullTarget
->
Action
()
buildWhen
predicate
target
=
do
bool
<-
interpretExpr
target
predicate
when
bool
$
build
target
-- Run the builder with a given collection of arguments
verboseRun
::
Builder
->
[
String
]
->
Action
()
verboseRun
builder
args
=
do
...
...
src/Rules/Data.hs
View file @
c41e156c
...
...
@@ -4,10 +4,10 @@ module Rules.Data (
cabalArgs
,
ghcPkgArgs
,
buildPackageData
)
where
import
Way
import
Base
import
Package
import
Builder
import
Switches
import
Expression
import
Control.Monad.Extra
import
Settings.GhcPkg
...
...
@@ -31,16 +31,14 @@ buildPackageData target =
,
"build"
</>
"autogen"
</>
"cabal_macros.h"
-- TODO: Is this needed? Also check out Paths_cpsa.hs.
-- , "build" </> "autogen" </> ("Paths_" ++ name) <.> "hs"
]
&%>
\
_
->
do
]
&%>
\
files
->
do
let
configure
=
pkgPath
pkg
</>
"configure"
-- GhcCabal will run the configure script, so we depend on it
need
[
pkgPath
pkg
</>
pkgCabal
pkg
]
-- We still don't know who built the configure script from configure.ac
whenM
(
doesFileExist
$
configure
<.>
"ac"
)
$
need
[
configure
]
-- TODO: 1) automate? 2) mutliple files 3) vanilla?
build
$
fullTarget
target
(
path
</>
"package-data.mk"
)
GhcCabal
vanilla
-- TODO: when (registerPackage settings) $
build
$
fullTarget
target
(
path
</>
"package-data.mk"
)
(
GhcPkg
stage
)
vanilla
build
$
fullTarget
target
files
GhcCabal
buildWhen
registerPackage
$
fullTarget
target
files
(
GhcPkg
stage
)
postProcessPackageData
$
path
</>
"package-data.mk"
-- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
...
...
src/Switches.hs
View file @
c41e156c
...
...
@@ -5,7 +5,8 @@ module Switches (
targetOss
,
targetOs
,
notTargetOs
,
targetArchs
,
dynamicGhcPrograms
,
ghcWithInterpreter
,
platformSupportsSharedLibs
,
crossCompiling
,
gccIsClang
,
gccLt46
,
windowsHost
,
notWindowsHost
gccIsClang
,
gccLt46
,
windowsHost
,
notWindowsHost
,
registerPackage
)
where
import
Base
...
...
@@ -91,6 +92,10 @@ windowsHost = configKeyValues "host-os-cpp" ["mingw32", "cygwin32"]
notWindowsHost
::
Predicate
notWindowsHost
=
liftM
not
windowsHost
-- TODO: Actually, we don't register compiler in some circumstances -- fix.
registerPackage
::
Predicate
registerPackage
=
return
True
-- splitObjects :: Stage -> Condition
-- splitObjects stage = do
-- arch <- showArg TargetArch
...
...
src/Target.hs
View file @
c41e156c
{-# LANGUAGE DeriveGeneric, TypeSynonymInstances #-}
module
Target
(
Target
(
..
),
StageTarget
(
..
),
StagePackageTarget
(
..
),
FullTarget
(
..
),
stageTarget
,
stagePackageTarget
,
fullTarget
stageTarget
,
stagePackageTarget
,
fullTarget
,
fullTargetWithWay
)
where
import
Way
...
...
@@ -18,7 +18,7 @@ data Target = Target
{
getStage
::
Stage
,
getPackage
::
Package
,
getFile
::
FilePath
,
-- TODO: handle multple files?
getFile
s
::
[
FilePath
]
,
getBuilder
::
Builder
,
getWay
::
Way
}
...
...
@@ -32,9 +32,9 @@ stageTarget stage = Target
{
getStage
=
stage
,
getPackage
=
error
"stageTarget: Package not set"
,
getFile
=
error
"stageTarget: File not set"
,
getFile
s
=
error
"stageTarget: File
s
not set"
,
getBuilder
=
error
"stageTarget: Builder not set"
,
getWay
=
error
"s
tage
Target: Way not set"
getWay
=
vanilla
-- most
ta
r
ge
ts are built only one way (vanilla)
}
-- StagePackageTarget is a Target whose fields getStage and getPackage are
...
...
@@ -46,18 +46,28 @@ stagePackageTarget stage package = Target
{
getStage
=
stage
,
getPackage
=
package
,
getFile
=
error
"stagePackageTarget: File not set"
,
getFile
s
=
error
"stagePackageTarget: File
s
not set"
,
getBuilder
=
error
"stagePackageTarget: Builder not set"
,
getWay
=
error
"stagePackageTarget: Way not set"
getWay
=
vanilla
}
-- FullTarget is a Target whose fields are all assigned
type
FullTarget
=
Target
fullTarget
::
StagePackageTarget
->
FilePath
->
Builder
->
Way
->
FullTarget
fullTarget
target
file
builder
way
=
target
-- Most targets are built only one way, vanilla, hence we set it by default.
fullTarget
::
StagePackageTarget
->
[
FilePath
]
->
Builder
->
FullTarget
fullTarget
target
files
builder
=
target
{
getFile
=
file
,
getFiles
=
files
,
getBuilder
=
builder
,
getWay
=
vanilla
}
-- Use this function to be explicit about build the way.
fullTargetWithWay
::
StagePackageTarget
->
[
FilePath
]
->
Builder
->
Way
->
FullTarget
fullTargetWithWay
target
files
builder
way
=
target
{
getFiles
=
files
,
getBuilder
=
builder
,
getWay
=
way
}
...
...
@@ -65,7 +75,7 @@ fullTarget target file builder way = target
-- Shows a (full) target as "package:file@stage (builder, way)"
instance
Show
FullTarget
where
show
target
=
show
(
getPackage
target
)
++
":"
++
getFile
target
++
":"
++
show
(
getFile
s
target
)
++
"@"
++
show
(
getStage
target
)
++
" ("
++
show
(
getBuilder
target
)
++
", "
++
show
(
getWay
target
)
++
")"
...
...
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