    -- | @futhark eval@
    module Futhark.CLI.Eval (main) where

    import Control.Exception
    import Control.Monad
    import Control.Monad.Except (ExceptT, runExceptT, throwError)
    import Control.Monad.Free.Church
    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Data.Map qualified as M
    import Data.Maybe
    import Data.Text qualified as T
    import Data.Text.IO qualified as T
    import Futhark.Compiler
    import Futhark.MonadFreshNames
    import Futhark.Pipeline
    import Futhark.Util.Options
    import Futhark.Util.Pretty
    import Language.Futhark
    import Language.Futhark.Interpreter qualified as I
    import Language.Futhark.Parser
    import Language.Futhark.Semantic qualified as T
    import Language.Futhark.TypeChecker qualified as I
    import Language.Futhark.TypeChecker qualified as T
    import System.Exit
    import System.FilePath
    import System.IO
    import Prelude

    -- | Run @futhark eval@.
    main :: String -> [String] -> IO ()
    main :: String -> [String] -> IO ()
    main = InterpreterConfig
    -> [FunOptDescr InterpreterConfig]
    -> String
    -> ([String] -> InterpreterConfig -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> String
    -> ([String] -> cfg -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    mainWithOptions InterpreterConfig
    interpreterConfig [FunOptDescr InterpreterConfig]
    options String
    "options... <exprs...>" [String] -> InterpreterConfig -> Maybe (IO ())
    run
      where
        run :: [String] -> InterpreterConfig -> Maybe (IO ())
    run [] InterpreterConfig
    _ = Maybe (IO ())
    forall a. Maybe a
    Nothing
        run [String]
    exprs InterpreterConfig
    config = IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ [String] -> InterpreterConfig -> IO ()
    runExprs [String]
    exprs InterpreterConfig
    config

    runExprs :: [String] -> InterpreterConfig -> IO ()
    runExprs :: [String] -> InterpreterConfig -> IO ()
    runExprs [String]
    exprs InterpreterConfig
    cfg = do
      let InterpreterConfig Bool
    _ Maybe String
    file = InterpreterConfig
    cfg
      maybe_new_state <- InterpreterConfig
    -> Maybe String
    -> IO (Either (Doc AnsiStyle) (VNameSource, Env, Ctx))
    newFutharkiState InterpreterConfig
    cfg Maybe String
    file
      (src, env, ctx) <- case maybe_new_state of
        Left Doc AnsiStyle
    reason -> do
          Handle -> Doc AnsiStyle -> IO ()
    hPutDocLn Handle
    stderr Doc AnsiStyle
    reason
          ExitCode -> IO (VNameSource, Env, Ctx)
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO (VNameSource, Env, Ctx))
    -> ExitCode -> IO (VNameSource, Env, Ctx)
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    2
        Right (VNameSource, Env, Ctx)
    s -> (VNameSource, Env, Ctx) -> IO (VNameSource, Env, Ctx)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (VNameSource, Env, Ctx)
    s
      mapM_ (runExpr src env ctx) exprs

    -- Use parseExp, checkExp, then interpretExp.
    runExpr :: VNameSource -> T.Env -> I.Ctx -> String -> IO ()
    runExpr :: VNameSource -> Env -> Ctx -> String -> IO ()
    runExpr VNameSource
    src Env
    env Ctx
    ctx String
    str = do
      uexp <- case String -> Text -> Either SyntaxError UncheckedExp
    parseExp String
    "" (String -> Text
    T.pack String
    str) of
        Left (SyntaxError Loc
    _ Text
    serr) -> do
          Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    serr
          ExitCode -> IO UncheckedExp
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO UncheckedExp) -> ExitCode -> IO UncheckedExp
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    1
        Right UncheckedExp
    e -> UncheckedExp -> IO UncheckedExp
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure UncheckedExp
    e
      fexp <- case T.checkExp [] src env uexp of
        (Warnings
    _, Left TypeError
    terr) -> do
          Handle -> Doc AnsiStyle -> IO ()
    hPutDoc Handle
    stderr (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> Doc AnsiStyle
    I.prettyTypeError TypeError
    terr
          ExitCode -> IO (ExpBase Info VName)
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO (ExpBase Info VName))
    -> ExitCode -> IO (ExpBase Info VName)
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    1
        (Warnings
    _, Right ([], ExpBase Info VName
    e)) -> ExpBase Info VName -> IO (ExpBase Info VName)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ExpBase Info VName
    e
        (Warnings
    _, Right ([TypeParam]
    tparams, ExpBase Info VName
    e)) -> do
          Doc AnsiStyle -> IO ()
    putDocLn (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle
    "Inferred type of expression: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Doc ann -> Doc ann
    align (StructType -> Doc AnsiStyle
    forall a ann. Pretty a => a -> Doc ann
    forall ann. StructType -> Doc ann
    pretty (ExpBase Info VName -> StructType
    typeOf ExpBase Info VName
    e))
          Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Text
    "The following types are ambiguous: "
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> [Text] -> Text
    T.intercalate Text
    ", " ((TypeParam -> Text) -> [TypeParam] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> Text
    nameToText (Name -> Text) -> (TypeParam -> Name) -> TypeParam -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VName -> Name
    forall v. IsName v => v -> Name
    toName (VName -> Name) -> (TypeParam -> VName) -> TypeParam -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TypeParam -> VName
    forall vn. TypeParamBase vn -> vn
    typeParamName) [TypeParam]
    tparams)
          ExitCode -> IO (ExpBase Info VName)
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO (ExpBase Info VName))
    -> ExitCode -> IO (ExpBase Info VName)
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    1
      pval <- runInterpreterNoBreak $ I.interpretExp ctx fexp
      case pval of
        Left InterpreterError
    err -> do
          Handle -> Doc AnsiStyle -> IO ()
    hPutDoc Handle
    stderr (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ InterpreterError -> Doc AnsiStyle
    I.prettyInterpreterError InterpreterError
    err
          ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    1
        Right Value
    val -> Doc AnsiStyle -> IO ()
    putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Value -> Doc AnsiStyle
    forall (m :: * -> *) a. Value m -> Doc a
    I.prettyValue Value
    val Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline

    data InterpreterConfig = InterpreterConfig
      { InterpreterConfig -> Bool
    interpreterPrintWarnings :: Bool,
        InterpreterConfig -> Maybe String
    interpreterFile :: Maybe String
      }

    interpreterConfig :: InterpreterConfig
    interpreterConfig :: InterpreterConfig
    interpreterConfig = Bool -> Maybe String -> InterpreterConfig
    InterpreterConfig Bool
    True Maybe String
    forall a. Maybe a
    Nothing

    options :: [FunOptDescr InterpreterConfig]
    options :: [FunOptDescr InterpreterConfig]
    options =
      [ String
    -> [String]
    -> ArgDescr
         (Either (IO ()) (InterpreterConfig -> InterpreterConfig))
    -> String
    -> FunOptDescr InterpreterConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          String
    "f"
          [String
    "file"]
          ( (String -> Either (IO ()) (InterpreterConfig -> InterpreterConfig))
    -> String
    -> ArgDescr
         (Either (IO ()) (InterpreterConfig -> InterpreterConfig))
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg
              ( \String
    entry -> (InterpreterConfig -> InterpreterConfig)
    -> Either (IO ()) (InterpreterConfig -> InterpreterConfig)
    forall a b. b -> Either a b
    Right ((InterpreterConfig -> InterpreterConfig)
     -> Either (IO ()) (InterpreterConfig -> InterpreterConfig))
    -> (InterpreterConfig -> InterpreterConfig)
    -> Either (IO ()) (InterpreterConfig -> InterpreterConfig)
    forall a b. (a -> b) -> a -> b
    $ \InterpreterConfig
    config ->
                  InterpreterConfig
    config {interpreterFile = Just entry}
              )
              String
    "NAME"
          )
          String
    "The file to load before evaluating expressions.",
        String
    -> [String]
    -> ArgDescr
         (Either (IO ()) (InterpreterConfig -> InterpreterConfig))
    -> String
    -> FunOptDescr InterpreterConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          String
    "w"
          [String
    "no-warnings"]
          (Either (IO ()) (InterpreterConfig -> InterpreterConfig)
    -> ArgDescr
         (Either (IO ()) (InterpreterConfig -> InterpreterConfig))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (InterpreterConfig -> InterpreterConfig)
     -> ArgDescr
          (Either (IO ()) (InterpreterConfig -> InterpreterConfig)))
    -> Either (IO ()) (InterpreterConfig -> InterpreterConfig)
    -> ArgDescr
         (Either (IO ()) (InterpreterConfig -> InterpreterConfig))
    forall a b. (a -> b) -> a -> b
    $ (InterpreterConfig -> InterpreterConfig)
    -> Either (IO ()) (InterpreterConfig -> InterpreterConfig)
    forall a b. b -> Either a b
    Right ((InterpreterConfig -> InterpreterConfig)
     -> Either (IO ()) (InterpreterConfig -> InterpreterConfig))
    -> (InterpreterConfig -> InterpreterConfig)
    -> Either (IO ()) (InterpreterConfig -> InterpreterConfig)
    forall a b. (a -> b) -> a -> b
    $ \InterpreterConfig
    config -> InterpreterConfig
    config {interpreterPrintWarnings = False})
          String
    "Do not print warnings."
      ]

    newFutharkiState ::
      InterpreterConfig ->
      Maybe FilePath ->
      IO (Either (Doc AnsiStyle) (VNameSource, T.Env, I.Ctx))
    newFutharkiState :: InterpreterConfig
    -> Maybe String
    -> IO (Either (Doc AnsiStyle) (VNameSource, Env, Ctx))
    newFutharkiState InterpreterConfig
    cfg Maybe String
    maybe_file = ExceptT (Doc AnsiStyle) IO (VNameSource, Env, Ctx)
    -> IO (Either (Doc AnsiStyle) (VNameSource, Env, Ctx))
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT (Doc AnsiStyle) IO (VNameSource, Env, Ctx)
     -> IO (Either (Doc AnsiStyle) (VNameSource, Env, Ctx)))
    -> ExceptT (Doc AnsiStyle) IO (VNameSource, Env, Ctx)
    -> IO (Either (Doc AnsiStyle) (VNameSource, Env, Ctx))
    forall a b. (a -> b) -> a -> b
    $ do
      (ws, imports, src) <-
        (CompilerError -> Doc AnsiStyle)
    -> Either CompilerError (Warnings, Imports, VNameSource)
    -> ExceptT (Doc AnsiStyle) IO (Warnings, Imports, VNameSource)
    forall err err' a.
    (err -> err') -> Either err a -> ExceptT err' IO a
    badOnLeft CompilerError -> Doc AnsiStyle
    prettyCompilerError
          (Either CompilerError (Warnings, Imports, VNameSource)
     -> ExceptT (Doc AnsiStyle) IO (Warnings, Imports, VNameSource))
    -> ExceptT
         (Doc AnsiStyle)
         IO
         (Either CompilerError (Warnings, Imports, VNameSource))
    -> ExceptT (Doc AnsiStyle) IO (Warnings, Imports, VNameSource)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO (Either CompilerError (Warnings, Imports, VNameSource))
    -> ExceptT
         (Doc AnsiStyle)
         IO
         (Either CompilerError (Warnings, Imports, VNameSource))
    forall a. IO a -> ExceptT (Doc AnsiStyle) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO
            ( ExceptT CompilerError IO (Warnings, Imports, VNameSource)
    -> IO (Either CompilerError (Warnings, Imports, VNameSource))
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT ([Name]
    -> [String]
    -> ExceptT CompilerError IO (Warnings, Imports, VNameSource)
    forall (m :: * -> *).
    (MonadError CompilerError m, MonadIO m) =>
    [Name] -> [String] -> m (Warnings, Imports, VNameSource)
    readProgramFiles [] ([String]
     -> ExceptT CompilerError IO (Warnings, Imports, VNameSource))
    -> [String]
    -> ExceptT CompilerError IO (Warnings, Imports, VNameSource)
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> [String]
    forall a. Maybe a -> [a]
    maybeToList Maybe String
    maybe_file)
                IO (Either CompilerError (Warnings, Imports, VNameSource))
    -> (IOException
        -> IO (Either CompilerError (Warnings, Imports, VNameSource)))
    -> IO (Either CompilerError (Warnings, Imports, VNameSource))
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \(IOException
    err :: IOException) ->
                  Either CompilerError (Warnings, Imports, VNameSource)
    -> IO (Either CompilerError (Warnings, Imports, VNameSource))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> Either CompilerError (Warnings, Imports, VNameSource)
    forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
    externalErrorS (IOException -> String
    forall a. Show a => a -> String
    show IOException
    err))
            )
      when (interpreterPrintWarnings cfg) $
        liftIO $
          hPutDoc stderr $
            prettyWarnings ws

      ictx <-
        foldM (\Ctx
    ctx -> (InterpreterError -> Doc AnsiStyle)
    -> Either InterpreterError Ctx -> ExceptT (Doc AnsiStyle) IO Ctx
    forall err err' a.
    (err -> err') -> Either err a -> ExceptT err' IO a
    badOnLeft InterpreterError -> Doc AnsiStyle
    I.prettyInterpreterError (Either InterpreterError Ctx -> ExceptT (Doc AnsiStyle) IO Ctx)
    -> ((ImportName, Prog)
        -> ExceptT (Doc AnsiStyle) IO (Either InterpreterError Ctx))
    -> (ImportName, Prog)
    -> ExceptT (Doc AnsiStyle) IO Ctx
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< F ExtOp Ctx
    -> ExceptT (Doc AnsiStyle) IO (Either InterpreterError Ctx)
    forall (m :: * -> *) a.
    MonadIO m =>
    F ExtOp a -> m (Either InterpreterError a)
    runInterpreterNoBreak (F ExtOp Ctx
     -> ExceptT (Doc AnsiStyle) IO (Either InterpreterError Ctx))
    -> ((ImportName, Prog) -> F ExtOp Ctx)
    -> (ImportName, Prog)
    -> ExceptT (Doc AnsiStyle) IO (Either InterpreterError Ctx)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ctx -> (ImportName, Prog) -> F ExtOp Ctx
    I.interpretImport Ctx
    ctx) I.initialCtx $
          map (fmap fileProg) imports

      let (tenv, ienv) =
            let (iname, fm) = last imports
             in ( fileScope fm,
                  ictx {I.ctxEnv = I.ctxImports ictx M.! iname}
                )

      pure (src, tenv, ienv)
      where
        badOnLeft :: (err -> err') -> Either err a -> ExceptT err' IO a
        badOnLeft :: forall err err' a.
    (err -> err') -> Either err a -> ExceptT err' IO a
    badOnLeft err -> err'
    _ (Right a
    x) = a -> ExceptT err' IO a
    forall a. a -> ExceptT err' IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    x
        badOnLeft err -> err'
    p (Left err
    err) = err' -> ExceptT err' IO a
    forall a. err' -> ExceptT err' IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (err' -> ExceptT err' IO a) -> err' -> ExceptT err' IO a
    forall a b. (a -> b) -> a -> b
    $ err -> err'
    p err
    err

    runInterpreterNoBreak :: (MonadIO m) => F I.ExtOp a -> m (Either I.InterpreterError a)
    runInterpreterNoBreak :: forall (m :: * -> *) a.
    MonadIO m =>
    F ExtOp a -> m (Either InterpreterError a)
    runInterpreterNoBreak F ExtOp a
    m = F ExtOp a -> forall r. (a -> r) -> (ExtOp r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F ExtOp a
    m (Either InterpreterError a -> m (Either InterpreterError a)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either InterpreterError a -> m (Either InterpreterError a))
    -> (a -> Either InterpreterError a)
    -> a
    -> m (Either InterpreterError a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either InterpreterError a
    forall a b. b -> Either a b
    Right) ExtOp (m (Either InterpreterError a))
    -> m (Either InterpreterError a)
    forall {f :: * -> *} {b}.
    MonadIO f =>
    ExtOp (f (Either InterpreterError b))
    -> f (Either InterpreterError b)
    intOp
      where
        intOp :: ExtOp (f (Either InterpreterError b))
    -> f (Either InterpreterError b)
    intOp (I.ExtOpError InterpreterError
    err) = Either InterpreterError b -> f (Either InterpreterError b)
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either InterpreterError b -> f (Either InterpreterError b))
    -> Either InterpreterError b -> f (Either InterpreterError b)
    forall a b. (a -> b) -> a -> b
    $ InterpreterError -> Either InterpreterError b
    forall a b. a -> Either a b
    Left InterpreterError
    err
        intOp (I.ExtOpTrace Text
    w Doc ()
    v f (Either InterpreterError b)
    c) = do
          IO () -> f ()
    forall a. IO a -> f a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> f ()) -> IO () -> f ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDocLn (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Doc AnsiStyle
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Text
    w Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    ":" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Doc ann -> Doc ann
    align (Doc () -> Doc AnsiStyle
    forall ann xxx. Doc ann -> Doc xxx
    unAnnotate Doc ()
    v)
          f (Either InterpreterError b)
    c
        intOp (I.ExtOpBreak Loc
    _ BreakReason
    _ NonEmpty StackFrame
    _ f (Either InterpreterError b)
    c) = f (Either InterpreterError b)
    c