Commit 45f3bff7 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Fix warnings, improve documentation

parent c8bab283
......@@ -19,7 +19,6 @@ module Hadrian.Expression (
import Control.Monad.Extra
import Control.Monad.Trans
import Control.Monad.Trans.Reader
import Data.Semigroup (Semigroup, (<>))
import Development.Shake
import Development.Shake.Classes
......@@ -71,7 +70,7 @@ class ToPredicate p c b where
infixr 3 ?
-- | Apply a predicate to an expression.
(?) :: (Monoid a, Semigroup a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a
(?) :: (Monoid a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a
p ? e = do
bool <- toPredicate p
if bool then e else mempty
......
......@@ -11,14 +11,16 @@ import Hadrian.Oracles.TextFile
import Hadrian.Oracles.Path
import Base
import Way.Type
-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
-- | Each 'Setting' comes from @system.config@ file, e.g. 'target-os = mingw32'.
-- @setting TargetOs@ looks up the config file and returns "mingw32".
-- 'SettingList' is used for multiple string values separated by spaces, such
-- as @gmp-include-dirs = a b@.
-- @settingList GmpIncludeDirs@ therefore returns a list of strings ["a", "b"].
-- | Each 'Setting' comes from the file @hadrian/cfg/system.config@, generated
-- by the @configure@ script from the input file @hadrian/cfg/system.config.in@.
-- For example, the line
--
-- > target-os = mingw32
--
-- sets the value of the setting 'TargetOs'. The action 'setting' 'TargetOs'
-- looks up the value of the setting and returns the string @"mingw32"@,
-- tracking the result in the Shake database.
data Setting = BuildArch
| BuildOs
| BuildPlatform
......@@ -57,13 +59,24 @@ data Setting = BuildArch
| TargetPlatformFull
| TargetVendor
-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
-- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@,
-- generated by the @configure@ script from the input file
-- @hadrian/cfg/system.config.in@. For example, the line
--
-- > hs-cpp-args = -E -undef -traditional
--
-- sets the value of 'HsCppArgs'. The action 'settingList' 'HsCppArgs' looks up
-- the value of the setting and returns the list of strings
-- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database.
data SettingList = ConfCcArgs Stage
| ConfCppArgs Stage
| ConfGccLinkerArgs Stage
| ConfLdLinkerArgs Stage
| HsCppArgs
-- | Maps 'Setting's to names in @cfg/system.config.in@.
-- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the
-- result.
setting :: Setting -> Action String
setting key = lookupValueOrError configFile $ case key of
BuildArch -> "build-arch"
......@@ -104,6 +117,8 @@ setting key = lookupValueOrError configFile $ case key of
TargetPlatformFull -> "target-platform-full"
TargetVendor -> "target-vendor"
-- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the
-- result.
settingList :: SettingList -> Action [String]
settingList key = fmap words $ lookupValueOrError configFile $ case key of
ConfCcArgs stage -> "conf-cc-args-" ++ stageString stage
......@@ -112,38 +127,50 @@ settingList key = fmap words $ lookupValueOrError configFile $ case key of
ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString stage
HsCppArgs -> "hs-cpp-args"
-- | Get a configuration setting.
-- | An expression that looks up the value of a 'Setting' in @cfg/system.config@,
-- tracking the result.
getSetting :: Setting -> Expr c b String
getSetting = expr . setting
-- | Get a list of configuration settings.
-- | An expression that looks up the value of a 'SettingList' in
-- @cfg/system.config@, tracking the result.
getSettingList :: SettingList -> Args c b
getSettingList = expr . settingList
-- | Check whether the value of a 'Setting' matches one of the given strings.
matchSetting :: Setting -> [String] -> Action Bool
matchSetting key values = (`elem` values) <$> setting key
-- | Check whether the target platform setting matches one of the given strings.
anyTargetPlatform :: [String] -> Action Bool
anyTargetPlatform = matchSetting TargetPlatformFull
-- | Check whether the target OS setting matches one of the given strings.
anyTargetOs :: [String] -> Action Bool
anyTargetOs = matchSetting TargetOs
-- | Check whether the target architecture setting matches one of the given
-- strings.
anyTargetArch :: [String] -> Action Bool
anyTargetArch = matchSetting TargetArch
-- | Check whether the host OS setting matches one of the given strings.
anyHostOs :: [String] -> Action Bool
anyHostOs = matchSetting HostOs
-- | Check whether the host OS setting is set to @"ios"@.
iosHost :: Action Bool
iosHost = anyHostOs ["ios"]
-- | Check whether the host OS setting is set to @"darwin"@.
osxHost :: Action Bool
osxHost = anyHostOs ["darwin"]
-- | Check whether the host OS setting is set to @"mingw32"@ or @"cygwin32"@.
windowsHost :: Action Bool
windowsHost = anyHostOs ["mingw32", "cygwin32"]
-- | Check whether the target supports GHCi.
ghcWithInterpreter :: Action Bool
ghcWithInterpreter = do
goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "solaris2"
......@@ -153,14 +180,17 @@ ghcWithInterpreter = do
, "sparc64", "arm" ]
return $ goodOs && goodArch
-- | Check whether the target architecture supports placing info tables next to
-- code. See: https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/HeapObjects#TABLES_NEXT_TO_CODE.
ghcEnableTablesNextToCode :: Action Bool
ghcEnableTablesNextToCode = notM $ anyTargetArch ["ia64", "powerpc64", "powerpc64le"]
-- | Check to use @libffi@ for adjustors.
useLibFFIForAdjustors :: Action Bool
useLibFFIForAdjustors = notM $ anyTargetArch ["i386", "x86_64"]
-- | Canonicalised GHC version number, used for integer version comparisons. We
-- expand GhcMinorVersion to two digits by adding a leading zero if necessary.
-- expand 'GhcMinorVersion' to two digits by adding a leading zero if necessary.
ghcCanonVersion :: Action String
ghcCanonVersion = do
ghcMajorVersion <- setting GhcMajorVersion
......@@ -172,18 +202,20 @@ ghcCanonVersion = do
topDirectory :: Action FilePath
topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
-- TODO: find out why we need version number in the dynamic suffix
-- The current theory: dynamic libraries are eventually placed in a single
-- giant directory in the load path of the dynamic linker, and hence we must
-- distinguish different versions of GHC. In contrast static libraries live
-- in their own per-package directory and hence do not need a unique filename.
-- We also need to respect the system's dynamic extension, e.g. .dll or .so.
-- | The file suffix used for libraries of a given build 'Way'. For example,
-- @_p.a@ corresponds to a static profiled library, and @-ghc7.11.20141222.so@
-- is a dynamic vanilly library. Why do we need GHC version number in the
-- dynamic suffix? Here is a possible reason: dynamic libraries are placed in a
-- single giant directory in the load path of the dynamic linker, and hence we
-- must distinguish different versions of GHC. In contrast, static libraries
-- live in their own per-package directory and hence do not need a unique
-- filename. We also need to respect the system's dynamic extension, e.g. @.dll@
-- or @.so@.
libsuf :: Way -> Action String
libsuf way =
if not (wayUnit Dynamic way)
then return $ waySuffix way ++ ".a" -- e.g., _p.a
else do
extension <- setting DynamicExtension -- e.g., .dll or .so
version <- setting ProjectVersion -- e.g., 7.11.20141222
let suffix = waySuffix $ removeWayUnit Dynamic way
return $ "-ghc" ++ version ++ suffix ++ extension
libsuf way
| not (wayUnit Dynamic way) = return (waySuffix way ++ ".a") -- e.g., _p.a
| otherwise = do
extension <- setting DynamicExtension -- e.g., .dll or .so
version <- setting ProjectVersion -- e.g., 7.11.20141222
let suffix = waySuffix (removeWayUnit Dynamic way)
return ("-ghc" ++ version ++ suffix ++ extension)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment