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
272f1005
Commit
272f1005
authored
Jul 19, 2015
by
Andrey Mokhov
Browse files
Refactor and rename Oracles/Option.hs.
parent
a8cfbde5
Changes
9
Hide whitespace changes
Inline
Side-by-side
src/Base.hs
View file @
272f1005
...
...
@@ -6,7 +6,7 @@ module Base (
module
Control
.
Applicative
,
module
Data
.
Function
,
module
Data
.
Monoid
,
module
Data
.
List
,
--
module Data.List,
Stage
(
..
),
Arg
,
ArgList
,
ShowArg
(
..
),
ShowArgs
(
..
),
...
...
@@ -18,7 +18,6 @@ import Development.Shake.FilePath
import
Control.Applicative
import
Data.Function
import
Data.Monoid
import
Data.List
import
GHC.Generics
import
Development.Shake.Classes
...
...
src/Builder.hs
View file @
272f1005
...
...
@@ -6,9 +6,10 @@ module Builder (
import
Base
import
Util
import
Data.List
import
Oracles.Base
import
Oracles.Flag
import
Oracles.
Option
import
Oracles.
Setting
import
GHC.Generics
import
Development.Shake.Classes
...
...
src/Expression.hs
View file @
272f1005
...
...
@@ -16,6 +16,7 @@ import Base
import
Builder
import
Package
import
Target
import
Data.List
import
Oracles.Base
import
Data.Monoid
import
Control.Monad.Reader
hiding
(
liftIO
)
...
...
src/Oracles.hs
View file @
272f1005
...
...
@@ -13,6 +13,7 @@ import Control.Monad.Extra
import
Oracles.Base
import
Oracles.PackageData
import
Oracles.DependencyList
import
Data.List
-- Oracle for configuration files
configOracle
::
Rules
()
...
...
src/Oracles/Option.hs
deleted
100644 → 0
View file @
a8cfbde5
module
Oracles.Option
(
Option
(
..
),
MultiOption
(
..
),
windowsHost
)
where
import
Base
import
Oracles.Base
-- For each Option the file default.config contains a line of the
-- form 'target-os = mingw32'.
-- (showArg TargetOs) is an action that consults the config files
-- and returns "mingw32".
--
-- MultiOption is used for multiple string options separated by spaces,
-- such as 'src-hc-args = -H32m -O'.
-- (showArgs SrcHcArgs) therefore returns a list of strings ["-H32", "-O"].
data
Option
=
TargetOs
|
TargetArch
|
TargetPlatformFull
|
HostOsCpp
|
DynamicExtension
|
ProjectVersion
|
GhcSourcePath
data
MultiOption
=
SrcHcArgs
|
ConfCcArgs
Stage
|
ConfGccLinkerArgs
Stage
|
ConfLdLinkerArgs
Stage
|
ConfCppArgs
Stage
|
IconvIncludeDirs
|
IconvLibDirs
|
GmpIncludeDirs
|
GmpLibDirs
instance
ShowArg
Option
where
showArg
opt
=
askConfig
$
case
opt
of
TargetOs
->
"target-os"
TargetArch
->
"target-arch"
TargetPlatformFull
->
"target-platform-full"
HostOsCpp
->
"host-os-cpp"
DynamicExtension
->
"dynamic-extension"
ProjectVersion
->
"project-version"
GhcSourcePath
->
"ghc-source-path"
instance
ShowArgs
MultiOption
where
showArgs
opt
=
showArgs
$
fmap
words
$
askConfig
$
case
opt
of
SrcHcArgs
->
"src-hc-args"
ConfCcArgs
stage
->
"conf-cc-args"
++
showStage
stage
ConfCppArgs
stage
->
"conf-cpp-args"
++
showStage
stage
ConfGccLinkerArgs
stage
->
"conf-gcc-linker-args"
++
showStage
stage
ConfLdLinkerArgs
stage
->
"conf-ld-linker-args"
++
showStage
stage
IconvIncludeDirs
->
"iconv-include-dirs"
IconvLibDirs
->
"iconv-lib-dirs"
GmpIncludeDirs
->
"gmp-include-dirs"
GmpLibDirs
->
"gmp-lib-dirs"
where
showStage
=
(
"-stage"
++
)
.
show
windowsHost
::
Action
Bool
windowsHost
=
do
hostOsCpp
<-
showArg
HostOsCpp
return
$
hostOsCpp
`
elem
`
[
"mingw32"
,
"cygwin32"
]
src/Oracles/PackageData.hs
View file @
272f1005
...
...
@@ -8,6 +8,7 @@ module Oracles.PackageData (
import
Development.Shake.Classes
import
Base
import
Util
import
Data.List
import
Data.Maybe
-- For each (PackageData path) the file 'path/package-data.mk' contains
...
...
src/Oracles/Setting.hs
0 → 100644
View file @
272f1005
module
Oracles.Setting
(
Setting
(
..
),
MultiSetting
(
..
),
setting
,
multiSetting
,
windowsHost
)
where
import
Base
import
Oracles.Base
-- Each Setting comes from the system.config file, e.g. 'target-os = mingw32'.
-- setting TargetOs looks up the config file and returns "mingw32".
--
-- MultiSetting is used for multiple string values separated by spaces, such
-- as 'src-hc-args = -H32m -O'.
-- multiSetting SrcHcArgs therefore returns a list of strings ["-H32", "-O"].
data
Setting
=
TargetOs
|
TargetArch
|
TargetPlatformFull
|
HostOsCpp
|
DynamicExtension
|
ProjectVersion
|
GhcSourcePath
data
MultiSetting
=
SrcHcArgs
|
ConfCcArgs
Stage
|
ConfGccLinkerArgs
Stage
|
ConfLdLinkerArgs
Stage
|
ConfCppArgs
Stage
|
IconvIncludeDirs
|
IconvLibDirs
|
GmpIncludeDirs
|
GmpLibDirs
setting
::
Setting
->
Action
String
setting
s
=
askConfig
$
case
s
of
TargetOs
->
"target-os"
TargetArch
->
"target-arch"
TargetPlatformFull
->
"target-platform-full"
HostOsCpp
->
"host-os-cpp"
DynamicExtension
->
"dynamic-extension"
ProjectVersion
->
"project-version"
GhcSourcePath
->
"ghc-source-path"
multiSetting
::
MultiSetting
->
Action
[
String
]
multiSetting
s
=
fmap
words
$
askConfig
$
case
s
of
SrcHcArgs
->
"src-hc-args"
ConfCcArgs
stage
->
"conf-cc-args"
++
showStage
stage
ConfCppArgs
stage
->
"conf-cpp-args"
++
showStage
stage
ConfGccLinkerArgs
stage
->
"conf-gcc-linker-args"
++
showStage
stage
ConfLdLinkerArgs
stage
->
"conf-ld-linker-args"
++
showStage
stage
IconvIncludeDirs
->
"iconv-include-dirs"
IconvLibDirs
->
"iconv-lib-dirs"
GmpIncludeDirs
->
"gmp-include-dirs"
GmpLibDirs
->
"gmp-lib-dirs"
where
showStage
=
(
"-stage"
++
)
.
show
windowsHost
::
Action
Bool
windowsHost
=
do
hostOsCpp
<-
setting
HostOsCpp
return
$
hostOsCpp
`
elem
`
[
"mingw32"
,
"cygwin32"
]
src/Settings/GhcCabal.hs
View file @
272f1005
...
...
@@ -7,14 +7,15 @@ import Base
import
Builder
import
Package
import
Util
import
Oracles.Base
import
Switches
import
Expression
import
Switches
import
Oracles.Base
import
Settings.User
import
Settings.Ways
import
Settings.Util
import
Settings.Packages
import
Settings.TargetDirectory
import
Data.List
cabalArgs
::
Args
cabalArgs
=
builder
GhcCabal
?
do
...
...
src/Way.hs
View file @
272f1005
...
...
@@ -15,10 +15,10 @@ module Way ( -- TODO: rename to "Way"?
import
Base
import
Util
import
Data.IntSet
(
IntSet
)
import
qualified
Data.IntSet
as
IntSet
import
Oracles.Option
import
Oracles.Setting
import
Development.Shake.Classes
import
Data.List
hiding
(
delete
)
import
Data.IntSet
(
IntSet
,
elems
,
member
,
delete
,
fromList
)
data
WayUnit
=
Threaded
|
Debug
...
...
@@ -45,13 +45,13 @@ instance Read WayUnit where
newtype
Way
=
Way
IntSet
wayFromUnits
::
[
WayUnit
]
->
Way
wayFromUnits
=
Way
.
IntSet
.
fromList
.
map
fromEnum
wayFromUnits
=
Way
.
fromList
.
map
fromEnum
wayToUnits
::
Way
->
[
WayUnit
]
wayToUnits
(
Way
set
)
=
map
toEnum
.
IntSet
.
elems
$
set
wayToUnits
(
Way
set
)
=
map
toEnum
.
elems
$
set
wayUnit
::
WayUnit
->
Way
->
Bool
wayUnit
unit
(
Way
set
)
=
fromEnum
unit
`
IntSet
.
member
`
set
wayUnit
unit
(
Way
set
)
=
fromEnum
unit
`
member
`
set
instance
Show
Way
where
show
way
=
if
null
tag
then
"v"
else
tag
...
...
@@ -117,9 +117,9 @@ libsuf way @ (Way set) =
if
(
not
.
wayUnit
Dynamic
$
way
)
then
return
$
wayPrefix
way
++
"a"
-- e.g., p_a
else
do
extension
<-
s
howAr
g
DynamicExtension
-- e.g., .dll or .so
version
<-
s
howAr
g
ProjectVersion
-- e.g., 7.11.20141222
let
prefix
=
wayPrefix
.
Way
.
IntSet
.
delete
(
fromEnum
Dynamic
)
$
set
extension
<-
s
ettin
g
DynamicExtension
-- e.g., .dll or .so
version
<-
s
ettin
g
ProjectVersion
-- e.g., 7.11.20141222
let
prefix
=
wayPrefix
.
Way
.
delete
(
fromEnum
Dynamic
)
$
set
-- e.g., p_ghc7.11.20141222.dll (the result)
return
$
prefix
++
"ghc"
++
version
++
extension
...
...
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