[project @ 2002-04-05 23:24:25 by sof]

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

diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs
index 0be0937..92961ef 100644 (file)
--- a/ghc/compiler/main/DriverUtil.hs
+++ b/ghc/compiler/main/DriverUtil.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.29 2002/01/22 14:47:52 simonmar Exp $
+-- $Id: DriverUtil.hs,v 1.32 2002/04/05 16:43:56 sof Exp $
 --
 -- Utils for the driver
 --
@@ -19,18 +19,13 @@ import Config               ( cLeadingUnderscore )
 import IOExts
 import Exception
 import Dynamic
-import RegexString
 
-import Directory       ( getDirectoryContents )
+import Directory       ( getDirectoryContents, doesDirectoryExist )
 import IO
 import List
 import Char
 import Monad
 
-
------------------------------------------------------------------------------
--- Errors
-
 -----------------------------------------------------------------------------
 -- Reading OPTIONS pragmas
 
@@ -49,12 +44,18 @@ getOptionsFromSource file
                () | null l -> look h
                   | prefixMatch "#" l -> look h
                   | prefixMatch "{-# LINE" l -> look h   -- -}
-                  | Just (opts:_) <- matchRegex optionRegex l
+                  | Just opts <- matchOptions l
                        -> do rest <- look h
                               return (words opts ++ rest)
                   | otherwise -> return []
 
-optionRegex = mkRegex "\\{-#[ \t]+OPTIONS[ \t]+(.*)#-\\}"   -- -}
+matchOptions s
+  | Just s1 <- my_prefix_match "{-#" s,
+    Just s2 <- my_prefix_match "OPTIONS" (remove_spaces s1),
+    Just s3 <- my_prefix_match "}-#" (reverse s2)
+  = Just (reverse s3)
+  | otherwise
+  = Nothing
 
 -----------------------------------------------------------------------------
 -- A version of getDirectoryContents that is non-fatal if the
@@ -68,6 +69,13 @@ softGetDirectoryContents d
          )
 
 -----------------------------------------------------------------------------
+-- Verify that the 'dirname' portion of a FilePath exists.
+-- 
+doesDirNameExist :: FilePath -> IO Bool
+doesDirNameExist fpath = doesDirectoryExist (getdir fpath)
+
+
+-----------------------------------------------------------------------------
 -- Prefixing underscore to linker-level names
 prefixUnderscore :: String -> String
 prefixUnderscore
@@ -80,6 +88,9 @@ prefixUnderscore
 unknownFlagErr :: String -> a
 unknownFlagErr f = throwDyn (UsageError ("unrecognised flag: " ++ f))
 
+unknownFlagsErr :: [String] -> a
+unknownFlagsErr fs = throwDyn (UsageError ("unrecognised flags: " ++ unwords fs))
+
 my_partition :: (a -> Maybe b) -> [a] -> ([(a,b)],[a])
 my_partition _ [] = ([],[])
 my_partition p (a:as)
@@ -190,6 +201,9 @@ newdir dir s = dir ++ '/':drop_longest_prefix s isPathSeparator
 remove_spaces :: String -> String
 remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
 
+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