X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDynFlags.hs;h=09932b6f200d2df538fe28dacc913dc0d58f7235;hb=395f4b287e9c679f31ef63b9f9bd11734a691776;hp=62d269d1ba6cd5a1d476a735c7dd483f9a4bb154;hpb=d1c1b7d0e7b94ede238845c91f58582bad3b3ef3;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DynFlags.hs b/ghc/compiler/main/DynFlags.hs index 62d269d..09932b6 100644 --- a/ghc/compiler/main/DynFlags.hs +++ b/ghc/compiler/main/DynFlags.hs @@ -37,6 +37,7 @@ module DynFlags ( getOpts, -- (DynFlags -> [a]) -> IO [a] getVerbFlag, updOptLevel, + setTmpDir, -- parsing DynFlags parseDynamicFlags, @@ -54,11 +55,14 @@ import DriverPhases ( Phase(..), phaseInputExt ) import Config import CmdLineParser import Panic ( panic, GhcException(..) ) -import Util ( notNull, splitLongestPrefix, split ) +import Util ( notNull, splitLongestPrefix, split, normalisePath ) import DATA_IOREF ( readIORef ) import EXCEPTION ( throwDyn ) import Monad ( when ) +#ifdef mingw32_TARGET_OS +import Data.List ( isPrefixOf ) +#endif import Maybe ( fromJust ) import Char ( isDigit, isUpper ) @@ -166,6 +170,7 @@ data DynFlag | Opt_NoHsMain | Opt_SplitObjs | Opt_StgStats + | Opt_HideAllPackages -- keeping stuff | Opt_KeepHiDiffs @@ -213,7 +218,7 @@ data DynFlags = DynFlags { libraryPaths :: [String], frameworkPaths :: [String], -- used on darwin only cmdlineFrameworks :: [String], -- ditto - tmpDir :: String, + tmpDir :: String, -- no trailing '/' -- options for particular phases opt_L :: [String], @@ -237,7 +242,7 @@ data DynFlags = DynFlags { pgm_l :: (String,[Option]), pgm_dll :: (String,[Option]), - -- ** Package flags + -- ** Package flags extraPkgConfs :: [FilePath], -- The -package-conf flags given on the command line, in the order -- they appeared. @@ -245,7 +250,7 @@ data DynFlags = DynFlags { packageFlags :: [PackageFlag], -- The -package and -hide-package flags from the command-line - -- ** Package state + -- ** Package state pkgState :: PackageState, -- hsc dynamic flags @@ -342,7 +347,7 @@ defaultDynFlags = libraryPaths = [], frameworkPaths = [], cmdlineFrameworks = [], - tmpDir = [], + tmpDir = cDEFAULT_TMPDIR, opt_L = [], opt_P = [], @@ -431,7 +436,6 @@ setObjectSuf f d = d{ objectSuf = f} setHcSuf f d = d{ hcSuf = f} setHiSuf f d = d{ hiSuf = f} setHiDir f d = d{ hiDir = f} -setTmpDir f d = d{ tmpDir = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. @@ -769,6 +773,10 @@ dynamic_flags = [ , ( "optdll" , HasArg (upd . addOptdll) ) , ( "optdep" , HasArg (upd . addOptdep) ) + , ( "split-objs" , NoArg (if can_split + then setDynFlag Opt_SplitObjs + else return ()) ) + -------- Linking ---------------------------------------------------- , ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) , ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep. @@ -814,6 +822,7 @@ dynamic_flags = [ , ( "package-name" , HasArg ignorePackage ) -- for compatibility , ( "package" , HasArg exposePackage ) , ( "hide-package" , HasArg hidePackage ) + , ( "hide-all-packages", NoArg (setDynFlag Opt_HideAllPackages) ) , ( "ignore-package" , HasArg ignorePackage ) , ( "syslib" , HasArg exposePackage ) -- for compatibility @@ -1088,20 +1097,20 @@ splitPathList s = filter notNull (splitUp s) -- 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 [] = [] - splitUp (x:':':div:xs) - | div `elem` dir_markers = do - let (p,rs) = findNextPath xs - in ((x:':':div:p): splitUp rs) + splitUp [] = [] + splitUp (x:':':div:xs) | div `elem` dir_markers + = ((x:':':div:p): splitUp rs) + where + (p,rs) = findNextPath xs -- we used to check for existence of the path here, but that -- required the IO monad to be threaded through the command-line -- parser which is quite inconvenient. The - splitUp xs = do - let (p,rs) = findNextPath xs - return (cons p (splitUp rs)) + splitUp xs = cons p (splitUp rs) + where + (p,rs) = findNextPath xs - cons "" xs = xs - cons x xs = x:xs + 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 @@ -1118,6 +1127,40 @@ splitPathList s = filter notNull (splitUp s) dir_markers = ['/', '\\'] #endif +-- ----------------------------------------------------------------------------- +-- tmpDir, where we store temporary files. + +setTmpDir :: FilePath -> DynFlags -> DynFlags +setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir } + where +#if !defined(mingw32_HOST_OS) + canonicalise p = normalisePath p +#else + -- Canonicalisation of temp path under win32 is a bit more + -- involved: (a) strip trailing slash, + -- (b) normalise slashes + -- (c) just in case, if there is a prefix /cygdrive/x/, change to x: + -- + canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path)) + + -- if we're operating under cygwin, and TMP/TEMP is of + -- the form "/cygdrive/drive/path", translate this to + -- "drive:/path" (as GHC isn't a cygwin app and doesn't + -- understand /cygdrive paths.) + xltCygdrive path + | "/cygdrive/" `isPrefixOf` path = + case drop (length "/cygdrive/") path of + drive:xs@('/':_) -> drive:':':xs + _ -> path + | otherwise = path + + -- strip the trailing backslash (awful, but we only do this once). + removeTrailingSlash path = + case last path of + '/' -> init path + '\\' -> init path + _ -> path +#endif ----------------------------------------------------------------------------- -- Via-C compilation stuff @@ -1228,3 +1271,23 @@ picCCOpts dflags | otherwise = [] #endif + +-- ----------------------------------------------------------------------------- +-- Splitting + +can_split :: Bool +can_split = +#if defined(i386_TARGET_ARCH) \ + || defined(x86_64_TARGET_ARCH) \ + || defined(alpha_TARGET_ARCH) \ + || defined(hppa_TARGET_ARCH) \ + || defined(m68k_TARGET_ARCH) \ + || defined(mips_TARGET_ARCH) \ + || defined(powerpc_TARGET_ARCH) \ + || defined(rs6000_TARGET_ARCH) \ + || defined(sparc_TARGET_ARCH) + True +#else + False +#endif +