Compile.hs 3.8 KB
Newer Older
1
{-# LANGUAGE NoImplicitPrelude #-}
Andrey Mokhov's avatar
Andrey Mokhov committed
2
3
4
5
module Package.Compile (buildPackageCompile) where

import Package.Base

6
7
argListDir :: FilePath
argListDir = "shake/arg/buildPackageCompile"
Andrey Mokhov's avatar
Andrey Mokhov committed
8
9

suffixArgs :: Way -> Args
10
11
suffixArgs way =
    return ["-hisuf", hisuf way, "-osuf", osuf way, "-hcsuf", hcsuf way]
Andrey Mokhov's avatar
Andrey Mokhov committed
12

13
14
ghcArgs :: Package -> TodoItem -> Way -> [FilePath] -> FilePath -> Args
ghcArgs (Package _ path _) (stage, dist, _) way srcs result =
Andrey Mokhov's avatar
Andrey Mokhov committed
15
16
    let pathDist = path </> dist
        buildDir = toStandard $ pathDist </> "build"
17
18
19
20
    in args [ suffixArgs way
            , wayHcArgs way
            , args SrcHcArgs
            , packageArgs stage pathDist
21
            , includeGhcArgs path dist
22
23
24
25
26
27
28
29
            , concatArgs ["-optP"] $ CppArgs pathDist
            , args $ HsArgs pathDist
            -- TODO: now we have both -O and -O2
            -- <> arg ["-O2"]
            , productArgs ["-odir", "-hidir", "-stubdir"] buildDir
            , when (splitObjects stage) $ arg "-split-objs"
            , args ("-c":srcs)
            , args ["-o", result] ]
30

31
32
33
34
35
36
37
38
39
40
gccArgs :: Package -> TodoItem -> [FilePath] -> FilePath -> Args
gccArgs (Package _ path _) (_, dist, _) srcs result =
    let pathDist = path </> dist
    in args [ args $ CcArgs pathDist
            , commonCcArgs
            , commonCcWarninigArgs
            , pathArgs "-I" path $ IncludeDirs pathDist
            , args ("-c":srcs)
            , args ["-o", result] ]

41
42
43
buildRule :: Package -> TodoItem -> Rules ()
buildRule pkg @ (Package name path _) todo @ (stage, dist, _) =
    let buildDir = toStandard $ path </> dist </> "build"
44
45
        hDepFile = buildDir </> "haskell.deps"
        cDepFile = buildDir </> "c.deps"
Andrey Mokhov's avatar
Andrey Mokhov committed
46
    in
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
    forM_ allWays $ \way -> do -- TODO: optimise (too many ways in allWays)
        let oPattern  = "*." ++ osuf way
        let hiPattern = "*." ++ hisuf way
        [buildDir <//> oPattern, buildDir <//> hiPattern] |%> \out -> do
            need [argListPath argListDir pkg stage, hDepFile, cDepFile]
            let obj = toStandard $ out -<.> osuf way
                vanillaObj = toStandard $ out -<.> "o"
            -- TODO: keep only vanilla dependencies in hDepFile
            hDeps <- args $ DependencyList hDepFile obj
            cDeps <- args $ DependencyList cDepFile $ takeFileName vanillaObj
            let hSrcs = filter ("//*hs" ?==) hDeps
                cSrcs = filter ("//*.c" ?==) cDeps
            -- Report impossible cases
            when (null $ hSrcs ++ cSrcs)
                $ redError_ $ "No source files found for "
                ++ toStandard out ++ "."
            when (not (null hSrcs) && not (null cSrcs))
                $ redError_ $ "Both c and Haskell sources found for "
                ++ toStandard out ++ "."
            -- Build using appropriate compiler
            need $ hDeps ++ cDeps
            when (not $ null hSrcs)
                $ terseRun (Ghc stage) $ ghcArgs pkg todo way hSrcs obj
            when (not $ null cSrcs)
71
                $ terseRun (Gcc stage) $ gccArgs pkg todo cSrcs obj
Andrey Mokhov's avatar
Andrey Mokhov committed
72

73
74
75
76
77
78
argListRule :: Package -> TodoItem -> Rules ()
argListRule pkg todo @ (stage, _, settings) =
    (argListPath argListDir pkg stage) %> \out -> do
        need $ ["shake/src/Package/Compile.hs"] ++ sourceDependecies
        ways' <- ways settings
        ghcList <- forM ways' $ \way ->
79
80
81
            argListWithComment
                ("way '" ++ tag way ++ "'")
                (Ghc stage)
82
                (ghcArgs pkg todo way ["input.hs"] $ "output" <.> osuf way)
83
84
85
86
87
88
89
        gccList <- forM ways' $ \way ->
            argListWithComment
                ("way '" ++ tag way ++ "'")
                (Gcc stage)
                (gccArgs pkg todo ["input.c"] $ "output" <.> osuf way)

        writeFileChanged out $ unlines ghcList ++ "\n" ++ unlines gccList
90
91
92

buildPackageCompile :: Package -> TodoItem -> Rules ()
buildPackageCompile = argListRule <> buildRule