From: Ross Paterson Date: Mon, 4 Jun 2007 11:52:33 +0000 (+0000) Subject: --configure-option and --ghc-option are now provided by Cabal X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=75778e0eb41a19b575a5ecdf94889843f4791232;p=ghc-base.git --configure-option and --ghc-option are now provided by Cabal --- diff --git a/Setup.hs b/Setup.hs index 6f10989..c2e1b1d 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,4 +1,3 @@ - {- We need to do some ugly hacks here as base mix of portable and unportable stuff, as well as home to some GHC magic. @@ -14,61 +13,26 @@ import Distribution.Simple import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Utils import System.Cmd -import System.Environment import System.FilePath import System.Info main :: IO () -main = do args <- getArgs - let (ghcArgs, args') = extractGhcArgs args - (confArgs, args'') = extractConfigureArgs args' - hooks = defaultUserHooks { +main = do let hooks = defaultUserHooks { confHook = add_extra_deps $ confHook defaultUserHooks, - postConf = add_configure_options confArgs - $ postConf defaultUserHooks, buildHook = build_primitive_sources - $ add_ghc_options ghcArgs $ filter_modules_hook $ buildHook defaultUserHooks, - makefileHook = add_ghc_options ghcArgs - $ filter_modules_hook + makefileHook = filter_modules_hook $ makefileHook defaultUserHooks, regHook = add_extra_libs $ regHook defaultUserHooks, instHook = filter_modules_hook $ instHook defaultUserHooks } - withArgs args'' $ defaultMainWithHooks hooks - -extractGhcArgs :: [String] -> ([String], [String]) -extractGhcArgs = extractPrefixArgs "--ghc-option=" - -extractConfigureArgs :: [String] -> ([String], [String]) -extractConfigureArgs = extractPrefixArgs "--configure-option=" - -extractPrefixArgs :: String -> [String] -> ([String], [String]) -extractPrefixArgs the_prefix args - = let f [] = ([], []) - f (x:xs) = case f xs of - (wantedArgs, otherArgs) -> - case removePrefix the_prefix x of - Just wantedArg -> - (wantedArg:wantedArgs, otherArgs) - Nothing -> - (wantedArgs, x:otherArgs) - in f args - -removePrefix :: String -> String -> Maybe String -removePrefix "" ys = Just ys -removePrefix _ "" = Nothing -removePrefix (x:xs) (y:ys) - | x == y = removePrefix xs ys - | otherwise = Nothing + defaultMainWithHooks hooks type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO () type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo -type PostConfHook = Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo - -> IO () -- type PDHook = PackageDescription -> ConfigFlags -> IO () @@ -87,22 +51,6 @@ build_primitive_sources f pd lbi uhs x ++ primops ++ " > " ++ primopwrappers) f pd lbi uhs x -add_ghc_options :: [String] -> Hook a -> Hook a -add_ghc_options args f pd lbi uhs x - = do let lib' = case library pd of - Just lib -> - let bi = libBuildInfo lib - opts = options bi ++ [(GHC, args)] - bi' = bi { options = opts } - in lib { libBuildInfo = bi' } - Nothing -> error "Expected a library" - pd' = pd { library = Just lib' } - f pd' lbi uhs x - -add_configure_options :: [String] -> PostConfHook -> PostConfHook -add_configure_options args f as cfs pd lbi - = f (as ++ args) cfs pd lbi - filter_modules_hook :: Hook a -> Hook a filter_modules_hook f pd lbi uhs x = let build_filter = case compilerFlavor $ compiler lbi of @@ -155,4 +103,3 @@ add_extra_libs f pd lbi uhs x Nothing -> error "Expected a library" else pd in f pd' lbi uhs x -