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 foldl1' was added in GHC 6.4
411 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 604
412 foldl1' :: (a -> a -> a) -> [a] -> a
413 foldl1' f (x:xs) = foldl' f x xs
414 foldl1' _ [] = panic "foldl1'"
418 %************************************************************************
420 \subsubsection[Utils-Carsten-mergesort]{A mergesort from Carsten}
422 %************************************************************************
425 Date: Mon, 3 May 93 20:45:23 +0200
426 From: Carsten Kehler Holst <kehler@cs.chalmers.se>
427 To: partain@dcs.gla.ac.uk
428 Subject: natural merge sort beats quick sort [ and it is prettier ]
430 Here is a piece of Haskell code that I'm rather fond of. See it as an
431 attempt to get rid of the ridiculous quick-sort routine. group is
432 quite useful by itself I think it was John's idea originally though I
433 believe the lazy version is due to me [surprisingly complicated].
434 gamma [used to be called] is called gamma because I got inspired by
435 the Gamma calculus. It is not very close to the calculus but does
436 behave less sequentially than both foldr and foldl. One could imagine
437 a version of gamma that took a unit element as well thereby avoiding
438 the problem with empty lists.
440 I've tried this code against
442 1) insertion sort - as provided by haskell
443 2) the normal implementation of quick sort
444 3) a deforested version of quick sort due to Jan Sparud
445 4) a super-optimized-quick-sort of Lennart's
447 If the list is partially sorted both merge sort and in particular
448 natural merge sort wins. If the list is random [ average length of
449 rising subsequences = approx 2 ] mergesort still wins and natural
450 merge sort is marginally beaten by Lennart's soqs. The space
451 consumption of merge sort is a bit worse than Lennart's quick sort
452 approx a factor of 2. And a lot worse if Sparud's bug-fix [see his
453 fpca article ] isn't used because of group.
460 group :: (a -> a -> Bool) -> [a] -> [[a]]
461 -- Given a <= function, group finds maximal contiguous up-runs
462 -- or down-runs in the input list.
463 -- It's stable, in the sense that it never re-orders equal elements
465 -- Date: Mon, 12 Feb 1996 15:09:41 +0000
466 -- From: Andy Gill <andy@dcs.gla.ac.uk>
467 -- Here is a `better' definition of group.
470 group p (x:xs) = group' xs x x (x :)
472 group' [] _ _ s = [s []]
473 group' (x:xs) x_min x_max s
474 | x_max `p` x = group' xs x_min x (s . (x :))
475 | not (x_min `p` x) = group' xs x x_max ((x :) . s)
476 | otherwise = s [] : group' xs x x (x :)
477 -- NB: the 'not' is essential for stablity
478 -- x `p` x_min would reverse equal elements
480 generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
481 generalMerge _ xs [] = xs
482 generalMerge _ [] ys = ys
483 generalMerge p (x:xs) (y:ys) | x `p` y = x : generalMerge p xs (y:ys)
484 | otherwise = y : generalMerge p (x:xs) ys
486 -- gamma is now called balancedFold
488 balancedFold :: (a -> a -> a) -> [a] -> a
489 balancedFold _ [] = error "can't reduce an empty list using balancedFold"
490 balancedFold _ [x] = x
491 balancedFold f l = balancedFold f (balancedFold' f l)
493 balancedFold' :: (a -> a -> a) -> [a] -> [a]
494 balancedFold' f (x:y:xs) = f x y : balancedFold' f xs
495 balancedFold' _ xs = xs
497 generalNaturalMergeSort :: (a -> a -> Bool) -> [a] -> [a]
498 generalNaturalMergeSort _ [] = []
499 generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
502 generalMergeSort p [] = []
503 generalMergeSort p xs = (balancedFold (generalMerge p) . map (: [])) xs
505 mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
507 mergeSort = generalMergeSort (<=)
508 naturalMergeSort = generalNaturalMergeSort (<=)
510 mergeSortLe le = generalMergeSort le
513 sortLe :: (a->a->Bool) -> [a] -> [a]
514 sortLe le = generalNaturalMergeSort le
516 sortWith :: Ord b => (a->b) -> [a] -> [a]
517 sortWith get_key xs = sortLe le xs
519 x `le` y = get_key x < get_key y
521 on :: (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering
522 on cmp sel = \x y -> sel x `cmp` sel y
526 %************************************************************************
528 \subsection[Utils-transitive-closure]{Transitive closure}
530 %************************************************************************
532 This algorithm for transitive closure is straightforward, albeit quadratic.
535 transitiveClosure :: (a -> [a]) -- Successor function
536 -> (a -> a -> Bool) -- Equality predicate
538 -> [a] -- The transitive closure
540 transitiveClosure succ eq xs
544 go done (x:xs) | x `is_in` done = go done xs
545 | otherwise = go (x:done) (succ x ++ xs)
548 x `is_in` (y:ys) | eq x y = True
549 | otherwise = x `is_in` ys
552 %************************************************************************
554 \subsection[Utils-accum]{Accumulating}
556 %************************************************************************
558 A combination of foldl with zip. It works with equal length lists.
561 foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
563 foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
564 foldl2 _ _ _ _ = panic "Util: foldl2"
566 all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
567 -- True if the lists are the same length, and
568 -- all corresponding elements satisfy the predicate
570 all2 p (x:xs) (y:ys) = p x y && all2 p xs ys
574 Count the number of times a predicate is true
577 count :: (a -> Bool) -> [a] -> Int
579 count p (x:xs) | p x = 1 + count p xs
580 | otherwise = count p xs
583 @splitAt@, @take@, and @drop@ but with length of another
584 list giving the break-off point:
587 takeList :: [b] -> [a] -> [a]
592 (y:ys) -> y : takeList xs ys
594 dropList :: [b] -> [a] -> [a]
596 dropList _ xs@[] = xs
597 dropList (_:xs) (_:ys) = dropList xs ys
600 splitAtList :: [b] -> [a] -> ([a], [a])
601 splitAtList [] xs = ([], xs)
602 splitAtList _ xs@[] = (xs, xs)
603 splitAtList (_:xs) (y:ys) = (y:ys', ys'')
605 (ys', ys'') = splitAtList xs ys
607 snocView :: [a] -> Maybe ([a],a)
608 -- Split off the last element
609 snocView [] = Nothing
610 snocView xs = go [] xs
612 -- Invariant: second arg is non-empty
613 go acc [x] = Just (reverse acc, x)
614 go acc (x:xs) = go (x:acc) xs
615 go _ [] = panic "Util: snocView"
617 split :: Char -> String -> [String]
618 split c s = case rest of
620 _:rest -> chunk : split c rest
621 where (chunk, rest) = break (==c) s
625 %************************************************************************
627 \subsection[Utils-comparison]{Comparisons}
629 %************************************************************************
632 isEqual :: Ordering -> Bool
633 -- Often used in (isEqual (a `compare` b))
638 thenCmp :: Ordering -> Ordering -> Ordering
639 {-# INLINE thenCmp #-}
640 thenCmp EQ ordering = ordering
641 thenCmp ordering _ = ordering
643 eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool
644 eqListBy _ [] [] = True
645 eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys
646 eqListBy _ _ _ = False
648 cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
649 -- `cmpList' uses a user-specified comparer
654 cmpList cmp (a:as) (b:bs)
655 = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }
659 -- This (with a more general type) is Data.List.stripPrefix from GHC 6.8.
660 -- This definition can be removed once we require at least 6.8 to build.
661 maybePrefixMatch :: String -> String -> Maybe String
662 maybePrefixMatch [] rest = Just rest
663 maybePrefixMatch (_:_) [] = Nothing
664 maybePrefixMatch (p:pat) (r:rest)
665 | p == r = maybePrefixMatch pat rest
666 | otherwise = Nothing
668 removeSpaces :: String -> String
669 removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
672 %************************************************************************
674 \subsection[Utils-pairs]{Pairs}
676 %************************************************************************
679 unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
680 unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
684 seqList :: [a] -> b -> b
686 seqList (x:xs) b = x `seq` seqList xs b
692 global :: a -> IORef a
693 global a = unsafePerformIO (newIORef a)
697 consIORef :: IORef [a] -> a -> IO ()
700 writeIORef var (x:xs)
706 looksLikeModuleName :: String -> Bool
707 looksLikeModuleName [] = False
708 looksLikeModuleName (c:cs) = isUpper c && go cs
710 go ('.':cs) = looksLikeModuleName cs
711 go (c:cs) = (isAlphaNum c || c == '_') && go cs
714 Akin to @Prelude.words@, but acts like the Bourne shell, treating
715 quoted strings as Haskell Strings, and also parses Haskell [String]
719 getCmd :: String -> Either String -- Error
720 (String, String) -- (Cmd, Rest)
721 getCmd s = case break isSpace $ dropWhile isSpace s of
722 ([], _) -> Left ("Couldn't find command in " ++ show s)
725 toCmdArgs :: String -> Either String -- Error
726 (String, [String]) -- (Cmd, Args)
727 toCmdArgs s = case getCmd s of
729 Right (cmd, s') -> case toArgs s' of
731 Right args -> Right (cmd, args)
733 toArgs :: String -> Either String -- Error
736 = case dropWhile isSpace str of
737 s@('[':_) -> case reads s of
739 | all isSpace spaces ->
742 Left ("Couldn't read " ++ show str ++ "as [String]")
745 toArgs' s = case dropWhile isSpace s of
747 ('"' : _) -> case reads s of
749 -- rest must either be [] or start with a space
750 | all isSpace (take 1 rest) ->
753 Right args -> Right (arg : args)
755 Left ("Couldn't read " ++ show s ++ "as String")
756 s' -> case break isSpace s' of
757 (arg, s'') -> case toArgs' s'' of
759 Right args -> Right (arg : args)
762 -- -----------------------------------------------------------------------------
766 readRational__ :: ReadS Rational -- NB: doesn't handle leading "-"
767 readRational__ r = do
770 return ((n%1)*10^^(k-d), t)
773 (ds,s) <- lexDecDigits r
774 (ds',t) <- lexDotDigits s
775 return (read (ds++ds'), length ds', t)
777 readExp (e:s) | e `elem` "eE" = readExp' s
778 readExp s = return (0,s)
780 readExp' ('+':s) = readDec s
781 readExp' ('-':s) = do (k,t) <- readDec s
783 readExp' s = readDec s
786 (ds,r) <- nonnull isDigit s
787 return (foldl1 (\n d -> n * 10 + d) [ ord d - ord '0' | d <- ds ],
790 lexDecDigits = nonnull isDigit
792 lexDotDigits ('.':s) = return (span isDigit s)
793 lexDotDigits s = return ("",s)
795 nonnull p s = do (cs@(_:_),t) <- return (span p s)
798 readRational :: String -> Rational -- NB: *does* handle a leading "-"
801 '-' : xs -> - (read_me xs)
805 = case (do { (x,"") <- readRational__ s ; return x }) of
807 [] -> error ("readRational: no parse:" ++ top_s)
808 _ -> error ("readRational: ambiguous parse:" ++ top_s)
811 -----------------------------------------------------------------------------
812 -- Create a hierarchy of directories
814 createDirectoryHierarchy :: FilePath -> IO ()
815 createDirectoryHierarchy dir | isDrive dir = return () -- XXX Hack
816 createDirectoryHierarchy dir = do
817 b <- doesDirectoryExist dir
818 unless b $ do createDirectoryHierarchy (takeDirectory dir)
821 -----------------------------------------------------------------------------
822 -- Verify that the 'dirname' portion of a FilePath exists.
824 doesDirNameExist :: FilePath -> IO Bool
825 doesDirNameExist fpath = case takeDirectory fpath of
826 "" -> return True -- XXX Hack
827 _ -> doesDirectoryExist (takeDirectory fpath)
829 -- -----------------------------------------------------------------------------
832 later :: IO b -> IO a -> IO a
835 handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a
836 handleDyn = flip catchDyn
838 handle :: (Exception -> IO a) -> IO a -> IO a
839 handle h f = f `Exception.catch` \e -> case e of
840 ExitException _ -> throw e
843 -- --------------------------------------------------------------
844 -- check existence & modification time at the same time
846 modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime)
847 modificationTimeIfExists f = do
848 (do t <- getModificationTime f; return (Just t))
849 `IO.catch` \e -> if isDoesNotExistError e
853 -- split a string at the last character where 'pred' is True,
854 -- returning a pair of strings. The first component holds the string
855 -- up (but not including) the last character for which 'pred' returned
856 -- True, the second whatever comes after (but also not including the
859 -- If 'pred' returns False for all characters in the string, the original
860 -- string is returned in the first component (and the second one is just
862 splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
863 splitLongestPrefix str pred
864 | null r_pre = (str, [])
865 | otherwise = (reverse (tail r_pre), reverse r_suf)
866 -- 'tail' drops the char satisfying 'pred'
867 where (r_suf, r_pre) = break pred (reverse str)
869 escapeSpaces :: String -> String
870 escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
874 --------------------------------------------------------------
876 --------------------------------------------------------------
878 -- | The function splits the given string to substrings
879 -- using the 'searchPathSeparator'.
880 parseSearchPath :: String -> [FilePath]
881 parseSearchPath path = split path
883 split :: String -> [String]
887 _:rest -> chunk : split rest
891 #ifdef mingw32_HOST_OS
892 ('\"':xs@(_:_)) | last xs == '\"' -> init xs
896 (chunk', rest') = break (==searchPathSeparator) s
898 -- | A platform-specific character used to separate search path strings in
899 -- environment variables. The separator is a colon (\":\") on Unix and
900 -- Macintosh, and a semicolon (\";\") on the Windows operating system.
901 searchPathSeparator :: Char
902 #if mingw32_HOST_OS || mingw32_TARGET_OS
903 searchPathSeparator = ';'
905 searchPathSeparator = ':'
908 data Direction = Forwards | Backwards
910 reslash :: Direction -> FilePath -> FilePath
912 where f ('/' : xs) = slash : f xs
913 f ('\\' : xs) = slash : f xs
914 f (x : xs) = x : f xs