Modules: Utils and Data (#13009)

Update Haddock submodule

Metric Increase:
   haddock.compiler

1 files changed, 1465 insertions, 0 deletions

diff --git a/compiler/GHC/Utils/Misc.hs b/compiler/GHC/Utils/Misc.hs
new file mode 100644
index 0000000000..b191507fca
--- /dev/null
+++ b/compiler/GHC/Utils/Misc.hs
@@ -0,0 +1,1465 @@
+-- (c) The University of Glasgow 2006
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TupleSections #-}
+
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+-- | Highly random utility functions
+--
+module GHC.Utils.Misc (
+        -- * Flags dependent on the compiler build
+        ghciSupported, debugIsOn,
+        isWindowsHost, isDarwinHost,
+
+        -- * Miscellaneous higher-order functions
+        applyWhen, nTimes,
+
+        -- * General list processing
+        zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
+        zipLazy, stretchZipWith, zipWithAndUnzip, zipAndUnzip,
+
+        zipWithLazy, zipWith3Lazy,
+
+        filterByList, filterByLists, partitionByList,
+
+        unzipWith,
+
+        mapFst, mapSnd, chkAppend,
+        mapAndUnzip, mapAndUnzip3, mapAccumL2,
+        filterOut, partitionWith,
+
+        dropWhileEndLE, spanEnd, last2, lastMaybe,
+
+        foldl1', foldl2, count, countWhile, all2,
+
+        lengthExceeds, lengthIs, lengthIsNot,
+        lengthAtLeast, lengthAtMost, lengthLessThan,
+        listLengthCmp, atLength,
+        equalLength, compareLength, leLength, ltLength,
+
+        isSingleton, only, singleton,
+        notNull, snocView,
+
+        isIn, isn'tIn,
+
+        chunkList,
+
+        changeLast,
+
+        whenNonEmpty,
+
+        -- * Tuples
+        fstOf3, sndOf3, thdOf3,
+        firstM, first3M, secondM,
+        fst3, snd3, third3,
+        uncurry3,
+        liftFst, liftSnd,
+
+        -- * List operations controlled by another list
+        takeList, dropList, splitAtList, split,
+        dropTail, capitalise,
+
+        -- * Sorting
+        sortWith, minWith, nubSort, ordNub,
+
+        -- * Comparisons
+        isEqual, eqListBy, eqMaybeBy,
+        thenCmp, cmpList,
+        removeSpaces,
+        (<&&>), (<||>),
+
+        -- * Edit distance
+        fuzzyMatch, fuzzyLookup,
+
+        -- * Transitive closures
+        transitiveClosure,
+
+        -- * Strictness
+        seqList, strictMap,
+
+        -- * Module names
+        looksLikeModuleName,
+        looksLikePackageName,
+
+        -- * Argument processing
+        getCmd, toCmdArgs, toArgs,
+
+        -- * Integers
+        exactLog2,
+
+        -- * Floating point
+        readRational,
+        readHexRational,
+
+        -- * IO-ish utilities
+        doesDirNameExist,
+        getModificationUTCTime,
+        modificationTimeIfExists,
+        withAtomicRename,
+
+        global, consIORef, globalM,
+        sharedGlobal, sharedGlobalM,
+
+        -- * Filenames and paths
+        Suffix,
+        splitLongestPrefix,
+        escapeSpaces,
+        Direction(..), reslash,
+        makeRelativeTo,
+
+        -- * Utils for defining Data instances
+        abstractConstr, abstractDataType, mkNoRepType,
+
+        -- * Utils for printing C code
+        charToC,
+
+        -- * Hashing
+        hashString,
+
+        -- * Call stacks
+        HasCallStack,
+        HasDebugCallStack,
+
+        -- * Utils for flags
+        OverridingBool(..),
+        overrideWith,
+    ) where
+
+#include "HsVersions.h"
+
+import GHC.Prelude
+
+import GHC.Utils.Exception
+import GHC.Utils.Panic.Plain
+
+import Data.Data
+import Data.IORef       ( IORef, newIORef, atomicModifyIORef' )
+import System.IO.Unsafe ( unsafePerformIO )
+import Data.List        hiding (group)
+import Data.List.NonEmpty  ( NonEmpty(..) )
+
+import GHC.Exts
+import GHC.Stack (HasCallStack)
+
+import Control.Applicative ( liftA2 )
+import Control.Monad    ( liftM, guard )
+import Control.Monad.IO.Class ( MonadIO, liftIO )
+import GHC.Conc.Sync ( sharedCAF )
+import System.IO.Error as IO ( isDoesNotExistError )
+import System.Directory ( doesDirectoryExist, getModificationTime, renameFile )
+import System.FilePath
+
+import Data.Char        ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit, toUpper
+                        , isHexDigit, digitToInt )
+import Data.Int
+import Data.Ratio       ( (%) )
+import Data.Ord         ( comparing )
+import Data.Bits
+import Data.Word
+import qualified Data.IntMap as IM
+import qualified Data.Set as Set
+
+import Data.Time
+
+#if defined(DEBUG)
+import {-# SOURCE #-} GHC.Utils.Outputable ( warnPprTrace, text )
+#endif
+
+infixr 9 `thenCmp`
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Is DEBUG on, are we on Windows, etc?}
+*                                                                      *
+************************************************************************
+
+These booleans are global constants, set by CPP flags.  They allow us to
+recompile a single module (this one) to change whether or not debug output
+appears. They sometimes let us avoid even running CPP elsewhere.
+
+It's important that the flags are literal constants (True/False). Then,
+with -0, tests of the flags in other modules will simplify to the correct
+branch of the conditional, thereby dropping debug code altogether when
+the flags are off.
+-}
+
+ghciSupported :: Bool
+#if defined(HAVE_INTERNAL_INTERPRETER)
+ghciSupported = True
+#else
+ghciSupported = False
+#endif
+
+debugIsOn :: Bool
+#if defined(DEBUG)
+debugIsOn = True
+#else
+debugIsOn = False
+#endif
+
+isWindowsHost :: Bool
+#if defined(mingw32_HOST_OS)
+isWindowsHost = True
+#else
+isWindowsHost = False
+#endif
+
+isDarwinHost :: Bool
+#if defined(darwin_HOST_OS)
+isDarwinHost = True
+#else
+isDarwinHost = False
+#endif
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Miscellaneous higher-order functions}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Apply a function iff some condition is met.
+applyWhen :: Bool -> (a -> a) -> a -> a
+applyWhen True f x = f x
+applyWhen _    _ x = x
+
+-- | A for loop: Compose a function with itself n times.  (nth rather than twice)
+nTimes :: Int -> (a -> a) -> (a -> a)
+nTimes 0 _ = id
+nTimes 1 f = f
+nTimes n f = f . nTimes (n-1) f
+
+fstOf3   :: (a,b,c) -> a
+sndOf3   :: (a,b,c) -> b
+thdOf3   :: (a,b,c) -> c
+fstOf3      (a,_,_) =  a
+sndOf3      (_,b,_) =  b
+thdOf3      (_,_,c) =  c
+
+fst3 :: (a -> d) -> (a, b, c) -> (d, b, c)
+fst3 f (a, b, c) = (f a, b, c)
+
+snd3 :: (b -> d) -> (a, b, c) -> (a, d, c)
+snd3 f (a, b, c) = (a, f b, c)
+
+third3 :: (c -> d) -> (a, b, c) -> (a, b, d)
+third3 f (a, b, c) = (a, b, f c)
+
+uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
+uncurry3 f (a, b, c) = f a b c
+
+liftFst :: (a -> b) -> (a, c) -> (b, c)
+liftFst f (a,c) = (f a, c)
+
+liftSnd :: (a -> b) -> (c, a) -> (c, b)
+liftSnd f (c,a) = (c, f a)
+
+firstM :: Monad m => (a -> m c) -> (a, b) -> m (c, b)
+firstM f (x, y) = liftM (\x' -> (x', y)) (f x)
+
+first3M :: Monad m => (a -> m d) -> (a, b, c) -> m (d, b, c)
+first3M f (x, y, z) = liftM (\x' -> (x', y, z)) (f x)
+
+secondM :: Monad m => (b -> m c) -> (a, b) -> m (a, c)
+secondM f (x, y) = (x,) <$> f y
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Utils-lists]{General list processing}
+*                                                                      *
+************************************************************************
+-}
+
+filterOut :: (a->Bool) -> [a] -> [a]
+-- ^ Like filter, only it reverses the sense of the test
+filterOut _ [] = []
+filterOut p (x:xs) | p x       = filterOut p xs
+                   | otherwise = x : filterOut p xs
+
+partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
+-- ^ Uses a function to determine which of two output lists an input element should join
+partitionWith _ [] = ([],[])
+partitionWith f (x:xs) = case f x of
+                         Left  b -> (b:bs, cs)
+                         Right c -> (bs, c:cs)
+    where (bs,cs) = partitionWith f xs
+
+chkAppend :: [a] -> [a] -> [a]
+-- Checks for the second argument being empty
+-- Used in situations where that situation is common
+chkAppend xs ys
+  | null ys   = xs
+  | otherwise = xs ++ ys
+
+{-
+A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
+are of equal length.  Alastair Reid thinks this should only happen if
+DEBUGging on; hey, why not?
+-}
+
+zipEqual        :: String -> [a] -> [b] -> [(a,b)]
+zipWithEqual    :: String -> (a->b->c) -> [a]->[b]->[c]
+zipWith3Equal   :: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
+zipWith4Equal   :: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
+
+#if !defined(DEBUG)
+zipEqual      _ = zip
+zipWithEqual  _ = zipWith
+zipWith3Equal _ = zipWith3
+zipWith4Equal _ = zipWith4
+#else
+zipEqual _   []     []     = []
+zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs
+zipEqual msg _      _      = panic ("zipEqual: unequal lists: "++msg)
+
+zipWithEqual msg z (a:as) (b:bs)=  z a b : zipWithEqual msg z as bs
+zipWithEqual _   _ [] []        =  []
+zipWithEqual msg _ _ _          =  panic ("zipWithEqual: unequal lists: "++msg)
+
+zipWith3Equal msg z (a:as) (b:bs) (c:cs)
+                                =  z a b c : zipWith3Equal msg z as bs cs
+zipWith3Equal _   _ [] []  []   =  []
+zipWith3Equal msg _ _  _   _    =  panic ("zipWith3Equal: unequal lists: "++msg)
+
+zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)
+                                =  z a b c d : zipWith4Equal msg z as bs cs ds
+zipWith4Equal _   _ [] [] [] [] =  []
+zipWith4Equal msg _ _  _  _  _  =  panic ("zipWith4Equal: unequal lists: "++msg)
+#endif
+
+-- | 'zipLazy' is a kind of 'zip' that is lazy in the second list (observe the ~)
+zipLazy :: [a] -> [b] -> [(a,b)]
+zipLazy []     _       = []
+zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
+
+-- | 'zipWithLazy' is like 'zipWith' but is lazy in the second list.
+-- The length of the output is always the same as the length of the first
+-- list.
+zipWithLazy :: (a -> b -> c) -> [a] -> [b] -> [c]
+zipWithLazy _ []     _       = []
+zipWithLazy f (a:as) ~(b:bs) = f a b : zipWithLazy f as bs
+
+-- | 'zipWith3Lazy' is like 'zipWith3' but is lazy in the second and third lists.
+-- The length of the output is always the same as the length of the first
+-- list.
+zipWith3Lazy :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
+zipWith3Lazy _ []     _       _       = []
+zipWith3Lazy f (a:as) ~(b:bs) ~(c:cs) = f a b c : zipWith3Lazy f as bs cs
+
+-- | 'filterByList' takes a list of Bools and a list of some elements and
+-- filters out these elements for which the corresponding value in the list of
+-- Bools is False. This function does not check whether the lists have equal
+-- length.
+filterByList :: [Bool] -> [a] -> [a]
+filterByList (True:bs)  (x:xs) = x : filterByList bs xs
+filterByList (False:bs) (_:xs) =     filterByList bs xs
+filterByList _          _      = []
+
+-- | 'filterByLists' takes a list of Bools and two lists as input, and
+-- outputs a new list consisting of elements from the last two input lists. For
+-- each Bool in the list, if it is 'True', then it takes an element from the
+-- former list. If it is 'False', it takes an element from the latter list.
+-- The elements taken correspond to the index of the Bool in its list.
+-- For example:
+--
+-- @
+-- filterByLists [True, False, True, False] \"abcd\" \"wxyz\" = \"axcz\"
+-- @
+--
+-- This function does not check whether the lists have equal length.
+filterByLists :: [Bool] -> [a] -> [a] -> [a]
+filterByLists (True:bs)  (x:xs) (_:ys) = x : filterByLists bs xs ys
+filterByLists (False:bs) (_:xs) (y:ys) = y : filterByLists bs xs ys
+filterByLists _          _      _      = []
+
+-- | 'partitionByList' takes a list of Bools and a list of some elements and
+-- partitions the list according to the list of Bools. Elements corresponding
+-- to 'True' go to the left; elements corresponding to 'False' go to the right.
+-- For example, @partitionByList [True, False, True] [1,2,3] == ([1,3], [2])@
+-- This function does not check whether the lists have equal
+-- length; when one list runs out, the function stops.
+partitionByList :: [Bool] -> [a] -> ([a], [a])
+partitionByList = go [] []
+  where
+    go trues falses (True  : bs) (x : xs) = go (x:trues) falses bs xs
+    go trues falses (False : bs) (x : xs) = go trues (x:falses) bs xs
+    go trues falses _ _ = (reverse trues, reverse falses)
+
+stretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]
+-- ^ @stretchZipWith p z f xs ys@ stretches @ys@ by inserting @z@ in
+-- the places where @p@ returns @True@
+
+stretchZipWith _ _ _ []     _ = []
+stretchZipWith p z f (x:xs) ys
+  | p x       = f x z : stretchZipWith p z f xs ys
+  | otherwise = case ys of
+                []     -> []
+                (y:ys) -> f x y : stretchZipWith p z f xs ys
+
+mapFst :: (a->c) -> [(a,b)] -> [(c,b)]
+mapSnd :: (b->c) -> [(a,b)] -> [(a,c)]
+
+mapFst f xys = [(f x, y) | (x,y) <- xys]
+mapSnd f xys = [(x, f y) | (x,y) <- xys]
+
+mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
+
+mapAndUnzip _ [] = ([], [])
+mapAndUnzip f (x:xs)
+  = let (r1,  r2)  = f x
+        (rs1, rs2) = mapAndUnzip f xs
+    in
+    (r1:rs1, r2:rs2)
+
+mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
+
+mapAndUnzip3 _ [] = ([], [], [])
+mapAndUnzip3 f (x:xs)
+  = let (r1,  r2,  r3)  = f x
+        (rs1, rs2, rs3) = mapAndUnzip3 f xs
+    in
+    (r1:rs1, r2:rs2, r3:rs3)
+
+zipWithAndUnzip :: (a -> b -> (c,d)) -> [a] -> [b] -> ([c],[d])
+zipWithAndUnzip f (a:as) (b:bs)
+  = let (r1,  r2)  = f a b
+        (rs1, rs2) = zipWithAndUnzip f as bs
+    in
+    (r1:rs1, r2:rs2)
+zipWithAndUnzip _ _ _ = ([],[])
+
+-- | This has the effect of making the two lists have equal length by dropping
+-- the tail of the longer one.
+zipAndUnzip :: [a] -> [b] -> ([a],[b])
+zipAndUnzip (a:as) (b:bs)
+  = let (rs1, rs2) = zipAndUnzip as bs
+    in
+    (a:rs1, b:rs2)
+zipAndUnzip _ _ = ([],[])
+
+mapAccumL2 :: (s1 -> s2 -> a -> (s1, s2, b)) -> s1 -> s2 -> [a] -> (s1, s2, [b])
+mapAccumL2 f s1 s2 xs = (s1', s2', ys)
+  where ((s1', s2'), ys) = mapAccumL (\(s1, s2) x -> case f s1 s2 x of
+                                                       (s1', s2', y) -> ((s1', s2'), y))
+                                     (s1, s2) xs
+
+-- | @atLength atLen atEnd ls n@ unravels list @ls@ to position @n@. Precisely:
+--
+-- @
+--  atLength atLenPred atEndPred ls n
+--   | n < 0         = atLenPred ls
+--   | length ls < n = atEndPred (n - length ls)
+--   | otherwise     = atLenPred (drop n ls)
+-- @
+atLength :: ([a] -> b)   -- Called when length ls >= n, passed (drop n ls)
+                         --    NB: arg passed to this function may be []
+         -> b            -- Called when length ls <  n
+         -> [a]
+         -> Int
+         -> b
+atLength atLenPred atEnd ls0 n0
+  | n0 < 0    = atLenPred ls0
+  | otherwise = go n0 ls0
+  where
+    -- go's first arg n >= 0
+    go 0 ls     = atLenPred ls
+    go _ []     = atEnd           -- n > 0 here
+    go n (_:xs) = go (n-1) xs
+
+-- Some special cases of atLength:
+
+-- | @(lengthExceeds xs n) = (length xs > n)@
+lengthExceeds :: [a] -> Int -> Bool
+lengthExceeds lst n
+  | n < 0
+  = True
+  | otherwise
+  = atLength notNull False lst n
+
+-- | @(lengthAtLeast xs n) = (length xs >= n)@
+lengthAtLeast :: [a] -> Int -> Bool
+lengthAtLeast = atLength (const True) False
+
+-- | @(lengthIs xs n) = (length xs == n)@
+lengthIs :: [a] -> Int -> Bool
+lengthIs lst n
+  | n < 0
+  = False
+  | otherwise
+  = atLength null False lst n
+
+-- | @(lengthIsNot xs n) = (length xs /= n)@
+lengthIsNot :: [a] -> Int -> Bool
+lengthIsNot lst n
+  | n < 0 = True
+  | otherwise = atLength notNull True lst n
+
+-- | @(lengthAtMost xs n) = (length xs <= n)@
+lengthAtMost :: [a] -> Int -> Bool
+lengthAtMost lst n
+  | n < 0
+  = False
+  | otherwise
+  = atLength null True lst n
+
+-- | @(lengthLessThan xs n) == (length xs < n)@
+lengthLessThan :: [a] -> Int -> Bool
+lengthLessThan = atLength (const False) True
+
+listLengthCmp :: [a] -> Int -> Ordering
+listLengthCmp = atLength atLen atEnd
+ where
+  atEnd = LT    -- Not yet seen 'n' elts, so list length is < n.
+
+  atLen []     = EQ
+  atLen _      = GT
+
+equalLength :: [a] -> [b] -> Bool
+-- ^ True if length xs == length ys
+equalLength []     []     = True
+equalLength (_:xs) (_:ys) = equalLength xs ys
+equalLength _      _      = False
+
+compareLength :: [a] -> [b] -> Ordering
+compareLength []     []     = EQ
+compareLength (_:xs) (_:ys) = compareLength xs ys
+compareLength []     _      = LT
+compareLength _      []     = GT
+
+leLength :: [a] -> [b] -> Bool
+-- ^ True if length xs <= length ys
+leLength xs ys = case compareLength xs ys of
+                   LT -> True
+                   EQ -> True
+                   GT -> False
+
+ltLength :: [a] -> [b] -> Bool
+-- ^ True if length xs < length ys
+ltLength xs ys = case compareLength xs ys of
+                   LT -> True
+                   EQ -> False
+                   GT -> False
+
+----------------------------
+singleton :: a -> [a]
+singleton x = [x]
+
+isSingleton :: [a] -> Bool
+isSingleton [_] = True
+isSingleton _   = False
+
+notNull :: [a] -> Bool
+notNull [] = False
+notNull _  = True
+
+only :: [a] -> a
+#if defined(DEBUG)
+only [a] = a
+#else
+only (a:_) = a
+#endif
+only _ = panic "Util: only"
+
+-- Debugging/specialising versions of \tr{elem} and \tr{notElem}
+
+# if !defined(DEBUG)
+isIn, isn'tIn :: Eq a => String -> a -> [a] -> Bool
+isIn    _msg x ys = x `elem` ys
+isn'tIn _msg x ys = x `notElem` ys
+
+# else /* DEBUG */
+isIn, isn'tIn :: (HasDebugCallStack, Eq a) => String -> a -> [a] -> Bool
+isIn msg x ys
+  = elem100 0 x ys
+  where
+    elem100 :: Eq a => Int -> a -> [a] -> Bool
+    elem100 _ _ [] = False
+    elem100 i x (y:ys)
+      | i > 100 = WARN(True, text ("Over-long elem in " ++ msg)) (x `elem` (y:ys))
+      | otherwise = x == y || elem100 (i + 1) x ys
+
+isn'tIn msg x ys
+  = notElem100 0 x ys
+  where
+    notElem100 :: Eq a => Int -> a -> [a] -> Bool
+    notElem100 _ _ [] =  True
+    notElem100 i x (y:ys)
+      | i > 100 = WARN(True, text ("Over-long notElem in " ++ msg)) (x `notElem` (y:ys))
+      | otherwise = x /= y && notElem100 (i + 1) x ys
+# endif /* DEBUG */
+
+
+-- | Split a list into chunks of /n/ elements
+chunkList :: Int -> [a] -> [[a]]
+chunkList _ [] = []
+chunkList n xs = as : chunkList n bs where (as,bs) = splitAt n xs
+
+-- | Replace the last element of a list with another element.
+changeLast :: [a] -> a -> [a]
+changeLast []     _  = panic "changeLast"
+changeLast [_]    x  = [x]
+changeLast (x:xs) x' = x : changeLast xs x'
+
+whenNonEmpty :: Applicative m => [a] -> (NonEmpty a -> m ()) -> m ()
+whenNonEmpty []     _ = pure ()
+whenNonEmpty (x:xs) f = f (x :| xs)
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection{Sort utils}
+*                                                                      *
+************************************************************************
+-}
+
+minWith :: Ord b => (a -> b) -> [a] -> a
+minWith get_key xs = ASSERT( not (null xs) )
+                     head (sortWith get_key xs)
+
+nubSort :: Ord a => [a] -> [a]
+nubSort = Set.toAscList . Set.fromList
+
+-- | Remove duplicates but keep elements in order.
+--   O(n * log n)
+ordNub :: Ord a => [a] -> [a]
+ordNub xs
+  = go Set.empty xs
+  where
+    go _ [] = []
+    go s (x:xs)
+      | Set.member x s = go s xs
+      | otherwise = x : go (Set.insert x s) xs
+
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Utils-transitive-closure]{Transitive closure}
+*                                                                      *
+************************************************************************
+
+This algorithm for transitive closure is straightforward, albeit quadratic.
+-}
+
+transitiveClosure :: (a -> [a])         -- Successor function
+                  -> (a -> a -> Bool)   -- Equality predicate
+                  -> [a]
+                  -> [a]                -- The transitive closure
+
+transitiveClosure succ eq xs
+ = go [] xs
+ where
+   go done []                      = done
+   go done (x:xs) | x `is_in` done = go done xs
+                  | otherwise      = go (x:done) (succ x ++ xs)
+
+   _ `is_in` []                 = False
+   x `is_in` (y:ys) | eq x y    = True
+                    | otherwise = x `is_in` ys
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Utils-accum]{Accumulating}
+*                                                                      *
+************************************************************************
+
+A combination of foldl with zip.  It works with equal length lists.
+-}
+
+foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
+foldl2 _ z [] [] = z
+foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
+foldl2 _ _ _      _      = panic "Util: foldl2"
+
+all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
+-- True if the lists are the same length, and
+-- all corresponding elements satisfy the predicate
+all2 _ []     []     = True
+all2 p (x:xs) (y:ys) = p x y && all2 p xs ys
+all2 _ _      _      = False
+
+-- Count the number of times a predicate is true
+
+count :: (a -> Bool) -> [a] -> Int
+count p = go 0
+  where go !n [] = n
+        go !n (x:xs) | p x       = go (n+1) xs
+                     | otherwise = go n xs
+
+countWhile :: (a -> Bool) -> [a] -> Int
+-- Length of an /initial prefix/ of the list satisfying p
+countWhile p = go 0
+  where go !n (x:xs) | p x = go (n+1) xs
+        go !n _            = n
+
+{-
+@splitAt@, @take@, and @drop@ but with length of another
+list giving the break-off point:
+-}
+
+takeList :: [b] -> [a] -> [a]
+-- (takeList as bs) trims bs to the be same length
+-- as as, unless as is longer in which case it's a no-op
+takeList [] _ = []
+takeList (_:xs) ls =
+   case ls of
+     [] -> []
+     (y:ys) -> y : takeList xs ys
+
+dropList :: [b] -> [a] -> [a]
+dropList [] xs    = xs
+dropList _  xs@[] = xs
+dropList (_:xs) (_:ys) = dropList xs ys
+
+
+splitAtList :: [b] -> [a] -> ([a], [a])
+splitAtList [] xs     = ([], xs)
+splitAtList _ xs@[]   = (xs, xs)
+splitAtList (_:xs) (y:ys) = (y:ys', ys'')
+    where
+      (ys', ys'') = splitAtList xs ys
+
+-- drop from the end of a list
+dropTail :: Int -> [a] -> [a]
+-- Specification: dropTail n = reverse . drop n . reverse
+-- Better implemention due to Joachim Breitner
+-- http://www.joachim-breitner.de/blog/archives/600-On-taking-the-last-n-elements-of-a-list.html
+dropTail n xs
+  = go (drop n xs) xs
+  where
+    go (_:ys) (x:xs) = x : go ys xs
+    go _      _      = []  -- Stop when ys runs out
+                           -- It'll always run out before xs does
+
+-- dropWhile from the end of a list. This is similar to Data.List.dropWhileEnd,
+-- but is lazy in the elements and strict in the spine. For reasonably short lists,
+-- such as path names and typical lines of text, dropWhileEndLE is generally
+-- faster than dropWhileEnd. Its advantage is magnified when the predicate is
+-- expensive--using dropWhileEndLE isSpace to strip the space off a line of text
+-- is generally much faster than using dropWhileEnd isSpace for that purpose.
+-- Specification: dropWhileEndLE p = reverse . dropWhile p . reverse
+-- Pay attention to the short-circuit (&&)! The order of its arguments is the only
+-- difference between dropWhileEnd and dropWhileEndLE.
+dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
+dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) []
+
+-- | @spanEnd p l == reverse (span p (reverse l))@. The first list
+-- returns actually comes after the second list (when you look at the
+-- input list).
+spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
+spanEnd p l = go l [] [] l
+  where go yes _rev_yes rev_no [] = (yes, reverse rev_no)
+        go yes rev_yes  rev_no (x:xs)
+          | p x       = go yes (x : rev_yes) rev_no                  xs
+          | otherwise = go xs  []            (x : rev_yes ++ rev_no) xs
+
+-- | Get the last two elements in a list. Partial!
+{-# INLINE last2 #-}
+last2 :: [a] -> (a,a)
+last2 = foldl' (\(_,x2) x -> (x2,x)) (partialError,partialError)
+  where
+    partialError = panic "last2 - list length less than two"
+
+lastMaybe :: [a] -> Maybe a
+lastMaybe [] = Nothing
+lastMaybe xs = Just $ last xs
+
+-- | Split a list into its last element and the initial part of the list.
+-- @snocView xs = Just (init xs, last xs)@ for non-empty lists.
+-- @snocView xs = Nothing@ otherwise.
+-- Unless both parts of the result are guaranteed to be used
+-- prefer separate calls to @last@ + @init@.
+-- If you are guaranteed to use both, this will
+-- be more efficient.
+snocView :: [a] -> Maybe ([a],a)
+snocView [] = Nothing
+snocView xs
+    | (xs,x) <- go xs
+    = Just (xs,x)
+  where
+    go :: [a] -> ([a],a)
+    go [x] = ([],x)
+    go (x:xs)
+        | !(xs',x') <- go xs
+        = (x:xs', x')
+    go [] = error "impossible"
+
+split :: Char -> String -> [String]
+split c s = case rest of
+                []     -> [chunk]
+                _:rest -> chunk : split c rest
+  where (chunk, rest) = break (==c) s
+
+-- | Convert a word to title case by capitalising the first letter
+capitalise :: String -> String
+capitalise [] = []
+capitalise (c:cs) = toUpper c : cs
+
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Utils-comparison]{Comparisons}
+*                                                                      *
+************************************************************************
+-}
+
+isEqual :: Ordering -> Bool
+-- Often used in (isEqual (a `compare` b))
+isEqual GT = False
+isEqual EQ = True
+isEqual LT = False
+
+thenCmp :: Ordering -> Ordering -> Ordering
+{-# INLINE thenCmp #-}
+thenCmp EQ       ordering = ordering
+thenCmp ordering _        = ordering
+
+eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool
+eqListBy _  []     []     = True
+eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys
+eqListBy _  _      _      = False
+
+eqMaybeBy :: (a ->a->Bool) -> Maybe a -> Maybe a -> Bool
+eqMaybeBy _  Nothing  Nothing  = True
+eqMaybeBy eq (Just x) (Just y) = eq x y
+eqMaybeBy _  _        _        = False
+
+cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
+    -- `cmpList' uses a user-specified comparer
+
+cmpList _   []     [] = EQ
+cmpList _   []     _  = LT
+cmpList _   _      [] = GT
+cmpList cmp (a:as) (b:bs)
+  = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }
+
+removeSpaces :: String -> String
+removeSpaces = dropWhileEndLE isSpace . dropWhile isSpace
+
+-- Boolean operators lifted to Applicative
+(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool
+(<&&>) = liftA2 (&&)
+infixr 3 <&&> -- same as (&&)
+
+(<||>) :: Applicative f => f Bool -> f Bool -> f Bool
+(<||>) = liftA2 (||)
+infixr 2 <||> -- same as (||)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Edit distance}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Find the "restricted" Damerau-Levenshtein edit distance between two strings.
+-- See: <http://en.wikipedia.org/wiki/Damerau-Levenshtein_distance>.
+-- Based on the algorithm presented in "A Bit-Vector Algorithm for Computing
+-- Levenshtein and Damerau Edit Distances" in PSC'02 (Heikki Hyyro).
+-- See http://www.cs.uta.fi/~helmu/pubs/psc02.pdf and
+--     http://www.cs.uta.fi/~helmu/pubs/PSCerr.html for an explanation
+restrictedDamerauLevenshteinDistance :: String -> String -> Int
+restrictedDamerauLevenshteinDistance str1 str2
+  = restrictedDamerauLevenshteinDistanceWithLengths m n str1 str2
+  where
+    m = length str1
+    n = length str2
+
+restrictedDamerauLevenshteinDistanceWithLengths
+  :: Int -> Int -> String -> String -> Int
+restrictedDamerauLevenshteinDistanceWithLengths m n str1 str2
+  | m <= n
+  = if n <= 32 -- n must be larger so this check is sufficient
+    then restrictedDamerauLevenshteinDistance' (undefined :: Word32) m n str1 str2
+    else restrictedDamerauLevenshteinDistance' (undefined :: Integer) m n str1 str2
+
+  | otherwise
+  = if m <= 32 -- m must be larger so this check is sufficient
+    then restrictedDamerauLevenshteinDistance' (undefined :: Word32) n m str2 str1
+    else restrictedDamerauLevenshteinDistance' (undefined :: Integer) n m str2 str1
+
+restrictedDamerauLevenshteinDistance'
+  :: (Bits bv, Num bv) => bv -> Int -> Int -> String -> String -> Int
+restrictedDamerauLevenshteinDistance' _bv_dummy m n str1 str2
+  | [] <- str1 = n
+  | otherwise  = extractAnswer $
+                 foldl' (restrictedDamerauLevenshteinDistanceWorker
+                             (matchVectors str1) top_bit_mask vector_mask)
+                        (0, 0, m_ones, 0, m) str2
+  where
+    m_ones@vector_mask = (2 ^ m) - 1
+    top_bit_mask = (1 `shiftL` (m - 1)) `asTypeOf` _bv_dummy
+    extractAnswer (_, _, _, _, distance) = distance
+
+restrictedDamerauLevenshteinDistanceWorker
+      :: (Bits bv, Num bv) => IM.IntMap bv -> bv -> bv
+      -> (bv, bv, bv, bv, Int) -> Char -> (bv, bv, bv, bv, Int)
+restrictedDamerauLevenshteinDistanceWorker str1_mvs top_bit_mask vector_mask
+                                           (pm, d0, vp, vn, distance) char2
+  = seq str1_mvs $ seq top_bit_mask $ seq vector_mask $
+    seq pm' $ seq d0' $ seq vp' $ seq vn' $
+    seq distance'' $ seq char2 $
+    (pm', d0', vp', vn', distance'')
+  where
+    pm' = IM.findWithDefault 0 (ord char2) str1_mvs
+
+    d0' = ((((sizedComplement vector_mask d0) .&. pm') `shiftL` 1) .&. pm)
+      .|. ((((pm' .&. vp) + vp) .&. vector_mask) `xor` vp) .|. pm' .|. vn
+          -- No need to mask the shiftL because of the restricted range of pm
+
+    hp' = vn .|. sizedComplement vector_mask (d0' .|. vp)
+    hn' = d0' .&. vp
+
+    hp'_shift = ((hp' `shiftL` 1) .|. 1) .&. vector_mask
+    hn'_shift = (hn' `shiftL` 1) .&. vector_mask
+    vp' = hn'_shift .|. sizedComplement vector_mask (d0' .|. hp'_shift)
+    vn' = d0' .&. hp'_shift
+
+    distance' = if hp' .&. top_bit_mask /= 0 then distance + 1 else distance
+    distance'' = if hn' .&. top_bit_mask /= 0 then distance' - 1 else distance'
+
+sizedComplement :: Bits bv => bv -> bv -> bv
+sizedComplement vector_mask vect = vector_mask `xor` vect
+
+matchVectors :: (Bits bv, Num bv) => String -> IM.IntMap bv
+matchVectors = snd . foldl' go (0 :: Int, IM.empty)
+  where
+    go (ix, im) char = let ix' = ix + 1
+                           im' = IM.insertWith (.|.) (ord char) (2 ^ ix) im
+                       in seq ix' $ seq im' $ (ix', im')
+
+{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'
+                      :: Word32 -> Int -> Int -> String -> String -> Int #-}
+{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'
+                      :: Integer -> Int -> Int -> String -> String -> Int #-}
+
+{-# SPECIALIZE restrictedDamerauLevenshteinDistanceWorker
+               :: IM.IntMap Word32 -> Word32 -> Word32
+               -> (Word32, Word32, Word32, Word32, Int)
+               -> Char -> (Word32, Word32, Word32, Word32, Int) #-}
+{-# SPECIALIZE restrictedDamerauLevenshteinDistanceWorker
+               :: IM.IntMap Integer -> Integer -> Integer
+               -> (Integer, Integer, Integer, Integer, Int)
+               -> Char -> (Integer, Integer, Integer, Integer, Int) #-}
+
+{-# SPECIALIZE INLINE sizedComplement :: Word32 -> Word32 -> Word32 #-}
+{-# SPECIALIZE INLINE sizedComplement :: Integer -> Integer -> Integer #-}
+
+{-# SPECIALIZE matchVectors :: String -> IM.IntMap Word32 #-}
+{-# SPECIALIZE matchVectors :: String -> IM.IntMap Integer #-}
+
+fuzzyMatch :: String -> [String] -> [String]
+fuzzyMatch key vals = fuzzyLookup key [(v,v) | v <- vals]
+
+-- | Search for possible matches to the users input in the given list,
+-- returning a small number of ranked results
+fuzzyLookup :: String -> [(String,a)] -> [a]
+fuzzyLookup user_entered possibilites
+  = map fst $ take mAX_RESULTS $ sortBy (comparing snd)
+    [ (poss_val, distance) | (poss_str, poss_val) <- possibilites
+                       , let distance = restrictedDamerauLevenshteinDistance
+                                            poss_str user_entered
+                       , distance <= fuzzy_threshold ]
+  where
+    -- Work out an appropriate match threshold:
+    -- We report a candidate if its edit distance is <= the threshold,
+    -- The threshold is set to about a quarter of the # of characters the user entered
+    --   Length    Threshold
+    --     1         0          -- Don't suggest *any* candidates
+    --     2         1          -- for single-char identifiers
+    --     3         1
+    --     4         1
+    --     5         1
+    --     6         2
+    --
+    fuzzy_threshold = truncate $ fromIntegral (length user_entered + 2) / (4 :: Rational)
+    mAX_RESULTS = 3
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Utils-pairs]{Pairs}
+*                                                                      *
+************************************************************************
+-}
+
+unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
+unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
+
+seqList :: [a] -> b -> b
+seqList [] b = b
+seqList (x:xs) b = x `seq` seqList xs b
+
+strictMap :: (a -> b) -> [a] -> [b]
+strictMap _ [] = []
+strictMap f (x : xs) =
+  let
+    !x' = f x
+    !xs' = strictMap f xs
+  in
+    x' : xs'
+
+{-
+************************************************************************
+*                                                                      *
+                        Globals and the RTS
+*                                                                      *
+************************************************************************
+
+When a plugin is loaded, it currently gets linked against a *newly
+loaded* copy of the GHC package. This would not be a problem, except
+that the new copy has its own mutable state that is not shared with
+that state that has already been initialized by the original GHC
+package.
+
+(Note that if the GHC executable was dynamically linked this
+wouldn't be a problem, because we could share the GHC library it
+links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)
+
+The solution is to make use of @sharedCAF@ through @sharedGlobal@
+for globals that are shared between multiple copies of ghc packages.
+-}
+
+-- Global variables:
+
+global :: a -> IORef a
+global a = unsafePerformIO (newIORef a)
+
+consIORef :: IORef [a] -> a -> IO ()
+consIORef var x = do
+  atomicModifyIORef' var (\xs -> (x:xs,()))
+
+globalM :: IO a -> IORef a
+globalM ma = unsafePerformIO (ma >>= newIORef)
+
+-- Shared global variables:
+
+sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
+sharedGlobal a get_or_set = unsafePerformIO $
+  newIORef a >>= flip sharedCAF get_or_set
+
+sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
+sharedGlobalM ma get_or_set = unsafePerformIO $
+  ma >>= newIORef >>= flip sharedCAF get_or_set
+
+-- Module names:
+
+looksLikeModuleName :: String -> Bool
+looksLikeModuleName [] = False
+looksLikeModuleName (c:cs) = isUpper c && go cs
+  where go [] = True
+        go ('.':cs) = looksLikeModuleName cs
+        go (c:cs)   = (isAlphaNum c || c == '_' || c == '\'') && go cs
+
+-- Similar to 'parse' for Distribution.Package.PackageName,
+-- but we don't want to depend on Cabal.
+looksLikePackageName :: String -> Bool
+looksLikePackageName = all (all isAlphaNum <&&> not . (all isDigit)) . split '-'
+
+{-
+Akin to @Prelude.words@, but acts like the Bourne shell, treating
+quoted strings as Haskell Strings, and also parses Haskell [String]
+syntax.
+-}
+
+getCmd :: String -> Either String             -- Error
+                           (String, String) -- (Cmd, Rest)
+getCmd s = case break isSpace $ dropWhile isSpace s of
+           ([], _) -> Left ("Couldn't find command in " ++ show s)
+           res -> Right res
+
+toCmdArgs :: String -> Either String             -- Error
+                              (String, [String]) -- (Cmd, Args)
+toCmdArgs s = case getCmd s of
+              Left err -> Left err
+              Right (cmd, s') -> case toArgs s' of
+                                 Left err -> Left err
+                                 Right args -> Right (cmd, args)
+
+toArgs :: String -> Either String   -- Error
+                           [String] -- Args
+toArgs str
+    = case dropWhile isSpace str of
+      s@('[':_) -> case reads s of
+                   [(args, spaces)]
+                    | all isSpace spaces ->
+                       Right args
+                   _ ->
+                       Left ("Couldn't read " ++ show str ++ " as [String]")
+      s -> toArgs' s
+ where
+  toArgs' :: String -> Either String [String]
+  -- Remove outer quotes:
+  -- > toArgs' "\"foo\" \"bar baz\""
+  -- Right ["foo", "bar baz"]
+  --
+  -- Keep inner quotes:
+  -- > toArgs' "-DFOO=\"bar baz\""
+  -- Right ["-DFOO=\"bar baz\""]
+  toArgs' s = case dropWhile isSpace s of
+              [] -> Right []
+              ('"' : _) -> do
+                    -- readAsString removes outer quotes
+                    (arg, rest) <- readAsString s
+                    (arg:) `fmap` toArgs' rest
+              s' -> case break (isSpace <||> (== '"')) s' of
+                    (argPart1, s''@('"':_)) -> do
+                        (argPart2, rest) <- readAsString s''
+                        -- show argPart2 to keep inner quotes
+                        ((argPart1 ++ show argPart2):) `fmap` toArgs' rest
+                    (arg, s'') -> (arg:) `fmap` toArgs' s''
+
+  readAsString :: String -> Either String (String, String)
+  readAsString s = case reads s of
+                [(arg, rest)]
+                    -- rest must either be [] or start with a space
+                    | all isSpace (take 1 rest) ->
+                    Right (arg, rest)
+                _ ->
+                    Left ("Couldn't read " ++ show s ++ " as String")
+-----------------------------------------------------------------------------
+-- Integers
+
+-- | Determine the $\log_2$ of exact powers of 2
+exactLog2 :: Integer -> Maybe Integer
+exactLog2 x
+   | x <= 0                               = Nothing
+   | x > fromIntegral (maxBound :: Int32) = Nothing
+   | x' .&. (-x') /= x'                   = Nothing
+   | otherwise                            = Just (fromIntegral c)
+      where
+         x' = fromIntegral x :: Int32
+         c = countTrailingZeros x'
+
+{-
+-- -----------------------------------------------------------------------------
+-- Floats
+-}
+
+readRational__ :: ReadS Rational -- NB: doesn't handle leading "-"
+readRational__ r = do
+     (n,d,s) <- readFix r
+     (k,t)   <- readExp s
+     return ((n%1)*10^^(k-d), t)
+ where
+     readFix r = do
+        (ds,s)  <- lexDecDigits r
+        (ds',t) <- lexDotDigits s
+        return (read (ds++ds'), length ds', t)
+
+     readExp (e:s) | e `elem` "eE" = readExp' s
+     readExp s                     = return (0,s)
+
+     readExp' ('+':s) = readDec s
+     readExp' ('-':s) = do (k,t) <- readDec s
+                           return (-k,t)
+     readExp' s       = readDec s
+
+     readDec s = do
+        (ds,r) <- nonnull isDigit s
+        return (foldl1 (\n d -> n * 10 + d) [ ord d - ord '0' | d <- ds ],
+                r)
+
+     lexDecDigits = nonnull isDigit
+
+     lexDotDigits ('.':s) = return (span' isDigit s)
+     lexDotDigits s       = return ("",s)
+
+     nonnull p s = do (cs@(_:_),t) <- return (span' p s)
+                      return (cs,t)
+
+     span' _ xs@[]         =  (xs, xs)
+     span' p xs@(x:xs')
+               | x == '_'  = span' p xs'   -- skip "_" (#14473)
+               | p x       =  let (ys,zs) = span' p xs' in (x:ys,zs)
+               | otherwise =  ([],xs)
+
+readRational :: String -> Rational -- NB: *does* handle a leading "-"
+readRational top_s
+  = case top_s of
+      '-' : xs -> - (read_me xs)
+      xs       -> read_me xs
+  where
+    read_me s
+      = case (do { (x,"") <- readRational__ s ; return x }) of
+          [x] -> x
+          []  -> error ("readRational: no parse:"        ++ top_s)
+          _   -> error ("readRational: ambiguous parse:" ++ top_s)
+
+
+readHexRational :: String -> Rational
+readHexRational str =
+  case str of
+    '-' : xs -> - (readMe xs)
+    xs       -> readMe xs
+  where
+  readMe as =
+    case readHexRational__ as of
+      Just n -> n
+      _      -> error ("readHexRational: no parse:" ++ str)
+
+
+readHexRational__ :: String -> Maybe Rational
+readHexRational__ ('0' : x : rest)
+  | x == 'X' || x == 'x' =
+  do let (front,rest2) = span' isHexDigit rest
+     guard (not (null front))
+     let frontNum = steps 16 0 front
+     case rest2 of
+       '.' : rest3 ->
+          do let (back,rest4) = span' isHexDigit rest3
+             guard (not (null back))
+             let backNum = steps 16 frontNum back
+                 exp1    = -4 * length back
+             case rest4 of
+               p : ps | isExp p -> fmap (mk backNum . (+ exp1)) (getExp ps)
+               _ -> return (mk backNum exp1)
+       p : ps | isExp p -> fmap (mk frontNum) (getExp ps)
+       _ -> Nothing
+
+  where
+  isExp p = p == 'p' || p == 'P'
+
+  getExp ('+' : ds) = dec ds
+  getExp ('-' : ds) = fmap negate (dec ds)
+  getExp ds         = dec ds
+
+  mk :: Integer -> Int -> Rational
+  mk n e = fromInteger n * 2^^e
+
+  dec cs = case span' isDigit cs of
+             (ds,"") | not (null ds) -> Just (steps 10 0 ds)
+             _ -> Nothing
+
+  steps base n ds = foldl' (step base) n ds
+  step  base n d  = base * n + fromIntegral (digitToInt d)
+
+  span' _ xs@[]         =  (xs, xs)
+  span' p xs@(x:xs')
+            | x == '_'  = span' p xs'   -- skip "_"  (#14473)
+            | p x       =  let (ys,zs) = span' p xs' in (x:ys,zs)
+            | otherwise =  ([],xs)
+
+readHexRational__ _ = Nothing
+
+-----------------------------------------------------------------------------
+-- Verify that the 'dirname' portion of a FilePath exists.
+--
+doesDirNameExist :: FilePath -> IO Bool
+doesDirNameExist fpath = doesDirectoryExist (takeDirectory fpath)
+
+-----------------------------------------------------------------------------
+-- Backwards compatibility definition of getModificationTime
+
+getModificationUTCTime :: FilePath -> IO UTCTime
+getModificationUTCTime = getModificationTime
+
+-- --------------------------------------------------------------
+-- check existence & modification time at the same time
+
+modificationTimeIfExists :: FilePath -> IO (Maybe UTCTime)
+modificationTimeIfExists f = do
+  (do t <- getModificationUTCTime f; return (Just t))
+        `catchIO` \e -> if isDoesNotExistError e
+                        then return Nothing
+                        else ioError e
+
+-- --------------------------------------------------------------
+-- atomic file writing by writing to a temporary file first (see #14533)
+--
+-- This should be used in all cases where GHC writes files to disk
+-- and uses their modification time to skip work later,
+-- as otherwise a partially written file (e.g. due to crash or Ctrl+C)
+-- also results in a skip.
+
+withAtomicRename :: (MonadIO m) => FilePath -> (FilePath -> m a) -> m a
+withAtomicRename targetFile f = do
+  -- The temp file must be on the same file system (mount) as the target file
+  -- to result in an atomic move on most platforms.
+  -- The standard way to ensure that is to place it into the same directory.
+  -- This can still be fooled when somebody mounts a different file system
+  -- at just the right time, but that is not a case we aim to cover here.
+  let temp = targetFile <.> "tmp"
+  res <- f temp
+  liftIO $ renameFile temp targetFile
+  return res
+
+-- --------------------------------------------------------------
+-- split a string at the last character where 'pred' is True,
+-- returning a pair of strings. The first component holds the string
+-- up (but not including) the last character for which 'pred' returned
+-- True, the second whatever comes after (but also not including the
+-- last character).
+--
+-- If 'pred' returns False for all characters in the string, the original
+-- string is returned in the first component (and the second one is just
+-- empty).
+splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
+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)
+
+escapeSpaces :: String -> String
+escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
+
+type Suffix = String
+
+--------------------------------------------------------------
+-- * Search path
+--------------------------------------------------------------
+
+data Direction = Forwards | Backwards
+
+reslash :: Direction -> FilePath -> FilePath
+reslash d = f
+    where f ('/'  : xs) = slash : f xs
+          f ('\\' : xs) = slash : f xs
+          f (x    : xs) = x     : f xs
+          f ""          = ""
+          slash = case d of
+                  Forwards -> '/'
+                  Backwards -> '\\'
+
+makeRelativeTo :: FilePath -> FilePath -> FilePath
+this `makeRelativeTo` that = directory </> thisFilename
+    where (thisDirectory, thisFilename) = splitFileName this
+          thatDirectory = dropFileName that
+          directory = joinPath $ f (splitPath thisDirectory)
+                                   (splitPath thatDirectory)
+
+          f (x : xs) (y : ys)
+           | x == y = f xs ys
+          f xs ys = replicate (length ys) ".." ++ xs
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Utils-Data]{Utils for defining Data instances}
+*                                                                      *
+************************************************************************
+
+These functions helps us to define Data instances for abstract types.
+-}
+
+abstractConstr :: String -> Constr
+abstractConstr n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix
+
+abstractDataType :: String -> DataType
+abstractDataType n = mkDataType n [abstractConstr n]
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Utils-C]{Utils for printing C code}
+*                                                                      *
+************************************************************************
+-}
+
+charToC :: Word8 -> String
+charToC w =
+  case chr (fromIntegral w) of
+        '\"' -> "\\\""
+        '\'' -> "\\\'"
+        '\\' -> "\\\\"
+        c | c >= ' ' && c <= '~' -> [c]
+          | otherwise -> ['\\',
+                         chr (ord '0' + ord c `div` 64),
+                         chr (ord '0' + ord c `div` 8 `mod` 8),
+                         chr (ord '0' + ord c         `mod` 8)]
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Utils-Hashing]{Utils for hashing}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A sample hash function for Strings.  We keep multiplying by the
+-- golden ratio and adding.  The implementation is:
+--
+-- > hashString = foldl' f golden
+-- >   where f m c = fromIntegral (ord c) * magic + hashInt32 m
+-- >         magic = 0xdeadbeef
+--
+-- Where hashInt32 works just as hashInt shown above.
+--
+-- Knuth argues that repeated multiplication by the golden ratio
+-- will minimize gaps in the hash space, and thus it's a good choice
+-- for combining together multiple keys to form one.
+--
+-- Here we know that individual characters c are often small, and this
+-- produces frequent collisions if we use ord c alone.  A
+-- particular problem are the shorter low ASCII and ISO-8859-1
+-- character strings.  We pre-multiply by a magic twiddle factor to
+-- obtain a good distribution.  In fact, given the following test:
+--
+-- > testp :: Int32 -> Int
+-- > testp k = (n - ) . length . group . sort . map hs . take n $ ls
+-- >   where ls = [] : [c : l | l <- ls, c <- ['\0'..'\xff']]
+-- >         hs = foldl' f golden
+-- >         f m c = fromIntegral (ord c) * k + hashInt32 m
+-- >         n = 100000
+--
+-- We discover that testp magic = 0.
+hashString :: String -> Int32
+hashString = foldl' f golden
+   where f m c = fromIntegral (ord c) * magic + hashInt32 m
+         magic = fromIntegral (0xdeadbeef :: Word32)
+
+golden :: Int32
+golden = 1013904242 -- = round ((sqrt 5 - 1) * 2^32) :: Int32
+-- was -1640531527 = round ((sqrt 5 - 1) * 2^31) :: Int32
+-- but that has bad mulHi properties (even adding 2^32 to get its inverse)
+-- Whereas the above works well and contains no hash duplications for
+-- [-32767..65536]
+
+-- | A sample (and useful) hash function for Int32,
+-- implemented by extracting the uppermost 32 bits of the 64-bit
+-- result of multiplying by a 33-bit constant.  The constant is from
+-- Knuth, derived from the golden ratio:
+--
+-- > golden = round ((sqrt 5 - 1) * 2^32)
+--
+-- We get good key uniqueness on small inputs
+-- (a problem with previous versions):
+--  (length $ group $ sort $ map hashInt32 [-32767..65536]) == 65536 + 32768
+--
+hashInt32 :: Int32 -> Int32
+hashInt32 x = mulHi x golden + x
+
+-- hi 32 bits of a x-bit * 32 bit -> 64-bit multiply
+mulHi :: Int32 -> Int32 -> Int32
+mulHi a b = fromIntegral (r `shiftR` 32)
+   where r :: Int64
+         r = fromIntegral a * fromIntegral b
+
+-- | A call stack constraint, but only when 'isDebugOn'.
+#if defined(DEBUG)
+type HasDebugCallStack = HasCallStack
+#else
+type HasDebugCallStack = (() :: Constraint)
+#endif
+
+data OverridingBool
+  = Auto
+  | Always
+  | Never
+  deriving Show
+
+overrideWith :: Bool -> OverridingBool -> Bool
+overrideWith b Auto   = b
+overrideWith _ Always = True
+overrideWith _ Never  = False