Add build flavours, implement a simple quick flavour.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 24 Jan 2016 22:16:48 +0000 (22:16 +0000)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 24 Jan 2016 22:16:48 +0000 (22:16 +0000)
See #188.

.appveyor.yml
src/CmdLineFlag.hs
src/Expression.hs
src/Main.hs
src/Settings/Args.hs
src/Settings/Flavours/Quick.hs [new file with mode: 0644]

index d8854cc..7ffabc3 100644 (file)
@@ -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
index 249070a..0142abb 100644 (file)
@@ -1,6 +1,6 @@
 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
index 1d1dc27..eb5ee25 100644 (file)
@@ -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
index 69f739b..12ec014 100644 (file)
@@ -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
index 3bd32d7..dec3ce9 100644 (file)
@@ -1,7 +1,6 @@
 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 ]
diff --git a/src/Settings/Flavours/Quick.hs b/src/Settings/Flavours/Quick.hs
new file mode 100644 (file)
index 0000000..1f2def1
--- /dev/null
@@ -0,0 +1,9 @@
+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"