    -- | Non-Futhark-specific utilities.  If you find yourself writing
    -- general functions on generic data structures, consider putting them
    -- here.
    --
    -- Sometimes it is also preferable to copy a small function rather
    -- than introducing a large dependency.  In this case, make sure to
    -- note where you got it from (and make sure that the license is
    -- compatible).
    module Futhark.Util
      ( nubOrd,
        nubByOrd,
        mapAccumLM,
        maxinum,
        mininum,
        chunk,
        chunks,
        chunkLike,
        dropAt,
        takeLast,
        dropLast,
        mapEither,
        partitionMaybe,
        maybeNth,
        maybeHead,
        lookupWithIndex,
        splitFromEnd,
        splitAt3,
        focusNth,
        focusMaybe,
        hashText,
        showText,
        unixEnvironment,
        isEnvVarAtLeast,
        startupTime,
        fancyTerminal,
        hFancyTerminal,
        runProgramWithExitCode,
        directoryContents,
        fromPOSIX,
        toPOSIX,
        trim,
        pmapIO,
        interactWithFileSafely,
        convFloat,
        UserText,
        EncodedText,
        zEncodeText,
        atMostChars,
        invertMap,
        cartesian,
        traverseFold,
        fixPoint,
        concatMapM,
        topologicalSort,
        debugTraceM,
      )
    where

    import Control.Concurrent
    import Control.Exception
    import Control.Monad
    import Control.Monad.State
    import Crypto.Hash.MD5 as MD5
    import Data.Bifunctor
    import Data.ByteString qualified as BS
    import Data.ByteString.Base16 qualified as Base16
    import Data.Char
    import Data.Either
    import Data.Foldable (fold, toList)
    import Data.Function ((&))
    import Data.IntMap qualified as IM
    import Data.List qualified as L
    import Data.List.NonEmpty qualified as NE
    import Data.Map qualified as M
    import Data.Maybe
    import Data.Set qualified as S
    import Data.Text qualified as T
    import Data.Text.Encoding qualified as T
    import Data.Text.Encoding.Error qualified as T
    import Data.Time.Clock (UTCTime, getCurrentTime)
    import Data.Tuple (swap)
    import Debug.Trace
    import Numeric
    import System.Directory.Tree qualified as Dir
    import System.Environment
    import System.Exit
    import System.FilePath qualified as Native
    import System.FilePath.Posix qualified as Posix
    import System.IO (Handle, hIsTerminalDevice, stdout)
    import System.IO.Error (isDoesNotExistError)
    import System.IO.Unsafe
    import System.Process.ByteString
    import Text.Read (readMaybe)

    -- | Like @nub@, but without the quadratic runtime.
    nubOrd :: (Ord a) => [a] -> [a]
    nubOrd :: forall a. Ord a => [a] -> [a]
    nubOrd = (a -> a -> Ordering) -> [a] -> [a]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    nubByOrd a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare

    -- | Like @nubBy@, but without the quadratic runtime.
    nubByOrd :: (a -> a -> Ordering) -> [a] -> [a]
    nubByOrd :: forall a. (a -> a -> Ordering) -> [a] -> [a]
    nubByOrd a -> a -> Ordering
    cmp = (NonEmpty a -> a) -> [NonEmpty a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map NonEmpty a -> a
    forall a. NonEmpty a -> a
    NE.head ([NonEmpty a] -> [a]) -> ([a] -> [NonEmpty a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> a -> Bool) -> [a] -> [NonEmpty a]
    forall (f :: * -> *) a.
    Foldable f =>
    (a -> a -> Bool) -> f a -> [NonEmpty a]
    NE.groupBy a -> a -> Bool
    eq ([a] -> [NonEmpty a]) -> ([a] -> [a]) -> [a] -> [NonEmpty a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> a -> Ordering) -> [a] -> [a]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    L.sortBy a -> a -> Ordering
    cmp
      where
        eq :: a -> a -> Bool
    eq a
    x a
    y = a -> a -> Ordering
    cmp a
    x a
    y Ordering -> Ordering -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ordering
    EQ

    -- | Like 'Data.Traversable.mapAccumL', but monadic and generalised to
    -- any 'Traversable'.
    mapAccumLM ::
      (Monad m, Traversable t) =>
      (acc -> x -> m (acc, y)) ->
      acc ->
      t x ->
      m (acc, t y)
    mapAccumLM :: forall (m :: * -> *) (t :: * -> *) acc x y.
    (Monad m, Traversable t) =>
    (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
    mapAccumLM acc -> x -> m (acc, y)
    op acc
    initial t x
    l = do
      (l', acc) <- StateT acc m (t y) -> acc -> m (t y, acc)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT ((x -> StateT acc m y) -> t x -> StateT acc m (t y)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b)
    traverse x -> StateT acc m y
    forall {t :: (* -> *) -> * -> *}.
    (MonadState acc (t m), MonadTrans t) =>
    x -> t m y
    f t x
    l) acc
    initial
      pure (acc, l')
      where
        f :: x -> t m y
    f x
    x = do
          acc <- t m acc
    forall s (m :: * -> *). MonadState s m => m s
    get
          (acc', y) <- lift $ op acc x
          put acc'
          pure y

    -- | @chunk n a@ splits @a@ into @n@-size-chunks.  If the length of
    -- @a@ is not divisible by @n@, the last chunk will have fewer than
    -- @n@ elements (but it will never be empty).
    chunk :: Int -> [a] -> [[a]]
    chunk :: forall a. Int -> [a] -> [[a]]
    chunk Int
    _ [] = []
    chunk Int
    n [a]
    xs =
      let ([a]
    bef, [a]
    aft) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n [a]
    xs
       in [a]
    bef [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    chunk Int
    n [a]
    aft

    -- | @chunks ns a@ splits @a@ into chunks determined by the elements
    -- of @ns@.  It must hold that @sum ns == length a@, or the resulting
    -- list may contain too few chunks, or not all elements of @a@.
    chunks :: [Int] -> [a] -> [[a]]
    chunks :: forall a. [Int] -> [a] -> [[a]]
    chunks [] [a]
    _ = []
    chunks (Int
    n : [Int]
    ns) [a]
    xs =
      let ([a]
    bef, [a]
    aft) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n [a]
    xs
       in [a]
    bef [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [Int] -> [a] -> [[a]]
    forall a. [Int] -> [a] -> [[a]]
    chunks [Int]
    ns [a]
    aft

    -- | @chunkLike xss ys@ chunks the elements of @ys@ to match the
    -- elements of @xss@.  The sum of the lengths of the sublists of @xss@
    -- must match the length of @ys@.
    chunkLike :: [[a]] -> [b] -> [[b]]
    chunkLike :: forall a b. [[a]] -> [b] -> [[b]]
    chunkLike [[a]]
    as = [Int] -> [b] -> [[b]]
    forall a. [Int] -> [a] -> [[a]]
    chunks (([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    as)

    -- | Like 'maximum', but returns zero for an empty list.
    maxinum :: (Num a, Ord a, Foldable f) => f a -> a
    maxinum :: forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
    maxinum = (a -> a -> a) -> a -> f a -> a
    forall b a. (b -> a -> b) -> b -> f a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl' a -> a -> a
    forall a. Ord a => a -> a -> a
    max a
    0

    -- | Like 'minimum', but returns zero for an empty list.
    mininum :: (Num a, Ord a, Foldable f) => f a -> a
    mininum :: forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
    mininum f a
    xs = (a -> a -> a) -> a -> f a -> a
    forall b a. (b -> a -> b) -> b -> f a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl' a -> a -> a
    forall a. Ord a => a -> a -> a
    min (f a -> a
    forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
    maxinum f a
    xs) f a
    xs

    -- | @dropAt i n@ drops @n@ elements starting at element @i@.
    dropAt :: Int -> Int -> [a] -> [a]
    dropAt :: forall a. Int -> Int -> [a] -> [a]
    dropAt Int
    i Int
    n [a]
    xs = Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take Int
    i [a]
    xs [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) [a]
    xs

    -- | @takeLast n l@ takes the last @n@ elements of @l@.
    takeLast :: Int -> [a] -> [a]
    takeLast :: forall a. Int -> [a] -> [a]
    takeLast Int
    n = [a] -> [a]
    forall a. [a] -> [a]
    reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take Int
    n ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    forall a. [a] -> [a]
    reverse

    -- | @dropLast n l@ drops the last @n@ elements of @l@.
    dropLast :: Int -> [a] -> [a]
    dropLast :: forall a. Int -> [a] -> [a]
    dropLast Int
    n = [a] -> [a]
    forall a. [a] -> [a]
    reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    n ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    forall a. [a] -> [a]
    reverse

    -- | A combination of 'map' and 'partitionEithers'.
    mapEither :: (a -> Either b c) -> [a] -> ([b], [c])
    mapEither :: forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
    mapEither a -> Either b c
    f [a]
    l = [Either b c] -> ([b], [c])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers ([Either b c] -> ([b], [c])) -> [Either b c] -> ([b], [c])
    forall a b. (a -> b) -> a -> b
    $ (a -> Either b c) -> [a] -> [Either b c]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Either b c
    f [a]
    l

    -- | A combination of 'Data.List.partition' and 'mapMaybe'
    partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
    partitionMaybe :: forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
    partitionMaybe a -> Maybe b
    f = ([b], [a]) -> [a] -> ([b], [a])
    helper ([], [])
      where
        helper :: ([b], [a]) -> [a] -> ([b], [a])
    helper ([b]
    acc1, [a]
    acc2) [] = ([b] -> [b]
    forall a. [a] -> [a]
    reverse [b]
    acc1, [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    acc2)
        helper ([b]
    acc1, [a]
    acc2) (a
    x : [a]
    xs) =
          case a -> Maybe b
    f a
    x of
            Just b
    x' -> ([b], [a]) -> [a] -> ([b], [a])
    helper (b
    x' b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    : [b]
    acc1, [a]
    acc2) [a]
    xs
            Maybe b
    Nothing -> ([b], [a]) -> [a] -> ([b], [a])
    helper ([b]
    acc1, a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    acc2) [a]
    xs

    -- | Return the list element at the given index, if the index is valid.
    maybeNth :: (Integral int) => int -> [a] -> Maybe a
    maybeNth :: forall int a. Integral int => int -> [a] -> Maybe a
    maybeNth int
    i [a]
    l
      | int
    i int -> int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= int
    0, a
    v : [a]
    _ <- int -> [a] -> [a]
    forall i a. Integral i => i -> [a] -> [a]
    L.genericDrop int
    i [a]
    l = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    v
      | Bool
    otherwise = Maybe a
    forall a. Maybe a
    Nothing

    -- | Return the first element of the list, if it exists.
    maybeHead :: [a] -> Maybe a
    maybeHead :: forall a. [a] -> Maybe a
    maybeHead [] = Maybe a
    forall a. Maybe a
    Nothing
    maybeHead (a
    x : [a]
    _) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x

    -- | Lookup a value, returning also the index at which it appears.
    lookupWithIndex :: (Eq a) => a -> [(a, b)] -> Maybe (Int, b)
    lookupWithIndex :: forall a b. Eq a => a -> [(a, b)] -> Maybe (Int, b)
    lookupWithIndex a
    needle [(a, b)]
    haystack =
      a -> [(a, (Int, b))] -> Maybe (Int, b)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup a
    needle ([(a, (Int, b))] -> Maybe (Int, b))
    -> [(a, (Int, b))] -> Maybe (Int, b)
    forall a b. (a -> b) -> a -> b
    $ [a] -> [(Int, b)] -> [(a, (Int, b))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (((a, b) -> a) -> [(a, b)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, b) -> a
    forall a b. (a, b) -> a
    fst [(a, b)]
    haystack) ([Int] -> [b] -> [(Int, b)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0 ..] (((a, b) -> b) -> [(a, b)] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, b) -> b
    forall a b. (a, b) -> b
    snd [(a, b)]
    haystack))

    -- | Like 'splitAt', but from the end.
    splitFromEnd :: Int -> [a] -> ([a], [a])
    splitFromEnd :: forall a. Int -> [a] -> ([a], [a])
    splitFromEnd Int
    i [a]
    l = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i) [a]
    l

    -- | Like 'splitAt', but produces three lists.
    splitAt3 :: Int -> Int -> [a] -> ([a], [a], [a])
    splitAt3 :: forall a. Int -> Int -> [a] -> ([a], [a], [a])
    splitAt3 Int
    n Int
    m [a]
    l =
      let ([a]
    xs, [a]
    l') = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n [a]
    l
          ([a]
    ys, [a]
    zs) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    m [a]
    l'
       in ([a]
    xs, [a]
    ys, [a]
    zs)

    -- | Return the list element at the given index, if the index is
    -- valid, along with the elements before and after.
    focusNth :: (Integral int) => int -> [a] -> Maybe ([a], a, [a])
    focusNth :: forall int a. Integral int => int -> [a] -> Maybe ([a], a, [a])
    focusNth int
    i [a]
    xs
      | ([a]
    bef, a
    x : [a]
    aft) <- int -> [a] -> ([a], [a])
    forall i a. Integral i => i -> [a] -> ([a], [a])
    L.genericSplitAt int
    i [a]
    xs = ([a], a, [a]) -> Maybe ([a], a, [a])
    forall a. a -> Maybe a
    Just ([a]
    bef, a
    x, [a]
    aft)
      | Bool
    otherwise = Maybe ([a], a, [a])
    forall a. Maybe a
    Nothing

    -- | Return the first list element that satisifes a predicate, along with the
    -- elements before and after.
    focusMaybe :: (a -> Maybe b) -> [a] -> Maybe ([a], b, [a])
    focusMaybe :: forall a b. (a -> Maybe b) -> [a] -> Maybe ([a], b, [a])
    focusMaybe a -> Maybe b
    f [a]
    xs = do
      idx <- (a -> Bool) -> [a] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    L.findIndex (Maybe b -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe b -> Bool) -> (a -> Maybe b) -> a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe b
    f) [a]
    xs
      (before, focus, after) <- focusNth idx xs
      res <- f focus
      pure (before, res, after)

    -- | Compute a hash of a text that is stable across OS versions.
    -- Returns the hash as a text as well, ready for human consumption.
    hashText :: T.Text -> T.Text
    hashText :: Text -> Text
    hashText =
      OnDecodeError -> ByteString -> Text
    T.decodeUtf8With OnDecodeError
    T.lenientDecode (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Base16.encode (ByteString -> ByteString)
    -> (Text -> ByteString) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    MD5.hash (ByteString -> ByteString)
    -> (Text -> ByteString) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ByteString
    T.encodeUtf8

    -- | Like 'show', but produces text.
    showText :: (Show a) => a -> T.Text
    showText :: forall a. Show a => a -> Text
    showText = String -> Text
    T.pack (String -> Text) -> (a -> String) -> a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    {-# NOINLINE unixEnvironment #-}

    -- | The Unix environment when the Futhark compiler started.
    unixEnvironment :: [(String, String)]
    unixEnvironment :: [(String, String)]
    unixEnvironment = IO [(String, String)] -> [(String, String)]
    forall a. IO a -> a
    unsafePerformIO IO [(String, String)]
    getEnvironment

    -- | True if the environment variable, viewed as an integer, has at
    -- least this numeric value.  Returns False if variable is unset or
    -- not numeric.
    isEnvVarAtLeast :: String -> Int -> Bool
    isEnvVarAtLeast :: String -> Int -> Bool
    isEnvVarAtLeast String
    s Int
    x =
      case String -> Maybe Int
    forall a. Read a => String -> Maybe a
    readMaybe (String -> Maybe Int) -> Maybe String -> Maybe Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    s [(String, String)]
    unixEnvironment of
        Just Int
    y -> Int
    y Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    x
        Maybe Int
    _ -> Bool
    False

    {-# NOINLINE startupTime #-}

    -- | The time at which the process started - or more accurately, the
    -- first time this binding was forced.
    startupTime :: UTCTime
    startupTime :: UTCTime
    startupTime = IO UTCTime -> UTCTime
    forall a. IO a -> a
    unsafePerformIO IO UTCTime
    getCurrentTime

    {-# NOINLINE fancyTerminal #-}

    -- | Are we running in a terminal capable of fancy commands and
    -- visualisation?
    fancyTerminal :: Bool
    fancyTerminal :: Bool
    fancyTerminal = IO Bool -> Bool
    forall a. IO a -> a
    unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Handle -> IO Bool
    hFancyTerminal Handle
    stdout

    -- | Is this handle connected to a terminal capable of fancy commands
    -- and visualisation?
    hFancyTerminal :: Handle -> IO Bool
    hFancyTerminal :: Handle -> IO Bool
    hFancyTerminal Handle
    h = do
      isTTY <- Handle -> IO Bool
    hIsTerminalDevice Handle
    h
      isDumb <- (Just "dumb" ==) <$> lookupEnv "TERM"
      pure $ isTTY && not isDumb

    -- | Like 'readProcessWithExitCode', but also wraps exceptions when
    -- the indicated binary cannot be launched, or some other exception is
    -- thrown.  Also does shenanigans to handle improperly encoded outputs.
    runProgramWithExitCode ::
      FilePath ->
      [String] ->
      BS.ByteString ->
      IO (Either IOException (ExitCode, String, String))
    runProgramWithExitCode :: String
    -> [String]
    -> ByteString
    -> IO (Either IOException (ExitCode, String, String))
    runProgramWithExitCode String
    exe [String]
    args ByteString
    inp =
      ((ExitCode, String, String)
    -> Either IOException (ExitCode, String, String)
    forall a b. b -> Either a b
    Right ((ExitCode, String, String)
     -> Either IOException (ExitCode, String, String))
    -> ((ExitCode, ByteString, ByteString)
        -> (ExitCode, String, String))
    -> (ExitCode, ByteString, ByteString)
    -> Either IOException (ExitCode, String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ExitCode, ByteString, ByteString) -> (ExitCode, String, String)
    forall {a}. (a, ByteString, ByteString) -> (a, String, String)
    postprocess ((ExitCode, ByteString, ByteString)
     -> Either IOException (ExitCode, String, String))
    -> IO (ExitCode, ByteString, ByteString)
    -> IO (Either IOException (ExitCode, String, String))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String
    -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
    readProcessWithExitCode String
    exe [String]
    args ByteString
    inp)
        IO (Either IOException (ExitCode, String, String))
    -> (IOException
        -> IO (Either IOException (ExitCode, String, String)))
    -> IO (Either IOException (ExitCode, String, String))
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \IOException
    e -> Either IOException (ExitCode, String, String)
    -> IO (Either IOException (ExitCode, String, String))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IOException -> Either IOException (ExitCode, String, String)
    forall a b. a -> Either a b
    Left IOException
    e)
      where
        decode :: ByteString -> String
    decode = Text -> String
    T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OnDecodeError -> ByteString -> Text
    T.decodeUtf8With OnDecodeError
    T.lenientDecode
        postprocess :: (a, ByteString, ByteString) -> (a, String, String)
    postprocess (a
    code, ByteString
    out, ByteString
    err) =
          (a
    code, ByteString -> String
    decode ByteString
    out, ByteString -> String
    decode ByteString
    err)

    -- | Every non-directory file contained in a directory tree.
    directoryContents :: FilePath -> IO [FilePath]
    directoryContents :: String -> IO [String]
    directoryContents String
    dir = do
      _ Dir.:/ tree <- (String -> IO String) -> String -> IO (AnchoredDirTree String)
    forall a. (String -> IO a) -> String -> IO (AnchoredDirTree a)
    Dir.readDirectoryWith String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    dir
      case Dir.failures tree of
        Dir.Failed String
    _ IOException
    err : [DirTree String]
    _ -> IOException -> IO [String]
    forall a e. (HasCallStack, Exception e) => e -> a
    throw IOException
    err
        [DirTree String]
    _ -> [String] -> IO [String]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ (DirTree String -> Maybe String) -> [DirTree String] -> [String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe DirTree String -> Maybe String
    forall {a}. DirTree a -> Maybe a
    isFile ([DirTree String] -> [String]) -> [DirTree String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ DirTree String -> [DirTree String]
    forall a. DirTree a -> [DirTree a]
    Dir.flattenDir DirTree String
    tree
      where
        isFile :: DirTree a -> Maybe a
    isFile (Dir.File String
    _ a
    path) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    path
        isFile DirTree a
    _ = Maybe a
    forall a. Maybe a
    Nothing

    -- | Turn a POSIX filepath into a filepath for the native system.
    toPOSIX :: Native.FilePath -> Posix.FilePath
    toPOSIX :: String -> String
    toPOSIX = [String] -> String
    Posix.joinPath ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    Native.splitDirectories

    -- | Some bad operating systems do not use forward slash as
    -- directory separator - this is where we convert Futhark includes
    -- (which always use forward slash) to native paths.
    fromPOSIX :: Posix.FilePath -> Native.FilePath
    fromPOSIX :: String -> String
    fromPOSIX = [String] -> String
    Native.joinPath ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    Posix.splitDirectories

    -- | Remove leading and trailing whitespace from a string.  Not an
    -- efficient implementation!
    trim :: String -> String
    trim :: String -> String
    trim = String -> String
    forall a. [a] -> [a]
    reverse (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 (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. [a] -> [a]
    reverse (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

    -- | Run various 'IO' actions concurrently, possibly with a bound on
    -- the number of threads.  The list must be finite.  The ordering of
    -- the result list is not deterministic - add your own sorting if
    -- needed.  If any of the actions throw an exception, then that
    -- exception is propagated to this function.
    pmapIO :: Maybe Int -> (a -> IO b) -> [a] -> IO [b]
    pmapIO :: forall a b. Maybe Int -> (a -> IO b) -> [a] -> IO [b]
    pmapIO Maybe Int
    concurrency a -> IO b
    f [a]
    elems = do
      tasks <- [a] -> IO (MVar [a])
    forall a. a -> IO (MVar a)
    newMVar [a]
    elems
      results <- newEmptyMVar
      num_threads <- maybe getNumCapabilities pure concurrency
      replicateM_ num_threads $ forkIO $ worker tasks results
      replicateM (length elems) $ getResult results
      where
        worker :: MVar [a] -> MVar (Either a b) -> IO ()
    worker MVar [a]
    tasks MVar (Either a b)
    results = do
          task <- MVar [a] -> ([a] -> IO ([a], Maybe a)) -> IO (Maybe a)
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar [a]
    tasks [a] -> IO ([a], Maybe a)
    forall {f :: * -> *} {a}. Applicative f => [a] -> f ([a], Maybe a)
    getTask
          case task of
            Maybe a
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
            Just a
    x -> do
              y <- (b -> Either a b
    forall a b. b -> Either a b
    Right (b -> Either a b) -> IO b -> IO (Either a b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> IO b
    f a
    x) IO (Either a b) -> (a -> IO (Either a b)) -> IO (Either a b)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` (Either a b -> IO (Either a b)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either a b -> IO (Either a b))
    -> (a -> Either a b) -> a -> IO (Either a b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either a b
    forall a b. a -> Either a b
    Left)
              putMVar results y
              worker tasks results

        getTask :: [a] -> f ([a], Maybe a)
    getTask [] = ([a], Maybe a) -> f ([a], Maybe a)
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([], Maybe a
    forall a. Maybe a
    Nothing)
        getTask (a
    task : [a]
    tasks) = ([a], Maybe a) -> f ([a], Maybe a)
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([a]
    tasks, a -> Maybe a
    forall a. a -> Maybe a
    Just a
    task)

        getResult :: MVar (Either SomeException b) -> IO b
    getResult MVar (Either SomeException b)
    results = do
          res <- MVar (Either SomeException b) -> IO (Either SomeException b)
    forall a. MVar a -> IO a
    takeMVar MVar (Either SomeException b)
    results
          case res of
            Left SomeException
    err -> SomeException -> IO b
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SomeException
    err :: SomeException)
            Right b
    v -> b -> IO b
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure b
    v

    -- | Do some operation on a file, returning 'Nothing' if the file does
    -- not exist, and 'Left' if some other error occurs.
    interactWithFileSafely :: IO a -> IO (Maybe (Either String a))
    interactWithFileSafely :: forall a. IO a -> IO (Maybe (Either String a))
    interactWithFileSafely IO a
    m =
      (Either String a -> Maybe (Either String a)
    forall a. a -> Maybe a
    Just (Either String a -> Maybe (Either String a))
    -> (a -> Either String a) -> a -> Maybe (Either String a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either String a
    forall a b. b -> Either a b
    Right (a -> Maybe (Either String a))
    -> IO a -> IO (Maybe (Either String a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO a
    m) IO (Maybe (Either String a))
    -> (IOException -> IO (Maybe (Either String a)))
    -> IO (Maybe (Either String a))
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` IOException -> IO (Maybe (Either String a))
    forall {f :: * -> *} {b}.
    Applicative f =>
    IOException -> f (Maybe (Either String b))
    couldNotRead
      where
        couldNotRead :: IOException -> f (Maybe (Either String b))
    couldNotRead IOException
    e
          | IOException -> Bool
    isDoesNotExistError IOException
    e =
              Maybe (Either String b) -> f (Maybe (Either String b))
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Either String b)
    forall a. Maybe a
    Nothing
          | Bool
    otherwise =
              Maybe (Either String b) -> f (Maybe (Either String b))
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Either String b) -> f (Maybe (Either String b)))
    -> Maybe (Either String b) -> f (Maybe (Either String b))
    forall a b. (a -> b) -> a -> b
    $ Either String b -> Maybe (Either String b)
    forall a. a -> Maybe a
    Just (Either String b -> Maybe (Either String b))
    -> Either String b -> Maybe (Either String b)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String b
    forall a b. a -> Either a b
    Left (String -> Either String b) -> String -> Either String b
    forall a b. (a -> b) -> a -> b
    $ IOException -> String
    forall a. Show a => a -> String
    show IOException
    e

    -- | Convert between different floating-point types, preserving
    -- infinities and NaNs.
    convFloat :: (RealFloat from, RealFloat to) => from -> to
    convFloat :: forall from to. (RealFloat from, RealFloat to) => from -> to
    convFloat from
    v
      | from -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite from
    v, from
    v from -> from -> Bool
    forall a. Ord a => a -> a -> Bool
    > from
    0 = to
    1 to -> to -> to
    forall a. Fractional a => a -> a -> a
    / to
    0
      | from -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite from
    v, from
    v from -> from -> Bool
    forall a. Ord a => a -> a -> Bool
    < from
    0 = -to
    1 to -> to -> to
    forall a. Fractional a => a -> a -> a
    / to
    0
      | from -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN from
    v = to
    0 to -> to -> to
    forall a. Fractional a => a -> a -> a
    / to
    0
      | Bool
    otherwise = Rational -> to
    forall a. Fractional a => Rational -> a
    fromRational (Rational -> to) -> Rational -> to
    forall a b. (a -> b) -> a -> b
    $ from -> Rational
    forall a. Real a => a -> Rational
    toRational from
    v

    -- Z-encoding from https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/SymbolNames
    --
    -- Slightly simplified as we do not need it to deal with tuples and
    -- the like.
    --
    -- (c) The University of Glasgow, 1997-2006

    -- | As the user typed it.
    type UserString = String

    -- | Encoded form.
    type EncodedString = String

    -- | As 'zEncodeText', but for strings.
    zEncodeString :: UserString -> EncodedString
    zEncodeString :: String -> String
    zEncodeString String
    "" = String
    ""
    zEncodeString (Char
    c : String
    cs) = Char -> String
    encodeDigitChar Char
    c String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char -> String) -> String -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Char -> String
    encodeChar String
    cs

    -- | As the user typed it.
    type UserText = T.Text

    -- | Encoded form.
    type EncodedText = T.Text

    -- | Z-encode a text using a slightly simplified variant of GHC
    -- Z-encoding.  The encoded string is a valid identifier in most
    -- programming languages.
    zEncodeText :: UserText -> EncodedText
    zEncodeText :: Text -> Text
    zEncodeText = String -> Text
    T.pack (String -> Text) -> (Text -> String) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    zEncodeString (String -> String) -> (Text -> String) -> Text -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack

    unencodedChar :: Char -> Bool -- True for chars that don't need encoding
    unencodedChar :: Char -> Bool
    unencodedChar Char
    'Z' = Bool
    False
    unencodedChar Char
    'z' = Bool
    False
    unencodedChar Char
    '_' = Bool
    True
    unencodedChar Char
    c =
      Char -> Bool
    isAsciiLower Char
    c
        Bool -> Bool -> Bool
    || Char -> Bool
    isAsciiUpper Char
    c
        Bool -> Bool -> Bool
    || Char -> Bool
    isDigit Char
    c

    -- If a digit is at the start of a symbol then we need to encode it.
    -- Otherwise names like 9pH-0.1 give linker errors.
    encodeDigitChar :: Char -> EncodedString
    encodeDigitChar :: Char -> String
    encodeDigitChar Char
    c
      | Char -> Bool
    isDigit Char
    c = Char -> String
    encodeAsUnicodeCharar Char
    c
      | Bool
    otherwise = Char -> String
    encodeChar Char
    c

    encodeChar :: Char -> EncodedString
    encodeChar :: Char -> String
    encodeChar Char
    c | Char -> Bool
    unencodedChar Char
    c = [Char
    c] -- Common case first

    -- Constructors
    encodeChar Char
    '(' = String
    "ZL" -- Needed for things like (,), and (->)
    encodeChar Char
    ')' = String
    "ZR" -- For symmetry with (
    encodeChar Char
    '[' = String
    "ZM"
    encodeChar Char
    ']' = String
    "ZN"
    encodeChar Char
    ':' = String
    "ZC"
    encodeChar Char
    'Z' = String
    "ZZ"
    -- Variables
    encodeChar Char
    'z' = String
    "zz"
    encodeChar Char
    '&' = String
    "za"
    encodeChar Char
    '|' = String
    "zb"
    encodeChar Char
    '^' = String
    "zc"
    encodeChar Char
    '$' = String
    "zd"
    encodeChar Char
    '=' = String
    "ze"
    encodeChar Char
    '>' = String
    "zg"
    encodeChar Char
    '#' = String
    "zh"
    encodeChar Char
    '.' = String
    "zi"
    encodeChar Char
    '<' = String
    "zl"
    encodeChar Char
    '-' = String
    "zm"
    encodeChar Char
    '!' = String
    "zn"
    encodeChar Char
    '+' = String
    "zp"
    encodeChar Char
    '\'' = String
    "zq"
    encodeChar Char
    '\\' = String
    "zr"
    encodeChar Char
    '/' = String
    "zs"
    encodeChar Char
    '*' = String
    "zt"
    encodeChar Char
    '_' = String
    "zu"
    encodeChar Char
    '%' = String
    "zv"
    encodeChar Char
    c = Char -> String
    encodeAsUnicodeCharar Char
    c

    encodeAsUnicodeCharar :: Char -> EncodedString
    encodeAsUnicodeCharar :: Char -> String
    encodeAsUnicodeCharar Char
    c =
      Char
    'z'
        Char -> String -> String
    forall a. a -> [a] -> [a]
    : if Bool -> (Char -> Bool) -> Maybe Char -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False Char -> Bool
    isDigit (Maybe Char -> Bool) -> Maybe Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe Char
    forall a. [a] -> Maybe a
    maybeHead String
    hex_str
          then String
    hex_str
          else Char
    '0' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    hex_str
      where
        hex_str :: String
    hex_str = Int -> String -> String
    forall a. Integral a => a -> String -> String
    showHex (Char -> Int
    ord Char
    c) String
    "U"

    -- | Truncate to at most this many characters, making the last three
    -- characters "..." if truncation is necessary.
    atMostChars :: Int -> T.Text -> T.Text
    atMostChars :: Int -> Text -> Text
    atMostChars Int
    n Text
    s
      | Text -> Int
    T.length Text
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    n = Int -> Text -> Text
    T.take (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3) Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "..."
      | Bool
    otherwise = Text
    s

    -- | Invert a map, handling duplicate values (now keys) by
    -- constructing a set of corresponding values.
    invertMap :: (Ord v, Ord k) => M.Map k v -> M.Map v (S.Set k)
    invertMap :: forall v k. (Ord v, Ord k) => Map k v -> Map v (Set k)
    invertMap Map k v
    m =
      ((k, v) -> Map v (Set k) -> Map v (Set k))
    -> Map v (Set k) -> [(k, v)] -> Map v (Set k)
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr
        ((v -> Set k -> Map v (Set k) -> Map v (Set k))
    -> (v, Set k) -> Map v (Set k) -> Map v (Set k)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ((Set k -> Set k -> Set k)
    -> v -> Set k -> Map v (Set k) -> Map v (Set k)
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith Set k -> Set k -> Set k
    forall a. Semigroup a => a -> a -> a
    (<>)) ((v, Set k) -> Map v (Set k) -> Map v (Set k))
    -> ((k, v) -> (v, Set k))
    -> (k, v)
    -> Map v (Set k)
    -> Map v (Set k)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Set k, v) -> (v, Set k)
    forall a b. (a, b) -> (b, a)
    swap ((Set k, v) -> (v, Set k))
    -> ((k, v) -> (Set k, v)) -> (k, v) -> (v, Set k)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (k -> Set k) -> (k, v) -> (Set k, v)
    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 k -> Set k
    forall a. a -> Set a
    S.singleton)
        Map v (Set k)
    forall a. Monoid a => a
    mempty
        (Map k v -> [(k, v)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map k v
    m)

    -- | Compute the cartesian product of two foldable collections, using the given
    -- combinator function.
    cartesian :: (Monoid m, Foldable t) => (a -> a -> m) -> t a -> t a -> m
    cartesian :: forall m (t :: * -> *) a.
    (Monoid m, Foldable t) =>
    (a -> a -> m) -> t a -> t a -> m
    cartesian a -> a -> m
    f t a
    xs t a
    ys =
      [(a
    x, a
    y) | a
    x <- t a -> [a]
    forall a. t a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList t a
    xs, a
    y <- t a -> [a]
    forall a. t a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList t a
    ys]
        [(a, a)] -> ([(a, a)] -> m) -> m
    forall a b. a -> (a -> b) -> b
    & ((a, a) -> m) -> [(a, a)] -> m
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ((a -> a -> m) -> (a, a) -> m
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry a -> a -> m
    f)

    -- | Applicatively fold a traversable.
    traverseFold :: (Monoid m, Traversable t, Applicative f) => (a -> f m) -> t a -> f m
    traverseFold :: forall m (t :: * -> *) (f :: * -> *) a.
    (Monoid m, Traversable t, Applicative f) =>
    (a -> f m) -> t a -> f m
    traverseFold a -> f m
    f = (t m -> m) -> f (t m) -> f m
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap t m -> m
    forall m. Monoid m => t m -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold (f (t m) -> f m) -> (t a -> f (t m)) -> t a -> f m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> f m) -> t a -> f (t m)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b)
    traverse a -> f m
    f

    -- | Perform fixpoint iteration.
    fixPoint :: (Eq a) => (a -> a) -> a -> a
    fixPoint :: forall a. Eq a => (a -> a) -> a -> a
    fixPoint a -> a
    f a
    x =
      let x' :: a
    x' = a -> a
    f a
    x
       in if a
    x' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    x then a
    x else (a -> a) -> a -> a
    forall a. Eq a => (a -> a) -> a -> a
    fixPoint a -> a
    f a
    x'

    -- | Like 'concatMap', but monoidal and monadic.
    concatMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b
    concatMapM :: forall (m :: * -> *) b a.
    (Monad m, Monoid b) =>
    (a -> m b) -> [a] -> m b
    concatMapM a -> m b
    f [a]
    xs = [b] -> b
    forall a. Monoid a => [a] -> a
    mconcat ([b] -> b) -> m [b] -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (a -> m b) -> [a] -> m [b]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM a -> m b
    f [a]
    xs

    -- | Topological sorting of an array with an adjancency function, if
    -- there is a cycle, it causes an error. @dep a b@ means @a -> b@,
    -- and the returned array guarantee that for i < j:
    --
    -- @not ( dep (ret !! j) (ret !! i) )@.
    topologicalSort :: (a -> a -> Bool) -> [a] -> [a]
    topologicalSort :: forall a. (a -> a -> Bool) -> [a] -> [a]
    topologicalSort a -> a -> Bool
    dep [a]
    nodes =
      ([a], IntMap Bool) -> [a]
    forall a b. (a, b) -> a
    fst (([a], IntMap Bool) -> [a]) -> ([a], IntMap Bool) -> [a]
    forall a b. (a -> b) -> a -> b
    $ State ([a], IntMap Bool) ()
    -> ([a], IntMap Bool) -> ([a], IntMap Bool)
    forall s a. State s a -> s -> s
    execState (((a, Int) -> State ([a], IntMap Bool) ())
    -> [(a, Int)] -> State ([a], IntMap Bool) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Int -> State ([a], IntMap Bool) ()
    forall {m :: * -> *}.
    MonadState ([a], IntMap Bool) m =>
    Int -> m ()
    sorting (Int -> State ([a], IntMap Bool) ())
    -> ((a, Int) -> Int) -> (a, Int) -> State ([a], IntMap Bool) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, Int) -> Int
    forall a b. (a, b) -> b
    snd) [(a, Int)]
    nodes_idx) ([a]
    forall a. Monoid a => a
    mempty, IntMap Bool
    forall a. Monoid a => a
    mempty)
      where
        nodes_idx :: [(a, Int)]
    nodes_idx = [a] -> [Int] -> [(a, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    nodes [Int
    0 ..]
        depends_of :: a -> (a, a) -> Maybe a
    depends_of a
    a (a
    b, a
    i) =
          if a
    a a -> a -> Bool
    `dep` a
    b
            then a -> Maybe a
    forall a. a -> Maybe a
    Just a
    i
            else Maybe a
    forall a. Maybe a
    Nothing

        -- Using an IntMap Bool
        -- when reading a lookup:
        -- \* Nothing : never explored
        -- \* Just True : being explored
        -- \* Just False : explored
        sorting :: Int -> m ()
    sorting Int
    i = do
          status <- (([a], IntMap Bool) -> Maybe Bool) -> m (Maybe Bool)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((([a], IntMap Bool) -> Maybe Bool) -> m (Maybe Bool))
    -> (([a], IntMap Bool) -> Maybe Bool) -> m (Maybe Bool)
    forall a b. (a -> b) -> a -> b
    $ Int -> IntMap Bool -> Maybe Bool
    forall a. Int -> IntMap a -> Maybe a
    IM.lookup Int
    i (IntMap Bool -> Maybe Bool)
    -> (([a], IntMap Bool) -> IntMap Bool)
    -> ([a], IntMap Bool)
    -> Maybe Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([a], IntMap Bool) -> IntMap Bool
    forall a b. (a, b) -> b
    snd
          when (status == Just True) $ error "topological sorting has encountered a cycle"
          unless (status == Just False) $ do
            let node = [a]
    nodes [a] -> Int -> a
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i
            modify $ second $ IM.insert i True
            mapM_ sorting $ mapMaybe (depends_of node) nodes_idx
            modify $ bimap (node :) (IM.insert i False)

    -- | 'traceM', but only if @FUTHARK_COMPILER_DEBUGGING@ is set to to
    -- the appropriate level.
    debugTraceM :: (Monad m) => Int -> String -> m ()
    debugTraceM :: forall (m :: * -> *). Monad m => Int -> String -> m ()
    debugTraceM Int
    level
      | String -> Int -> Bool
    isEnvVarAtLeast String
    "FUTHARK_COMPILER_DEBUGGING" Int
    level = String -> m ()
    forall (f :: * -> *). Applicative f => String -> f ()
    traceM
      | Bool
    otherwise = m () -> String -> m ()
    forall a b. a -> b -> a
    const (m () -> String -> m ()) -> m () -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()