2 % (c) The University of Glasgow 2006
3 % (c) The University of Glasgow 1992-2002
5 \section[Util]{Highly random utility functions}
9 ghciSupported, debugIsOn, ghciTablesNextToCode, picIsOn,
10 isWindowsHost, isWindowsTarget, isDarwinTarget,
12 -- general list processing
13 zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
14 zipLazy, stretchZipWith,
16 mapAndUnzip, mapAndUnzip3,
17 nOfThem, filterOut, partitionWith, splitEithers,
20 lengthExceeds, lengthIs, lengthAtLeast,
21 listLengthCmp, atLength, equalLength, compareLength,
23 isSingleton, only, singleton,
34 -- transitive closures
40 takeList, dropList, splitAtList, split,
44 thenCmp, cmpList, maybePrefixMatch,
58 getCmd, toCmdArgs, toArgs,
60 -- Floating point stuff
64 createDirectoryHierarchy,
66 modificationTimeIfExists,
68 later, handleDyn, handle,
75 Direction(..), reslash,
78 #include "HsVersions.h"
82 import Control.Exception ( Exception(..), finally, catchDyn, throw )
83 import qualified Control.Exception as Exception
84 import Data.Dynamic ( Typeable )
85 import Data.IORef ( IORef, newIORef )
86 import System.IO.Unsafe ( unsafePerformIO )
87 import Data.IORef ( readIORef, writeIORef )
88 import Data.List hiding (group)
90 import qualified Data.List as List ( elem )
92 import qualified Data.List as List ( notElem )
96 import Control.Monad ( unless )
97 import System.IO.Error as IO ( catch, isDoesNotExistError )
98 import System.Directory ( doesDirectoryExist, createDirectory,
100 import System.FilePath hiding ( searchPathSeparator )
101 import Data.Char ( isUpper, isAlphaNum, isSpace, ord, isDigit )
102 import Data.Ratio ( (%) )
103 import System.Time ( ClockTime )
108 %************************************************************************
110 \subsection{Is DEBUG on, are we on Windows, etc?}
112 %************************************************************************
115 ghciSupported :: Bool
119 ghciSupported = False
129 ghciTablesNextToCode :: Bool
130 #ifdef GHCI_TABLES_NEXT_TO_CODE
131 ghciTablesNextToCode = True
133 ghciTablesNextToCode = False
143 isWindowsHost :: Bool
144 #ifdef mingw32_HOST_OS
147 isWindowsHost = False
150 isWindowsTarget :: Bool
151 #ifdef mingw32_TARGET_OS
152 isWindowsTarget = True
154 isWindowsTarget = False
157 isDarwinTarget :: Bool
158 #ifdef darwin_TARGET_OS
159 isDarwinTarget = True
161 isDarwinTarget = False
165 %************************************************************************
167 \subsection{A for loop}
169 %************************************************************************
172 -- Compose a function with itself n times. (nth rather than twice)
173 nTimes :: Int -> (a -> a) -> (a -> a)
176 nTimes n f = f . nTimes (n-1) f
179 %************************************************************************
181 \subsection[Utils-lists]{General list processing}
183 %************************************************************************
186 filterOut :: (a->Bool) -> [a] -> [a]
187 -- Like filter, only reverses the sense of the test
189 filterOut p (x:xs) | p x = filterOut p xs
190 | otherwise = x : filterOut p xs
192 partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
193 partitionWith _ [] = ([],[])
194 partitionWith f (x:xs) = case f x of
196 Right c -> (bs, c:cs)
197 where (bs,cs) = partitionWith f xs
199 splitEithers :: [Either a b] -> ([a], [b])
200 splitEithers [] = ([],[])
201 splitEithers (e : es) = case e of
203 Right y -> (xs, y:ys)
204 where (xs,ys) = splitEithers es
207 A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
208 are of equal length. Alastair Reid thinks this should only happen if
209 DEBUGging on; hey, why not?
212 zipEqual :: String -> [a] -> [b] -> [(a,b)]
213 zipWithEqual :: String -> (a->b->c) -> [a]->[b]->[c]
214 zipWith3Equal :: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
215 zipWith4Equal :: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
219 zipWithEqual _ = zipWith
220 zipWith3Equal _ = zipWith3
221 zipWith4Equal _ = zipWith4
223 zipEqual _ [] [] = []
224 zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs
225 zipEqual msg _ _ = panic ("zipEqual: unequal lists:"++msg)
227 zipWithEqual msg z (a:as) (b:bs)= z a b : zipWithEqual msg z as bs
228 zipWithEqual _ _ [] [] = []
229 zipWithEqual msg _ _ _ = panic ("zipWithEqual: unequal lists:"++msg)
231 zipWith3Equal msg z (a:as) (b:bs) (c:cs)
232 = z a b c : zipWith3Equal msg z as bs cs
233 zipWith3Equal _ _ [] [] [] = []
234 zipWith3Equal msg _ _ _ _ = panic ("zipWith3Equal: unequal lists:"++msg)
236 zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)
237 = z a b c d : zipWith4Equal msg z as bs cs ds
238 zipWith4Equal _ _ [] [] [] [] = []
239 zipWith4Equal msg _ _ _ _ _ = panic ("zipWith4Equal: unequal lists:"++msg)
244 -- zipLazy is lazy in the second list (observe the ~)
246 zipLazy :: [a] -> [b] -> [(a,b)]
248 -- We want to write this, but with GHC 6.4 we get a warning, so it
250 -- zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
251 -- so we write this instead:
252 zipLazy (x:xs) zs = let y : ys = zs
253 in (x,y) : zipLazy xs ys
258 stretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]
259 -- (stretchZipWith p z f xs ys) stretches ys by inserting z in
260 -- the places where p returns *True*
262 stretchZipWith _ _ _ [] _ = []
263 stretchZipWith p z f (x:xs) ys
264 | p x = f x z : stretchZipWith p z f xs ys
265 | otherwise = case ys of
267 (y:ys) -> f x y : stretchZipWith p z f xs ys
272 mapFst :: (a->c) -> [(a,b)] -> [(c,b)]
273 mapSnd :: (b->c) -> [(a,b)] -> [(a,c)]
275 mapFst f xys = [(f x, y) | (x,y) <- xys]
276 mapSnd f xys = [(x, f y) | (x,y) <- xys]
278 mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
280 mapAndUnzip _ [] = ([], [])
283 (rs1, rs2) = mapAndUnzip f xs
287 mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
289 mapAndUnzip3 _ [] = ([], [], [])
290 mapAndUnzip3 f (x:xs)
291 = let (r1, r2, r3) = f x
292 (rs1, rs2, rs3) = mapAndUnzip3 f xs
294 (r1:rs1, r2:rs2, r3:rs3)
298 nOfThem :: Int -> a -> [a]
299 nOfThem n thing = replicate n thing
301 -- 'atLength atLen atEnd ls n' unravels list 'ls' to position 'n';
304 -- atLength atLenPred atEndPred ls n
305 -- | n < 0 = atLenPred n
306 -- | length ls < n = atEndPred (n - length ls)
307 -- | otherwise = atLenPred (drop n ls)
309 atLength :: ([a] -> b)
314 atLength atLenPred atEndPred ls n
315 | n < 0 = atEndPred n
316 | otherwise = go n ls
318 go n [] = atEndPred n
319 go 0 ls = atLenPred ls
320 go n (_:xs) = go (n-1) xs
323 lengthExceeds :: [a] -> Int -> Bool
324 -- (lengthExceeds xs n) = (length xs > n)
325 lengthExceeds = atLength notNull (const False)
327 lengthAtLeast :: [a] -> Int -> Bool
328 lengthAtLeast = atLength notNull (== 0)
330 lengthIs :: [a] -> Int -> Bool
331 lengthIs = atLength null (==0)
333 listLengthCmp :: [a] -> Int -> Ordering
334 listLengthCmp = atLength atLen atEnd
338 | x > 0 = LT -- not yet seen 'n' elts, so list length is < n.
344 equalLength :: [a] -> [b] -> Bool
345 equalLength [] [] = True
346 equalLength (_:xs) (_:ys) = equalLength xs ys
347 equalLength _ _ = False
349 compareLength :: [a] -> [b] -> Ordering
350 compareLength [] [] = EQ
351 compareLength (_:xs) (_:ys) = compareLength xs ys
352 compareLength [] _ = LT
353 compareLength _ [] = GT
355 ----------------------------
356 singleton :: a -> [a]
359 isSingleton :: [a] -> Bool
360 isSingleton [_] = True
361 isSingleton _ = False
363 notNull :: [a] -> Bool
373 only _ = panic "Util: only"
376 Debugging/specialising versions of \tr{elem} and \tr{notElem}
379 isIn, isn'tIn :: Eq a => String -> a -> [a] -> Bool
382 isIn _msg x ys = elem__ x ys
383 isn'tIn _msg x ys = notElem__ x ys
385 --these are here to be SPECIALIZEd (automagically)
386 elem__ :: Eq a => a -> [a] -> Bool
388 elem__ x (y:ys) = x == y || elem__ x ys
390 notElem__ :: Eq a => a -> [a] -> Bool
391 notElem__ _ [] = True
392 notElem__ x (y:ys) = x /= y && notElem__ x ys
396 = elem (_ILIT(0)) x ys
400 | i ># _ILIT(100) = trace ("Over-long elem in " ++ msg)
401 (x `List.elem` (y:ys))
402 | otherwise = x == y || elem (i +# _ILIT(1)) x ys
405 = notElem (_ILIT(0)) x ys
407 notElem _ _ [] = True
409 | i ># _ILIT(100) = trace ("Over-long notElem in " ++ msg)
410 (x `List.notElem` (y:ys))
411 | otherwise = x /= y && notElem (i +# _ILIT(1)) x ys
415 %************************************************************************
417 \subsubsection[Utils-Carsten-mergesort]{A mergesort from Carsten}
419 %************************************************************************
422 Date: Mon, 3 May 93 20:45:23 +0200
423 From: Carsten Kehler Holst <kehler@cs.chalmers.se>
424 To: partain@dcs.gla.ac.uk
425 Subject: natural merge sort beats quick sort [ and it is prettier ]
427 Here is a piece of Haskell code that I'm rather fond of. See it as an
428 attempt to get rid of the ridiculous quick-sort routine. group is
429 quite useful by itself I think it was John's idea originally though I
430 believe the lazy version is due to me [surprisingly complicated].
431 gamma [used to be called] is called gamma because I got inspired by
432 the Gamma calculus. It is not very close to the calculus but does
433 behave less sequentially than both foldr and foldl. One could imagine
434 a version of gamma that took a unit element as well thereby avoiding
435 the problem with empty lists.
437 I've tried this code against
439 1) insertion sort - as provided by haskell
440 2) the normal implementation of quick sort
441 3) a deforested version of quick sort due to Jan Sparud
442 4) a super-optimized-quick-sort of Lennart's
444 If the list is partially sorted both merge sort and in particular
445 natural merge sort wins. If the list is random [ average length of
446 rising subsequences = approx 2 ] mergesort still wins and natural
447 merge sort is marginally beaten by Lennart's soqs. The space
448 consumption of merge sort is a bit worse than Lennart's quick sort
449 approx a factor of 2. And a lot worse if Sparud's bug-fix [see his
450 fpca article ] isn't used because of group.
457 group :: (a -> a -> Bool) -> [a] -> [[a]]
458 -- Given a <= function, group finds maximal contiguous up-runs
459 -- or down-runs in the input list.
460 -- It's stable, in the sense that it never re-orders equal elements
462 -- Date: Mon, 12 Feb 1996 15:09:41 +0000
463 -- From: Andy Gill <andy@dcs.gla.ac.uk>
464 -- Here is a `better' definition of group.
467 group p (x:xs) = group' xs x x (x :)
469 group' [] _ _ s = [s []]
470 group' (x:xs) x_min x_max s
471 | x_max `p` x = group' xs x_min x (s . (x :))
472 | not (x_min `p` x) = group' xs x x_max ((x :) . s)
473 | otherwise = s [] : group' xs x x (x :)
474 -- NB: the 'not' is essential for stablity
475 -- x `p` x_min would reverse equal elements
477 generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
478 generalMerge _ xs [] = xs
479 generalMerge _ [] ys = ys
480 generalMerge p (x:xs) (y:ys) | x `p` y = x : generalMerge p xs (y:ys)
481 | otherwise = y : generalMerge p (x:xs) ys
483 -- gamma is now called balancedFold
485 balancedFold :: (a -> a -> a) -> [a] -> a
486 balancedFold _ [] = error "can't reduce an empty list using balancedFold"
487 balancedFold _ [x] = x
488 balancedFold f l = balancedFold f (balancedFold' f l)
490 balancedFold' :: (a -> a -> a) -> [a] -> [a]
491 balancedFold' f (x:y:xs) = f x y : balancedFold' f xs
492 balancedFold' _ xs = xs
494 generalNaturalMergeSort :: (a -> a -> Bool) -> [a] -> [a]
495 generalNaturalMergeSort _ [] = []
496 generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
499 generalMergeSort p [] = []
500 generalMergeSort p xs = (balancedFold (generalMerge p) . map (: [])) xs
502 mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
504 mergeSort = generalMergeSort (<=)
505 naturalMergeSort = generalNaturalMergeSort (<=)
507 mergeSortLe le = generalMergeSort le
510 sortLe :: (a->a->Bool) -> [a] -> [a]
511 sortLe le = generalNaturalMergeSort le
513 sortWith :: Ord b => (a->b) -> [a] -> [a]
514 sortWith get_key xs = sortLe le xs
516 x `le` y = get_key x < get_key y
518 on :: (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering
519 on cmp sel = \x y -> sel x `cmp` sel y
523 %************************************************************************
525 \subsection[Utils-transitive-closure]{Transitive closure}
527 %************************************************************************
529 This algorithm for transitive closure is straightforward, albeit quadratic.
532 transitiveClosure :: (a -> [a]) -- Successor function
533 -> (a -> a -> Bool) -- Equality predicate
535 -> [a] -- The transitive closure
537 transitiveClosure succ eq xs
541 go done (x:xs) | x `is_in` done = go done xs
542 | otherwise = go (x:done) (succ x ++ xs)
545 x `is_in` (y:ys) | eq x y = True
546 | otherwise = x `is_in` ys
549 %************************************************************************
551 \subsection[Utils-accum]{Accumulating}
553 %************************************************************************
555 A combination of foldl with zip. It works with equal length lists.
558 foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
560 foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
561 foldl2 _ _ _ _ = panic "Util: foldl2"
563 all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
564 -- True if the lists are the same length, and
565 -- all corresponding elements satisfy the predicate
567 all2 p (x:xs) (y:ys) = p x y && all2 p xs ys
571 Count the number of times a predicate is true
574 count :: (a -> Bool) -> [a] -> Int
576 count p (x:xs) | p x = 1 + count p xs
577 | otherwise = count p xs
580 @splitAt@, @take@, and @drop@ but with length of another
581 list giving the break-off point:
584 takeList :: [b] -> [a] -> [a]
589 (y:ys) -> y : takeList xs ys
591 dropList :: [b] -> [a] -> [a]
593 dropList _ xs@[] = xs
594 dropList (_:xs) (_:ys) = dropList xs ys
597 splitAtList :: [b] -> [a] -> ([a], [a])
598 splitAtList [] xs = ([], xs)
599 splitAtList _ xs@[] = (xs, xs)
600 splitAtList (_:xs) (y:ys) = (y:ys', ys'')
602 (ys', ys'') = splitAtList xs ys
604 snocView :: [a] -> Maybe ([a],a)
605 -- Split off the last element
606 snocView [] = Nothing
607 snocView xs = go [] xs
609 -- Invariant: second arg is non-empty
610 go acc [x] = Just (reverse acc, x)
611 go acc (x:xs) = go (x:acc) xs
612 go _ [] = panic "Util: snocView"
614 split :: Char -> String -> [String]
615 split c s = case rest of
617 _:rest -> chunk : split c rest
618 where (chunk, rest) = break (==c) s
622 %************************************************************************
624 \subsection[Utils-comparison]{Comparisons}
626 %************************************************************************
629 isEqual :: Ordering -> Bool
630 -- Often used in (isEqual (a `compare` b))
635 thenCmp :: Ordering -> Ordering -> Ordering
636 {-# INLINE thenCmp #-}
637 thenCmp EQ ordering = ordering
638 thenCmp ordering _ = ordering
640 eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool
641 eqListBy _ [] [] = True
642 eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys
643 eqListBy _ _ _ = False
645 cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
646 -- `cmpList' uses a user-specified comparer
651 cmpList cmp (a:as) (b:bs)
652 = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }
656 -- This (with a more general type) is Data.List.stripPrefix from GHC 6.8.
657 -- This definition can be removed once we require at least 6.8 to build.
658 maybePrefixMatch :: String -> String -> Maybe String
659 maybePrefixMatch [] rest = Just rest
660 maybePrefixMatch (_:_) [] = Nothing
661 maybePrefixMatch (p:pat) (r:rest)
662 | p == r = maybePrefixMatch pat rest
663 | otherwise = Nothing
665 removeSpaces :: String -> String
666 removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
669 %************************************************************************
671 \subsection[Utils-pairs]{Pairs}
673 %************************************************************************
676 unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
677 unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
681 seqList :: [a] -> b -> b
683 seqList (x:xs) b = x `seq` seqList xs b
689 global :: a -> IORef a
690 global a = unsafePerformIO (newIORef a)
694 consIORef :: IORef [a] -> a -> IO ()
697 writeIORef var (x:xs)
703 looksLikeModuleName :: String -> Bool
704 looksLikeModuleName [] = False
705 looksLikeModuleName (c:cs) = isUpper c && go cs
707 go ('.':cs) = looksLikeModuleName cs
708 go (c:cs) = (isAlphaNum c || c == '_') && go cs
711 Akin to @Prelude.words@, but acts like the Bourne shell, treating
712 quoted strings as Haskell Strings, and also parses Haskell [String]
716 getCmd :: String -> Either String -- Error
717 (String, String) -- (Cmd, Rest)
718 getCmd s = case break isSpace $ dropWhile isSpace s of
719 ([], _) -> Left ("Couldn't find command in " ++ show s)
722 toCmdArgs :: String -> Either String -- Error
723 (String, [String]) -- (Cmd, Args)
724 toCmdArgs s = case getCmd s of
726 Right (cmd, s') -> case toArgs s' of
728 Right args -> Right (cmd, args)
730 toArgs :: String -> Either String -- Error
733 = case dropWhile isSpace str of
734 s@('[':_) -> case reads s of
736 | all isSpace spaces ->
739 Left ("Couldn't read " ++ show str ++ "as [String]")
742 toArgs' s = case dropWhile isSpace s of
744 ('"' : _) -> case reads s of
746 -- rest must either be [] or start with a space
747 | all isSpace (take 1 rest) ->
750 Right args -> Right (arg : args)
752 Left ("Couldn't read " ++ show s ++ "as String")
753 s' -> case break isSpace s' of
754 (arg, s'') -> case toArgs' s'' of
756 Right args -> Right (arg : args)
759 -- -----------------------------------------------------------------------------
763 readRational__ :: ReadS Rational -- NB: doesn't handle leading "-"
764 readRational__ r = do
767 return ((n%1)*10^^(k-d), t)
770 (ds,s) <- lexDecDigits r
771 (ds',t) <- lexDotDigits s
772 return (read (ds++ds'), length ds', t)
774 readExp (e:s) | e `elem` "eE" = readExp' s
775 readExp s = return (0,s)
777 readExp' ('+':s) = readDec s
778 readExp' ('-':s) = do (k,t) <- readDec s
780 readExp' s = readDec s
783 (ds,r) <- nonnull isDigit s
784 return (foldl1 (\n d -> n * 10 + d) [ ord d - ord '0' | d <- ds ],
787 lexDecDigits = nonnull isDigit
789 lexDotDigits ('.':s) = return (span isDigit s)
790 lexDotDigits s = return ("",s)
792 nonnull p s = do (cs@(_:_),t) <- return (span p s)
795 readRational :: String -> Rational -- NB: *does* handle a leading "-"
798 '-' : xs -> - (read_me xs)
802 = case (do { (x,"") <- readRational__ s ; return x }) of
804 [] -> error ("readRational: no parse:" ++ top_s)
805 _ -> error ("readRational: ambiguous parse:" ++ top_s)
808 -----------------------------------------------------------------------------
809 -- Create a hierarchy of directories
811 createDirectoryHierarchy :: FilePath -> IO ()
812 createDirectoryHierarchy dir | isDrive dir = return () -- XXX Hack
813 createDirectoryHierarchy dir = do
814 b <- doesDirectoryExist dir
815 unless b $ do createDirectoryHierarchy (takeDirectory dir)
818 -----------------------------------------------------------------------------
819 -- Verify that the 'dirname' portion of a FilePath exists.
821 doesDirNameExist :: FilePath -> IO Bool
822 doesDirNameExist fpath = case takeDirectory fpath of
823 "" -> return True -- XXX Hack
824 _ -> doesDirectoryExist (takeDirectory fpath)
826 -- -----------------------------------------------------------------------------
829 later :: IO b -> IO a -> IO a
832 handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a
833 handleDyn = flip catchDyn
835 handle :: (Exception -> IO a) -> IO a -> IO a
836 handle h f = f `Exception.catch` \e -> case e of
837 ExitException _ -> throw e
840 -- --------------------------------------------------------------
841 -- check existence & modification time at the same time
843 modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime)
844 modificationTimeIfExists f = do
845 (do t <- getModificationTime f; return (Just t))
846 `IO.catch` \e -> if isDoesNotExistError e
850 -- split a string at the last character where 'pred' is True,
851 -- returning a pair of strings. The first component holds the string
852 -- up (but not including) the last character for which 'pred' returned
853 -- True, the second whatever comes after (but also not including the
856 -- If 'pred' returns False for all characters in the string, the original
857 -- string is returned in the first component (and the second one is just
859 splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
860 splitLongestPrefix str pred
861 | null r_pre = (str, [])
862 | otherwise = (reverse (tail r_pre), reverse r_suf)
863 -- 'tail' drops the char satisfying 'pred'
864 where (r_suf, r_pre) = break pred (reverse str)
866 escapeSpaces :: String -> String
867 escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
871 --------------------------------------------------------------
873 --------------------------------------------------------------
875 -- | The function splits the given string to substrings
876 -- using the 'searchPathSeparator'.
877 parseSearchPath :: String -> [FilePath]
878 parseSearchPath path = split path
880 split :: String -> [String]
884 _:rest -> chunk : split rest
888 #ifdef mingw32_HOST_OS
889 ('\"':xs@(_:_)) | last xs == '\"' -> init xs
893 (chunk', rest') = break (==searchPathSeparator) s
895 -- | A platform-specific character used to separate search path strings in
896 -- environment variables. The separator is a colon (\":\") on Unix and
897 -- Macintosh, and a semicolon (\";\") on the Windows operating system.
898 searchPathSeparator :: Char
899 #if mingw32_HOST_OS || mingw32_TARGET_OS
900 searchPathSeparator = ';'
902 searchPathSeparator = ':'
905 data Direction = Forwards | Backwards
907 reslash :: Direction -> FilePath -> FilePath
909 where f ('/' : xs) = slash : f xs
910 f ('\\' : xs) = slash : f xs
911 f (x : xs) = x : f xs