2 % (c) The University of Glasgow 2006
3 % (c) The University of Glasgow 1992-2002
7 -- | Highly random utility functions
9 -- * Flags dependent on the compiler build
10 ghciSupported, debugIsOn, ghciTablesNextToCode, isDynamicGhcLib,
11 isWindowsHost, isWindowsTarget, isDarwinTarget,
13 -- * General list processing
14 zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
15 zipLazy, stretchZipWith,
20 mapAndUnzip, mapAndUnzip3,
21 nOfThem, filterOut, partitionWith, splitEithers,
23 foldl1', foldl2, count, all2,
25 lengthExceeds, lengthIs, lengthAtLeast,
26 listLengthCmp, atLength, equalLength, compareLength,
28 isSingleton, only, singleton,
34 fstOf3, sndOf3, thirdOf3,
36 -- * List operations controlled by another list
37 takeList, dropList, splitAtList, split,
51 -- * Transitive closures
60 -- * Argument processing
61 getCmd, toCmdArgs, toArgs,
67 createDirectoryHierarchy,
69 modificationTimeIfExists,
71 global, consIORef, globalMVar, globalEmptyMVar,
73 -- * Filenames and paths
78 Direction(..), reslash,
80 -- * Utils for defining Data instances
81 abstractConstr, abstractDataType, mkNoRepType
84 #include "HsVersions.h"
89 import Data.IORef ( IORef, newIORef, atomicModifyIORef )
90 import System.IO.Unsafe ( unsafePerformIO )
91 import Data.List hiding (group)
92 import Control.Concurrent.MVar ( MVar, newMVar, newEmptyMVar )
98 import Control.Monad ( unless )
99 import System.IO.Error as IO ( catch, isDoesNotExistError )
100 import System.Directory ( doesDirectoryExist, createDirectory,
101 getModificationTime )
102 import System.FilePath
103 import Data.Char ( isUpper, isAlphaNum, isSpace, ord, isDigit )
104 import Data.Ratio ( (%) )
105 import System.Time ( ClockTime )
110 %************************************************************************
112 \subsection{Is DEBUG on, are we on Windows, etc?}
114 %************************************************************************
116 These booleans are global constants, set by CPP flags. They allow us to
117 recompile a single module (this one) to change whether or not debug output
118 appears. They sometimes let us avoid even running CPP elsewhere.
120 It's important that the flags are literal constants (True/False). Then,
121 with -0, tests of the flags in other modules will simplify to the correct
122 branch of the conditional, thereby dropping debug code altogether when
126 ghciSupported :: Bool
130 ghciSupported = False
140 ghciTablesNextToCode :: Bool
141 #ifdef GHCI_TABLES_NEXT_TO_CODE
142 ghciTablesNextToCode = True
144 ghciTablesNextToCode = False
147 isDynamicGhcLib :: Bool
149 isDynamicGhcLib = True
151 isDynamicGhcLib = False
154 isWindowsHost :: Bool
155 #ifdef mingw32_HOST_OS
158 isWindowsHost = False
161 isWindowsTarget :: Bool
162 #ifdef mingw32_TARGET_OS
163 isWindowsTarget = True
165 isWindowsTarget = False
168 isDarwinTarget :: Bool
169 #ifdef darwin_TARGET_OS
170 isDarwinTarget = True
172 isDarwinTarget = False
176 %************************************************************************
178 \subsection{A for loop}
180 %************************************************************************
183 -- | Compose a function with itself n times. (nth rather than twice)
184 nTimes :: Int -> (a -> a) -> (a -> a)
187 nTimes n f = f . nTimes (n-1) f
191 fstOf3 :: (a,b,c) -> a
192 sndOf3 :: (a,b,c) -> b
193 thirdOf3 :: (a,b,c) -> c
199 %************************************************************************
201 \subsection[Utils-lists]{General list processing}
203 %************************************************************************
206 filterOut :: (a->Bool) -> [a] -> [a]
207 -- ^ Like filter, only it reverses the sense of the test
209 filterOut p (x:xs) | p x = filterOut p xs
210 | otherwise = x : filterOut p xs
212 partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
213 -- ^ Uses a function to determine which of two output lists an input element should join
214 partitionWith _ [] = ([],[])
215 partitionWith f (x:xs) = case f x of
217 Right c -> (bs, c:cs)
218 where (bs,cs) = partitionWith f xs
220 splitEithers :: [Either a b] -> ([a], [b])
221 -- ^ Teases a list of 'Either's apart into two lists
222 splitEithers [] = ([],[])
223 splitEithers (e : es) = case e of
225 Right y -> (xs, y:ys)
226 where (xs,ys) = splitEithers es
229 A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
230 are of equal length. Alastair Reid thinks this should only happen if
231 DEBUGging on; hey, why not?
234 zipEqual :: String -> [a] -> [b] -> [(a,b)]
235 zipWithEqual :: String -> (a->b->c) -> [a]->[b]->[c]
236 zipWith3Equal :: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
237 zipWith4Equal :: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
241 zipWithEqual _ = zipWith
242 zipWith3Equal _ = zipWith3
243 zipWith4Equal _ = zipWith4
245 zipEqual _ [] [] = []
246 zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs
247 zipEqual msg _ _ = panic ("zipEqual: unequal lists:"++msg)
249 zipWithEqual msg z (a:as) (b:bs)= z a b : zipWithEqual msg z as bs
250 zipWithEqual _ _ [] [] = []
251 zipWithEqual msg _ _ _ = panic ("zipWithEqual: unequal lists:"++msg)
253 zipWith3Equal msg z (a:as) (b:bs) (c:cs)
254 = z a b c : zipWith3Equal msg z as bs cs
255 zipWith3Equal _ _ [] [] [] = []
256 zipWith3Equal msg _ _ _ _ = panic ("zipWith3Equal: unequal lists:"++msg)
258 zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)
259 = z a b c d : zipWith4Equal msg z as bs cs ds
260 zipWith4Equal _ _ [] [] [] [] = []
261 zipWith4Equal msg _ _ _ _ _ = panic ("zipWith4Equal: unequal lists:"++msg)
266 -- | 'zipLazy' is a kind of 'zip' that is lazy in the second list (observe the ~)
267 zipLazy :: [a] -> [b] -> [(a,b)]
269 -- We want to write this, but with GHC 6.4 we get a warning, so it
271 -- zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
272 -- so we write this instead:
273 zipLazy (x:xs) zs = let y : ys = zs
274 in (x,y) : zipLazy xs ys
279 stretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]
280 -- ^ @stretchZipWith p z f xs ys@ stretches @ys@ by inserting @z@ in
281 -- the places where @p@ returns @True@
283 stretchZipWith _ _ _ [] _ = []
284 stretchZipWith p z f (x:xs) ys
285 | p x = f x z : stretchZipWith p z f xs ys
286 | otherwise = case ys of
288 (y:ys) -> f x y : stretchZipWith p z f xs ys
293 mapFst :: (a->c) -> [(a,b)] -> [(c,b)]
294 mapSnd :: (b->c) -> [(a,b)] -> [(a,c)]
296 mapFst f xys = [(f x, y) | (x,y) <- xys]
297 mapSnd f xys = [(x, f y) | (x,y) <- xys]
299 mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
301 mapAndUnzip _ [] = ([], [])
304 (rs1, rs2) = mapAndUnzip f xs
308 mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
310 mapAndUnzip3 _ [] = ([], [], [])
311 mapAndUnzip3 f (x:xs)
312 = let (r1, r2, r3) = f x
313 (rs1, rs2, rs3) = mapAndUnzip3 f xs
315 (r1:rs1, r2:rs2, r3:rs3)
319 nOfThem :: Int -> a -> [a]
320 nOfThem n thing = replicate n thing
322 -- | @atLength atLen atEnd ls n@ unravels list @ls@ to position @n@. Precisely:
325 -- atLength atLenPred atEndPred ls n
326 -- | n < 0 = atLenPred n
327 -- | length ls < n = atEndPred (n - length ls)
328 -- | otherwise = atLenPred (drop n ls)
330 atLength :: ([a] -> b)
335 atLength atLenPred atEndPred ls n
336 | n < 0 = atEndPred n
337 | otherwise = go n ls
339 go n [] = atEndPred n
340 go 0 ls = atLenPred ls
341 go n (_:xs) = go (n-1) xs
343 -- Some special cases of atLength:
345 lengthExceeds :: [a] -> Int -> Bool
346 -- ^ > (lengthExceeds xs n) = (length xs > n)
347 lengthExceeds = atLength notNull (const False)
349 lengthAtLeast :: [a] -> Int -> Bool
350 lengthAtLeast = atLength notNull (== 0)
352 lengthIs :: [a] -> Int -> Bool
353 lengthIs = atLength null (==0)
355 listLengthCmp :: [a] -> Int -> Ordering
356 listLengthCmp = atLength atLen atEnd
360 | x > 0 = LT -- not yet seen 'n' elts, so list length is < n.
366 equalLength :: [a] -> [b] -> Bool
367 equalLength [] [] = True
368 equalLength (_:xs) (_:ys) = equalLength xs ys
369 equalLength _ _ = False
371 compareLength :: [a] -> [b] -> Ordering
372 compareLength [] [] = EQ
373 compareLength (_:xs) (_:ys) = compareLength xs ys
374 compareLength [] _ = LT
375 compareLength _ [] = GT
377 ----------------------------
378 singleton :: a -> [a]
381 isSingleton :: [a] -> Bool
382 isSingleton [_] = True
383 isSingleton _ = False
385 notNull :: [a] -> Bool
395 only _ = panic "Util: only"
398 Debugging/specialising versions of \tr{elem} and \tr{notElem}
401 isIn, isn'tIn :: Eq a => String -> a -> [a] -> Bool
404 isIn _msg x ys = x `elem` ys
405 isn'tIn _msg x ys = x `notElem` ys
409 = elem100 (_ILIT(0)) x ys
411 elem100 _ _ [] = False
413 | i ># _ILIT(100) = trace ("Over-long elem in " ++ msg)
415 | otherwise = x == y || elem100 (i +# _ILIT(1)) x ys
418 = notElem100 (_ILIT(0)) x ys
420 notElem100 _ _ [] = True
421 notElem100 i x (y:ys)
422 | i ># _ILIT(100) = trace ("Over-long notElem in " ++ msg)
424 | otherwise = x /= y && notElem100 (i +# _ILIT(1)) x ys
428 %************************************************************************
430 \subsubsection[Utils-Carsten-mergesort]{A mergesort from Carsten}
432 %************************************************************************
435 Date: Mon, 3 May 93 20:45:23 +0200
436 From: Carsten Kehler Holst <kehler@cs.chalmers.se>
437 To: partain@dcs.gla.ac.uk
438 Subject: natural merge sort beats quick sort [ and it is prettier ]
440 Here is a piece of Haskell code that I'm rather fond of. See it as an
441 attempt to get rid of the ridiculous quick-sort routine. group is
442 quite useful by itself I think it was John's idea originally though I
443 believe the lazy version is due to me [surprisingly complicated].
444 gamma [used to be called] is called gamma because I got inspired by
445 the Gamma calculus. It is not very close to the calculus but does
446 behave less sequentially than both foldr and foldl. One could imagine
447 a version of gamma that took a unit element as well thereby avoiding
448 the problem with empty lists.
450 I've tried this code against
452 1) insertion sort - as provided by haskell
453 2) the normal implementation of quick sort
454 3) a deforested version of quick sort due to Jan Sparud
455 4) a super-optimized-quick-sort of Lennart's
457 If the list is partially sorted both merge sort and in particular
458 natural merge sort wins. If the list is random [ average length of
459 rising subsequences = approx 2 ] mergesort still wins and natural
460 merge sort is marginally beaten by Lennart's soqs. The space
461 consumption of merge sort is a bit worse than Lennart's quick sort
462 approx a factor of 2. And a lot worse if Sparud's bug-fix [see his
463 fpca article ] isn't used because of group.
470 group :: (a -> a -> Bool) -> [a] -> [[a]]
471 -- Given a <= function, group finds maximal contiguous up-runs
472 -- or down-runs in the input list.
473 -- It's stable, in the sense that it never re-orders equal elements
475 -- Date: Mon, 12 Feb 1996 15:09:41 +0000
476 -- From: Andy Gill <andy@dcs.gla.ac.uk>
477 -- Here is a `better' definition of group.
480 group p (x:xs) = group' xs x x (x :)
482 group' [] _ _ s = [s []]
483 group' (x:xs) x_min x_max s
484 | x_max `p` x = group' xs x_min x (s . (x :))
485 | not (x_min `p` x) = group' xs x x_max ((x :) . s)
486 | otherwise = s [] : group' xs x x (x :)
487 -- NB: the 'not' is essential for stablity
488 -- x `p` x_min would reverse equal elements
490 generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
491 generalMerge _ xs [] = xs
492 generalMerge _ [] ys = ys
493 generalMerge p (x:xs) (y:ys) | x `p` y = x : generalMerge p xs (y:ys)
494 | otherwise = y : generalMerge p (x:xs) ys
496 -- gamma is now called balancedFold
498 balancedFold :: (a -> a -> a) -> [a] -> a
499 balancedFold _ [] = error "can't reduce an empty list using balancedFold"
500 balancedFold _ [x] = x
501 balancedFold f l = balancedFold f (balancedFold' f l)
503 balancedFold' :: (a -> a -> a) -> [a] -> [a]
504 balancedFold' f (x:y:xs) = f x y : balancedFold' f xs
505 balancedFold' _ xs = xs
507 generalNaturalMergeSort :: (a -> a -> Bool) -> [a] -> [a]
508 generalNaturalMergeSort _ [] = []
509 generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
512 generalMergeSort p [] = []
513 generalMergeSort p xs = (balancedFold (generalMerge p) . map (: [])) xs
515 mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
517 mergeSort = generalMergeSort (<=)
518 naturalMergeSort = generalNaturalMergeSort (<=)
520 mergeSortLe le = generalMergeSort le
523 sortLe :: (a->a->Bool) -> [a] -> [a]
524 sortLe le = generalNaturalMergeSort le
526 sortWith :: Ord b => (a->b) -> [a] -> [a]
527 sortWith get_key xs = sortLe le xs
529 x `le` y = get_key x < get_key y
531 on :: (a -> a -> c) -> (b -> a) -> b -> b -> c
532 on cmp sel = \x y -> sel x `cmp` sel y
536 %************************************************************************
538 \subsection[Utils-transitive-closure]{Transitive closure}
540 %************************************************************************
542 This algorithm for transitive closure is straightforward, albeit quadratic.
545 transitiveClosure :: (a -> [a]) -- Successor function
546 -> (a -> a -> Bool) -- Equality predicate
548 -> [a] -- The transitive closure
550 transitiveClosure succ eq xs
554 go done (x:xs) | x `is_in` done = go done xs
555 | otherwise = go (x:done) (succ x ++ xs)
558 x `is_in` (y:ys) | eq x y = True
559 | otherwise = x `is_in` ys
562 %************************************************************************
564 \subsection[Utils-accum]{Accumulating}
566 %************************************************************************
568 A combination of foldl with zip. It works with equal length lists.
571 foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
573 foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
574 foldl2 _ _ _ _ = panic "Util: foldl2"
576 all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
577 -- True if the lists are the same length, and
578 -- all corresponding elements satisfy the predicate
580 all2 p (x:xs) (y:ys) = p x y && all2 p xs ys
584 Count the number of times a predicate is true
587 count :: (a -> Bool) -> [a] -> Int
589 count p (x:xs) | p x = 1 + count p xs
590 | otherwise = count p xs
593 @splitAt@, @take@, and @drop@ but with length of another
594 list giving the break-off point:
597 takeList :: [b] -> [a] -> [a]
602 (y:ys) -> y : takeList xs ys
604 dropList :: [b] -> [a] -> [a]
606 dropList _ xs@[] = xs
607 dropList (_:xs) (_:ys) = dropList xs ys
610 splitAtList :: [b] -> [a] -> ([a], [a])
611 splitAtList [] xs = ([], xs)
612 splitAtList _ xs@[] = (xs, xs)
613 splitAtList (_:xs) (y:ys) = (y:ys', ys'')
615 (ys', ys'') = splitAtList xs ys
617 -- drop from the end of a list
618 dropTail :: Int -> [a] -> [a]
619 dropTail n = reverse . drop n . reverse
621 snocView :: [a] -> Maybe ([a],a)
622 -- Split off the last element
623 snocView [] = Nothing
624 snocView xs = go [] xs
626 -- Invariant: second arg is non-empty
627 go acc [x] = Just (reverse acc, x)
628 go acc (x:xs) = go (x:acc) xs
629 go _ [] = panic "Util: snocView"
631 split :: Char -> String -> [String]
632 split c s = case rest of
634 _:rest -> chunk : split c rest
635 where (chunk, rest) = break (==c) s
639 %************************************************************************
641 \subsection[Utils-comparison]{Comparisons}
643 %************************************************************************
646 isEqual :: Ordering -> Bool
647 -- Often used in (isEqual (a `compare` b))
652 thenCmp :: Ordering -> Ordering -> Ordering
653 {-# INLINE thenCmp #-}
654 thenCmp EQ ordering = ordering
655 thenCmp ordering _ = ordering
657 eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool
658 eqListBy _ [] [] = True
659 eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys
660 eqListBy _ _ _ = False
662 cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
663 -- `cmpList' uses a user-specified comparer
668 cmpList cmp (a:as) (b:bs)
669 = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }
673 removeSpaces :: String -> String
674 removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
677 %************************************************************************
679 \subsection[Utils-pairs]{Pairs}
681 %************************************************************************
684 unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
685 unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
689 seqList :: [a] -> b -> b
691 seqList (x:xs) b = x `seq` seqList xs b
697 global :: a -> IORef a
698 global a = unsafePerformIO (newIORef a)
702 consIORef :: IORef [a] -> a -> IO ()
704 atomicModifyIORef var (\xs -> (x:xs,()))
708 globalMVar :: a -> MVar a
709 globalMVar a = unsafePerformIO (newMVar a)
711 globalEmptyMVar :: MVar a
712 globalEmptyMVar = unsafePerformIO newEmptyMVar
718 looksLikeModuleName :: String -> Bool
719 looksLikeModuleName [] = False
720 looksLikeModuleName (c:cs) = isUpper c && go cs
722 go ('.':cs) = looksLikeModuleName cs
723 go (c:cs) = (isAlphaNum c || c == '_') && go cs
726 Akin to @Prelude.words@, but acts like the Bourne shell, treating
727 quoted strings as Haskell Strings, and also parses Haskell [String]
731 getCmd :: String -> Either String -- Error
732 (String, String) -- (Cmd, Rest)
733 getCmd s = case break isSpace $ dropWhile isSpace s of
734 ([], _) -> Left ("Couldn't find command in " ++ show s)
737 toCmdArgs :: String -> Either String -- Error
738 (String, [String]) -- (Cmd, Args)
739 toCmdArgs s = case getCmd s of
741 Right (cmd, s') -> case toArgs s' of
743 Right args -> Right (cmd, args)
745 toArgs :: String -> Either String -- Error
748 = case dropWhile isSpace str of
749 s@('[':_) -> case reads s of
751 | all isSpace spaces ->
754 Left ("Couldn't read " ++ show str ++ "as [String]")
757 toArgs' s = case dropWhile isSpace s of
759 ('"' : _) -> case reads s of
761 -- rest must either be [] or start with a space
762 | all isSpace (take 1 rest) ->
765 Right args -> Right (arg : args)
767 Left ("Couldn't read " ++ show s ++ "as String")
768 s' -> case break isSpace s' of
769 (arg, s'') -> case toArgs' s'' of
771 Right args -> Right (arg : args)
774 -- -----------------------------------------------------------------------------
778 readRational__ :: ReadS Rational -- NB: doesn't handle leading "-"
779 readRational__ r = do
782 return ((n%1)*10^^(k-d), t)
785 (ds,s) <- lexDecDigits r
786 (ds',t) <- lexDotDigits s
787 return (read (ds++ds'), length ds', t)
789 readExp (e:s) | e `elem` "eE" = readExp' s
790 readExp s = return (0,s)
792 readExp' ('+':s) = readDec s
793 readExp' ('-':s) = do (k,t) <- readDec s
795 readExp' s = readDec s
798 (ds,r) <- nonnull isDigit s
799 return (foldl1 (\n d -> n * 10 + d) [ ord d - ord '0' | d <- ds ],
802 lexDecDigits = nonnull isDigit
804 lexDotDigits ('.':s) = return (span isDigit s)
805 lexDotDigits s = return ("",s)
807 nonnull p s = do (cs@(_:_),t) <- return (span p s)
810 readRational :: String -> Rational -- NB: *does* handle a leading "-"
813 '-' : xs -> - (read_me xs)
817 = case (do { (x,"") <- readRational__ s ; return x }) of
819 [] -> error ("readRational: no parse:" ++ top_s)
820 _ -> error ("readRational: ambiguous parse:" ++ top_s)
823 -----------------------------------------------------------------------------
824 -- Create a hierarchy of directories
826 createDirectoryHierarchy :: FilePath -> IO ()
827 createDirectoryHierarchy dir | isDrive dir = return () -- XXX Hack
828 createDirectoryHierarchy dir = do
829 b <- doesDirectoryExist dir
830 unless b $ do createDirectoryHierarchy (takeDirectory dir)
833 -----------------------------------------------------------------------------
834 -- Verify that the 'dirname' portion of a FilePath exists.
836 doesDirNameExist :: FilePath -> IO Bool
837 doesDirNameExist fpath = case takeDirectory fpath of
838 "" -> return True -- XXX Hack
839 _ -> doesDirectoryExist (takeDirectory fpath)
841 -- --------------------------------------------------------------
842 -- check existence & modification time at the same time
844 modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime)
845 modificationTimeIfExists f = do
846 (do t <- getModificationTime f; return (Just t))
847 `IO.catch` \e -> if isDoesNotExistError e
851 -- split a string at the last character where 'pred' is True,
852 -- returning a pair of strings. The first component holds the string
853 -- up (but not including) the last character for which 'pred' returned
854 -- True, the second whatever comes after (but also not including the
857 -- If 'pred' returns False for all characters in the string, the original
858 -- string is returned in the first component (and the second one is just
860 splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
861 splitLongestPrefix str pred
862 | null r_pre = (str, [])
863 | otherwise = (reverse (tail r_pre), reverse r_suf)
864 -- 'tail' drops the char satisfying 'pred'
865 where (r_suf, r_pre) = break pred (reverse str)
867 escapeSpaces :: String -> String
868 escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
872 --------------------------------------------------------------
874 --------------------------------------------------------------
876 -- | The function splits the given string to substrings
877 -- using the 'searchPathSeparator'.
878 parseSearchPath :: String -> [FilePath]
879 parseSearchPath path = split path
881 split :: String -> [String]
885 _:rest -> chunk : split rest
889 #ifdef mingw32_HOST_OS
890 ('\"':xs@(_:_)) | last xs == '\"' -> init xs
894 (chunk', rest') = break isSearchPathSeparator s
896 data Direction = Forwards | Backwards
898 reslash :: Direction -> FilePath -> FilePath
900 where f ('/' : xs) = slash : f xs
901 f ('\\' : xs) = slash : f xs
902 f (x : xs) = x : f xs
909 %************************************************************************
911 \subsection[Utils-Data]{Utils for defining Data instances}
913 %************************************************************************
915 These functions helps us to define Data instances for abstract types.
918 abstractConstr :: String -> Constr
919 abstractConstr n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix
923 abstractDataType :: String -> DataType
924 abstractDataType n = mkDataType n [abstractConstr n]
928 -- Old GHC versions come with a base library with this function misspelled.
929 #if __GLASGOW_HASKELL__ < 612
930 mkNoRepType :: String -> DataType
931 mkNoRepType = mkNorepType