[project @ 2005-04-22 21:54:37 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / DynFlags.hs

diff --git a/ghc/compiler/main/DynFlags.hs b/ghc/compiler/main/DynFlags.hs
index 62d269d..09932b6 100644 (file)
--- 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
     -- "<Drive>:/" 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
+