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.
7 module Main (main) where
11 import Distribution.PackageDescription
12 import Distribution.Setup
13 import Distribution.Simple
14 import Distribution.Simple.LocalBuildInfo
15 import Distribution.Simple.Utils
17 import System.Environment
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
32 $ buildHook defaultUserHooks,
33 makefileHook = add_ghc_options ghcArgs
35 $ makefileHook defaultUserHooks,
36 regHook = add_extra_libs
37 $ regHook defaultUserHooks,
38 instHook = filter_modules_hook
39 $ instHook defaultUserHooks }
40 withArgs args'' $ defaultMainWithHooks hooks
42 extractGhcArgs :: [String] -> ([String], [String])
43 extractGhcArgs = extractPrefixArgs "--ghc-option="
45 extractConfigureArgs :: [String] -> ([String], [String])
46 extractConfigureArgs = extractPrefixArgs "--configure-option="
48 extractPrefixArgs :: String -> [String] -> ([String], [String])
49 extractPrefixArgs the_prefix args
51 f (x:xs) = case f xs of
52 (wantedArgs, otherArgs) ->
53 case removePrefix the_prefix x of
55 (wantedArg:wantedArgs, otherArgs)
57 (wantedArgs, x:otherArgs)
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
67 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
68 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
69 type PostConfHook = Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo
72 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
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"
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
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' }
93 add_configure_options :: [String] -> PostConfHook -> PostConfHook
94 add_configure_options args f as cfs pd lbi
95 = f (as ++ args) cfs pd lbi
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
102 lib' = case library pd of
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' }
110 isPortableBuild :: String -> Bool
112 | "GHC" `isPrefixOf` s = False
113 | "Data.Generics" `isPrefixOf` s = False
114 | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
116 forGHCBuild :: String -> Bool
117 forGHCBuild = ("GHC.Prim" /=)
119 add_extra_deps :: ConfHook -> ConfHook
120 add_extra_deps f pd cf
122 case compilerFlavor (compiler lbi) of
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
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
137 let lib_bi = libBuildInfo lib
138 lib_bi' = lib_bi { extraLibs = "wsock32"
144 lib' = lib { libBuildInfo = lib_bi' }
145 in pd { library = Just lib' }
146 Nothing -> error "Expected a library"