X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FUtil.lhs;h=e692ff1aa3afcd868b7deaafcf44f9e9ea5bc39e;hb=7b667aaef31c75bede4443e9686039d07b2ff409;hp=9725f427b7740de671b5d5c9aa339a69113f56b6;hpb=34c2b1b2cdc009b62402bd1c31ffc1ae17df8969;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 9725f42..e692ff1 100644
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -13,7 +13,7 @@ module Util (
 	mapAndUnzip, mapAndUnzip3,
 	nOfThem, filterOut,
 	lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength,
-	isSingleton, only,
+	isSingleton, only, singleton,
 	notNull, snocView,
 
 	isIn, isn'tIn,
@@ -29,7 +29,7 @@ module Util (
 
 	-- accumulating
 	mapAccumL, mapAccumR, mapAccumB, 
-	foldl2, count,
+	foldl2, count, all2,
 	
 	takeList, dropList, splitAtList, split,
 
@@ -63,12 +63,14 @@ module Util (
 
 	-- Filename utils
 	Suffix,
-	splitFilename, getFileSuffix, splitFilenameDir, joinFileExt,
-	splitFilename3, removeSuffix, 
-	dropLongestPrefix, takeLongestPrefix, splitLongestPrefix,
+	splitFilename, suffixOf, basenameOf, joinFileExt,
+	splitFilenameDir, joinFileName,
+	splitFilename3,
+	splitLongestPrefix,
 	replaceFilenameSuffix, directoryOf, filenameOf,
 	replaceFilenameDirectory,
 	escapeSpaces, isPathSeparator,
+	parseSearchPath,
 	normalisePath, platformPath, pgmPath,
     ) where
 
@@ -298,6 +300,9 @@ listLengthCmp = atLength atLen atEnd
   atLen []     = EQ
   atLen _      = GT
 
+singleton :: a -> [a]
+singleton x = [x]
+
 isSingleton :: [a] -> Bool
 isSingleton [x] = True
 isSingleton  _  = False
@@ -567,6 +572,13 @@ A combination of foldl with zip.  It works with equal length lists.
 foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
 foldl2 k z [] [] = z
 foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
+
+all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
+-- True if the lists are the same length, and 
+-- all corresponding elements satisfy the predicate
+all2 p []     []     = True
+all2 p (x:xs) (y:ys) = p x y && all2 p xs ys
+all2 p xs     ys     = False
 \end{code}
 
 Count the number of times a predicate is true
@@ -862,13 +874,20 @@ modificationTimeIfExists f = do
 -- --------------------------------------------------------------
 -- Filename manipulation
 		
+-- Filenames are kept "normalised" inside GHC, using '/' as the path
+-- separator.  On Windows these functions will also recognise '\\' as
+-- the path separator, but will generally construct paths using '/'.
+
 type Suffix = String
 
 splitFilename :: String -> (String,Suffix)
 splitFilename f = splitLongestPrefix f (=='.')
 
-getFileSuffix :: String -> Suffix
-getFileSuffix f = dropLongestPrefix f (=='.')
+basenameOf :: FilePath -> String
+basenameOf = fst . splitFilename
+
+suffixOf :: FilePath -> Suffix
+suffixOf = snd . splitFilename
 
 joinFileExt :: String -> String -> FilePath
 joinFileExt path ""  = path
@@ -885,20 +904,15 @@ splitFilenameDir str
 -- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
 splitFilename3 :: String -> (String,String,Suffix)
 splitFilename3 str
-   = let (dir, rest) = splitLongestPrefix str isPathSeparator
-	 (dir', rest') | null rest = (".", dir)
-		       | otherwise = (dir, rest)
-	 (name, ext) = splitFilename rest'
-     in  (dir', name, ext)
-
-removeSuffix :: Char -> String -> Suffix
-removeSuffix c s = takeLongestPrefix s (==c)
-
-dropLongestPrefix :: String -> (Char -> Bool) -> String
-dropLongestPrefix s pred = snd (splitLongestPrefix s pred)
+   = let (dir, rest) = splitFilenameDir str
+	 (name, ext) = splitFilename rest
+     in  (dir, name, ext)
 
-takeLongestPrefix :: String -> (Char -> Bool) -> String
-takeLongestPrefix s pred = fst (splitLongestPrefix s pred)
+joinFileName :: String -> String -> FilePath
+joinFileName ""  fname = fname
+joinFileName "." fname = fname
+joinFileName dir ""    = dir
+joinFileName dir fname = dir ++ '/':fname
 
 -- split a string at the last character where 'pred' is True,
 -- returning a pair of strings. The first component holds the string
@@ -907,17 +921,18 @@ takeLongestPrefix s pred = fst (splitLongestPrefix s pred)
 -- 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
+-- string is returned in the first component (and the second 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)
+splitLongestPrefix str pred
+  | null r_pre = (str,           [])
+  | otherwise  = (reverse (tail r_pre), reverse r_suf)
+	-- 'tail' drops the char satisfying 'pred'
+  where 
+    (r_suf, r_pre) = break pred (reverse str)
 
 replaceFilenameSuffix :: FilePath -> Suffix -> FilePath
-replaceFilenameSuffix s suf = removeSuffix '.' s ++ suf
+replaceFilenameSuffix file suf = basenameOf file `joinFileExt` suf
 
 -- directoryOf strips the filename off the input string, returning
 -- the directory.
@@ -930,8 +945,7 @@ filenameOf :: FilePath -> String
 filenameOf = snd . splitFilenameDir
 
 replaceFilenameDirectory :: FilePath -> String -> FilePath
-replaceFilenameDirectory s dir
- = dir ++ '/':dropLongestPrefix s isPathSeparator
+replaceFilenameDirectory path dir = dir `joinFileName` filenameOf path
 
 escapeSpaces :: String -> String
 escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
@@ -944,6 +958,40 @@ isPathSeparator ch =
   ch == '/'
 #endif
 
+--------------------------------------------------------------
+-- * Search path
+--------------------------------------------------------------
+
+-- | The function splits the given string to substrings
+-- using the 'searchPathSeparator'.
+parseSearchPath :: String -> [FilePath]
+parseSearchPath path = split path
+  where
+    split :: String -> [String]
+    split s =
+      case rest' of
+        []     -> [chunk] 
+        _:rest -> chunk : split rest
+      where
+        chunk = 
+          case chunk' of
+#ifdef mingw32_HOST_OS
+            ('\"':xs@(_:_)) | last xs == '\"' -> init xs
+#endif
+            _                                 -> chunk'
+
+        (chunk', rest') = break (==searchPathSeparator) s
+
+-- | A platform-specific character used to separate search path strings in 
+-- environment variables. The separator is a colon (\":\") on Unix and Macintosh, 
+-- and a semicolon (\";\") on the Windows operating system.
+searchPathSeparator :: Char
+#if mingw32_HOST_OS || mingw32_TARGET_OS
+searchPathSeparator = ';'
+#else
+searchPathSeparator = ':'
+#endif
+
 -----------------------------------------------------------------------------
 -- Convert filepath into platform / MSDOS form.