[project @ 2005-03-18 13:37:27 by simonmar]

Flags cleanup.

Basically the purpose of this commit is to move more of the compiler's
global state into DynFlags, which is moving in the direction we need
to go for the GHC API which can have multiple active sessions
supported by a single GHC instance.

Before:

$ grep 'global_var' */*hs | wc -l
     78

After:

$ grep 'global_var' */*hs | wc -l
     27

Well, it's an improvement.  Most of what's left won't really affect
our ability to host multiple sessions.

Lots of static flags have become dynamic flags (yay!).  Notably lots
of flags that we used to think of as "driver" flags, like -I and -L,
are now dynamic.  The most notable static flags left behind are the
"way" flags, eg. -prof.  It would be nice to fix this, but it isn't
urgent.

On the way, lots of cleanup has happened.  Everything related to
static and dynamic flags lives in StaticFlags and DynFlags
respectively, and they share a common command-line parser library in
CmdLineParser.  The flags related to modes (--makde, --interactive
etc.) are now private to the front end: in fact private to Main
itself, for now.

2 files changed, 161 insertions, 6 deletions

diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 5a4368c09a..e0e9bbb672 100644
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -54,7 +54,7 @@ module Outputable (
 import {-# SOURCE #-} 	Module( Module )
 import {-# SOURCE #-} 	OccName( OccName )
 
-import CmdLineOpts	( opt_PprStyle_Debug, opt_PprUserLength )
+import StaticFlags	( opt_PprStyle_Debug, opt_PprUserLength )
 import PackageConfig	( PackageId, packageIdString )
 import FastString
 import qualified Pretty
diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 11d1b5e545..d3eb975694 100644
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -30,11 +30,12 @@ module Util (
 	mapAccumL, mapAccumR, mapAccumB, 
 	foldl2, count,
 	
-	takeList, dropList, splitAtList,
+	takeList, dropList, splitAtList, split,
 
 	-- comparisons
 	isEqual, eqListBy, equalLength, compareLength,
 	thenCmp, cmpList, prefixMatch, suffixMatch, maybePrefixMatch,
+	removeSpaces,
 
 	-- strictness
 	foldl', seqList,
@@ -42,7 +43,7 @@ module Util (
 	-- pairs
 	unzipWith,
 
-	global,
+	global, consIORef,
 
 	-- module names
 	looksLikeModuleName,
@@ -51,6 +52,21 @@ module Util (
 
 	-- Floating point stuff
 	readRational,
+
+	-- IO-ish utilities
+	createDirectoryHierarchy,
+	doesDirNameExist,
+
+	later, handleDyn, handle,
+
+	-- Filename utils
+	Suffix,
+	splitFilename, getFileSuffix, splitFilenameDir,
+	splitFilename3, removeSuffix, 
+	dropLongestPrefix, takeLongestPrefix, splitLongestPrefix,
+	replaceFilenameSuffix, directoryOf, filenameOf,
+	replaceFilenameDirectory,
+	escapeSpaces, isPathSeparator,
     ) where
 
 #include "HsVersions.h"
@@ -58,11 +74,12 @@ module Util (
 import Panic		( panic, trace )
 import FastTypes
 
-#if __GLASGOW_HASKELL__ <= 408
-import EXCEPTION	( catchIO, justIoErrors, raiseInThread )
-#endif
+import EXCEPTION	( Exception(..), finally, throwDyn, catchDyn, throw )
+import qualified EXCEPTION as Exception
+import DYNAMIC		( Typeable )
 import DATA_IOREF	( IORef, newIORef )
 import UNSAFE_IO	( unsafePerformIO )
+import DATA_IOREF	( readIORef, writeIORef )
 
 import qualified List	( elem, notElem )
 
@@ -70,6 +87,9 @@ import qualified List	( elem, notElem )
 import List		( zipWith4 )
 #endif
 
+import Monad		( when )
+import IO		( catch )
+import Directory	( doesDirectoryExist, createDirectory )
 import Char		( isUpper, isAlphaNum, isSpace, ord, isDigit )
 import Ratio		( (%) )
 
@@ -571,6 +591,11 @@ splitAtList (_:xs) (y:ys) = (y:ys', ys'')
     where
       (ys', ys'') = splitAtList xs ys
 
+split :: Char -> String -> [String]
+split c s = case rest of
+		[]     -> [chunk] 
+		_:rest -> chunk : split c rest
+  where (chunk, rest) = break (==c) s
 \end{code}
 
 
@@ -634,6 +659,9 @@ maybePrefixMatch (p:pat) (r:rest)
 
 suffixMatch :: Eq a => [a] -> [a] -> Bool
 suffixMatch pat str = prefixMatch (reverse pat) (reverse str)
+
+removeSpaces :: String -> String
+removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
 \end{code}
 
 %************************************************************************
@@ -685,6 +713,13 @@ global :: a -> IORef a
 global a = unsafePerformIO (newIORef a)
 \end{code}
 
+\begin{code}
+consIORef :: IORef [a] -> a -> IO ()
+consIORef var x = do
+  xs <- readIORef var
+  writeIORef var (x:xs)
+\end{code}
+
 Module names:
 
 \begin{code}
@@ -768,4 +803,124 @@ readRational top_s
 	  [x] -> x
 	  []  -> error ("readRational: no parse:"        ++ top_s)
 	  _   -> error ("readRational: ambiguous parse:" ++ top_s)
+
+
+-----------------------------------------------------------------------------
+-- Create a hierarchy of directories
+
+createDirectoryHierarchy :: FilePath -> IO ()
+createDirectoryHierarchy dir = do
+  b <- doesDirectoryExist dir
+  when (not b) $ do
+	createDirectoryHierarchy (directoryOf dir)
+	createDirectory dir
+
+-----------------------------------------------------------------------------
+-- Verify that the 'dirname' portion of a FilePath exists.
+-- 
+doesDirNameExist :: FilePath -> IO Bool
+doesDirNameExist fpath = doesDirectoryExist (directoryOf fpath)
+
+-- -----------------------------------------------------------------------------
+-- Exception utils
+
+later = flip finally
+
+handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a
+handleDyn = flip catchDyn
+
+handle :: (Exception -> IO a) -> IO a -> IO a
+#if __GLASGOW_HASKELL__ < 501
+handle = flip Exception.catchAllIO
+#else
+handle h f = f `Exception.catch` \e -> case e of
+    ExitException _ -> throw e
+    _               -> h e
+#endif
+
+-- --------------------------------------------------------------
+-- Filename manipulation
+		
+type Suffix = String
+
+splitFilename :: String -> (String,Suffix)
+splitFilename f = splitLongestPrefix f (=='.')
+
+getFileSuffix :: String -> Suffix
+getFileSuffix f = dropLongestPrefix f (=='.')
+
+-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy.ext")
+splitFilenameDir :: String -> (String,String)
+splitFilenameDir str
+  = let (dir, rest) = splitLongestPrefix str isPathSeparator
+  	real_dir | null dir  = "."
+		 | otherwise = dir
+    in  (real_dir, rest)
+
+-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
+splitFilename3 :: String -> (String,String,Suffix)
+splitFilename3 str
+   = let (dir, rest) = splitLongestPrefix str isPathSeparator
+	 (name, ext) = splitFilename rest
+	 real_dir | null dir  = "."
+		  | otherwise = dir
+     in  (real_dir, name, ext)
+
+removeSuffix :: Char -> String -> Suffix
+removeSuffix c s
+  | null pre  = s
+  | otherwise = reverse pre
+  where (suf,pre) = break (==c) (reverse s)
+
+dropLongestPrefix :: String -> (Char -> Bool) -> String
+dropLongestPrefix s pred = reverse suf
+  where (suf,_pre) = break pred (reverse s)
+
+takeLongestPrefix :: String -> (Char -> Bool) -> String
+takeLongestPrefix s pred = reverse pre
+  where (_suf,pre) = break pred (reverse s)
+
+-- split a string at the last character where 'pred' is True,
+-- returning a pair of strings. The first component holds the string
+-- up (but not including) the last character for which 'pred' returned
+-- True, the second whatever comes after (but also not including the
+-- last character).
+--
+-- If 'pred' returns False for all characters in the string, the original
+-- string is returned in the second component (and the first one is just
+-- empty).
+splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
+splitLongestPrefix s pred
+  = case pre of
+	[]      -> ([], reverse suf)
+	(_:pre) -> (reverse pre, reverse suf)
+  where (suf,pre) = break pred (reverse s)
+
+replaceFilenameSuffix :: FilePath -> Suffix -> FilePath
+replaceFilenameSuffix s suf = removeSuffix '.' s ++ suf
+
+-- directoryOf strips the filename off the input string, returning
+-- the directory.
+directoryOf :: FilePath -> String
+directoryOf = fst . splitFilenameDir
+
+-- filenameOf strips the directory off the input string, returning
+-- the filename.
+filenameOf :: FilePath -> String
+filenameOf = snd . splitFilenameDir
+
+replaceFilenameDirectory :: FilePath -> String -> FilePath
+replaceFilenameDirectory s dir
+ = dir ++ '/':dropLongestPrefix s isPathSeparator
+
+escapeSpaces :: String -> String
+escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
+
+isPathSeparator :: Char -> Bool
+isPathSeparator ch =
+#ifdef mingw32_TARGET_OS
+  ch == '/' || ch == '\\'
+#else
+  ch == '/'
+#endif
 \end{code}