2 % (c) The University of Glasgow 2006
3 % (c) The University of Glasgow 1992-2002
5 \section[Util]{Highly random utility functions}
9 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?}
112 %************************************************************************
122 ghciTablesNextToCode :: Bool
123 #ifdef GHCI_TABLES_NEXT_TO_CODE
124 ghciTablesNextToCode = True
126 ghciTablesNextToCode = False
136 isWindowsHost :: Bool
137 #ifdef mingw32_HOST_OS
140 isWindowsHost = False
143 isWindowsTarget :: Bool
144 #ifdef mingw32_TARGET_OS
145 isWindowsTarget = True
147 isWindowsTarget = False
150 isDarwinTarget :: Bool
151 #ifdef darwin_TARGET_OS
152 isDarwinTarget = True
154 isDarwinTarget = False
158 %************************************************************************
160 \subsection{A for loop}
162 %************************************************************************
165 -- Compose a function with itself n times. (nth rather than twice)
166 nTimes :: Int -> (a -> a) -> (a -> a)
169 nTimes n f = f . nTimes (n-1) f
172 %************************************************************************
174 \subsection[Utils-lists]{General list processing}
176 %************************************************************************
179 filterOut :: (a->Bool) -> [a] -> [a]
180 -- Like filter, only reverses the sense of the test
182 filterOut p (x:xs) | p x = filterOut p xs
183 | otherwise = x : filterOut p xs
185 partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
186 partitionWith _ [] = ([],[])
187 partitionWith f (x:xs) = case f x of
189 Right c -> (bs, c:cs)
190 where (bs,cs) = partitionWith f xs
192 splitEithers :: [Either a b] -> ([a], [b])
193 splitEithers [] = ([],[])
194 splitEithers (e : es) = case e of
196 Right y -> (xs, y:ys)
197 where (xs,ys) = splitEithers es
200 A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
201 are of equal length. Alastair Reid thinks this should only happen if
202 DEBUGging on; hey, why not?
205 zipEqual :: String -> [a] -> [b] -> [(a,b)]
206 zipWithEqual :: String -> (a->b->c) -> [a]->[b]->[c]
207 zipWith3Equal :: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
208 zipWith4Equal :: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
212 zipWithEqual _ = zipWith
213 zipWith3Equal _ = zipWith3
214 zipWith4Equal _ = zipWith4
216 zipEqual _ [] [] = []
217 zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs
218 zipEqual msg _ _ = panic ("zipEqual: unequal lists:"++msg)
220 zipWithEqual msg z (a:as) (b:bs)= z a b : zipWithEqual msg z as bs
221 zipWithEqual _ _ [] [] = []
222 zipWithEqual msg _ _ _ = panic ("zipWithEqual: unequal lists:"++msg)
224 zipWith3Equal msg z (a:as) (b:bs) (c:cs)
225 = z a b c : zipWith3Equal msg z as bs cs
226 zipWith3Equal _ _ [] [] [] = []
227 zipWith3Equal msg _ _ _ _ = panic ("zipWith3Equal: unequal lists:"++msg)
229 zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)
230 = z a b c d : zipWith4Equal msg z as bs cs ds
231 zipWith4Equal _ _ [] [] [] [] = []
232 zipWith4Equal msg _ _ _ _ _ = panic ("zipWith4Equal: unequal lists:"++msg)
237 -- zipLazy is lazy in the second list (observe the ~)
239 zipLazy :: [a] -> [b] -> [(a,b)]
241 -- We want to write this, but with GHC 6.4 we get a warning, so it
243 -- zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
244 -- so we write this instead:
245 zipLazy (x:xs) zs = let y : ys = zs
246 in (x,y) : zipLazy xs ys
251 stretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]
252 -- (stretchZipWith p z f xs ys) stretches ys by inserting z in
253 -- the places where p returns *True*
255 stretchZipWith _ _ _ [] _ = []
256 stretchZipWith p z f (x:xs) ys
257 | p x = f x z : stretchZipWith p z f xs ys
258 | otherwise = case ys of
260 (y:ys) -> f x y : stretchZipWith p z f xs ys
265 mapFst :: (a->c) -> [(a,b)] -> [(c,b)]
266 mapSnd :: (b->c) -> [(a,b)] -> [(a,c)]
268 mapFst f xys = [(f x, y) | (x,y) <- xys]
269 mapSnd f xys = [(x, f y) | (x,y) <- xys]
271 mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
273 mapAndUnzip _ [] = ([], [])
276 (rs1, rs2) = mapAndUnzip f xs
280 mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
282 mapAndUnzip3 _ [] = ([], [], [])
283 mapAndUnzip3 f (x:xs)
284 = let (r1, r2, r3) = f x
285 (rs1, rs2, rs3) = mapAndUnzip3 f xs
287 (r1:rs1, r2:rs2, r3:rs3)
291 nOfThem :: Int -> a -> [a]
292 nOfThem n thing = replicate n thing
294 -- 'atLength atLen atEnd ls n' unravels list 'ls' to position 'n';
297 -- atLength atLenPred atEndPred ls n
298 -- | n < 0 = atLenPred n
299 -- | length ls < n = atEndPred (n - length ls)
300 -- | otherwise = atLenPred (drop n ls)
302 atLength :: ([a] -> b)
307 atLength atLenPred atEndPred ls n
308 | n < 0 = atEndPred n
309 | otherwise = go n ls
311 go n [] = atEndPred n
312 go 0 ls = atLenPred ls
313 go n (_:xs) = go (n-1) xs
316 lengthExceeds :: [a] -> Int -> Bool
317 -- (lengthExceeds xs n) = (length xs > n)
318 lengthExceeds = atLength notNull (const False)
320 lengthAtLeast :: [a] -> Int -> Bool
321 lengthAtLeast = atLength notNull (== 0)
323 lengthIs :: [a] -> Int -> Bool
324 lengthIs = atLength null (==0)
326 listLengthCmp :: [a] -> Int -> Ordering
327 listLengthCmp = atLength atLen atEnd
331 | x > 0 = LT -- not yet seen 'n' elts, so list length is < n.
337 equalLength :: [a] -> [b] -> Bool
338 equalLength [] [] = True
339 equalLength (_:xs) (_:ys) = equalLength xs ys
340 equalLength _ _ = False
342 compareLength :: [a] -> [b] -> Ordering
343 compareLength [] [] = EQ
344 compareLength (_:xs) (_:ys) = compareLength xs ys
345 compareLength [] _ = LT
346 compareLength _ [] = GT
348 ----------------------------
349 singleton :: a -> [a]
352 isSingleton :: [a] -> Bool
353 isSingleton [_] = True
354 isSingleton _ = False
356 notNull :: [a] -> Bool
366 only _ = panic "Util: only"
369 Debugging/specialising versions of \tr{elem} and \tr{notElem}
372 isIn, isn'tIn :: Eq a => String -> a -> [a] -> Bool
375 isIn _msg x ys = elem__ x ys
376 isn'tIn _msg x ys = notElem__ x ys
378 --these are here to be SPECIALIZEd (automagically)
379 elem__ :: Eq a => a -> [a] -> Bool
381 elem__ x (y:ys) = x == y || elem__ x ys
383 notElem__ :: Eq a => a -> [a] -> Bool
384 notElem__ _ [] = True
385 notElem__ x (y:ys) = x /= y && notElem__ x ys
389 = elem (_ILIT(0)) x ys
393 | i ># _ILIT(100) = trace ("Over-long elem in " ++ msg)
394 (x `List.elem` (y:ys))
395 | otherwise = x == y || elem (i +# _ILIT(1)) x ys
398 = notElem (_ILIT(0)) x ys
400 notElem _ _ [] = True
402 | i ># _ILIT(100) = trace ("Over-long notElem in " ++ msg)
403 (x `List.notElem` (y:ys))
404 | otherwise = x /= y && notElem (i +# _ILIT(1)) x ys
408 %************************************************************************
410 \subsubsection[Utils-Carsten-mergesort]{A mergesort from Carsten}
412 %************************************************************************
415 Date: Mon, 3 May 93 20:45:23 +0200
416 From: Carsten Kehler Holst <kehler@cs.chalmers.se>
417 To: partain@dcs.gla.ac.uk
418 Subject: natural merge sort beats quick sort [ and it is prettier ]
420 Here is a piece of Haskell code that I'm rather fond of. See it as an
421 attempt to get rid of the ridiculous quick-sort routine. group is
422 quite useful by itself I think it was John's idea originally though I
423 believe the lazy version is due to me [surprisingly complicated].
424 gamma [used to be called] is called gamma because I got inspired by
425 the Gamma calculus. It is not very close to the calculus but does
426 behave less sequentially than both foldr and foldl. One could imagine
427 a version of gamma that took a unit element as well thereby avoiding
428 the problem with empty lists.
430 I've tried this code against
432 1) insertion sort - as provided by haskell
433 2) the normal implementation of quick sort
434 3) a deforested version of quick sort due to Jan Sparud
435 4) a super-optimized-quick-sort of Lennart's
437 If the list is partially sorted both merge sort and in particular
438 natural merge sort wins. If the list is random [ average length of
439 rising subsequences = approx 2 ] mergesort still wins and natural
440 merge sort is marginally beaten by Lennart's soqs. The space
441 consumption of merge sort is a bit worse than Lennart's quick sort
442 approx a factor of 2. And a lot worse if Sparud's bug-fix [see his
443 fpca article ] isn't used because of group.
450 group :: (a -> a -> Bool) -> [a] -> [[a]]
451 -- Given a <= function, group finds maximal contiguous up-runs
452 -- or down-runs in the input list.
453 -- It's stable, in the sense that it never re-orders equal elements
455 -- Date: Mon, 12 Feb 1996 15:09:41 +0000
456 -- From: Andy Gill <andy@dcs.gla.ac.uk>
457 -- Here is a `better' definition of group.
460 group p (x:xs) = group' xs x x (x :)
462 group' [] _ _ s = [s []]
463 group' (x:xs) x_min x_max s
464 | x_max `p` x = group' xs x_min x (s . (x :))
465 | not (x_min `p` x) = group' xs x x_max ((x :) . s)
466 | otherwise = s [] : group' xs x x (x :)
467 -- NB: the 'not' is essential for stablity
468 -- x `p` x_min would reverse equal elements
470 generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
471 generalMerge _ xs [] = xs
472 generalMerge _ [] ys = ys
473 generalMerge p (x:xs) (y:ys) | x `p` y = x : generalMerge p xs (y:ys)
474 | otherwise = y : generalMerge p (x:xs) ys
476 -- gamma is now called balancedFold
478 balancedFold :: (a -> a -> a) -> [a] -> a
479 balancedFold _ [] = error "can't reduce an empty list using balancedFold"
480 balancedFold _ [x] = x
481 balancedFold f l = balancedFold f (balancedFold' f l)
483 balancedFold' :: (a -> a -> a) -> [a] -> [a]
484 balancedFold' f (x:y:xs) = f x y : balancedFold' f xs
485 balancedFold' _ xs = xs
487 generalNaturalMergeSort :: (a -> a -> Bool) -> [a] -> [a]
488 generalNaturalMergeSort _ [] = []
489 generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
492 generalMergeSort p [] = []
493 generalMergeSort p xs = (balancedFold (generalMerge p) . map (: [])) xs
495 mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
497 mergeSort = generalMergeSort (<=)
498 naturalMergeSort = generalNaturalMergeSort (<=)
500 mergeSortLe le = generalMergeSort le
503 sortLe :: (a->a->Bool) -> [a] -> [a]
504 sortLe le = generalNaturalMergeSort le
506 sortWith :: Ord b => (a->b) -> [a] -> [a]
507 sortWith get_key xs = sortLe le xs
509 x `le` y = get_key x < get_key y
511 on :: (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering
512 on cmp sel = \x y -> sel x `cmp` sel y
516 %************************************************************************
518 \subsection[Utils-transitive-closure]{Transitive closure}
520 %************************************************************************
522 This algorithm for transitive closure is straightforward, albeit quadratic.
525 transitiveClosure :: (a -> [a]) -- Successor function
526 -> (a -> a -> Bool) -- Equality predicate
528 -> [a] -- The transitive closure
530 transitiveClosure succ eq xs
534 go done (x:xs) | x `is_in` done = go done xs
535 | otherwise = go (x:done) (succ x ++ xs)
538 x `is_in` (y:ys) | eq x y = True
539 | otherwise = x `is_in` ys
542 %************************************************************************
544 \subsection[Utils-accum]{Accumulating}
546 %************************************************************************
548 A combination of foldl with zip. It works with equal length lists.
551 foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
553 foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
554 foldl2 _ _ _ _ = panic "Util: foldl2"
556 all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
557 -- True if the lists are the same length, and
558 -- all corresponding elements satisfy the predicate
560 all2 p (x:xs) (y:ys) = p x y && all2 p xs ys
564 Count the number of times a predicate is true
567 count :: (a -> Bool) -> [a] -> Int
569 count p (x:xs) | p x = 1 + count p xs
570 | otherwise = count p xs
573 @splitAt@, @take@, and @drop@ but with length of another
574 list giving the break-off point:
577 takeList :: [b] -> [a] -> [a]
582 (y:ys) -> y : takeList xs ys
584 dropList :: [b] -> [a] -> [a]
586 dropList _ xs@[] = xs
587 dropList (_:xs) (_:ys) = dropList xs ys
590 splitAtList :: [b] -> [a] -> ([a], [a])
591 splitAtList [] xs = ([], xs)
592 splitAtList _ xs@[] = (xs, xs)
593 splitAtList (_:xs) (y:ys) = (y:ys', ys'')
595 (ys', ys'') = splitAtList xs ys
597 snocView :: [a] -> Maybe ([a],a)
598 -- Split off the last element
599 snocView [] = Nothing
600 snocView xs = go [] xs
602 -- Invariant: second arg is non-empty
603 go acc [x] = Just (reverse acc, x)
604 go acc (x:xs) = go (x:acc) xs
605 go _ [] = panic "Util: snocView"
607 split :: Char -> String -> [String]
608 split c s = case rest of
610 _:rest -> chunk : split c rest
611 where (chunk, rest) = break (==c) s
615 %************************************************************************
617 \subsection[Utils-comparison]{Comparisons}
619 %************************************************************************
622 isEqual :: Ordering -> Bool
623 -- Often used in (isEqual (a `compare` b))
628 thenCmp :: Ordering -> Ordering -> Ordering
629 {-# INLINE thenCmp #-}
630 thenCmp EQ ordering = ordering
631 thenCmp ordering _ = ordering
633 eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool
634 eqListBy _ [] [] = True
635 eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys
636 eqListBy _ _ _ = False
638 cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
639 -- `cmpList' uses a user-specified comparer
644 cmpList cmp (a:as) (b:bs)
645 = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }
649 -- This (with a more general type) is Data.List.stripPrefix from GHC 6.8.
650 -- This definition can be removed once we require at least 6.8 to build.
651 maybePrefixMatch :: String -> String -> Maybe String
652 maybePrefixMatch [] rest = Just rest
653 maybePrefixMatch (_:_) [] = Nothing
654 maybePrefixMatch (p:pat) (r:rest)
655 | p == r = maybePrefixMatch pat rest
656 | otherwise = Nothing
658 removeSpaces :: String -> String
659 removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
662 %************************************************************************
664 \subsection[Utils-pairs]{Pairs}
666 %************************************************************************
669 unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
670 unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
674 seqList :: [a] -> b -> b
676 seqList (x:xs) b = x `seq` seqList xs b
682 global :: a -> IORef a
683 global a = unsafePerformIO (newIORef a)
687 consIORef :: IORef [a] -> a -> IO ()
690 writeIORef var (x:xs)
696 looksLikeModuleName :: String -> Bool
697 looksLikeModuleName [] = False
698 looksLikeModuleName (c:cs) = isUpper c && go cs
700 go ('.':cs) = looksLikeModuleName cs
701 go (c:cs) = (isAlphaNum c || c == '_') && go cs
704 Akin to @Prelude.words@, but acts like the Bourne shell, treating
705 quoted strings as Haskell Strings, and also parses Haskell [String]
709 getCmd :: String -> Either String -- Error
710 (String, String) -- (Cmd, Rest)
711 getCmd s = case break isSpace $ dropWhile isSpace s of
712 ([], _) -> Left ("Couldn't find command in " ++ show s)
715 toCmdArgs :: String -> Either String -- Error
716 (String, [String]) -- (Cmd, Args)
717 toCmdArgs s = case getCmd s of
719 Right (cmd, s') -> case toArgs s' of
721 Right args -> Right (cmd, args)
723 toArgs :: String -> Either String -- Error
726 = case dropWhile isSpace str of
727 s@('[':_) -> case reads s of
729 | all isSpace spaces ->
732 Left ("Couldn't read " ++ show str ++ "as [String]")
735 toArgs' s = case dropWhile isSpace s of
737 ('"' : _) -> case reads s of
739 -- rest must either be [] or start with a space
740 | all isSpace (take 1 rest) ->
743 Right args -> Right (arg : args)
745 Left ("Couldn't read " ++ show s ++ "as String")
746 s' -> case break isSpace s' of
747 (arg, s'') -> case toArgs' s'' of
749 Right args -> Right (arg : args)
752 -- -----------------------------------------------------------------------------
756 readRational__ :: ReadS Rational -- NB: doesn't handle leading "-"
757 readRational__ r = do
760 return ((n%1)*10^^(k-d), t)
763 (ds,s) <- lexDecDigits r
764 (ds',t) <- lexDotDigits s
765 return (read (ds++ds'), length ds', t)
767 readExp (e:s) | e `elem` "eE" = readExp' s
768 readExp s = return (0,s)
770 readExp' ('+':s) = readDec s
771 readExp' ('-':s) = do (k,t) <- readDec s
773 readExp' s = readDec s
776 (ds,r) <- nonnull isDigit s
777 return (foldl1 (\n d -> n * 10 + d) [ ord d - ord '0' | d <- ds ],
780 lexDecDigits = nonnull isDigit
782 lexDotDigits ('.':s) = return (span isDigit s)
783 lexDotDigits s = return ("",s)
785 nonnull p s = do (cs@(_:_),t) <- return (span p s)
788 readRational :: String -> Rational -- NB: *does* handle a leading "-"
791 '-' : xs -> - (read_me xs)
795 = case (do { (x,"") <- readRational__ s ; return x }) of
797 [] -> error ("readRational: no parse:" ++ top_s)
798 _ -> error ("readRational: ambiguous parse:" ++ top_s)
801 -----------------------------------------------------------------------------
802 -- Create a hierarchy of directories
804 createDirectoryHierarchy :: FilePath -> IO ()
805 createDirectoryHierarchy dir | isDrive dir = return () -- XXX Hack
806 createDirectoryHierarchy dir = do
807 b <- doesDirectoryExist dir
808 unless b $ do createDirectoryHierarchy (takeDirectory dir)
811 -----------------------------------------------------------------------------
812 -- Verify that the 'dirname' portion of a FilePath exists.
814 doesDirNameExist :: FilePath -> IO Bool
815 doesDirNameExist fpath = case takeDirectory fpath of
816 "" -> return True -- XXX Hack
817 _ -> doesDirectoryExist (takeDirectory fpath)
819 -- -----------------------------------------------------------------------------
822 later :: IO b -> IO a -> IO a
825 handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a
826 handleDyn = flip catchDyn
828 handle :: (Exception -> IO a) -> IO a -> IO a
829 handle h f = f `Exception.catch` \e -> case e of
830 ExitException _ -> throw e
833 -- --------------------------------------------------------------
834 -- check existence & modification time at the same time
836 modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime)
837 modificationTimeIfExists f = do
838 (do t <- getModificationTime f; return (Just t))
839 `IO.catch` \e -> if isDoesNotExistError e
843 -- split a string at the last character where 'pred' is True,
844 -- returning a pair of strings. The first component holds the string
845 -- up (but not including) the last character for which 'pred' returned
846 -- True, the second whatever comes after (but also not including the
849 -- If 'pred' returns False for all characters in the string, the original
850 -- string is returned in the first component (and the second one is just
852 splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
853 splitLongestPrefix str pred
854 | null r_pre = (str, [])
855 | otherwise = (reverse (tail r_pre), reverse r_suf)
856 -- 'tail' drops the char satisfying 'pred'
857 where (r_suf, r_pre) = break pred (reverse str)
859 escapeSpaces :: String -> String
860 escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
864 --------------------------------------------------------------
866 --------------------------------------------------------------
868 -- | The function splits the given string to substrings
869 -- using the 'searchPathSeparator'.
870 parseSearchPath :: String -> [FilePath]
871 parseSearchPath path = split path
873 split :: String -> [String]
877 _:rest -> chunk : split rest
881 #ifdef mingw32_HOST_OS
882 ('\"':xs@(_:_)) | last xs == '\"' -> init xs
886 (chunk', rest') = break (==searchPathSeparator) s
888 -- | A platform-specific character used to separate search path strings in
889 -- environment variables. The separator is a colon (\":\") on Unix and
890 -- Macintosh, and a semicolon (\";\") on the Windows operating system.
891 searchPathSeparator :: Char
892 #if mingw32_HOST_OS || mingw32_TARGET_OS
893 searchPathSeparator = ';'
895 searchPathSeparator = ':'
898 data Direction = Forwards | Backwards
900 reslash :: Direction -> FilePath -> FilePath
902 where f ('/' : xs) = slash : f xs
903 f ('\\' : xs) = slash : f xs
904 f (x : xs) = x : f xs