Build GHC/Prim.hs and GHC/PrimopWrappers.hs from Cabal
[packages/random.git] / Setup.hs
1
2 {-
3 We need to do some ugly hacks here as base mix of portable and
4 unportable stuff, as well as home to some GHC magic.
5 -}
6
7 module Main (main) where
8
9 import Control.Monad
10 import Data.List
11 import Distribution.PackageDescription
12 import Distribution.Setup
13 import Distribution.Simple
14 import Distribution.Simple.LocalBuildInfo
15 import Distribution.Simple.Utils
16 import System.Cmd
17 import System.Environment
18 import System.Info
19
20 main :: IO ()
21 main = do args <- getArgs
22 let (ghcArgs, args') = extractGhcArgs args
23 (confArgs, args'') = extractConfigureArgs args'
24 hooks = defaultUserHooks {
25 confHook = add_extra_deps
26 $ confHook defaultUserHooks,
27 postConf = add_configure_options confArgs
28 $ postConf defaultUserHooks,
29 buildHook = build_primitive_sources
30 $ add_ghc_options ghcArgs
31 $ filter_modules_hook
32 $ buildHook defaultUserHooks,
33 makefileHook = add_ghc_options ghcArgs
34 $ filter_modules_hook
35 $ makefileHook defaultUserHooks,
36 regHook = add_extra_libs
37 $ regHook defaultUserHooks,
38 instHook = filter_modules_hook
39 $ instHook defaultUserHooks }
40 withArgs args'' $ defaultMainWithHooks hooks
41
42 extractGhcArgs :: [String] -> ([String], [String])
43 extractGhcArgs = extractPrefixArgs "--ghc-option="
44
45 extractConfigureArgs :: [String] -> ([String], [String])
46 extractConfigureArgs = extractPrefixArgs "--configure-option="
47
48 extractPrefixArgs :: String -> [String] -> ([String], [String])
49 extractPrefixArgs the_prefix args
50 = let f [] = ([], [])
51 f (x:xs) = case f xs of
52 (wantedArgs, otherArgs) ->
53 case removePrefix the_prefix x of
54 Just wantedArg ->
55 (wantedArg:wantedArgs, otherArgs)
56 Nothing ->
57 (wantedArgs, x:otherArgs)
58 in f args
59
60 removePrefix :: String -> String -> Maybe String
61 removePrefix "" ys = Just ys
62 removePrefix _ "" = Nothing
63 removePrefix (x:xs) (y:ys)
64 | x == y = removePrefix xs ys
65 | otherwise = Nothing
66
67 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
68 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
69 type PostConfHook = Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo
70 -> IO ()
71
72 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
73
74 build_primitive_sources :: Hook a -> Hook a
75 build_primitive_sources f pd lbi uhs x
76 = do when (compilerFlavor (compiler lbi) == GHC) $ do
77 maybeExit $ system "../../utils/genprimopcode/genprimopcode --make-haskell-source < ../../compiler/prelude/primops.txt > GHC/Prim.hs"
78 maybeExit $ system "../../utils/genprimopcode/genprimopcode --make-haskell-wrappers < ../../compiler/prelude/primops.txt > GHC/PrimopWrappers.hs"
79 f pd lbi uhs x
80
81 add_ghc_options :: [String] -> Hook a -> Hook a
82 add_ghc_options args f pd lbi uhs x
83 = do let lib' = case library pd of
84 Just lib ->
85 let bi = libBuildInfo lib
86 opts = options bi ++ [(GHC, args)]
87 bi' = bi { options = opts }
88 in lib { libBuildInfo = bi' }
89 Nothing -> error "Expected a library"
90 pd' = pd { library = Just lib' }
91 f pd' lbi uhs x
92
93 add_configure_options :: [String] -> PostConfHook -> PostConfHook
94 add_configure_options args f as cfs pd lbi
95 = f (as ++ args) cfs pd lbi
96
97 filter_modules_hook :: Hook a -> Hook a
98 filter_modules_hook f pd lbi uhs x
99 = let build_filter = case compilerFlavor $ compiler lbi of
100 GHC -> forGHCBuild
101 _ -> isPortableBuild
102 lib' = case library pd of
103 Just lib ->
104 let ems = filter build_filter (exposedModules lib)
105 in lib { exposedModules = ems }
106 Nothing -> error "Expected a library"
107 pd' = pd { library = Just lib' }
108 in f pd' lbi uhs x
109
110 isPortableBuild :: String -> Bool
111 isPortableBuild s
112 | "GHC" `isPrefixOf` s = False
113 | "Data.Generics" `isPrefixOf` s = False
114 | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
115
116 forGHCBuild :: String -> Bool
117 forGHCBuild = ("GHC.Prim" /=)
118
119 add_extra_deps :: ConfHook -> ConfHook
120 add_extra_deps f pd cf
121 = do lbi <- f pd cf
122 case compilerFlavor (compiler lbi) of
123 GHC ->
124 do -- Euch. We should just add the right thing to the lbi
125 -- ourselves rather than rerunning configure.
126 let pd' = pd { buildDepends = Dependency "rts" AnyVersion
127 : buildDepends pd }
128 f pd' cf
129 _ ->
130 return lbi
131
132 add_extra_libs :: Hook a -> Hook a
133 add_extra_libs f pd lbi uhs x
134 = let pd' = if (os == "mingw32") && (compilerFlavor (compiler lbi) == GHC)
135 then case library pd of
136 Just lib ->
137 let lib_bi = libBuildInfo lib
138 lib_bi' = lib_bi { extraLibs = "wsock32"
139 : "msvcrt"
140 : "kernel32"
141 : "user32"
142 : "shell32"
143 : extraLibs lib_bi }
144 lib' = lib { libBuildInfo = lib_bi' }
145 in pd { library = Just lib' }
146 Nothing -> error "Expected a library"
147 else pd
148 in f pd' lbi uhs x
149