    {-# LANGUAGE Strict #-}

    -- | High-level API for invoking the Futhark compiler.
    module Futhark.Compiler
      ( runPipelineOnProgram,
        runCompilerOnProgram,
        dumpError,
        handleWarnings,
        prettyProgErrors,
        module Futhark.Compiler.Program,
        module Futhark.Compiler.Config,
        readProgramFile,
        readProgramFiles,
        readProgramOrDie,
        readUntypedProgram,
        readUntypedProgramOrDie,
      )
    where

    import Control.Monad
    import Control.Monad.Except (MonadError)
    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Data.Bifunctor (first)
    import Data.List (sortOn)
    import Data.List.NonEmpty qualified as NE
    import Data.Loc (Loc (..), posCoff, posFile)
    import Data.Text.IO qualified as T
    import Futhark.Analysis.Alias qualified as Alias
    import Futhark.Compiler.Config
    import Futhark.Compiler.Program
    import Futhark.IR
    import Futhark.IR.SOACS qualified as I
    import Futhark.IR.TypeCheck qualified as I
    import Futhark.Internalise
    import Futhark.MonadFreshNames
    import Futhark.Pipeline
    import Futhark.Util.Log
    import Futhark.Util.Pretty
    import Language.Futhark qualified as E
    import Language.Futhark.Semantic (includeToString)
    import Language.Futhark.Warnings
    import System.Exit (ExitCode (..), exitWith)
    import System.IO

    -- | Print a compiler error to stdout.  The 'FutharkConfig' controls
    -- to which degree auxiliary information (e.g. the failing program) is
    -- also printed.
    dumpError :: FutharkConfig -> CompilerError -> IO ()
    dumpError :: FutharkConfig -> CompilerError -> IO ()
    dumpError FutharkConfig
    config CompilerError
    err =
      case CompilerError
    err of
        ExternalError Doc AnsiStyle
    s -> do
          Handle -> Doc AnsiStyle -> IO ()
    hPutDoc Handle
    stderr Doc AnsiStyle
    s
          Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    ""
          Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    "If you find this error message confusing, uninformative, or wrong, please open an issue:"
          Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    "  https://github.com/diku-dk/futhark/issues"
        InternalError Text
    s Text
    info ErrorClass
    CompilerBug -> do
          Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    "Internal compiler error.  Please report this:"
          Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    "  https://github.com/diku-dk/futhark/issues"
          Text -> Text -> IO ()
    report Text
    s Text
    info
        InternalError Text
    s Text
    info ErrorClass
    CompilerLimitation -> do
          Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    "Known compiler limitation encountered.  Sorry."
          Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    "Revise your program or try a different Futhark compiler."
          Text -> Text -> IO ()
    report Text
    s Text
    info
      where
        report :: Text -> Text -> IO ()
    report Text
    s Text
    info = do
          Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    s
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Verbosity, Maybe FilePath) -> Verbosity
    forall a b. (a, b) -> a
    fst (FutharkConfig -> (Verbosity, Maybe FilePath)
    futharkVerbose FutharkConfig
    config) Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    > Verbosity
    NotVerbose)
            (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (Text -> IO ())
    -> (FilePath -> Text -> IO ()) -> Maybe FilePath -> Text -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
              (Handle -> Text -> IO ()
    T.hPutStr Handle
    stderr)
              FilePath -> Text -> IO ()
    T.writeFile
              ((Verbosity, Maybe FilePath) -> Maybe FilePath
    forall a b. (a, b) -> b
    snd (FutharkConfig -> (Verbosity, Maybe FilePath)
    futharkVerbose FutharkConfig
    config))
            (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text
    info Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n"

    -- | Read a program from the given 'FilePath', run the given
    -- 'Pipeline', and finish up with the given 'Action'.
    runCompilerOnProgram ::
      FutharkConfig ->
      Pipeline I.SOACS rep ->
      Action rep ->
      FilePath ->
      IO ()
    runCompilerOnProgram :: forall rep.
    FutharkConfig
    -> Pipeline SOACS rep -> Action rep -> FilePath -> IO ()
    runCompilerOnProgram FutharkConfig
    config Pipeline SOACS rep
    pipeline Action rep
    action FilePath
    file = do
      res <- FutharkM () -> Verbosity -> IO (Either CompilerError ())
    forall a. FutharkM a -> Verbosity -> IO (Either CompilerError a)
    runFutharkM FutharkM ()
    compile (Verbosity -> IO (Either CompilerError ()))
    -> Verbosity -> IO (Either CompilerError ())
    forall a b. (a -> b) -> a -> b
    $ (Verbosity, Maybe FilePath) -> Verbosity
    forall a b. (a, b) -> a
    fst ((Verbosity, Maybe FilePath) -> Verbosity)
    -> (Verbosity, Maybe FilePath) -> Verbosity
    forall a b. (a -> b) -> a -> b
    $ FutharkConfig -> (Verbosity, Maybe FilePath)
    futharkVerbose FutharkConfig
    config
      case res of
        Left CompilerError
    err -> IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
          FutharkConfig -> CompilerError -> IO ()
    dumpError FutharkConfig
    config CompilerError
    err
          ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    2
        Right () ->
          () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      where
        compile :: FutharkM ()
    compile = do
          prog <- FutharkConfig
    -> Pipeline SOACS rep -> FilePath -> FutharkM (Prog rep)
    forall torep.
    FutharkConfig
    -> Pipeline SOACS torep -> FilePath -> FutharkM (Prog torep)
    runPipelineOnProgram FutharkConfig
    config Pipeline SOACS rep
    pipeline FilePath
    file
          when ((> NotVerbose) . fst $ futharkVerbose config) $
            logMsg $
              "Running action " ++ actionName action
          actionProcedure action prog
          when ((> NotVerbose) . fst $ futharkVerbose config) $
            logMsg ("Done." :: String)

    -- | Read a program from the given 'FilePath', run the given
    -- 'Pipeline', and return it.
    runPipelineOnProgram ::
      FutharkConfig ->
      Pipeline I.SOACS torep ->
      FilePath ->
      FutharkM (Prog torep)
    runPipelineOnProgram :: forall torep.
    FutharkConfig
    -> Pipeline SOACS torep -> FilePath -> FutharkM (Prog torep)
    runPipelineOnProgram FutharkConfig
    config Pipeline SOACS torep
    pipeline FilePath
    file = do
      Bool -> FutharkM () -> FutharkM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (PipelineConfig -> Bool
    pipelineVerbose PipelineConfig
    pipeline_config) (FutharkM () -> FutharkM ()) -> FutharkM () -> FutharkM ()
    forall a b. (a -> b) -> a -> b
    $
        FilePath -> FutharkM ()
    forall a. ToLog a => a -> FutharkM ()
    forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
    logMsg (FilePath
    "Reading and type-checking source program" :: String)
      (prog_imports, namesrc) <-
        FutharkConfig
    -> FutharkM (Warnings, (Imports, VNameSource))
    -> FutharkM (Imports, VNameSource)
    forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
    handleWarnings FutharkConfig
    config (FutharkM (Warnings, (Imports, VNameSource))
     -> FutharkM (Imports, VNameSource))
    -> FutharkM (Warnings, (Imports, VNameSource))
    -> FutharkM (Imports, VNameSource)
    forall a b. (a -> b) -> a -> b
    $
          (\(Warnings
    a, Imports
    b, VNameSource
    c) -> (Warnings
    a, (Imports
    b, VNameSource
    c)))
            ((Warnings, Imports, VNameSource)
     -> (Warnings, (Imports, VNameSource)))
    -> FutharkM (Warnings, Imports, VNameSource)
    -> FutharkM (Warnings, (Imports, VNameSource))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Name] -> FilePath -> FutharkM (Warnings, Imports, VNameSource)
    forall (m :: * -> *).
    (MonadError CompilerError m, MonadIO m) =>
    [Name] -> FilePath -> m (Warnings, Imports, VNameSource)
    readProgramFile (FutharkConfig -> [Name]
    futharkEntryPoints FutharkConfig
    config) FilePath
    file

      putNameSource namesrc
      int_prog <- internaliseProg config prog_imports
      when (pipelineVerbose pipeline_config) $
        logMsg ("Type-checking internalised program" :: String)
      typeCheckInternalProgram int_prog
      runPipeline pipeline pipeline_config int_prog
      where
        pipeline_config :: PipelineConfig
    pipeline_config =
          PipelineConfig
            { pipelineVerbose :: Bool
    pipelineVerbose = (Verbosity, Maybe FilePath) -> Verbosity
    forall a b. (a, b) -> a
    fst (FutharkConfig -> (Verbosity, Maybe FilePath)
    futharkVerbose FutharkConfig
    config) Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    > Verbosity
    NotVerbose,
              pipelineValidate :: Bool
    pipelineValidate = FutharkConfig -> Bool
    futharkTypeCheck FutharkConfig
    config
            }

    typeCheckInternalProgram :: I.Prog I.SOACS -> FutharkM ()
    typeCheckInternalProgram :: Prog SOACS -> FutharkM ()
    typeCheckInternalProgram Prog SOACS
    prog =
      case Prog (Aliases SOACS) -> Either (TypeError SOACS) ()
    forall rep.
    Checkable rep =>
    Prog (Aliases rep) -> Either (TypeError rep) ()
    I.checkProg Prog (Aliases SOACS)
    prog' of
        Left TypeError SOACS
    err -> FilePath -> Doc AnsiStyle -> FutharkM ()
    forall (m :: * -> *) a.
    MonadError CompilerError m =>
    FilePath -> Doc AnsiStyle -> m a
    internalErrorS (FilePath
    "After internalisation:\n" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ TypeError SOACS -> FilePath
    forall a. Show a => a -> FilePath
    show TypeError SOACS
    err) (Prog (Aliases SOACS) -> Doc AnsiStyle
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Prog (Aliases SOACS) -> Doc ann
    pretty Prog (Aliases SOACS)
    prog')
        Right () -> () -> FutharkM ()
    forall a. a -> FutharkM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      where
        prog' :: Prog (Aliases SOACS)
    prog' = Prog SOACS -> Prog (Aliases SOACS)
    forall rep. AliasableRep rep => Prog rep -> Prog (Aliases rep)
    Alias.aliasAnalysis Prog SOACS
    prog

    -- | Prettyprint program errors as suitable for showing on a text console.
    prettyProgErrors :: NE.NonEmpty ProgError -> Doc AnsiStyle
    prettyProgErrors :: NonEmpty ProgError -> Doc AnsiStyle
    prettyProgErrors = [Doc AnsiStyle] -> Doc AnsiStyle
    forall a. [Doc a] -> Doc a
    stack ([Doc AnsiStyle] -> Doc AnsiStyle)
    -> (NonEmpty ProgError -> [Doc AnsiStyle])
    -> NonEmpty ProgError
    -> Doc AnsiStyle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
    forall ann. Doc ann -> [Doc ann] -> [Doc ann]
    punctuate Doc AnsiStyle
    forall ann. Doc ann
    line ([Doc AnsiStyle] -> [Doc AnsiStyle])
    -> (NonEmpty ProgError -> [Doc AnsiStyle])
    -> NonEmpty ProgError
    -> [Doc AnsiStyle]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ProgError -> Doc AnsiStyle) -> [ProgError] -> [Doc AnsiStyle]
    forall a b. (a -> b) -> [a] -> [b]
    map ProgError -> Doc AnsiStyle
    onError ([ProgError] -> [Doc AnsiStyle])
    -> (NonEmpty ProgError -> [ProgError])
    -> NonEmpty ProgError
    -> [Doc AnsiStyle]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ProgError -> (FilePath, Int)) -> [ProgError] -> [ProgError]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Loc -> (FilePath, Int)
    rep (Loc -> (FilePath, Int))
    -> (ProgError -> Loc) -> ProgError -> (FilePath, Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgError -> Loc
    forall a. Located a => a -> Loc
    locOf) ([ProgError] -> [ProgError])
    -> (NonEmpty ProgError -> [ProgError])
    -> NonEmpty ProgError
    -> [ProgError]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty ProgError -> [ProgError]
    forall a. NonEmpty a -> [a]
    NE.toList
      where
        rep :: Loc -> (FilePath, Int)
    rep Loc
    NoLoc = (FilePath
    "", Int
    0)
        rep (Loc Pos
    p Pos
    _) = (Pos -> FilePath
    posFile Pos
    p, Pos -> Int
    posCoff Pos
    p)
        onError :: ProgError -> Doc AnsiStyle
    onError (ProgError Loc
    NoLoc Doc ()
    msg) =
          Doc () -> Doc AnsiStyle
    forall ann xxx. Doc ann -> Doc xxx
    unAnnotate Doc ()
    msg
        onError (ProgError Loc
    loc Doc ()
    msg) =
          AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    annotate (Color -> AnsiStyle
    color Color
    Red) (Doc AnsiStyle
    "Error at " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Text -> Doc AnsiStyle
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (SrcLoc -> Text
    forall a. Located a => a -> Text
    locText (Loc -> SrcLoc
    forall a. Located a => a -> SrcLoc
    srclocOf Loc
    loc))) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    ":" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Doc a -> Doc a -> Doc a
    </> Doc () -> Doc AnsiStyle
    forall ann xxx. Doc ann -> Doc xxx
    unAnnotate Doc ()
    msg
        onError (ProgWarning Loc
    NoLoc Doc ()
    msg) =
          Doc () -> Doc AnsiStyle
    forall ann xxx. Doc ann -> Doc xxx
    unAnnotate Doc ()
    msg
        onError (ProgWarning Loc
    loc Doc ()
    msg) =
          AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    annotate (Color -> AnsiStyle
    color Color
    Yellow) (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle
    "Warning at " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Text -> Doc AnsiStyle
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (SrcLoc -> Text
    forall a. Located a => a -> Text
    locText (Loc -> SrcLoc
    forall a. Located a => a -> SrcLoc
    srclocOf Loc
    loc)) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    ":" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Doc a -> Doc a -> Doc a
    </> Doc () -> Doc AnsiStyle
    forall ann xxx. Doc ann -> Doc xxx
    unAnnotate Doc ()
    msg

    -- | Throw an exception formatted with 'prettyProgErrors' if there's
    -- an error.
    throwOnProgError ::
      (MonadError CompilerError m) =>
      Either (NE.NonEmpty ProgError) a ->
      m a
    throwOnProgError :: forall (m :: * -> *) a.
    MonadError CompilerError m =>
    Either (NonEmpty ProgError) a -> m a
    throwOnProgError =
      (NonEmpty ProgError -> m a)
    -> (a -> m a) -> Either (NonEmpty ProgError) a -> m a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Doc AnsiStyle -> m a
    forall (m :: * -> *) a.
    MonadError CompilerError m =>
    Doc AnsiStyle -> m a
    externalError (Doc AnsiStyle -> m a)
    -> (NonEmpty ProgError -> Doc AnsiStyle)
    -> NonEmpty ProgError
    -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty ProgError -> Doc AnsiStyle
    prettyProgErrors) a -> m a
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    -- | Read and type-check a Futhark program, comprising a single file,
    -- including all imports.
    readProgramFile ::
      (MonadError CompilerError m, MonadIO m) =>
      [I.Name] ->
      FilePath ->
      m (Warnings, Imports, VNameSource)
    readProgramFile :: forall (m :: * -> *).
    (MonadError CompilerError m, MonadIO m) =>
    [Name] -> FilePath -> m (Warnings, Imports, VNameSource)
    readProgramFile [Name]
    extra_eps =
      [Name] -> [FilePath] -> m (Warnings, Imports, VNameSource)
    forall (m :: * -> *).
    (MonadError CompilerError m, MonadIO m) =>
    [Name] -> [FilePath] -> m (Warnings, Imports, VNameSource)
    readProgramFiles [Name]
    extra_eps ([FilePath] -> m (Warnings, Imports, VNameSource))
    -> (FilePath -> [FilePath])
    -> FilePath
    -> m (Warnings, Imports, VNameSource)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> [FilePath]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    -- | Read and type-check a Futhark library, comprising multiple files,
    -- including all imports.
    readProgramFiles ::
      (MonadError CompilerError m, MonadIO m) =>
      [I.Name] ->
      [FilePath] ->
      m (Warnings, Imports, VNameSource)
    readProgramFiles :: forall (m :: * -> *).
    (MonadError CompilerError m, MonadIO m) =>
    [Name] -> [FilePath] -> m (Warnings, Imports, VNameSource)
    readProgramFiles [Name]
    extra_eps =
      Either (NonEmpty ProgError) (Warnings, Imports, VNameSource)
    -> m (Warnings, Imports, VNameSource)
    forall (m :: * -> *) a.
    MonadError CompilerError m =>
    Either (NonEmpty ProgError) a -> m a
    throwOnProgError (Either (NonEmpty ProgError) (Warnings, Imports, VNameSource)
     -> m (Warnings, Imports, VNameSource))
    -> ([FilePath]
        -> m (Either
                (NonEmpty ProgError) (Warnings, Imports, VNameSource)))
    -> [FilePath]
    -> m (Warnings, Imports, VNameSource)
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< IO (Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
    -> m (Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
     -> m (Either
             (NonEmpty ProgError) (Warnings, Imports, VNameSource)))
    -> ([FilePath]
        -> IO
             (Either (NonEmpty ProgError) (Warnings, Imports, VNameSource)))
    -> [FilePath]
    -> m (Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Name]
    -> [FilePath]
    -> IO
         (Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
    readLibrary [Name]
    extra_eps

    -- | Read and parse (but do not type-check) a Futhark program,
    -- including all imports.
    readUntypedProgram ::
      (MonadError CompilerError m, MonadIO m) =>
      FilePath ->
      m [(String, E.UncheckedProg)]
    readUntypedProgram :: forall (m :: * -> *).
    (MonadError CompilerError m, MonadIO m) =>
    FilePath -> m [(FilePath, UncheckedProg)]
    readUntypedProgram =
      ([(ImportName, UncheckedProg)] -> [(FilePath, UncheckedProg)])
    -> m [(ImportName, UncheckedProg)] -> m [(FilePath, UncheckedProg)]
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((ImportName, UncheckedProg) -> (FilePath, UncheckedProg))
    -> [(ImportName, UncheckedProg)] -> [(FilePath, UncheckedProg)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((ImportName -> FilePath)
    -> (ImportName, UncheckedProg) -> (FilePath, UncheckedProg)
    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 ImportName -> FilePath
    includeToString)) (m [(ImportName, UncheckedProg)] -> m [(FilePath, UncheckedProg)])
    -> (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)]
        -> m [(ImportName, UncheckedProg)])
    -> Either (NonEmpty ProgError) [(ImportName, UncheckedProg)]
    -> m [(FilePath, UncheckedProg)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Either (NonEmpty ProgError) [(ImportName, UncheckedProg)]
    -> m [(ImportName, UncheckedProg)]
    forall (m :: * -> *) a.
    MonadError CompilerError m =>
    Either (NonEmpty ProgError) a -> m a
    throwOnProgError
        (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)]
     -> m [(FilePath, UncheckedProg)])
    -> (FilePath
        -> m (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)]))
    -> FilePath
    -> m [(FilePath, UncheckedProg)]
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
    -> m (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
     -> m (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)]))
    -> (FilePath
        -> IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)]))
    -> FilePath
    -> m (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [FilePath]
    -> IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
    readUntypedLibrary ([FilePath]
     -> IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)]))
    -> (FilePath -> [FilePath])
    -> FilePath
    -> IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> [FilePath]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    orDie :: (MonadIO m) => FutharkM a -> m a
    orDie :: forall (m :: * -> *) a. MonadIO m => FutharkM a -> m a
    orDie FutharkM a
    m = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ do
      res <- FutharkM a -> Verbosity -> IO (Either CompilerError a)
    forall a. FutharkM a -> Verbosity -> IO (Either CompilerError a)
    runFutharkM FutharkM a
    m Verbosity
    NotVerbose
      case res of
        Left CompilerError
    err -> do
          FutharkConfig -> CompilerError -> IO ()
    dumpError FutharkConfig
    newFutharkConfig CompilerError
    err
          ExitCode -> IO a
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO a) -> ExitCode -> IO a
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    2
        Right a
    res' -> a -> IO a
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    res'

    -- | Not verbose, and terminates process on error.
    readProgramOrDie :: (MonadIO m) => FilePath -> m (Warnings, Imports, VNameSource)
    readProgramOrDie :: forall (m :: * -> *).
    MonadIO m =>
    FilePath -> m (Warnings, Imports, VNameSource)
    readProgramOrDie FilePath
    file = FutharkM (Warnings, Imports, VNameSource)
    -> m (Warnings, Imports, VNameSource)
    forall (m :: * -> *) a. MonadIO m => FutharkM a -> m a
    orDie (FutharkM (Warnings, Imports, VNameSource)
     -> m (Warnings, Imports, VNameSource))
    -> FutharkM (Warnings, Imports, VNameSource)
    -> m (Warnings, Imports, VNameSource)
    forall a b. (a -> b) -> a -> b
    $ [Name] -> FilePath -> FutharkM (Warnings, Imports, VNameSource)
    forall (m :: * -> *).
    (MonadError CompilerError m, MonadIO m) =>
    [Name] -> FilePath -> m (Warnings, Imports, VNameSource)
    readProgramFile [Name]
    forall a. Monoid a => a
    mempty FilePath
    file

    -- | Not verbose, and terminates process on error.
    readUntypedProgramOrDie :: (MonadIO m) => FilePath -> m [(String, E.UncheckedProg)]
    readUntypedProgramOrDie :: forall (m :: * -> *).
    MonadIO m =>
    FilePath -> m [(FilePath, UncheckedProg)]
    readUntypedProgramOrDie FilePath
    file = FutharkM [(FilePath, UncheckedProg)]
    -> m [(FilePath, UncheckedProg)]
    forall (m :: * -> *) a. MonadIO m => FutharkM a -> m a
    orDie (FutharkM [(FilePath, UncheckedProg)]
     -> m [(FilePath, UncheckedProg)])
    -> FutharkM [(FilePath, UncheckedProg)]
    -> m [(FilePath, UncheckedProg)]
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FutharkM [(FilePath, UncheckedProg)]
    forall (m :: * -> *).
    (MonadError CompilerError m, MonadIO m) =>
    FilePath -> m [(FilePath, UncheckedProg)]
    readUntypedProgram FilePath
    file

    -- | Run an operation that produces warnings, and handle them
    -- appropriately, yielding the non-warning return value.  "Proper
    -- handling" means e.g. to print them to the screen, as directed by
    -- the compiler configuration.
    handleWarnings :: FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
    handleWarnings :: forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
    handleWarnings FutharkConfig
    config FutharkM (Warnings, a)
    m = do
      (ws, a) <- FutharkM (Warnings, a)
    m

      when (futharkWarn config && anyWarnings ws) $ do
        liftIO $ hPutDoc stderr $ prettyWarnings ws
        when (futharkWerror config) $
          externalErrorS "Treating above warnings as errors due to --Werror."

      pure a