X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverState.hs;h=e9e8aec49431d592138fddbc1cf4f52a7b2ef871;hb=fdc830018cb48210e2ca441942de8eae8e6aedd2;hp=a31f171294aaa2c9c6b523e3ad7f9877b044d51a;hpb=a3af437651462ff88ae3e55da07a2383361bd37e;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index a31f171..e9e8aec 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverState.hs,v 1.42 2001/06/12 17:07:23 simonmar Exp $ +-- $Id: DriverState.hs,v 1.49 2001/07/17 15:28:30 simonpj Exp $ -- -- Settings for the driver -- @@ -12,22 +12,20 @@ module DriverState where #include "../includes/config.h" #include "HsVersions.h" -import CmStaticInfo +import Packages ( PackageConfig(..) ) import CmdLineOpts +import DriverPhases import DriverUtil import Util import Config import Exception import IOExts -#ifdef mingw32_TARGET_OS -import TmpFiles ( newTempName ) -import Directory ( removeFile ) -#endif import Panic import List import Char import Monad +import Directory ( doesDirectoryExist ) ----------------------------------------------------------------------------- -- non-configured things @@ -35,10 +33,21 @@ import Monad cHaskell1Version = "5" -- i.e., Haskell 98 ----------------------------------------------------------------------------- --- Global compilation flags +-- GHC modes of operation --- location of compiler-related files -GLOBAL_VAR(v_TopDir, error "no TOPDIR", String) +data GhcMode + = DoMkDependHS -- ghc -M + | DoMkDLL -- ghc --mk-dll + | StopBefore Phase -- ghc -E | -C | -S | -c + | DoMake -- ghc --make + | DoInteractive -- ghc --interactive + | DoLink -- [ the default ] + deriving (Eq) + +GLOBAL_VAR(v_GhcMode, error "mode not set", GhcMode) + +----------------------------------------------------------------------------- +-- Global compilation flags -- Cpp-related flags v_Hs_source_cpp_opts = global @@ -58,7 +67,6 @@ GLOBAL_VAR(v_Keep_tmp_files, False, Bool) -- Misc GLOBAL_VAR(v_Scale_sizes_by, 1.0, Double) -GLOBAL_VAR(v_Dry_run, False, Bool) GLOBAL_VAR(v_Static, True, Bool) GLOBAL_VAR(v_NoHsMain, False, Bool) GLOBAL_VAR(v_Recomp, True, Bool) @@ -70,8 +78,9 @@ GLOBAL_VAR(v_Excess_precision, False, Bool) -- Splitting object files (for libraries) GLOBAL_VAR(v_Split_object_files, False, Bool) -GLOBAL_VAR(v_Split_prefix, "", String) -GLOBAL_VAR(v_N_split_files, 0, Int) +GLOBAL_VAR(v_Split_info, ("",0), (String,Int)) + -- The split prefix and number of files + can_split :: Bool can_split = prefixMatch "i386" cTARGETPLATFORM @@ -239,8 +248,8 @@ buildCoreToDo = do -- This gets foldr inlined before strictness analysis ]), - if strictness then CoreDoStrictness else CoreDoNothing, if cpr then CoreDoCPResult else CoreDoNothing, + if strictness then CoreDoStrictness else CoreDoNothing, CoreDoWorkerWrapper, CoreDoGlomBinds, @@ -318,16 +327,72 @@ GLOBAL_VAR(v_Cmdline_libraries, [], [String]) addToDirList :: IORef [String] -> String -> IO () addToDirList ref path - = do paths <- readIORef ref - writeIORef ref (paths ++ split split_marker path) + = do paths <- readIORef ref + shiny_new_ones <- splitUp path + writeIORef ref (paths ++ shiny_new_ones) + + where + splitUp ::String -> IO [String] +#ifdef mingw32_TARGET_OS + -- 'hybrid' support for DOS-style paths in directory lists. + -- + -- That is, if "foo:bar:baz" is used, this interpreted as + -- consisting of three entries, 'foo', 'bar', 'baz'. + -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted + -- as four elts, "c:/foo", "c:\\foo", "x", and "/bar" -- + -- *provided* c:/foo exists and x:/bar doesn't. + -- + -- Notice that no attempt is made to fully replace the 'standard' + -- split marker ':' with the Windows / DOS one, ';'. The reason being + -- that this will cause too much breakage for users & ':' will + -- work fine even with DOS paths, if you're not insisting on being silly. + -- So, use either. + splitUp [] = return [] + splitUp (x:':':div:xs) + | div `elem` dir_markers = do + let (p,rs) = findNextPath xs + ps <- splitUp rs + {- + Consult the file system to check the interpretation + of (x:':':div:p) -- this is arguably excessive, we + could skip this test & just say that it is a valid + dir path. + -} + flg <- doesDirectoryExist (x:':':div:p) + if flg then + return ((x:':':div:p):ps) + else + return ([x]:(div:p):ps) + splitUp xs = do + let (p,rs) = findNextPath xs + ps <- splitUp rs + return (cons p ps) + + cons "" xs = xs + cons x xs = x:xs + + -- will be called either when we've consumed nought or the ":/" part of + -- a DOS path, so splitting is just a Q of finding the next split marker. + findNextPath xs = + case break (`elem` split_markers) xs of + (p, d:ds) -> (p, ds) + (p, xs) -> (p, xs) + + split_markers :: [Char] + split_markers = [':', ';'] + + dir_markers :: [Char] + dir_markers = ['/', '\\'] + +#else + splitUp xs = return (split split_marker xs) +#endif GLOBAL_VAR(v_HCHeader, "", String) ----------------------------------------------------------------------------- -- Packages -GLOBAL_VAR(v_Path_package_config, error "path_package_config", String) - -- package list is maintained in dependency order GLOBAL_VAR(v_Packages, ("std":"rts":"gmp":[]), [String]) @@ -346,12 +411,12 @@ addPackage package getPackageImportPath :: IO [String] getPackageImportPath = do ps <- getPackageInfo - munge_paths (concatMap import_dirs ps) + return (nub (filter (not.null) (concatMap import_dirs ps))) getPackageIncludePath :: IO [String] getPackageIncludePath = do ps <- getPackageInfo - munge_paths (concatMap include_dirs ps) + return (nub (filter (not.null) (concatMap include_dirs ps))) -- includes are in reverse dependency order (i.e. rts first) getPackageCIncludes :: IO [String] @@ -362,7 +427,7 @@ getPackageCIncludes = do getPackageLibraryPath :: IO [String] getPackageLibraryPath = do ps <- getPackageInfo - munge_paths (concatMap library_dirs ps) + return (nub (filter (not.null) (concatMap library_dirs ps))) getPackageLibraries :: IO [String] getPackageLibraries = do @@ -370,8 +435,29 @@ getPackageLibraries = do tag <- readIORef v_Build_tag let suffix = if null tag then "" else '_':tag return (concat ( - map (\p -> map (++suffix) (hs_libraries p) ++ extra_libraries p) ps + map (\p -> map (++suffix) (hACK (hs_libraries p)) ++ extra_libraries p) ps )) + where + -- This is a totally horrible (temporary) hack, for Win32. Problem is + -- that package.conf for Win32 says that the main prelude lib is + -- split into HSstd1 and HSstd2, which is needed due to limitations in + -- the PEi386 file format, to make GHCi work. However, we still only + -- have HSstd.a for static linking, not HSstd1.a and HSstd2.a. + -- getPackageLibraries is called to find the .a's to add to the static + -- link line. On Win32, this hACK detects HSstd1 and HSstd2 and + -- replaces them with HSstd, so static linking still works. + -- Libraries needed for dynamic (GHCi) linking are discovered via + -- different route (in InteractiveUI.linkPackage). + -- See driver/PackageSrc.hs for the HSstd1/HSstd2 split definition. + -- THIS IS A STRICTLY TEMPORARY HACK (famous last words ...) + hACK libs +# ifndef mingw32_TARGET_OS + = libs +# else + = if "HSstd1" `elem` libs && "HSstd2" `elem` libs + then "HSstd" : filter ((/= "HSstd").(take 5)) libs + else libs +# endif getPackageExtraGhcOpts :: IO [String] getPackageExtraGhcOpts = do @@ -406,13 +492,6 @@ lookupPkg nm ps [] -> Nothing (p:_) -> Just p -munge_paths ps = do - topdir <- readIORef v_TopDir - return (nub (filter (not.null) (map (munge_path topdir) ps))) - where munge_path topdir p - | Just p' <- my_prefix_match "$libdir" p = topdir ++ p' - | otherwise = p - ----------------------------------------------------------------------------- -- Ways @@ -597,19 +676,6 @@ unregFlags = ----------------------------------------------------------------------------- -- Programs for particular phases -GLOBAL_VAR(v_Pgm_L, error "pgm_L", String) -GLOBAL_VAR(v_Pgm_P, cRAWCPP, String) -GLOBAL_VAR(v_Pgm_c, cGCC, String) -GLOBAL_VAR(v_Pgm_m, error "pgm_m", String) -GLOBAL_VAR(v_Pgm_s, error "pgm_s", String) -GLOBAL_VAR(v_Pgm_a, cGCC, String) -GLOBAL_VAR(v_Pgm_l, cGCC, String) -GLOBAL_VAR(v_Pgm_dll, cMkDLL, String) - -#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS) -GLOBAL_VAR(v_Pgm_T, cTOUCH, String) -#endif - GLOBAL_VAR(v_Opt_dep, [], [String]) GLOBAL_VAR(v_Anti_opt_C, [], [String]) GLOBAL_VAR(v_Opt_C, [], [String])