Builder.hs 3.43 KB
Newer Older
Andrey Mokhov's avatar
Andrey Mokhov committed
1
{-# LANGUAGE DeriveGeneric #-}
Andrey Mokhov's avatar
Andrey Mokhov committed
2
module Builder (Builder (..), builderPath, specified, needBuilder) where
Andrey Mokhov's avatar
Andrey Mokhov committed
3

4
import Base
Andrey Mokhov's avatar
Andrey Mokhov committed
5 6
import GHC.Generics (Generic)
import Oracles
Andrey Mokhov's avatar
Andrey Mokhov committed
7
import Stage
Andrey Mokhov's avatar
Andrey Mokhov committed
8 9 10 11 12 13 14

-- A Builder is an external command invoked in separate process using Shake.cmd
--
-- Ghc Stage0 is the bootstrapping compiler
-- Ghc StageN, N > 0, is the one built on stage (N - 1)
-- GhcPkg Stage0 is the bootstrapping GhcPkg
-- GhcPkg StageN, N > 0, is the one built on stage 0 (TODO: need only Stage1?)
Andrey Mokhov's avatar
Andrey Mokhov committed
15
-- TODO: add Cpp builders
Andrey Mokhov's avatar
Andrey Mokhov committed
16 17 18 19 20
-- TODO: rename Gcc to Cc?
data Builder = Ar
             | Ld
             | Alex
             | Happy
Andrey Mokhov's avatar
Andrey Mokhov committed
21
             | Haddock
Andrey Mokhov's avatar
Andrey Mokhov committed
22 23 24 25
             | HsColour
             | GhcCabal
             | Gcc Stage
             | Ghc Stage
Andrey Mokhov's avatar
Andrey Mokhov committed
26
             | GhcM Stage
27
             | GccM Stage
Andrey Mokhov's avatar
Andrey Mokhov committed
28
             | GhcPkg Stage
Andrey Mokhov's avatar
Andrey Mokhov committed
29
             | GhcCabalHsColour
Andrey Mokhov's avatar
Andrey Mokhov committed
30 31 32
             deriving (Show, Eq, Generic)

-- Configuration files refer to Builders as follows:
Andrey Mokhov's avatar
Andrey Mokhov committed
33
-- TODO: determine paths to utils without looking up configuration files
Andrey Mokhov's avatar
Andrey Mokhov committed
34 35
builderKey :: Builder -> String
builderKey builder = case builder of
Andrey Mokhov's avatar
Andrey Mokhov committed
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
    Ar               -> "ar"
    Ld               -> "ld"
    Alex             -> "alex"
    Happy            -> "happy"
    Haddock          -> "haddock"
    HsColour         -> "hscolour"
    GhcCabal         -> "ghc-cabal"
    Ghc Stage0       -> "system-ghc"
    Ghc Stage1       -> "ghc-stage1"
    Ghc Stage2       -> "ghc-stage2"
    Ghc Stage3       -> "ghc-stage3"
    Gcc Stage0       -> "system-gcc"
    Gcc _            -> "gcc"
    GhcPkg Stage0    -> "system-ghc-pkg"
    GhcPkg _         -> "ghc-pkg"
    -- GhcM/GccM are synonyms for Ghc/Gcc (called with -M and -MM flags)
    GhcM stage       -> builderKey $ Ghc stage
    GccM stage       -> builderKey $ Gcc stage
    -- GhcCabalHsColour is a synonym for GhcCabal (called in hscolour mode)
    GhcCabalHsColour -> builderKey $ GhcCabal
Andrey Mokhov's avatar
Andrey Mokhov committed
56

57
builderPath :: Builder -> Action FilePath
Andrey Mokhov's avatar
Andrey Mokhov committed
58 59
builderPath builder = do
    path <- askConfigWithDefault (builderKey builder) $
60
            putError $ "\nCannot find path to '" ++ (builderKey builder)
Andrey Mokhov's avatar
Andrey Mokhov committed
61 62 63
                     ++ "' in configuration files."
    fixAbsolutePathOnWindows $ if null path then "" else path -<.> exe

64 65 66
specified :: Builder -> Action Bool
specified = fmap (not . null) . builderPath

67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
-- Make sure a builder exists on the given path and rebuild it if out of date.
-- If laxDependencies is True then we do not rebuild GHC even if it is out of
-- date (can save a lot of build time when changing GHC).
needBuilder :: Bool -> Builder -> Action ()
needBuilder laxDependencies builder = do
    path <- builderPath builder
    if laxDependencies && allowOrderOnlyDependency builder
    then orderOnly [path]
    else need      [path]
  where
    allowOrderOnlyDependency :: Builder -> Bool
    allowOrderOnlyDependency (Ghc  _) = True
    allowOrderOnlyDependency (GhcM _) = True
    allowOrderOnlyDependency _ = False

Andrey Mokhov's avatar
Andrey Mokhov committed
82 83 84 85 86 87 88 89
-- On Windows: if the path starts with "/", prepend it with the correct path to
-- the root, e.g: "/usr/local/bin/ghc.exe" => "C:/msys/usr/local/bin/ghc.exe".
fixAbsolutePathOnWindows :: FilePath -> Action FilePath
fixAbsolutePathOnWindows path = do
    windows <- windowsHost
    -- Note, below is different from FilePath.isAbsolute:
    if (windows && "/" `isPrefixOf` path)
    then do
90 91
        root <- windowsRoot
        return . unifyPath $ root ++ drop 1 path
Andrey Mokhov's avatar
Andrey Mokhov committed
92 93 94
    else
        return path

95
-- Instances for storing in the Shake database
Andrey Mokhov's avatar
Andrey Mokhov committed
96 97
instance Binary Builder
instance Hashable Builder