Commit 8738dd20 authored by Andrey Mokhov's avatar Andrey Mokhov

Add build flavours, implement a simple quick flavour.

See #188.
parent dfabde88
......@@ -39,4 +39,4 @@ install:
build_script:
- cd C:\msys64\home\ghc\shake-build
- echo "" | stack --no-terminal exec -- build.bat selftest
- echo "" | stack --no-terminal exec -- build.bat -j --no-progress inplace/bin/ghc-stage1.exe
- echo "" | stack --no-terminal exec -- build.bat -j --no-progress --flavour=quick inplace/bin/ghc-stage1.exe
module CmdLineFlag (
putCmdLineFlags, flags, cmdProgressInfo, ProgressInfo (..), cmdSplitObjects,
Configure (..), cmdConfigure
putCmdLineFlags, cmdFlags, cmdConfigure, Configure (..), cmdFlavour,
Flavour (..), cmdProgressInfo, ProgressInfo (..), cmdSplitObjects
) where
import Data.List.Extra
......@@ -12,56 +12,73 @@ import System.IO.Unsafe (unsafePerformIO)
-- Command line flags
data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show)
data Configure = SkipConfigure | RunConfigure String deriving (Eq, Show)
data Flavour = Default | Quick deriving (Eq, Show)
-- | 'CmdLineFlag.Untracked' is a collection of flags that can be passed via the
-- command line. These flags are not tracked, that is they do not force any
-- build rules to be rurun.
data Untracked = Untracked
{ progressInfo :: ProgressInfo
, splitObjects :: Bool
, configure :: Configure }
{ configure :: Configure
, flavour :: Flavour
, progressInfo :: ProgressInfo
, splitObjects :: Bool }
deriving (Eq, Show)
-- | Default values for 'CmdLineFlag.Untracked'.
defaultUntracked :: Untracked
defaultUntracked = Untracked
{ progressInfo = Normal
, splitObjects = False
, configure = SkipConfigure }
{ configure = SkipConfigure
, flavour = Default
, progressInfo = Normal
, splitObjects = False }
readConfigure :: Maybe String -> Either String (Untracked -> Untracked)
readConfigure ms =
maybe (Left "Cannot parse configure") (Right . set) (go $ lower <$> ms)
where
go :: Maybe String -> Maybe Configure
go (Just args) = Just $ RunConfigure args
go Nothing = Just $ RunConfigure ""
set :: Configure -> Untracked -> Untracked
set flag flags = flags { configure = flag }
readFlavour :: Maybe String -> Either String (Untracked -> Untracked)
readFlavour ms =
maybe (Left "Cannot parse flavour") (Right . set) (go =<< lower <$> ms)
where
go :: String -> Maybe Flavour
go "default" = Just Default
go "quick" = Just Quick
go _ = Nothing
set :: Flavour -> Untracked -> Untracked
set flag flags = flags { flavour = flag }
readProgressInfo :: Maybe String -> Either String (Untracked -> Untracked)
readProgressInfo ms =
maybe (Left "Cannot parse progressInfo") (Right . set) (go =<< lower <$> ms)
maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
where
go :: String -> Maybe ProgressInfo
go "none" = Just None
go "brief" = Just Brief
go "normal" = Just Normal
go "unicorn" = Just Unicorn
go _ = Nothing -- Left "no parse"
go _ = Nothing
set :: ProgressInfo -> Untracked -> Untracked
set flag flags = flags { progressInfo = flag }
readConfigure :: Maybe String -> Either String (Untracked -> Untracked)
readConfigure ms =
maybe (Left "Cannot parse configure") (Right . set) (go $ lower <$> ms)
where
go :: Maybe String -> Maybe Configure
go (Just args) = Just $ RunConfigure args
go Nothing = Just $ RunConfigure ""
set :: Configure -> Untracked -> Untracked
set flag flags = flags { configure = flag }
readSplitObjects :: Either String (Untracked -> Untracked)
readSplitObjects = Right $ \flags -> flags { splitObjects = True }
flags :: [OptDescr (Either String (Untracked -> Untracked))]
flags = [ Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
"Progress info style (None, Brief, Normal, or Unicorn)."
, Option [] ["split-objects"] (NoArg readSplitObjects)
"Generate split objects (requires a full clean rebuild)."
, Option [] ["configure"] (OptArg readConfigure "ARGS")
"Run configure with ARGS (also run boot if necessary)." ]
cmdFlags :: [OptDescr (Either String (Untracked -> Untracked))]
cmdFlags =
[ Option [] ["configure"] (OptArg readConfigure "ARGS")
"Run configure with ARGS (also run boot if necessary)."
, Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
"Build flavour (Default or Quick)."
, Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
"Progress info style (None, Brief, Normal, or Unicorn)."
, Option [] ["split-objects"] (NoArg readSplitObjects)
"Generate split objects (requires a full clean rebuild)." ]
-- TODO: Avoid unsafePerformIO by using shakeExtra (awaiting Shake's release)
{-# NOINLINE cmdLineFlags #-}
......@@ -76,11 +93,14 @@ putCmdLineFlags flags = modifyIORef cmdLineFlags (\f -> foldl (flip id) f flags)
getCmdLineFlags :: Untracked
getCmdLineFlags = unsafePerformIO $ readIORef cmdLineFlags
cmdConfigure :: Configure
cmdConfigure = configure getCmdLineFlags
cmdFlavour :: Flavour
cmdFlavour = flavour getCmdLineFlags
cmdProgressInfo :: ProgressInfo
cmdProgressInfo = progressInfo getCmdLineFlags
cmdSplitObjects :: Bool
cmdSplitObjects = splitObjects getCmdLineFlags
cmdConfigure :: Configure
cmdConfigure = configure getCmdLineFlags
......@@ -102,7 +102,7 @@ arg = append . return
class PredicateLike a where
(?) :: Monoid m => a -> Expr m -> Expr m
infixr 8 ?
infixr 3 ?
instance PredicateLike Predicate where
(?) = applyPredicate
......
......@@ -17,7 +17,7 @@ import qualified Rules.Perl
import qualified Test
main :: IO ()
main = shakeArgsWith options CmdLineFlag.flags $ \cmdLineFlags targets -> do
main = shakeArgsWith options CmdLineFlag.cmdFlags $ \cmdLineFlags targets -> do
CmdLineFlag.putCmdLineFlags cmdLineFlags
Environment.setupEnvironment
return . Just $ if null targets
......
module Settings.Args (getArgs) where
import Data.Monoid
import CmdLineFlag
import Expression
import Settings.Builders.Alex
import Settings.Builders.Ar
......@@ -18,6 +17,7 @@ import Settings.Builders.Hsc2Hs
import Settings.Builders.HsCpp
import Settings.Builders.Ld
import Settings.Builders.Tar
import Settings.Flavours.Quick
import Settings.Packages.Base
import Settings.Packages.Compiler
import Settings.Packages.Directory
......@@ -35,7 +35,10 @@ import Settings.Packages.Unlit
import Settings.User
getArgs :: Expr [String]
getArgs = fromDiffExpr $ defaultBuilderArgs <> defaultPackageArgs <> userArgs
getArgs = fromDiffExpr $ mconcat [ defaultBuilderArgs
, defaultPackageArgs
, flavourArgs
, userArgs ]
-- TODO: add src-hc-args = -H32m -O
-- TODO: GhcStage2HcOpts=-O2 unless GhcUnregisterised
......@@ -80,3 +83,7 @@ defaultPackageArgs = mconcat
, runGhcPackageArgs
, touchyPackageArgs
, unlitPackageArgs ]
flavourArgs :: Args
flavourArgs = mconcat
[ cmdFlavour == Quick ? quickFlavourArgs ]
module Settings.Flavours.Quick (quickFlavourArgs) where
import Expression
import Predicates (builderGhc)
-- TODO: consider putting all flavours in a single file
-- TODO: handle other, non Args, settings affected by flavours
quickFlavourArgs :: Args
quickFlavourArgs = builderGhc ? arg "-O0"
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