Compile.hs 3.78 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
    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
51
            need [argListPath argListDir pkg stage]
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
            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