Compile.hs 3.91 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
    let pathDist = path </> dist
16
        buildDir = unifyPath $ 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
gccArgs :: Package -> TodoItem -> [FilePath] -> FilePath -> Args
gccArgs (Package _ path _) (_, dist, _) srcs result =
    let pathDist = path </> dist
    in args [ args $ CcArgs pathDist
            , commonCcArgs
            , commonCcWarninigArgs
Andrey Mokhov's avatar
Andrey Mokhov committed
37
            , includeGccArgs path dist
38
39
40
            , args ("-c":srcs)
            , args ["-o", result] ]

Andrey Mokhov's avatar
Andrey Mokhov committed
41
42
43
44
45
46
47
48
49
50
51
compileC :: Package -> TodoItem -> [FilePath] -> FilePath -> Action ()
compileC pkg todo @ (stage, _, _) deps obj = do
    need deps
    let srcs = filter ("//*.c" ?==) deps
    run (Gcc stage) $ gccArgs pkg todo srcs obj

compileHaskell :: Package -> TodoItem -> FilePath -> Way -> Action ()
compileHaskell pkg @ (Package _ path _) todo @ (stage, dist, _) obj way = do
    let buildDir = unifyPath $ path </> dist </> "build"
    -- TODO: keep only vanilla dependencies in 'haskell.deps'
    deps <- args $ DependencyList (buildDir </> "haskell.deps") obj
Andrey Mokhov's avatar
Andrey Mokhov committed
52
    let srcs = filter ("//*hs" ?==) deps
Andrey Mokhov's avatar
Andrey Mokhov committed
53
54
55
    need deps
    run (Ghc stage) $ ghcArgs pkg todo way srcs obj

56
57
buildRule :: Package -> TodoItem -> Rules ()
buildRule pkg @ (Package name path _) todo @ (stage, dist, _) =
58
    let buildDir = unifyPath $ path </> dist </> "build"
59
        cDepFile = buildDir </> "c.deps"
Andrey Mokhov's avatar
Andrey Mokhov committed
60
    in
61
62
63
    forM_ allWays $ \way -> do -- TODO: optimise (too many ways in allWays)
        let oPattern  = "*." ++ osuf way
        let hiPattern = "*." ++ hisuf way
64

Andrey Mokhov's avatar
Andrey Mokhov committed
65
66
        (buildDir <//> hiPattern) %> \hi -> do
            let obj = hi -<.> osuf way
Andrey Mokhov's avatar
Andrey Mokhov committed
67
68
69
70
            -- TODO: Understand why 'need [obj]' doesn't work, leading to
            -- recursive rules error. Below is a workaround.
            -- putColoured Yellow $ "Hi " ++ hi
            compileHaskell pkg todo obj way
71
72

        (buildDir <//> oPattern) %> \obj -> do
Andrey Mokhov's avatar
Andrey Mokhov committed
73
74
75
76
77
            let vanillaObjName = takeFileName obj -<.> "o"
            cDeps <- args $ DependencyList cDepFile vanillaObjName
            if null cDeps
            then compileHaskell pkg todo obj way
            else compileC pkg todo cDeps obj
Andrey Mokhov's avatar
Andrey Mokhov committed
78
79
            -- Finally, record the argument list
            need [argListPath argListDir pkg stage]
80

81
82
83
84
85
86
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 ->
87
88
89
            argListWithComment
                ("way '" ++ tag way ++ "'")
                (Ghc stage)
90
                (ghcArgs pkg todo way ["input.hs"] $ "output" <.> osuf way)
91
92
93
94
95
96
97
        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
98
99
100

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