projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[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
--
--
-- Utils for the driver
--
@@
-19,18
+19,13
@@
import Config ( cLeadingUnderscore )
import IOExts
import Exception
import Dynamic
import IOExts
import Exception
import Dynamic
-import RegexString
-import Directory ( getDirectoryContents )
+import Directory ( getDirectoryContents, doesDirectoryExist )
import IO
import List
import Char
import Monad
import IO
import List
import Char
import Monad
-
------------------------------------------------------------------------------
--- Errors
-
-----------------------------------------------------------------------------
-- Reading OPTIONS pragmas
-----------------------------------------------------------------------------
-- Reading OPTIONS pragmas
@@
-49,12
+44,18
@@
getOptionsFromSource file
() | null l -> look h
| prefixMatch "#" l -> look h
| prefixMatch "{-# LINE" l -> look h -- -}
() | 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 []
-> 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
-----------------------------------------------------------------------------
-- 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
-- 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))
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)
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
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
isPathSeparator :: Char -> Bool
isPathSeparator ch =
#ifdef mingw32_TARGET_OS