    -- (c) The University of Glasgow 2006

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MagicHash #-}

    -- | Highly random utility functions
    --
    module GHC.Utils.Misc (
            -- * Miscellaneous higher-order functions
            applyWhen, nTimes, const2,

            -- * General list processing
            zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
            stretchZipWith, zipWithAndUnzip, zipAndUnzip,

            filterByList, filterByLists, partitionByList,

            unzipWith,

            mapFst, mapSnd, chkAppend,
            mapAndUnzip, mapAndUnzip3, mapAndUnzip4,
            filterOut, partitionWith, partitionWithM,

            dropWhileEndLE, spanEnd, last2, lastMaybe, onJust,

            List.foldl1', foldl2, count, countWhile, all2, any2,

            lengthExceeds, lengthIs, lengthIsNot,
            lengthAtLeast, lengthAtMost, lengthLessThan,
            listLengthCmp, atLength,
            equalLength, compareLength, leLength, ltLength,

            isSingleton, only, expectOnly, GHC.Utils.Misc.singleton,
            notNull, expectNonEmpty, snocView,

            holes,

            changeLast,

            whenNonEmpty,

            mergeListsBy,
            isSortedBy,

            -- Foldable generalised functions,

            mapMaybe',

            -- * Tuples
            fstOf3, sndOf3, thdOf3,
            fstOf4, sndOf4,
            fst3, snd3, third3,
            uncurry3,

            -- * List operations controlled by another list
            takeList, dropList, splitAtList, split,
            dropTail, capitalise,

            -- * Sorting
            sortWith, minWith, nubSort, ordNub, ordNubOn,

            -- * Comparisons
            isEqual,
            removeSpaces,
            (<&&>), (<||>),

            -- * Edit distance
            fuzzyMatch, fuzzyLookup,

            -- * Transitive closures
            transitiveClosure,

            -- * Strictness
            seqList, strictMap, strictZipWith, strictZipWith3,

            -- * Module names
            looksLikeModuleName,
            looksLikePackageName,

            -- * Integers
            exactLog2,

            -- * Floating point
            readRational,
            readSignificandExponentPair,
            readHexRational,
            readHexSignificandExponentPair,

            -- * IO-ish utilities
            doesDirNameExist,
            getModificationUTCTime,
            modificationTimeIfExists,
            fileHashIfExists,
            withAtomicRename,

            -- * 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,
        ) where

    import GHC.Prelude.Basic hiding ( head, init, last, tail )
    import qualified GHC.Prelude.Basic as Partial ( head )

    import GHC.Utils.Exception
    import GHC.Utils.Panic.Plain
    import GHC.Utils.Constants
    import GHC.Utils.Fingerprint

    import Data.Data
    import qualified Data.List as List
    import Data.List.NonEmpty  ( NonEmpty(..), last, nonEmpty )

    import GHC.Exts
    import GHC.Stack (HasCallStack)

    import Control.Monad    ( guard )
    import Control.Monad.IO.Class ( MonadIO, liftIO )
    import System.IO.Error as IO ( isDoesNotExistError )
    import System.Directory ( doesDirectoryExist, getModificationTime, renameFile )
    import System.FilePath

    import Data.Bifunctor   ( first, second )
    import Data.Char        ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit, toUpper
                            , isHexDigit, digitToInt )
    import Data.Int
    import Data.Ratio       ( (%) )
    import Data.Ord         ( comparing )
    import Data.Word
    import qualified Data.IntMap as IM
    import qualified Data.Set as Set

    import Data.Time

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Miscellaneous higher-order functions}
    *                                                                      *
    ************************************************************************
    -}

    -- | Apply a function iff some condition is met.
    applyWhen :: Bool -> (a -> a) -> a -> a
    applyWhen :: forall a. Bool -> (a -> a) -> a -> a
    applyWhen Bool
    True a -> a
    f a
    x = a -> a
    f a
    x
    applyWhen Bool
    _    a -> a
    _ a
    x = a
    x

    -- | Apply a function @n@ times to a given value.
    nTimes :: Int -> (a -> a) -> (a -> a)
    nTimes :: forall a. Int -> (a -> a) -> a -> a
    nTimes Int
    0 a -> a
    _ = a -> a
    forall a. a -> a
    id
    nTimes Int
    1 a -> a
    f = a -> a
    f
    nTimes Int
    n a -> a
    f = a -> a
    f (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> (a -> a) -> a -> a
    forall a. Int -> (a -> a) -> a -> a
    nTimes (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) a -> a
    f

    const2 :: a -> b -> c -> a
    const2 :: forall a b c. a -> b -> c -> a
    const2 a
    x b
    _ c
    _ = a
    x

    fstOf3   :: (a,b,c) -> a
    sndOf3   :: (a,b,c) -> b
    thdOf3   :: (a,b,c) -> c
    fstOf3 :: forall a b c. (a, b, c) -> a
    fstOf3      (a
    a,b
    _,c
    _) =  a
    a
    sndOf3 :: forall a b c. (a, b, c) -> b
    sndOf3      (a
    _,b
    b,c
    _) =  b
    b
    thdOf3 :: forall a b c. (a, b, c) -> c
    thdOf3      (a
    _,b
    _,c
    c) =  c
    c

    fstOf4   :: (a,b,c,d) -> a
    sndOf4   :: (a,b,c,d) -> b
    fstOf4 :: forall a b c d. (a, b, c, d) -> a
    fstOf4      (a
    a,b
    _,c
    _,d
    _) =  a
    a
    sndOf4 :: forall a b c d. (a, b, c, d) -> b
    sndOf4      (a
    _,b
    b,c
    _,d
    _) =  b
    b

    fst3 :: (a -> d) -> (a, b, c) -> (d, b, c)
    fst3 :: forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
    fst3 a -> d
    f (a
    a, b
    b, c
    c) = (a -> d
    f a
    a, b
    b, c
    c)

    snd3 :: (b -> d) -> (a, b, c) -> (a, d, c)
    snd3 :: forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
    snd3 b -> d
    f (a
    a, b
    b, c
    c) = (a
    a, b -> d
    f b
    b, c
    c)

    third3 :: (c -> d) -> (a, b, c) -> (a, b, d)
    third3 :: forall c d a b. (c -> d) -> (a, b, c) -> (a, b, d)
    third3 c -> d
    f (a
    a, b
    b, c
    c) = (a
    a, b
    b, c -> d
    f c
    c)

    uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
    uncurry3 :: forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
    uncurry3 a -> b -> c -> d
    f (a
    a, b
    b, c
    c) = a -> b -> c -> d
    f a
    a b
    b c
    c

    {-
    ************************************************************************
    *                                                                      *
    \subsection[Utils-lists]{General list processing}
    *                                                                      *
    ************************************************************************
    -}

    filterOut :: (a->Bool) -> [a] -> [a]
    -- ^ Like filter, only it reverses the sense of the test
    filterOut :: forall a. (a -> Bool) -> [a] -> [a]
    filterOut a -> Bool
    p = (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Bool
    p)

    partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
    -- ^ Uses a function to determine which of two output lists an input element should join
    partitionWith :: forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
    partitionWith a -> Either b c
    _ [] = ([],[])
    partitionWith a -> Either b c
    f (a
    x:[a]
    xs) = case a -> Either b c
    f a
    x of
                             Left  b
    b -> (b
    bb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    bs, [c]
    cs)
                             Right c
    c -> ([b]
    bs, c
    cc -> [c] -> [c]
    forall a. a -> [a] -> [a]
    :[c]
    cs)
        where ([b]
    bs,[c]
    cs) = (a -> Either b c) -> [a] -> ([b], [c])
    forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
    partitionWith a -> Either b c
    f [a]
    xs

    partitionWithM :: Monad m => (a -> m (Either b c)) -> [a] -> m ([b], [c])
    -- ^ Monadic version of `partitionWith`
    partitionWithM :: forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m (Either b c)) -> [a] -> m ([b], [c])
    partitionWithM a -> m (Either b c)
    _ [] = ([b], [c]) -> m ([b], [c])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
    partitionWithM a -> m (Either b c)
    f (a
    x:[a]
    xs) = do
      y <- a -> m (Either b c)
    f a
    x
      (bs, cs) <- partitionWithM f xs
      case y of
        Left  b
    b -> ([b], [c]) -> m ([b], [c])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b
    bb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    bs, [c]
    cs)
        Right c
    c -> ([b], [c]) -> m ([b], [c])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([b]
    bs, c
    cc -> [c] -> [c]
    forall a. a -> [a] -> [a]
    :[c]
    cs)
    {-# INLINEABLE partitionWithM #-}

    chkAppend :: [a] -> [a] -> [a]
    -- Checks for the second argument being empty
    -- Used in situations where that situation is common
    chkAppend :: forall a. [a] -> [a] -> [a]
    chkAppend [a]
    xs [a]
    ys
      | [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    ys   = [a]
    xs
      | Bool
    otherwise = [a]
    xs [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    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        :: HasDebugCallStack => String -> [a] -> [b] -> [(a,b)]
    zipWithEqual    :: HasDebugCallStack => String -> (a->b->c) -> [a]->[b]->[c]
    zipWith3Equal   :: HasDebugCallStack => String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
    zipWith4Equal   :: HasDebugCallStack => String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]

    #if !defined(DEBUG)
    zipEqual :: forall a b. HasDebugCallStack => String -> [a] -> [b] -> [(a, b)]
    zipEqual      String
    _ = [a] -> [b] -> [(a, b)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip
    zipWithEqual :: forall a b c.
    HasDebugCallStack =>
    String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual  String
    _ = (a -> b -> c) -> [a] -> [b] -> [c]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith
    zipWith3Equal :: forall a b c d.
    HasDebugCallStack =>
    String -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3Equal String
    _ = (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3
    zipWith4Equal :: forall a b c d e.
    HasDebugCallStack =>
    String
    -> (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
    zipWith4Equal String
    _ = (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
    forall a b c d e.
    (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
    List.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

    -- | '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 :: forall a. [Bool] -> [a] -> [a]
    filterByList (Bool
    True:[Bool]
    bs)  (a
    x:[a]
    xs) = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [Bool] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a]
    filterByList [Bool]
    bs [a]
    xs
    filterByList (Bool
    False:[Bool]
    bs) (a
    _:[a]
    xs) =     [Bool] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a]
    filterByList [Bool]
    bs [a]
    xs
    filterByList [Bool]
    _          [a]
    _      = []

    -- | '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 :: forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists (Bool
    True:[Bool]
    bs)  (a
    x:[a]
    xs) (a
    _:[a]
    ys) = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [Bool] -> [a] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists [Bool]
    bs [a]
    xs [a]
    ys
    filterByLists (Bool
    False:[Bool]
    bs) (a
    _:[a]
    xs) (a
    y:[a]
    ys) = a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [Bool] -> [a] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists [Bool]
    bs [a]
    xs [a]
    ys
    filterByLists [Bool]
    _          [a]
    _      [a]
    _      = []

    -- | '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 :: forall a. [Bool] -> [a] -> ([a], [a])
    partitionByList = [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    forall {a}. [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go [] []
      where
        go :: [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go [a]
    trues [a]
    falses (Bool
    True  : [Bool]
    bs) (a
    x : [a]
    xs) = [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    trues) [a]
    falses [Bool]
    bs [a]
    xs
        go [a]
    trues [a]
    falses (Bool
    False : [Bool]
    bs) (a
    x : [a]
    xs) = [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go [a]
    trues (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    falses) [Bool]
    bs [a]
    xs
        go [a]
    trues [a]
    falses [Bool]
    _ [a]
    _ = ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    trues, [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    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 :: forall a b c.
    (a -> Bool) -> b -> (a -> b -> c) -> [a] -> [b] -> [c]
    stretchZipWith a -> Bool
    _ b
    _ a -> b -> c
    _ []     [b]
    _ = []
    stretchZipWith a -> Bool
    p b
    z a -> b -> c
    f (a
    x:[a]
    xs) [b]
    ys
      | a -> Bool
    p a
    x       = a -> b -> c
    f a
    x b
    z c -> [c] -> [c]
    forall a. a -> [a] -> [a]
    : (a -> Bool) -> b -> (a -> b -> c) -> [a] -> [b] -> [c]
    forall a b c.
    (a -> Bool) -> b -> (a -> b -> c) -> [a] -> [b] -> [c]
    stretchZipWith a -> Bool
    p b
    z a -> b -> c
    f [a]
    xs [b]
    ys
      | Bool
    otherwise = case [b]
    ys of
                    []     -> []
                    (b
    y:[b]
    ys) -> a -> b -> c
    f a
    x b
    y c -> [c] -> [c]
    forall a. a -> [a] -> [a]
    : (a -> Bool) -> b -> (a -> b -> c) -> [a] -> [b] -> [c]
    forall a b c.
    (a -> Bool) -> b -> (a -> b -> c) -> [a] -> [b] -> [c]
    stretchZipWith a -> Bool
    p b
    z a -> b -> c
    f [a]
    xs [b]
    ys

    mapFst :: Functor f => (a->c) -> f(a,b) -> f(c,b)
    mapSnd :: Functor f => (b->c) -> f(a,b) -> f(a,c)

    mapFst :: forall (f :: * -> *) a c b.
    Functor f =>
    (a -> c) -> f (a, b) -> f (c, b)
    mapFst = ((a, b) -> (c, b)) -> f (a, b) -> f (c, b)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((a, b) -> (c, b)) -> f (a, b) -> f (c, b))
    -> ((a -> c) -> (a, b) -> (c, b))
    -> (a -> c)
    -> f (a, b)
    -> f (c, b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> c) -> (a, b) -> (c, b)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first
    mapSnd :: forall (f :: * -> *) b c a.
    Functor f =>
    (b -> c) -> f (a, b) -> f (a, c)
    mapSnd = ((a, b) -> (a, c)) -> f (a, b) -> f (a, c)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((a, b) -> (a, c)) -> f (a, b) -> f (a, c))
    -> ((b -> c) -> (a, b) -> (a, c))
    -> (b -> c)
    -> f (a, b)
    -> f (a, c)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> c) -> (a, b) -> (a, c)
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second

    mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])

    mapAndUnzip :: forall a b c. (a -> (b, c)) -> [a] -> ([b], [c])
    mapAndUnzip a -> (b, c)
    _ [] = ([], [])
    mapAndUnzip a -> (b, c)
    f (a
    x:[a]
    xs)
      = let (b
    r1,  c
    r2)  = a -> (b, c)
    f a
    x
            ([b]
    rs1, [c]
    rs2) = (a -> (b, c)) -> [a] -> ([b], [c])
    forall a b c. (a -> (b, c)) -> [a] -> ([b], [c])
    mapAndUnzip a -> (b, c)
    f [a]
    xs
        in
        (b
    r1b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    rs1, c
    r2c -> [c] -> [c]
    forall a. a -> [a] -> [a]
    :[c]
    rs2)

    mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
    mapAndUnzip3 :: forall a b c d. (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
    mapAndUnzip3 a -> (b, c, d)
    _ [] = ([], [], [])
    mapAndUnzip3 a -> (b, c, d)
    f (a
    x:[a]
    xs)
      = let (b
    r1,  c
    r2,  d
    r3)  = a -> (b, c, d)
    f a
    x
            ([b]
    rs1, [c]
    rs2, [d]
    rs3) = (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
    forall a b c d. (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
    mapAndUnzip3 a -> (b, c, d)
    f [a]
    xs
        in
        (b
    r1b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    rs1, c
    r2c -> [c] -> [c]
    forall a. a -> [a] -> [a]
    :[c]
    rs2, d
    r3d -> [d] -> [d]
    forall a. a -> [a] -> [a]
    :[d]
    rs3)

    mapAndUnzip4 :: (a -> (b, c, d, e)) -> [a] -> ([b], [c], [d], [e])
    mapAndUnzip4 :: forall a b c d e.
    (a -> (b, c, d, e)) -> [a] -> ([b], [c], [d], [e])
    mapAndUnzip4 a -> (b, c, d, e)
    _ [] = ([], [], [], [])
    mapAndUnzip4 a -> (b, c, d, e)
    f (a
    x:[a]
    xs)
      = let (b
    r1,  c
    r2,  d
    r3, e
    r4)  = a -> (b, c, d, e)
    f a
    x
            ([b]
    rs1, [c]
    rs2, [d]
    rs3, [e]
    rs4) = (a -> (b, c, d, e)) -> [a] -> ([b], [c], [d], [e])
    forall a b c d e.
    (a -> (b, c, d, e)) -> [a] -> ([b], [c], [d], [e])
    mapAndUnzip4 a -> (b, c, d, e)
    f [a]
    xs
        in
        (b
    r1b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    rs1, c
    r2c -> [c] -> [c]
    forall a. a -> [a] -> [a]
    :[c]
    rs2, d
    r3d -> [d] -> [d]
    forall a. a -> [a] -> [a]
    :[d]
    rs3, e
    r4e -> [e] -> [e]
    forall a. a -> [a] -> [a]
    :[e]
    rs4)

    zipWithAndUnzip :: (a -> b -> (c,d)) -> [a] -> [b] -> ([c],[d])
    zipWithAndUnzip :: forall a b c d. (a -> b -> (c, d)) -> [a] -> [b] -> ([c], [d])
    zipWithAndUnzip a -> b -> (c, d)
    f (a
    a:[a]
    as) (b
    b:[b]
    bs)
      = let (c
    r1,  d
    r2)  = a -> b -> (c, d)
    f a
    a b
    b
            ([c]
    rs1, [d]
    rs2) = (a -> b -> (c, d)) -> [a] -> [b] -> ([c], [d])
    forall a b c d. (a -> b -> (c, d)) -> [a] -> [b] -> ([c], [d])
    zipWithAndUnzip a -> b -> (c, d)
    f [a]
    as [b]
    bs
        in
        (c
    r1c -> [c] -> [c]
    forall a. a -> [a] -> [a]
    :[c]
    rs1, d
    r2d -> [d] -> [d]
    forall a. a -> [a] -> [a]
    :[d]
    rs2)
    zipWithAndUnzip a -> b -> (c, d)
    _ [a]
    _ [b]
    _ = ([],[])

    -- | 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 :: forall a b. [a] -> [b] -> ([a], [b])
    zipAndUnzip (a
    a:[a]
    as) (b
    b:[b]
    bs)
      = let ([a]
    rs1, [b]
    rs2) = [a] -> [b] -> ([a], [b])
    forall a b. [a] -> [b] -> ([a], [b])
    zipAndUnzip [a]
    as [b]
    bs
        in
        (a
    aa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    rs1, b
    bb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    rs2)
    zipAndUnzip [a]
    _ [b]
    _ = ([],[])

    -- | @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 :: forall a b. ([a] -> b) -> b -> [a] -> Int -> b
    atLength [a] -> b
    atLenPred b
    atEnd [a]
    ls0 Int
    n0
      | Int
    n0 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0    = [a] -> b
    atLenPred [a]
    ls0
      | Bool
    otherwise = Int -> [a] -> b
    go Int
    n0 [a]
    ls0
      where
        -- go's first arg n >= 0
        go :: Int -> [a] -> b
    go Int
    0 [a]
    ls     = [a] -> b
    atLenPred [a]
    ls
        go Int
    _ []     = b
    atEnd           -- n > 0 here
        go Int
    n (a
    _:[a]
    xs) = Int -> [a] -> b
    go (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [a]
    xs

    -- Some special cases of atLength:

    -- | @(lengthExceeds xs n) = (length xs > n)@
    lengthExceeds :: [a] -> Int -> Bool
    lengthExceeds :: forall a. [a] -> Int -> Bool
    lengthExceeds [a]
    lst Int
    n
      | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0
      = Bool
    True
      | Bool
    otherwise
      = ([a] -> Bool) -> Bool -> [a] -> Int -> Bool
    forall a b. ([a] -> b) -> b -> [a] -> Int -> b
    atLength [a] -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull Bool
    False [a]
    lst Int
    n

    -- | @(lengthAtLeast xs n) = (length xs >= n)@
    lengthAtLeast :: [a] -> Int -> Bool
    lengthAtLeast :: forall a. [a] -> Int -> Bool
    lengthAtLeast = ([a] -> Bool) -> Bool -> [a] -> Int -> Bool
    forall a b. ([a] -> b) -> b -> [a] -> Int -> b
    atLength (Bool -> [a] -> Bool
    forall a b. a -> b -> a
    const Bool
    True) Bool
    False

    -- | @(lengthIs xs n) = (length xs == n)@
    lengthIs :: [a] -> Int -> Bool
    lengthIs :: forall a. [a] -> Int -> Bool
    lengthIs [a]
    lst Int
    n
      | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0
      = Bool
    False
      | Bool
    otherwise
      = ([a] -> Bool) -> Bool -> [a] -> Int -> Bool
    forall a b. ([a] -> b) -> b -> [a] -> Int -> b
    atLength [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Bool
    False [a]
    lst Int
    n

    -- | @(lengthIsNot xs n) = (length xs /= n)@
    lengthIsNot :: [a] -> Int -> Bool
    lengthIsNot :: forall a. [a] -> Int -> Bool
    lengthIsNot [a]
    lst Int
    n
      | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = Bool
    True
      | Bool
    otherwise = ([a] -> Bool) -> Bool -> [a] -> Int -> Bool
    forall a b. ([a] -> b) -> b -> [a] -> Int -> b
    atLength [a] -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull Bool
    True [a]
    lst Int
    n

    -- | @(lengthAtMost xs n) = (length xs <= n)@
    lengthAtMost :: [a] -> Int -> Bool
    lengthAtMost :: forall a. [a] -> Int -> Bool
    lengthAtMost [a]
    lst Int
    n
      | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0
      = Bool
    False
      | Bool
    otherwise
      = ([a] -> Bool) -> Bool -> [a] -> Int -> Bool
    forall a b. ([a] -> b) -> b -> [a] -> Int -> b
    atLength [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Bool
    True [a]
    lst Int
    n

    -- | @(lengthLessThan xs n) == (length xs < n)@
    lengthLessThan :: [a] -> Int -> Bool
    lengthLessThan :: forall a. [a] -> Int -> Bool
    lengthLessThan = ([a] -> Bool) -> Bool -> [a] -> Int -> Bool
    forall a b. ([a] -> b) -> b -> [a] -> Int -> b
    atLength (Bool -> [a] -> Bool
    forall a b. a -> b -> a
    const Bool
    False) Bool
    True

    listLengthCmp :: [a] -> Int -> Ordering
    listLengthCmp :: forall a. [a] -> Int -> Ordering
    listLengthCmp = ([a] -> Ordering) -> Ordering -> [a] -> Int -> Ordering
    forall a b. ([a] -> b) -> b -> [a] -> Int -> b
    atLength [a] -> Ordering
    forall {a}. [a] -> Ordering
    atLen Ordering
    atEnd
     where
      atEnd :: Ordering
    atEnd = Ordering
    LT    -- Not yet seen 'n' elts, so list length is < n.

      atLen :: [a] -> Ordering
    atLen []     = Ordering
    EQ
      atLen [a]
    _      = Ordering
    GT

    equalLength :: [a] -> [b] -> Bool
    -- ^ True if length xs == length ys
    equalLength :: forall a b. [a] -> [b] -> Bool
    equalLength []     []     = Bool
    True
    equalLength (a
    _:[a]
    xs) (b
    _:[b]
    ys) = [a] -> [b] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [a]
    xs [b]
    ys
    equalLength [a]
    _      [b]
    _      = Bool
    False

    compareLength :: [a] -> [b] -> Ordering
    compareLength :: forall a b. [a] -> [b] -> Ordering
    compareLength []     []     = Ordering
    EQ
    compareLength (a
    _:[a]
    xs) (b
    _:[b]
    ys) = [a] -> [b] -> Ordering
    forall a b. [a] -> [b] -> Ordering
    compareLength [a]
    xs [b]
    ys
    compareLength []     [b]
    _      = Ordering
    LT
    compareLength [a]
    _      []     = Ordering
    GT

    leLength :: [a] -> [b] -> Bool
    -- ^ True if length xs <= length ys
    leLength :: forall a b. [a] -> [b] -> Bool
    leLength [a]
    xs [b]
    ys = case [a] -> [b] -> Ordering
    forall a b. [a] -> [b] -> Ordering
    compareLength [a]
    xs [b]
    ys of
                       Ordering
    LT -> Bool
    True
                       Ordering
    EQ -> Bool
    True
                       Ordering
    GT -> Bool
    False

    ltLength :: [a] -> [b] -> Bool
    -- ^ True if length xs < length ys
    ltLength :: forall a b. [a] -> [b] -> Bool
    ltLength [a]
    xs [b]
    ys = case [a] -> [b] -> Ordering
    forall a b. [a] -> [b] -> Ordering
    compareLength [a]
    xs [b]
    ys of
                       Ordering
    LT -> Bool
    True
                       Ordering
    EQ -> Bool
    False
                       Ordering
    GT -> Bool
    False

    ----------------------------
    singleton :: a -> [a]
    singleton :: forall a. a -> [a]
    singleton a
    x = [a
    x]

    isSingleton :: [a] -> Bool
    isSingleton :: forall a. [a] -> Bool
    isSingleton [a
    _] = Bool
    True
    isSingleton [a]
    _   = Bool
    False

    notNull :: Foldable f => f a -> Bool
    notNull :: forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull = Bool -> Bool
    not (Bool -> Bool) -> (f a -> Bool) -> f a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f a -> Bool
    forall a. f a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null

    -- | Utility function to go from a singleton list to it's element.
    --
    -- Wether or not the argument is a singleton list is only checked
    -- in debug builds.
    only :: [a] -> a
    #if defined(DEBUG)
    only [a] = a
    #else
    only :: forall a. [a] -> a
    only (a
    a:[a]
    _) = a
    a
    #endif
    only [a]
    _ = String -> a
    forall a. HasCallStack => String -> a
    panic String
    "Util: only"

    -- | Extract the single element of a list and panic with the given message if
    -- there are more elements or the list was empty.
    -- Like 'expectJust', but for lists.
    expectOnly :: HasDebugCallStack => String -> [a] -> a
    {-# INLINE expectOnly #-}
    #if defined(DEBUG)
    expectOnly _   [a]   = a
    #else
    expectOnly :: forall a. HasDebugCallStack => String -> [a] -> a
    expectOnly String
    _   (a
    a:[a]
    _) = a
    a
    #endif
    expectOnly String
    msg [a]
    _     = String -> a
    forall a. HasCallStack => String -> a
    panic (String
    "expectOnly: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg)

    -- | Compute all the ways of removing a single element from a list.
    --
    --  > holes [1,2,3] = [(1, [2,3]), (2, [1,3]), (3, [1,2])]
    holes :: [a] -> [(a, [a])]
    holes :: forall a. [a] -> [(a, [a])]
    holes []     = []
    holes (a
    x:[a]
    xs) = (a
    x, [a]
    xs) (a, [a]) -> [(a, [a])] -> [(a, [a])]
    forall a. a -> [a] -> [a]
    : ([a] -> [a]) -> [(a, [a])] -> [(a, [a])]
    forall (f :: * -> *) b c a.
    Functor f =>
    (b -> c) -> f (a, b) -> f (a, c)
    mapSnd (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) ([a] -> [(a, [a])]
    forall a. [a] -> [(a, [a])]
    holes [a]
    xs)

    -- | Replace the last element of a list with another element.
    changeLast :: [a] -> a -> [a]
    changeLast :: forall a. [a] -> a -> [a]
    changeLast []     a
    _  = String -> [a]
    forall a. HasCallStack => String -> a
    panic String
    "changeLast"
    changeLast [a
    _]    a
    x  = [a
    x]
    changeLast (a
    x:[a]
    xs) a
    x' = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> a -> [a]
    forall a. [a] -> a -> [a]
    changeLast [a]
    xs a
    x'

    -- | Like @expectJust msg . nonEmpty@; a better alternative to 'NE.fromList'.
    expectNonEmpty :: HasDebugCallStack => String -> [a] -> NonEmpty a
    {-# INLINE expectNonEmpty #-}
    expectNonEmpty :: forall a. HasDebugCallStack => String -> [a] -> NonEmpty a
    expectNonEmpty String
    _   (a
    x:[a]
    xs) = a
    xa -> [a] -> NonEmpty a
    forall a. a -> [a] -> NonEmpty a
    :|[a]
    xs
    expectNonEmpty String
    msg []     = String -> NonEmpty a
    forall a. String -> a
    expectNonEmptyPanic String
    msg

    expectNonEmptyPanic :: String -> a
    expectNonEmptyPanic :: forall a. String -> a
    expectNonEmptyPanic String
    msg = String -> a
    forall a. HasCallStack => String -> a
    panic (String
    "expectNonEmpty: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg)
    {-# NOINLINE expectNonEmptyPanic #-}

    whenNonEmpty :: Applicative m => [a] -> (NonEmpty a -> m ()) -> m ()
    whenNonEmpty :: forall (m :: * -> *) a.
    Applicative m =>
    [a] -> (NonEmpty a -> m ()) -> m ()
    whenNonEmpty []     NonEmpty a -> m ()
    _ = () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    whenNonEmpty (a
    x:[a]
    xs) NonEmpty a -> m ()
    f = NonEmpty a -> m ()
    f (a
    x a -> [a] -> NonEmpty a
    forall a. a -> [a] -> NonEmpty a
    :| [a]
    xs)

    -- | Merge an unsorted list of sorted lists, for example:
    --
    --  > mergeListsBy compare [ [2,5,15], [1,10,100] ] = [1,2,5,10,15,100]
    --
    --  \( O(n \log{} k) \)
    mergeListsBy :: forall a. (a -> a -> Ordering) -> [[a]] -> [a]
    mergeListsBy :: forall a. (a -> a -> Ordering) -> [[a]] -> [a]
    mergeListsBy a -> a -> Ordering
    cmp [[a]]
    lists | Bool
    debugIsOn, Bool -> Bool
    not (([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [a] -> Bool
    sorted [[a]]
    lists) =
      -- When debugging is on, we check that the input lists are sorted.
      String -> [a]
    forall a. HasCallStack => String -> a
    panic String
    "mergeListsBy: input lists must be sorted"
      where sorted :: [a] -> Bool
    sorted = (a -> a -> Ordering) -> [a] -> Bool
    forall a. (a -> a -> Ordering) -> [a] -> Bool
    isSortedBy a -> a -> Ordering
    cmp
    mergeListsBy a -> a -> Ordering
    cmp [[a]]
    all_lists = [[a]] -> [a]
    merge_lists [[a]]
    all_lists
      where
        -- Implements "Iterative 2-Way merge" described at
        -- https://en.wikipedia.org/wiki/K-way_merge_algorithm

        -- Merge two sorted lists into one in O(n).
        merge2 :: [a] -> [a] -> [a]
        merge2 :: [a] -> [a] -> [a]
    merge2 [] [a]
    ys = [a]
    ys
        merge2 [a]
    xs [] = [a]
    xs
        merge2 (a
    x:[a]
    xs) (a
    y:[a]
    ys) =
          case a -> a -> Ordering
    cmp a
    x a
    y of
            Ordering
    GT -> a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> [a]
    merge2 (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs) [a]
    ys
            Ordering
    _  -> a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> [a]
    merge2 [a]
    xs (a
    ya -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys)

        -- Merge the first list with the second, the third with the fourth, and so
        -- on. The output has half as much lists as the input.
        merge_neighbours :: [[a]] -> [[a]]
        merge_neighbours :: [[a]] -> [[a]]
    merge_neighbours []   = []
        merge_neighbours [[a]
    xs] = [[a]
    xs]
        merge_neighbours ([a]
    xs : [a]
    ys : [[a]]
    lists) =
          [a] -> [a] -> [a]
    merge2 [a]
    xs [a]
    ys [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]] -> [[a]]
    merge_neighbours [[a]]
    lists

        -- Since 'merge_neighbours' halves the amount of lists in each iteration,
        -- we perform O(log k) iteration. Each iteration is O(n). The total running
        -- time is therefore O(n log k).
        merge_lists :: [[a]] -> [a]
        merge_lists :: [[a]] -> [a]
    merge_lists [[a]]
    lists =
          case [[a]] -> [[a]]
    merge_neighbours [[a]]
    lists of
            []     -> []
            [[a]
    xs]   -> [a]
    xs
            [[a]]
    lists' -> [[a]] -> [a]
    merge_lists [[a]]
    lists'

    isSortedBy :: (a -> a -> Ordering) -> [a] -> Bool
    isSortedBy :: forall a. (a -> a -> Ordering) -> [a] -> Bool
    isSortedBy a -> a -> Ordering
    cmp = [a] -> Bool
    sorted
      where
        sorted :: [a] -> Bool
    sorted [] = Bool
    True
        sorted [a
    _] = Bool
    True
        sorted (a
    x:a
    y:[a]
    xs) = a -> a -> Ordering
    cmp a
    x a
    y Ordering -> Ordering -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Ordering
    GT Bool -> Bool -> Bool
    && [a] -> Bool
    sorted (a
    ya -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs)
    {-
    ************************************************************************
    *                                                                      *
    \subsubsection{Sort utils}
    *                                                                      *
    ************************************************************************
    -}

    minWith :: Ord b => (a -> b) -> [a] -> a
    minWith :: forall b a. Ord b => (a -> b) -> [a] -> a
    minWith a -> b
    get_key [a]
    xs = Bool -> ([a] -> a) -> [a] -> a
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not ([a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    xs) )
                         [a] -> a
    forall a. HasCallStack => [a] -> a
    Partial.head ((a -> b) -> [a] -> [a]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortWith a -> b
    get_key [a]
    xs)

    nubSort :: Ord a => [a] -> [a]
    nubSort :: forall a. Ord a => [a] -> [a]
    nubSort = Set a -> [a]
    forall a. Set a -> [a]
    Set.toAscList (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Set a
    forall a. Ord a => [a] -> Set a
    Set.fromList

    -- | Remove duplicates but keep elements in order.
    --   O(n * log n)
    ordNub :: Ord a => [a] -> [a]
    ordNub :: forall a. Ord a => [a] -> [a]
    ordNub [a]
    xs = (a -> a) -> [a] -> [a]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    ordNubOn a -> a
    forall a. a -> a
    id [a]
    xs

    -- | Remove duplicates but keep elements in order.
    --   O(n * log n)
    ordNubOn :: Ord b => (a -> b) -> [a] -> [a]
    ordNubOn :: forall b a. Ord b => (a -> b) -> [a] -> [a]
    ordNubOn a -> b
    f [a]
    xs
      = Set b -> [a] -> [a]
    go Set b
    forall a. Set a
    Set.empty [a]
    xs
      where
        go :: Set b -> [a] -> [a]
    go Set b
    _ [] = []
        go Set b
    s (a
    x:[a]
    xs)
          | b -> Set b -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member (a -> b
    f a
    x) Set b
    s = Set b -> [a] -> [a]
    go Set b
    s [a]
    xs
          | Bool
    otherwise = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : Set b -> [a] -> [a]
    go (b -> Set b -> Set b
    forall a. Ord a => a -> Set a -> Set a
    Set.insert (a -> b
    f a
    x) Set b
    s) [a]
    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 :: forall a. (a -> [a]) -> (a -> a -> Bool) -> [a] -> [a]
    transitiveClosure a -> [a]
    succ a -> a -> Bool
    eq [a]
    xs
     = [a] -> [a] -> [a]
    go [] [a]
    xs
     where
       go :: [a] -> [a] -> [a]
    go [a]
    done []                      = [a]
    done
       go [a]
    done (a
    x:[a]
    xs) | a
    x a -> [a] -> Bool
    `is_in` [a]
    done = [a] -> [a] -> [a]
    go [a]
    done [a]
    xs
                      | Bool
    otherwise      = [a] -> [a] -> [a]
    go (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    done) (a -> [a]
    succ a
    x [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    xs)

       a
    _ is_in :: a -> [a] -> Bool
    `is_in` []                 = Bool
    False
       a
    x `is_in` (a
    y:[a]
    ys) | a -> a -> Bool
    eq a
    x a
    y    = Bool
    True
                        | Bool
    otherwise = a
    x a -> [a] -> Bool
    `is_in` [a]
    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 :: forall acc a b. (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
    foldl2 acc -> a -> b -> acc
    _ acc
    z [] [] = acc
    z
    foldl2 acc -> a -> b -> acc
    k acc
    z (a
    a:[a]
    as) (b
    b:[b]
    bs) = (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
    forall acc a b. (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
    foldl2 acc -> a -> b -> acc
    k (acc -> a -> b -> acc
    k acc
    z a
    a b
    b) [a]
    as [b]
    bs
    foldl2 acc -> a -> b -> acc
    _ acc
    _ [a]
    _      [b]
    _      = String -> acc
    forall a. HasCallStack => String -> a
    panic String
    "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 :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
    all2 a -> b -> Bool
    _ []     []     = Bool
    True
    all2 a -> b -> Bool
    p (a
    x:[a]
    xs) (b
    y:[b]
    ys) = a -> b -> Bool
    p a
    x b
    y Bool -> Bool -> Bool
    && (a -> b -> Bool) -> [a] -> [b] -> Bool
    forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
    all2 a -> b -> Bool
    p [a]
    xs [b]
    ys
    all2 a -> b -> Bool
    _ [a]
    _      [b]
    _      = Bool
    False

    any2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
    -- True if any of the corresponding elements satisfy the predicate
    -- Unlike `all2`, this ignores excess elements of the other list
    any2 :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
    any2 a -> b -> Bool
    p (a
    x:[a]
    xs) (b
    y:[b]
    ys) = a -> b -> Bool
    p a
    x b
    y Bool -> Bool -> Bool
    || (a -> b -> Bool) -> [a] -> [b] -> Bool
    forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
    any2 a -> b -> Bool
    p [a]
    xs [b]
    ys
    any2 a -> b -> Bool
    _ [a]
    _      [b]
    _      = Bool
    False

    -- Count the number of times a predicate is true

    count :: (a -> Bool) -> [a] -> Int
    count :: forall a. (a -> Bool) -> [a] -> Int
    count a -> Bool
    p = Int -> [a] -> Int
    go Int
    0
      where go :: Int -> [a] -> Int
    go !Int
    n [] = Int
    n
            go !Int
    n (a
    x:[a]
    xs) | a -> Bool
    p a
    x       = Int -> [a] -> Int
    go (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) [a]
    xs
                         | Bool
    otherwise = Int -> [a] -> Int
    go Int
    n [a]
    xs

    countWhile :: (a -> Bool) -> [a] -> Int
    -- Length of an /initial prefix/ of the list satisfying p
    countWhile :: forall a. (a -> Bool) -> [a] -> Int
    countWhile a -> Bool
    p = Int -> [a] -> Int
    go Int
    0
      where go :: Int -> [a] -> Int
    go !Int
    n (a
    x:[a]
    xs) | a -> Bool
    p a
    x = Int -> [a] -> Int
    go (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) [a]
    xs
            go !Int
    n [a]
    _            = Int
    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 :: forall b a. [b] -> [a] -> [a]
    takeList [] [a]
    _ = []
    takeList (b
    _:[b]
    xs) [a]
    ls =
       case [a]
    ls of
         [] -> []
         (a
    y:[a]
    ys) -> a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [b] -> [a] -> [a]
    forall b a. [b] -> [a] -> [a]
    takeList [b]
    xs [a]
    ys

    dropList :: [b] -> [a] -> [a]
    dropList :: forall b a. [b] -> [a] -> [a]
    dropList [] [a]
    xs    = [a]
    xs
    dropList [b]
    _  xs :: [a]
    xs@[] = [a]
    xs
    dropList (b
    _:[b]
    xs) (a
    _:[a]
    ys) = [b] -> [a] -> [a]
    forall b a. [b] -> [a] -> [a]
    dropList [b]
    xs [a]
    ys

    -- | Given two lists xs and ys, return `splitAt (length xs) ys`.
    splitAtList :: [b] -> [a] -> ([a], [a])
    splitAtList :: forall b a. [b] -> [a] -> ([a], [a])
    splitAtList [b]
    xs [a]
    ys = Int# -> [b] -> [a] -> ([a], [a])
    go Int#
    0# [b]
    xs [a]
    ys
       where
          -- we are careful to avoid allocating when there are no leftover
          -- arguments: in this case we can return "ys" directly (cf #18535)
          --
          -- We make `xs` strict because in the general case `ys` isn't `[]` so we
          -- will have to evaluate `xs` anyway.
          go :: Int# -> [b] -> [a] -> ([a], [a])
    go Int#
    _  ![b]
    _     []     = ([a]
    ys, [])             -- length ys <= length xs
          go Int#
    n  []     [a]
    bs     = (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take (Int# -> Int
    I# Int#
    n) [a]
    ys, [a]
    bs) -- = splitAt n ys
          go Int#
    n  (b
    _:[b]
    as) (a
    _:[a]
    bs) = Int# -> [b] -> [a] -> ([a], [a])
    go (Int#
    n Int# -> Int# -> Int#
    +# Int#
    1#) [b]
    as [a]
    bs

    -- | drop from the end of a list
    dropTail :: Int -> [a] -> [a]
    -- Specification: dropTail n = reverse . drop n . reverse
    -- Better implementation due to Joachim Breitner
    -- http://www.joachim-breitner.de/blog/archives/600-On-taking-the-last-n-elements-of-a-list.html
    dropTail :: forall a. Int -> [a] -> [a]
    dropTail Int
    n [a]
    xs
      = [a] -> [a] -> [a]
    forall b a. [b] -> [a] -> [a]
    go (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    n [a]
    xs) [a]
    xs
      where
        go :: [a] -> [a] -> [a]
    go (a
    _:[a]
    ys) (a
    x:[a]
    xs) = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> [a]
    go [a]
    ys [a]
    xs
        go [a]
    _      [a]
    _      = []  -- 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 :: forall a. (a -> Bool) -> [a] -> [a]
    dropWhileEndLE a -> Bool
    p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\a
    x [a]
    r -> if [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    r Bool -> Bool -> Bool
    && a -> Bool
    p a
    x then [] else a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    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 :: forall a. (a -> Bool) -> [a] -> ([a], [a])
    spanEnd a -> Bool
    p [a]
    l = [a] -> [a] -> [a] -> [a] -> ([a], [a])
    go [a]
    l [] [] [a]
    l
      where go :: [a] -> [a] -> [a] -> [a] -> ([a], [a])
    go [a]
    yes [a]
    _rev_yes [a]
    rev_no [] = ([a]
    yes, [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    rev_no)
            go [a]
    yes [a]
    rev_yes  [a]
    rev_no (a
    x:[a]
    xs)
              | a -> Bool
    p a
    x       = [a] -> [a] -> [a] -> [a] -> ([a], [a])
    go [a]
    yes (a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    rev_yes) [a]
    rev_no                  [a]
    xs
              | Bool
    otherwise = [a] -> [a] -> [a] -> [a] -> ([a], [a])
    go [a]
    xs  []            (a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    rev_yes [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    rev_no) [a]
    xs

    -- | Get the last two elements in a list.
    {-# INLINE last2 #-}
    last2 :: [a] -> Maybe (a,a)
    last2 :: forall a. [a] -> Maybe (a, a)
    last2 = (Maybe a -> Maybe a -> Maybe (a, a))
    -> (Maybe a, Maybe a) -> Maybe (a, a)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ((a -> a -> (a, a)) -> Maybe a -> Maybe a -> Maybe (a, a)
    forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (,)) ((Maybe a, Maybe a) -> Maybe (a, a))
    -> ([a] -> (Maybe a, Maybe a)) -> [a] -> Maybe (a, a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Maybe a, Maybe a) -> a -> (Maybe a, Maybe a))
    -> (Maybe a, Maybe a) -> [a] -> (Maybe a, Maybe a)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' (\(Maybe a
    _,Maybe a
    x2) a
    x -> (Maybe a
    x2, a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x)) (Maybe a
    forall a. Maybe a
    Nothing, Maybe a
    forall a. Maybe a
    Nothing)

    lastMaybe :: [a] -> Maybe a
    lastMaybe :: forall a. [a] -> Maybe a
    lastMaybe [] = Maybe a
    forall a. Maybe a
    Nothing
    lastMaybe (a
    x:[a]
    xs) = a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ NonEmpty a -> a
    forall a. NonEmpty a -> a
    last (a
    xa -> [a] -> NonEmpty a
    forall a. a -> [a] -> NonEmpty a
    :|[a]
    xs)

    -- | @onJust x m f@ applies f to the value inside the Just or returns the default.
    onJust :: b -> Maybe a -> (a->b) -> b
    onJust :: forall b a. b -> Maybe a -> (a -> b) -> b
    onJust b
    dflt = ((a -> b) -> Maybe a -> b) -> Maybe a -> (a -> b) -> b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (b -> (a -> b) -> Maybe a -> b
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe b
    dflt)

    -- | 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 :: forall a. [a] -> Maybe ([a], a)
    snocView = (NonEmpty a -> ([a], a)) -> Maybe (NonEmpty a) -> Maybe ([a], a)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap NonEmpty a -> ([a], a)
    forall a. NonEmpty a -> ([a], a)
    go (Maybe (NonEmpty a) -> Maybe ([a], a))
    -> ([a] -> Maybe (NonEmpty a)) -> [a] -> Maybe ([a], a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Maybe (NonEmpty a)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty
      where
        go :: NonEmpty a -> ([a],a)
        go :: forall a. NonEmpty a -> ([a], a)
    go (a
    x:|[a]
    xs) = case [a] -> Maybe (NonEmpty a)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty [a]
    xs of
            Maybe (NonEmpty a)
    Nothing -> ([],a
    x)
            Just NonEmpty a
    xs -> case NonEmpty a -> ([a], a)
    forall a. NonEmpty a -> ([a], a)
    go NonEmpty a
    xs of !([a]
    xs', a
    x') -> (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs', a
    x')

    split :: Char -> String -> [String]
    split :: Char -> String -> [String]
    split Char
    c String
    s = case String
    rest of
                    []     -> [String
    chunk]
                    Char
    _:String
    rest -> String
    chunk String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : Char -> String -> [String]
    split Char
    c String
    rest
      where (String
    chunk, String
    rest) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    c) String
    s

    -- | Convert a word to title case by capitalising the first letter
    capitalise :: String -> String
    capitalise :: String -> String
    capitalise [] = []
    capitalise (Char
    c:String
    cs) = Char -> Char
    toUpper Char
    c Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    cs

    {-
    ************************************************************************
    *                                                                      *
    \subsection[Utils-comparison]{Comparisons}
    *                                                                      *
    ************************************************************************
    -}

    isEqual :: Ordering -> Bool
    -- Often used in (isEqual (a `compare` b))
    isEqual :: Ordering -> Bool
    isEqual Ordering
    GT = Bool
    False
    isEqual Ordering
    EQ = Bool
    True
    isEqual Ordering
    LT = Bool
    False

    removeSpaces :: String -> String
    removeSpaces :: String -> String
    removeSpaces = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhileEndLE Char -> Bool
    isSpace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace

    -- Boolean operators lifted to Applicative
    (<&&>) :: Applicative f => f Bool -> f Bool -> f Bool
    <&&> :: forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
    (<&&>) = (Bool -> Bool -> Bool) -> f Bool -> f Bool -> f Bool
    forall a b c. (a -> b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 Bool -> Bool -> Bool
    (&&)
    infixr 3 <&&> -- same as (&&)

    (<||>) :: Applicative f => f Bool -> f Bool -> f Bool
    <||> :: forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
    (<||>) = (Bool -> Bool -> Bool) -> f Bool -> f Bool -> f Bool
    forall a b c. (a -> b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 Bool -> Bool -> Bool
    (||)
    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 :: String -> String -> Int
    restrictedDamerauLevenshteinDistance String
    str1 String
    str2
      = Int -> Int -> String -> String -> Int
    restrictedDamerauLevenshteinDistanceWithLengths Int
    m Int
    n String
    str1 String
    str2
      where
        m :: Int
    m = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str1
        n :: Int
    n = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str2

    restrictedDamerauLevenshteinDistanceWithLengths
      :: Int -> Int -> String -> String -> Int
    restrictedDamerauLevenshteinDistanceWithLengths :: Int -> Int -> String -> String -> Int
    restrictedDamerauLevenshteinDistanceWithLengths Int
    m Int
    n String
    str1 String
    str2
      | Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    n
      = if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    32 -- n must be larger so this check is sufficient
        then Word32 -> Int -> Int -> String -> String -> Int
    forall bv.
    (Bits bv, Num bv) =>
    bv -> Int -> Int -> String -> String -> Int
    restrictedDamerauLevenshteinDistance' (Word32
    forall a. HasCallStack => a
    undefined :: Word32) Int
    m Int
    n String
    str1 String
    str2
        else Integer -> Int -> Int -> String -> String -> Int
    forall bv.
    (Bits bv, Num bv) =>
    bv -> Int -> Int -> String -> String -> Int
    restrictedDamerauLevenshteinDistance' (Integer
    forall a. HasCallStack => a
    undefined :: Integer) Int
    m Int
    n String
    str1 String
    str2

      | Bool
    otherwise
      = if Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    32 -- m must be larger so this check is sufficient
        then Word32 -> Int -> Int -> String -> String -> Int
    forall bv.
    (Bits bv, Num bv) =>
    bv -> Int -> Int -> String -> String -> Int
    restrictedDamerauLevenshteinDistance' (Word32
    forall a. HasCallStack => a
    undefined :: Word32) Int
    n Int
    m String
    str2 String
    str1
        else Integer -> Int -> Int -> String -> String -> Int
    forall bv.
    (Bits bv, Num bv) =>
    bv -> Int -> Int -> String -> String -> Int
    restrictedDamerauLevenshteinDistance' (Integer
    forall a. HasCallStack => a
    undefined :: Integer) Int
    n Int
    m String
    str2 String
    str1

    restrictedDamerauLevenshteinDistance'
      :: (Bits bv, Num bv) => bv -> Int -> Int -> String -> String -> Int
    restrictedDamerauLevenshteinDistance' :: forall bv.
    (Bits bv, Num bv) =>
    bv -> Int -> Int -> String -> String -> Int
    restrictedDamerauLevenshteinDistance' bv
    _bv_dummy Int
    m Int
    n String
    str1 String
    str2
      | [] <- String
    str1 = Int
    n
      | Bool
    otherwise  = (bv, bv, bv, bv, Int) -> Int
    forall {a} {b} {c} {d} {e}. (a, b, c, d, e) -> e
    extractAnswer ((bv, bv, bv, bv, Int) -> Int) -> (bv, bv, bv, bv, Int) -> Int
    forall a b. (a -> b) -> a -> b
    $
                     ((bv, bv, bv, bv, Int) -> Char -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> String -> (bv, bv, bv, bv, Int)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' (IntMap bv
    -> bv
    -> bv
    -> (bv, bv, bv, bv, Int)
    -> Char
    -> (bv, bv, bv, bv, Int)
    forall bv.
    (Bits bv, Num bv) =>
    IntMap bv
    -> bv
    -> bv
    -> (bv, bv, bv, bv, Int)
    -> Char
    -> (bv, bv, bv, bv, Int)
    restrictedDamerauLevenshteinDistanceWorker
                                 (String -> IntMap bv
    forall bv. (Bits bv, Num bv) => String -> IntMap bv
    matchVectors String
    str1) bv
    top_bit_mask bv
    vector_mask)
                            (bv
    0, bv
    0, bv
    m_ones, bv
    0, Int
    m) String
    str2
      where
        m_ones :: bv
    m_ones@bv
    vector_mask = (bv
    2 bv -> Int -> bv
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int
    m) bv -> bv -> bv
    forall a. Num a => a -> a -> a
    - bv
    1
        top_bit_mask :: bv
    top_bit_mask = (bv
    1 bv -> Int -> bv
    forall a. Bits a => a -> Int -> a
    `shiftL` (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)) bv -> bv -> bv
    forall a. a -> a -> a
    `asTypeOf` bv
    _bv_dummy
        extractAnswer :: (a, b, c, d, e) -> e
    extractAnswer (a
    _, b
    _, c
    _, d
    _, e
    distance) = e
    distance

    restrictedDamerauLevenshteinDistanceWorker
          :: (Bits bv, Num bv) => IM.IntMap bv -> bv -> bv
          -> (bv, bv, bv, bv, Int) -> Char -> (bv, bv, bv, bv, Int)
    restrictedDamerauLevenshteinDistanceWorker :: forall bv.
    (Bits bv, Num bv) =>
    IntMap bv
    -> bv
    -> bv
    -> (bv, bv, bv, bv, Int)
    -> Char
    -> (bv, bv, bv, bv, Int)
    restrictedDamerauLevenshteinDistanceWorker IntMap bv
    str1_mvs bv
    top_bit_mask bv
    vector_mask
                                               (bv
    pm, bv
    d0, bv
    vp, bv
    vn, Int
    distance) Char
    char2
      = IntMap bv -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. a -> b -> b
    seq IntMap bv
    str1_mvs ((bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. (a -> b) -> a -> b
    $ bv -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. a -> b -> b
    seq bv
    top_bit_mask ((bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. (a -> b) -> a -> b
    $ bv -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. a -> b -> b
    seq bv
    vector_mask ((bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. (a -> b) -> a -> b
    $
        bv -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. a -> b -> b
    seq bv
    pm' ((bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. (a -> b) -> a -> b
    $ bv -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. a -> b -> b
    seq bv
    d0' ((bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. (a -> b) -> a -> b
    $ bv -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. a -> b -> b
    seq bv
    vp' ((bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. (a -> b) -> a -> b
    $ bv -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. a -> b -> b
    seq bv
    vn' ((bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. (a -> b) -> a -> b
    $
        Int -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. a -> b -> b
    seq Int
    distance'' ((bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. (a -> b) -> a -> b
    $ Char -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. a -> b -> b
    seq Char
    char2 ((bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int))
    -> (bv, bv, bv, bv, Int) -> (bv, bv, bv, bv, Int)
    forall a b. (a -> b) -> a -> b
    $
        (bv
    pm', bv
    d0', bv
    vp', bv
    vn', Int
    distance'')
      where
        pm' :: bv
    pm' = bv -> Int -> IntMap bv -> bv
    forall a. a -> Int -> IntMap a -> a
    IM.findWithDefault bv
    0 (Char -> Int
    ord Char
    char2) IntMap bv
    str1_mvs

        d0' :: bv
    d0' = ((((bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    sizedComplement bv
    vector_mask bv
    d0) bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    pm') bv -> Int -> bv
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    1) bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    pm)
          bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .|. ((((bv
    pm' bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    vp) bv -> bv -> bv
    forall a. Num a => a -> a -> a
    + bv
    vp) bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    vector_mask) bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    `xor` bv
    vp) bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .|. bv
    pm' bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .|. bv
    vn
              -- No need to mask the shiftL because of the restricted range of pm

        hp' :: bv
    hp' = bv
    vn bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .|. bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    sizedComplement bv
    vector_mask (bv
    d0' bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .|. bv
    vp)
        hn' :: bv
    hn' = bv
    d0' bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    vp

        hp'_shift :: bv
    hp'_shift = ((bv
    hp' bv -> Int -> bv
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    1) bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .|. bv
    1) bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    vector_mask
        hn'_shift :: bv
    hn'_shift = (bv
    hn' bv -> Int -> bv
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    1) bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    vector_mask
        vp' :: bv
    vp' = bv
    hn'_shift bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .|. bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    sizedComplement bv
    vector_mask (bv
    d0' bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .|. bv
    hp'_shift)
        vn' :: bv
    vn' = bv
    d0' bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    hp'_shift

        distance' :: Int
    distance' = if bv
    hp' bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    top_bit_mask bv -> bv -> Bool
    forall a. Eq a => a -> a -> Bool
    /= bv
    0 then Int
    distance Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 else Int
    distance
        distance'' :: Int
    distance'' = if bv
    hn' bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    .&. bv
    top_bit_mask bv -> bv -> Bool
    forall a. Eq a => a -> a -> Bool
    /= bv
    0 then Int
    distance' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 else Int
    distance'

    sizedComplement :: Bits bv => bv -> bv -> bv
    sizedComplement :: forall bv. Bits bv => bv -> bv -> bv
    sizedComplement bv
    vector_mask bv
    vect = bv
    vector_mask bv -> bv -> bv
    forall bv. Bits bv => bv -> bv -> bv
    `xor` bv
    vect

    matchVectors :: (Bits bv, Num bv) => String -> IM.IntMap bv
    matchVectors :: forall bv. (Bits bv, Num bv) => String -> IntMap bv
    matchVectors = (Int, IntMap bv) -> IntMap bv
    forall a b. (a, b) -> b
    snd ((Int, IntMap bv) -> IntMap bv)
    -> (String -> (Int, IntMap bv)) -> String -> IntMap bv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, IntMap bv) -> Char -> (Int, IntMap bv))
    -> (Int, IntMap bv) -> String -> (Int, IntMap bv)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' (Int, IntMap bv) -> Char -> (Int, IntMap bv)
    forall {a} {a}.
    (Bits a, Integral a, Num a) =>
    (a, IntMap a) -> Char -> (a, IntMap a)
    go (Int
    0 :: Int, IntMap bv
    forall a. IntMap a
    IM.empty)
      where
        go :: (a, IntMap a) -> Char -> (a, IntMap a)
    go (a
    ix, IntMap a
    im) Char
    char = let ix' :: a
    ix' = a
    ix a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1
                               im' :: IntMap a
    im' = (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
    forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
    IM.insertWith a -> a -> a
    forall bv. Bits bv => bv -> bv -> bv
    (.|.) (Char -> Int
    ord Char
    char) (a
    2 a -> a -> a
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ a
    ix) IntMap a
    im
                           in a -> (a, IntMap a) -> (a, IntMap a)
    forall a b. a -> b -> b
    seq a
    ix' ((a, IntMap a) -> (a, IntMap a)) -> (a, IntMap a) -> (a, IntMap a)
    forall a b. (a -> b) -> a -> b
    $ IntMap a -> (a, IntMap a) -> (a, IntMap a)
    forall a b. a -> b -> b
    seq IntMap a
    im' ((a, IntMap a) -> (a, IntMap a)) -> (a, IntMap a) -> (a, IntMap a)
    forall a b. (a -> b) -> a -> b
    $ (a
    ix', IntMap a
    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 :: String -> [String] -> [String]
    fuzzyMatch String
    key [String]
    vals = String -> [(String, String)] -> [String]
    forall a. String -> [(String, a)] -> [a]
    fuzzyLookup String
    key [(String
    v,String
    v) | String
    v <- [String]
    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 :: forall a. String -> [(String, a)] -> [a]
    fuzzyLookup String
    user_entered [(String, a)]
    possibilities
      = ((a, (Int, Int, String)) -> a) -> [(a, (Int, Int, String))] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, (Int, Int, String)) -> a
    forall a b. (a, b) -> a
    fst ([(a, (Int, Int, String))] -> [a])
    -> [(a, (Int, Int, String))] -> [a]
    forall a b. (a -> b) -> a -> b
    $ Int -> [(a, (Int, Int, String))] -> [(a, (Int, Int, String))]
    forall a. Int -> [a] -> [a]
    take Int
    mAX_RESULTS ([(a, (Int, Int, String))] -> [(a, (Int, Int, String))])
    -> [(a, (Int, Int, String))] -> [(a, (Int, Int, String))]
    forall a b. (a -> b) -> a -> b
    $ ((a, (Int, Int, String)) -> (a, (Int, Int, String)) -> Ordering)
    -> [(a, (Int, Int, String))] -> [(a, (Int, Int, String))]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    List.sortBy (((a, (Int, Int, String)) -> (Int, Int, String))
    -> (a, (Int, Int, String)) -> (a, (Int, Int, String)) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (a, (Int, Int, String)) -> (Int, Int, String)
    forall a b. (a, b) -> b
    snd)
        [ (a
    poss_val, (Int, Int, String)
    sort_key)
        | (String
    poss_str, a
    poss_val) <- [(String, a)]
    possibilities
        , let distance :: Int
    distance = String -> String -> Int
    restrictedDamerauLevenshteinDistance String
    poss_str String
    user_entered
        , Int
    distance Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    fuzzy_threshold
        , let sort_key :: (Int, Int, String)
    sort_key = (Int
    distance, String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    poss_str, String
    poss_str)
        ]
      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
        --
        -- Candidates with the same distance are sorted by their length. We also
        -- use the actual string as the third sorting criteria the sort key to get
        -- deterministic output, even if the input may have depended on the uniques
        -- in question
        fuzzy_threshold :: Int
    fuzzy_threshold = Rational -> Int
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate (Rational -> Int) -> Rational -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    user_entered Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / (Rational
    4 :: Rational)
        mAX_RESULTS :: Int
    mAX_RESULTS = Int
    3

    {-
    ************************************************************************
    *                                                                      *
    \subsection[Utils-pairs]{Pairs}
    *                                                                      *
    ************************************************************************
    -}

    unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
    unzipWith :: forall a b c. (a -> b -> c) -> [(a, b)] -> [c]
    unzipWith = ((a, b) -> c) -> [(a, b)] -> [c]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((a, b) -> c) -> [(a, b)] -> [c])
    -> ((a -> b -> c) -> (a, b) -> c)
    -> (a -> b -> c)
    -> [(a, b)]
    -> [c]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> b -> c) -> (a, b) -> c
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry

    seqList :: [a] -> b -> b
    seqList :: forall a b. [a] -> b -> b
    seqList [] b
    b = b
    b
    seqList (a
    x:[a]
    xs) b
    b = a
    x a -> b -> b
    forall a b. a -> b -> b
    `seq` [a] -> b -> b
    forall a b. [a] -> b -> b
    seqList [a]
    xs b
    b

    strictMap :: (a -> b) -> [a] -> [b]
    strictMap :: forall a b. (a -> b) -> [a] -> [b]
    strictMap a -> b
    _ []     = []
    strictMap a -> b
    f (a
    x:[a]
    xs) =
      let
        !x' :: b
    x' = a -> b
    f a
    x
        !xs' :: [b]
    xs' = (a -> b) -> [a] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    strictMap a -> b
    f [a]
    xs
      in
        b
    x' b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    : [b]
    xs'

    strictZipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
    strictZipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    strictZipWith a -> b -> c
    _ []     [b]
    _      = []
    strictZipWith a -> b -> c
    _ [a]
    _      []     = []
    strictZipWith a -> b -> c
    f (a
    x:[a]
    xs) (b
    y:[b]
    ys) =
      let
        !x' :: c
    x' = a -> b -> c
    f a
    x b
    y
        !xs' :: [c]
    xs' = (a -> b -> c) -> [a] -> [b] -> [c]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    strictZipWith a -> b -> c
    f [a]
    xs [b]
    ys
      in
        c
    x' c -> [c] -> [c]
    forall a. a -> [a] -> [a]
    : [c]
    xs'

    strictZipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    strictZipWith3 :: forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    strictZipWith3 a -> b -> c -> d
    _ []     [b]
    _      [c]
    _      = []
    strictZipWith3 a -> b -> c -> d
    _ [a]
    _      []     [c]
    _      = []
    strictZipWith3 a -> b -> c -> d
    _ [a]
    _      [b]
    _      []     = []
    strictZipWith3 a -> b -> c -> d
    f (a
    x:[a]
    xs) (b
    y:[b]
    ys) (c
    z:[c]
    zs) =
      let
        !x' :: d
    x' = a -> b -> c -> d
    f a
    x b
    y c
    z
        !xs' :: [d]
    xs' = (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    strictZipWith3 a -> b -> c -> d
    f [a]
    xs [b]
    ys [c]
    zs
      in
        d
    x' d -> [d] -> [d]
    forall a. a -> [a] -> [a]
    : [d]
    xs'

    -- Module names:

    looksLikeModuleName :: String -> Bool
    looksLikeModuleName :: String -> Bool
    looksLikeModuleName [] = Bool
    False
    looksLikeModuleName (Char
    c:String
    cs) = Char -> Bool
    isUpper Char
    c Bool -> Bool -> Bool
    && String -> Bool
    go String
    cs
      where go :: String -> Bool
    go [] = Bool
    True
            go (Char
    '.':String
    cs) = String -> Bool
    looksLikeModuleName String
    cs
            go (Char
    c:String
    cs)   = (Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\'') Bool -> Bool -> Bool
    && String -> Bool
    go String
    cs

    -- Similar to 'parse' for Distribution.Package.PackageName,
    -- but we don't want to depend on Cabal.
    looksLikePackageName :: String -> Bool
    looksLikePackageName :: String -> Bool
    looksLikePackageName = (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isAlphaNum (String -> Bool) -> (String -> Bool) -> String -> Bool
    forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
    <&&> Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isDigit)) ([String] -> Bool) -> (String -> [String]) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> [String]
    split Char
    '-'

    -----------------------------------------------------------------------------
    -- Integers

    -- | Determine the $\log_2$ of exact powers of 2
    exactLog2 :: Integer -> Maybe Integer
    exactLog2 :: Integer -> Maybe Integer
    exactLog2 Integer
    x
       | Integer
    x Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    0                               = Maybe Integer
    forall a. Maybe a
    Nothing
       | Integer
    x Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int32 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32
    forall a. Bounded a => a
    maxBound :: Int32) = Maybe Integer
    forall a. Maybe a
    Nothing
       | Int32
    x' Int32 -> Int32 -> Int32
    forall bv. Bits bv => bv -> bv -> bv
    .&. (-Int32
    x') Int32 -> Int32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int32
    x'                   = Maybe Integer
    forall a. Maybe a
    Nothing
       | Bool
    otherwise                            = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    c)
          where
             x' :: Int32
    x' = Integer -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    x :: Int32
             c :: Int
    c = Int32 -> Int
    forall b. FiniteBits b => b -> Int
    countTrailingZeros Int32
    x'

    {-
    -- -----------------------------------------------------------------------------
    -- Floats
    -}

    readRational__ :: ReadS Rational -- NB: doesn't handle leading "-"
    readRational__ :: ReadS Rational
    readRational__ String
    r = do
          ((i, e), t) <- ReadS (Integer, Integer)
    readSignificandExponentPair__ String
    r
          return ((i%1)*10^^e, t)

    readRational :: String -> Rational -- NB: *does* handle a leading "-"
    readRational :: String -> Rational
    readRational String
    top_s
      = case String
    top_s of
          Char
    '-' : String
    xs -> Rational -> Rational
    forall a. Num a => a -> a
    negate (String -> Rational
    read_me String
    xs)
          String
    xs       -> String -> Rational
    read_me String
    xs
      where
        read_me :: String -> Rational
    read_me String
    s
          = case (do { (x,"") <- ReadS Rational
    readRational__ String
    s ; return x }) of
              [Rational
    x] -> Rational
    x
              []  -> String -> Rational
    forall a. HasCallStack => String -> a
    error (String
    "readRational: no parse:"        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    top_s)
              [Rational]
    _   -> String -> Rational
    forall a. HasCallStack => String -> a
    error (String
    "readRational: ambiguous parse:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    top_s)

    readSignificandExponentPair__ :: ReadS (Integer, Integer) -- NB: doesn't handle leading "-"
    readSignificandExponentPair__ :: ReadS (Integer, Integer)
    readSignificandExponentPair__ String
    r = do
         (n,d,s) <- String -> [(Integer, Int, String)]
    readFix String
    r
         (k,t)   <- readExp s
         let pair = (Integer
    n, Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    d))
         return (pair, t)
     where
         readFix :: String -> [(Integer, Int, String)]
    readFix String
    r = do
            (ds,s)  <- String -> [(String, String)]
    lexDecDigits String
    r
            (ds',t) <- lexDotDigits s
            return (read (ds++ds'), length ds', t)

         readExp :: String -> m (Int, String)
    readExp (Char
    e:String
    s) | Char
    e Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "eE" = String -> m (Int, String)
    forall {m :: * -> *}. MonadFail m => String -> m (Int, String)
    readExp' String
    s
         readExp String
    s                     = (Int, String) -> m (Int, String)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    0,String
    s)

         readExp' :: String -> m (Int, String)
    readExp' (Char
    '+':String
    s) = String -> m (Int, String)
    forall {m :: * -> *}. MonadFail m => String -> m (Int, String)
    readDec String
    s
         readExp' (Char
    '-':String
    s) = do (k,t) <- String -> m (Int, String)
    forall {m :: * -> *}. MonadFail m => String -> m (Int, String)
    readDec String
    s
                               return (-k,t)
         readExp' String
    s       = String -> m (Int, String)
    forall {m :: * -> *}. MonadFail m => String -> m (Int, String)
    readDec String
    s

         readDec :: String -> m (Int, String)
    readDec String
    s = do
            (ds,r) <- (Char -> Bool) -> String -> m (String, String)
    forall {m :: * -> *}.
    MonadFail m =>
    (Char -> Bool) -> String -> m (String, String)
    nonnull Char -> Bool
    isDigit String
    s
            return (foldl1 (\Int
    n Int
    d -> Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    d) [ ord d - ord '0' | d <- ds ],
                    r)

         lexDecDigits :: String -> [(String, String)]
    lexDecDigits = (Char -> Bool) -> String -> [(String, String)]
    forall {m :: * -> *}.
    MonadFail m =>
    (Char -> Bool) -> String -> m (String, String)
    nonnull Char -> Bool
    isDigit

         lexDotDigits :: String -> m (String, String)
    lexDotDigits (Char
    '.':String
    s) = (String, String) -> m (String, String)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    isDigit String
    s)
         lexDotDigits String
    s       = (String, String) -> m (String, String)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "",String
    s)

         nonnull :: (Char -> Bool) -> String -> m (String, String)
    nonnull Char -> Bool
    p String
    s = do (cs@(_:_),t) <- (String, String) -> m (String, String)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    p String
    s)
                          return (cs,t)

         span' :: (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    _ xs :: String
    xs@[]         =  (String
    xs, String
    xs)
         span' Char -> Bool
    p xs :: String
    xs@(Char
    x:String
    xs')
                   | Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'  = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    p String
    xs'   -- skip "_" (#14473)
                   | Char -> Bool
    p Char
    x       =  let (String
    ys,String
    zs) = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    p String
    xs' in (Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    ys,String
    zs)
                   | Bool
    otherwise =  ([],String
    xs)

    -- | Parse a string into a significand and exponent.
    -- A trivial example might be:
    --   ghci> readSignificandExponentPair "1E2"
    --   (1,2)
    -- In a more complex case we might return a exponent different than that
    -- which the user wrote. This is needed in order to use a Integer significand.
    --   ghci> readSignificandExponentPair "-1.11E5"
    --   (-111,3)
    readSignificandExponentPair :: String -> (Integer, Integer) -- NB: *does* handle a leading "-"
    readSignificandExponentPair :: String -> (Integer, Integer)
    readSignificandExponentPair String
    top_s
      = case String
    top_s of
          Char
    '-' : String
    xs -> let (Integer
    i, Integer
    e) = String -> (Integer, Integer)
    read_me String
    xs in (-Integer
    i, Integer
    e)
          String
    xs       -> String -> (Integer, Integer)
    read_me String
    xs
      where
        read_me :: String -> (Integer, Integer)
    read_me String
    s
          = case (do { (x,"") <- ReadS (Integer, Integer)
    readSignificandExponentPair__ String
    s ; return x }) of
              [(Integer, Integer)
    x] -> (Integer, Integer)
    x
              []  -> String -> (Integer, Integer)
    forall a. HasCallStack => String -> a
    error (String
    "readSignificandExponentPair: no parse:"        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    top_s)
              [(Integer, Integer)]
    _   -> String -> (Integer, Integer)
    forall a. HasCallStack => String -> a
    error (String
    "readSignificandExponentPair: ambiguous parse:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    top_s)

    readHexRational :: String -> Rational
    readHexRational :: String -> Rational
    readHexRational String
    str =
      case String
    str of
        Char
    '-' : String
    xs -> Rational -> Rational
    forall a. Num a => a -> a
    negate (String -> Rational
    readMe String
    xs)
        String
    xs       -> String -> Rational
    readMe String
    xs
      where
      readMe :: String -> Rational
    readMe String
    as =
        case String -> Maybe Rational
    readHexRational__ String
    as of
          Just Rational
    n -> Rational
    n
          Maybe Rational
    _      -> String -> Rational
    forall a. HasCallStack => String -> a
    error (String
    "readHexRational: no parse:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str)

    readHexRational__ :: String -> Maybe Rational
    readHexRational__ :: String -> Maybe Rational
    readHexRational__ (Char
    '0' : Char
    x : String
    rest)
      | Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'X' Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'x' =
      do let (String
    front,String
    rest2) = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    isHexDigit String
    rest
         Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    front))
         let frontNum :: Integer
    frontNum = Integer -> Integer -> String -> Integer
    forall {t :: * -> *} {b}.
    (Foldable t, Num b) =>
    b -> b -> t Char -> b
    steps Integer
    16 Integer
    0 String
    front
         case String
    rest2 of
           Char
    '.' : String
    rest3 ->
              do let (String
    back,String
    rest4) = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    isHexDigit String
    rest3
                 Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    back))
                 let backNum :: Integer
    backNum = Integer -> Integer -> String -> Integer
    forall {t :: * -> *} {b}.
    (Foldable t, Num b) =>
    b -> b -> t Char -> b
    steps Integer
    16 Integer
    frontNum String
    back
                     exp1 :: Int
    exp1    = -Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    back
                 case String
    rest4 of
                   Char
    p : String
    ps | Char -> Bool
    isExp Char
    p -> (Int -> Rational) -> Maybe Int -> Maybe Rational
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Integer -> Int -> Rational
    mk Integer
    backNum (Int -> Rational) -> (Int -> Int) -> Int -> Rational
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    exp1)) (String -> Maybe Int
    forall {a}. Num a => String -> Maybe a
    getExp String
    ps)
                   String
    _ -> Rational -> Maybe Rational
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Int -> Rational
    mk Integer
    backNum Int
    exp1)
           Char
    p : String
    ps | Char -> Bool
    isExp Char
    p -> (Int -> Rational) -> Maybe Int -> Maybe Rational
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Integer -> Int -> Rational
    mk Integer
    frontNum) (String -> Maybe Int
    forall {a}. Num a => String -> Maybe a
    getExp String
    ps)
           String
    _ -> Maybe Rational
    forall a. Maybe a
    Nothing

      where
      isExp :: Char -> Bool
    isExp Char
    p = Char
    p Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'p' Bool -> Bool -> Bool
    || Char
    p Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'P'

      getExp :: String -> Maybe a
    getExp (Char
    '+' : String
    ds) = String -> Maybe a
    forall {a}. Num a => String -> Maybe a
    dec String
    ds
      getExp (Char
    '-' : String
    ds) = (a -> a) -> Maybe a -> Maybe a
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> a
    forall a. Num a => a -> a
    negate (String -> Maybe a
    forall {a}. Num a => String -> Maybe a
    dec String
    ds)
      getExp String
    ds         = String -> Maybe a
    forall {a}. Num a => String -> Maybe a
    dec String
    ds

      mk :: Integer -> Int -> Rational
      mk :: Integer -> Int -> Rational
    mk Integer
    n Int
    e = Integer -> Rational
    forall a. Num a => Integer -> a
    fromInteger Integer
    n Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    2Rational -> Int -> Rational
    forall a b. (Fractional a, Integral b) => a -> b -> a
    ^^Int
    e

      dec :: String -> Maybe a
    dec String
    cs = case (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    isDigit String
    cs of
                 (String
    ds,String
    "") | Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    ds) -> a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> a -> String -> a
    forall {t :: * -> *} {b}.
    (Foldable t, Num b) =>
    b -> b -> t Char -> b
    steps a
    10 a
    0 String
    ds)
                 (String, String)
    _ -> Maybe a
    forall a. Maybe a
    Nothing

      steps :: b -> b -> t Char -> b
    steps b
    base b
    n t Char
    ds = (b -> Char -> b) -> b -> t Char -> b
    forall b a. (b -> a -> b) -> b -> t a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' (b -> b -> Char -> b
    forall {a}. Num a => a -> a -> Char -> a
    step b
    base) b
    n t Char
    ds
      step :: a -> a -> Char -> a
    step  a
    base a
    n Char
    d  = a
    base a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    n a -> a -> a
    forall a. Num a => a -> a -> a
    + Int -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    digitToInt Char
    d)

      span' :: (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    _ xs :: String
    xs@[]         =  (String
    xs, String
    xs)
      span' Char -> Bool
    p xs :: String
    xs@(Char
    x:String
    xs')
                | Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'  = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    p String
    xs'   -- skip "_"  (#14473)
                | Char -> Bool
    p Char
    x       =  let (String
    ys,String
    zs) = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    p String
    xs' in (Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    ys,String
    zs)
                | Bool
    otherwise =  ([],String
    xs)

    readHexRational__ String
    _ = Maybe Rational
    forall a. Maybe a
    Nothing

    -- | Parse a string into a significand and exponent according to
    -- the "Hexadecimal Floats in Haskell" proposal.
    -- A trivial example might be:
    --   ghci> readHexSignificandExponentPair "0x1p+1"
    --   (1,1)
    -- Behaves similar to readSignificandExponentPair but the base is 16
    -- and numbers are given in hexadecimal:
    --   ghci> readHexSignificandExponentPair "0xAp-4"
    --   (10,-4)
    --   ghci> readHexSignificandExponentPair "0x1.2p3"
    --   (18,-1)
    readHexSignificandExponentPair :: String -> (Integer, Integer)
    readHexSignificandExponentPair :: String -> (Integer, Integer)
    readHexSignificandExponentPair String
    str =
      case String
    str of
        Char
    '-' : String
    xs -> let (Integer
    i, Integer
    e) = String -> (Integer, Integer)
    readMe String
    xs in (-Integer
    i, Integer
    e)
        String
    xs       -> String -> (Integer, Integer)
    readMe String
    xs
      where
      readMe :: String -> (Integer, Integer)
    readMe String
    as =
        case String -> Maybe (Integer, Integer)
    readHexSignificandExponentPair__ String
    as of
          Just (Integer, Integer)
    n -> (Integer, Integer)
    n
          Maybe (Integer, Integer)
    _      -> String -> (Integer, Integer)
    forall a. HasCallStack => String -> a
    error (String
    "readHexSignificandExponentPair: no parse:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str)

    readHexSignificandExponentPair__ :: String -> Maybe (Integer, Integer)
    readHexSignificandExponentPair__ :: String -> Maybe (Integer, Integer)
    readHexSignificandExponentPair__ (Char
    '0' : Char
    x : String
    rest)
      | Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'X' Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'x' =
      do let (String
    front,String
    rest2) = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    isHexDigit String
    rest
         Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    front))
         let frontNum :: Integer
    frontNum = Integer -> Integer -> String -> Integer
    forall {t :: * -> *} {b}.
    (Foldable t, Num b) =>
    b -> b -> t Char -> b
    steps Integer
    16 Integer
    0 String
    front
         case String
    rest2 of
           Char
    '.' : String
    rest3 ->
              do let (String
    back,String
    rest4) = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    isHexDigit String
    rest3
                 Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    back))
                 let backNum :: Integer
    backNum = Integer -> Integer -> String -> Integer
    forall {t :: * -> *} {b}.
    (Foldable t, Num b) =>
    b -> b -> t Char -> b
    steps Integer
    16 Integer
    frontNum String
    back
                     exp1 :: Int
    exp1    = -Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    back
                 case String
    rest4 of
                   Char
    p : String
    ps | Char -> Bool
    isExp Char
    p -> (Int -> (Integer, Integer))
    -> Maybe Int -> Maybe (Integer, Integer)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Integer -> Int -> (Integer, Integer)
    mk Integer
    backNum (Int -> (Integer, Integer))
    -> (Int -> Int) -> Int -> (Integer, Integer)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    exp1)) (String -> Maybe Int
    forall {a}. Num a => String -> Maybe a
    getExp String
    ps)
                   String
    _ -> (Integer, Integer) -> Maybe (Integer, Integer)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Int -> (Integer, Integer)
    mk Integer
    backNum Int
    exp1)
           Char
    p : String
    ps | Char -> Bool
    isExp Char
    p -> (Int -> (Integer, Integer))
    -> Maybe Int -> Maybe (Integer, Integer)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Integer -> Int -> (Integer, Integer)
    mk Integer
    frontNum) (String -> Maybe Int
    forall {a}. Num a => String -> Maybe a
    getExp String
    ps)
           String
    _ -> Maybe (Integer, Integer)
    forall a. Maybe a
    Nothing

      where
      isExp :: Char -> Bool
    isExp Char
    p = Char
    p Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'p' Bool -> Bool -> Bool
    || Char
    p Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'P'

      getExp :: String -> Maybe a
    getExp (Char
    '+' : String
    ds) = String -> Maybe a
    forall {a}. Num a => String -> Maybe a
    dec String
    ds
      getExp (Char
    '-' : String
    ds) = (a -> a) -> Maybe a -> Maybe a
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> a
    forall a. Num a => a -> a
    negate (String -> Maybe a
    forall {a}. Num a => String -> Maybe a
    dec String
    ds)
      getExp String
    ds         = String -> Maybe a
    forall {a}. Num a => String -> Maybe a
    dec String
    ds

      mk :: Integer -> Int -> (Integer, Integer)
      mk :: Integer -> Int -> (Integer, Integer)
    mk Integer
    n Int
    e = (Integer
    n, Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    e)

      dec :: String -> Maybe a
    dec String
    cs = case (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    isDigit String
    cs of
                 (String
    ds,String
    "") | Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    ds) -> a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> a -> String -> a
    forall {t :: * -> *} {b}.
    (Foldable t, Num b) =>
    b -> b -> t Char -> b
    steps a
    10 a
    0 String
    ds)
                 (String, String)
    _ -> Maybe a
    forall a. Maybe a
    Nothing

      steps :: b -> b -> t Char -> b
    steps b
    base b
    n t Char
    ds = (b -> Char -> b) -> b -> t Char -> b
    forall b a. (b -> a -> b) -> b -> t a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (b -> b -> Char -> b
    forall {a}. Num a => a -> a -> Char -> a
    step b
    base) b
    n t Char
    ds
      step :: a -> a -> Char -> a
    step  a
    base a
    n Char
    d  = a
    base a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    n a -> a -> a
    forall a. Num a => a -> a -> a
    + Int -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    digitToInt Char
    d)

      span' :: (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    _ xs :: String
    xs@[]         =  (String
    xs, String
    xs)
      span' Char -> Bool
    p xs :: String
    xs@(Char
    x:String
    xs')
                | Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'  = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    p String
    xs'   -- skip "_"  (#14473)
                | Char -> Bool
    p Char
    x       =  let (String
    ys,String
    zs) = (Char -> Bool) -> String -> (String, String)
    span' Char -> Bool
    p String
    xs' in (Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    ys,String
    zs)
                | Bool
    otherwise =  ([],String
    xs)

    readHexSignificandExponentPair__ String
    _ = Maybe (Integer, Integer)
    forall a. Maybe a
    Nothing

    -----------------------------------------------------------------------------
    -- Verify that the 'dirname' portion of a FilePath exists.
    --
    doesDirNameExist :: FilePath -> IO Bool
    doesDirNameExist :: String -> IO Bool
    doesDirNameExist String
    fpath = String -> IO Bool
    doesDirectoryExist (String -> String
    takeDirectory String
    fpath)

    -----------------------------------------------------------------------------
    -- Backwards compatibility definition of getModificationTime

    getModificationUTCTime :: FilePath -> IO UTCTime
    getModificationUTCTime :: String -> IO UTCTime
    getModificationUTCTime = String -> IO UTCTime
    getModificationTime

    -- --------------------------------------------------------------
    -- check existence & modification time at the same time

    modificationTimeIfExists :: FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists :: String -> IO (Maybe UTCTime)
    modificationTimeIfExists String
    f =
      (do t <- String -> IO UTCTime
    getModificationUTCTime String
    f; return (Just t))
            IO (Maybe UTCTime)
    -> (IOException -> IO (Maybe UTCTime)) -> IO (Maybe UTCTime)
    forall a. IO a -> (IOException -> IO a) -> IO a
    `catchIO` \IOException
    e -> if IOException -> Bool
    isDoesNotExistError IOException
    e
                            then Maybe UTCTime -> IO (Maybe UTCTime)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe UTCTime
    forall a. Maybe a
    Nothing
                            else IOException -> IO (Maybe UTCTime)
    forall a. IOException -> IO a
    ioError IOException
    e

    -- --------------------------------------------------------------
    -- check existence & hash at the same time

    fileHashIfExists :: FilePath -> IO (Maybe Fingerprint)
    fileHashIfExists :: String -> IO (Maybe Fingerprint)
    fileHashIfExists String
    f =
      (do t <- String -> IO Fingerprint
    getFileHash String
    f; return (Just t))
            IO (Maybe Fingerprint)
    -> (IOException -> IO (Maybe Fingerprint))
    -> IO (Maybe Fingerprint)
    forall a. IO a -> (IOException -> IO a) -> IO a
    `catchIO` \IOException
    e -> if IOException -> Bool
    isDoesNotExistError IOException
    e
                            then Maybe Fingerprint -> IO (Maybe Fingerprint)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Fingerprint
    forall a. Maybe a
    Nothing
                            else IOException -> IO (Maybe Fingerprint)
    forall a. IOException -> IO a
    ioError IOException
    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 :: forall (m :: * -> *) a.
    MonadIO m =>
    String -> (String -> m a) -> m a
    withAtomicRename String
    targetFile String -> m a
    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 :: String
    temp = String
    targetFile String -> String -> String
    <.> String
    "tmp"
      res <- String -> m a
    f String
    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 :: String -> (Char -> Bool) -> (String, String)
    splitLongestPrefix String
    str Char -> Bool
    pred = case String
    r_pre of
        [] -> (String
    str,           [])
        Char
    _:String
    r_pre' -> (String -> String
    forall a. [a] -> [a]
    reverse String
    r_pre', String -> String
    forall a. [a] -> [a]
    reverse String
    r_suf)
                               -- 'tail' drops the char satisfying 'pred'
      where (String
    r_suf, String
    r_pre) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    pred (String -> String
    forall a. [a] -> [a]
    reverse String
    str)

    escapeSpaces :: String -> String
    escapeSpaces :: String -> String
    escapeSpaces = (Char -> String -> String) -> String -> String -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Char
    c String
    s -> if Char -> Bool
    isSpace Char
    c then Char
    '\\'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    s else Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    s) String
    ""

    type Suffix = String

    --------------------------------------------------------------
    -- * Search path
    --------------------------------------------------------------

    data Direction = Forwards | Backwards

    reslash :: Direction -> FilePath -> FilePath
    reslash :: Direction -> String -> String
    reslash Direction
    d = String -> String
    f
        where f :: String -> String
    f (Char
    '/'  : String
    xs) = Char
    slash Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    f String
    xs
              f (Char
    '\\' : String
    xs) = Char
    slash Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    f String
    xs
              f (Char
    x    : String
    xs) = Char
    x     Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    f String
    xs
              f String
    ""          = String
    ""
              slash :: Char
    slash = case Direction
    d of
                      Direction
    Forwards -> Char
    '/'
                      Direction
    Backwards -> Char
    '\\'

    makeRelativeTo :: FilePath -> FilePath -> FilePath
    String
    this makeRelativeTo :: String -> String -> String
    `makeRelativeTo` String
    that = String
    directory String -> String -> String
    </> String
    thisFilename
        where (String
    thisDirectory, String
    thisFilename) = String -> (String, String)
    splitFileName String
    this
              thatDirectory :: String
    thatDirectory = String -> String
    dropFileName String
    that
              directory :: String
    directory = [String] -> String
    joinPath ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String] -> [String]
    f (String -> [String]
    splitPath String
    thisDirectory)
                                       (String -> [String]
    splitPath String
    thatDirectory)

              f :: [String] -> [String] -> [String]
    f (String
    x : [String]
    xs) (String
    y : [String]
    ys)
               | String
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    y = [String] -> [String] -> [String]
    f [String]
    xs [String]
    ys
              f [String]
    xs [String]
    ys = Int -> String -> [String]
    forall a. Int -> a -> [a]
    replicate ([String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    ys) String
    ".." [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    xs

    {-
    ************************************************************************
    *                                                                      *
    \subsection[Utils-Data]{Utils for defining Data instances}
    *                                                                      *
    ************************************************************************

    These functions helps us to define Data instances for abstract types.
    -}

    abstractConstr :: String -> Constr
    abstractConstr :: String -> Constr
    abstractConstr String
    n = DataType -> String -> [String] -> Fixity -> Constr
    mkConstr (String -> DataType
    abstractDataType String
    n) (String
    "{abstract:"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    nString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "}") [] Fixity
    Prefix

    abstractDataType :: String -> DataType
    abstractDataType :: String -> DataType
    abstractDataType String
    n = String -> [Constr] -> DataType
    mkDataType String
    n [String -> Constr
    abstractConstr String
    n]

    {-
    ************************************************************************
    *                                                                      *
    \subsection[Utils-C]{Utils for printing C code}
    *                                                                      *
    ************************************************************************
    -}

    charToC :: Word8 -> String
    charToC :: Word8 -> String
    charToC Word8
    w =
      case Int -> Char
    chr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w) of
            Char
    '\"' -> String
    "\\\""
            Char
    '\'' -> String
    "\\\'"
            Char
    '\\' -> String
    "\\\\"
            Char
    c | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    ' ' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '~' -> [Char
    c]
              | Bool
    otherwise -> [Char
    '\\',
                             Int -> Char
    chr (Char -> Int
    ord Char
    '0' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    64),
                             Int -> Char
    chr (Char -> Int
    ord Char
    '0' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8 Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    8),
                             Int -> Char
    chr (Char -> Int
    ord Char
    '0' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    c         Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    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 :: String -> Int32
    hashString = (Int32 -> Char -> Int32) -> Int32 -> String -> Int32
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Int32 -> Char -> Int32
    f Int32
    golden
       where f :: Int32 -> Char -> Int32
    f Int32
    m Char
    c = Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c) Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    * Int32
    magic Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    + Int32 -> Int32
    hashInt32 Int32
    m
             magic :: Int32
    magic = Word32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    0xdeadbeef :: Word32)

    golden :: Int32
    golden :: Int32
    golden = Int32
    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 :: Int32 -> Int32
    hashInt32 Int32
    x = Int32 -> Int32 -> Int32
    mulHi Int32
    x Int32
    golden Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    + Int32
    x

    -- hi 32 bits of a x-bit * 32 bit -> 64-bit multiply
    mulHi :: Int32 -> Int32 -> Int32
    mulHi :: Int32 -> Int32 -> Int32
    mulHi Int32
    a Int32
    b = Int64 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64
    r Int64 -> Int -> Int64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32)
       where r :: Int64
             r :: Int64
    r = Int32 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    a Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int32 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    b

    -- | A call stack constraint, but only when 'isDebugOn'.
    #if defined(DEBUG)
    type HasDebugCallStack = HasCallStack
    #else
    type HasDebugCallStack = (() :: Constraint)
    #endif

    mapMaybe' :: Foldable f => (a -> Maybe b) -> f a -> [b]
    mapMaybe' :: forall (f :: * -> *) a b.
    Foldable f =>
    (a -> Maybe b) -> f a -> [b]
    mapMaybe' a -> Maybe b
    f = (a -> [b] -> [b]) -> [b] -> f a -> [b]
    forall a b. (a -> b -> b) -> b -> f a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> [b] -> [b]
    g []
      where
        g :: a -> [b] -> [b]
    g a
    x [b]
    rest
          | Just b
    y <- a -> Maybe b
    f a
    x = b
    y b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    : [b]
    rest
          | Bool
    otherwise     = [b]
    rest