    {-# LANGUAGE QuasiQuotes #-}

    -- | @futhark repl@
    module Futhark.CLI.REPL (main) where

    import Control.Exception
    import Control.Monad
    import Control.Monad.Except
    import Control.Monad.Free.Church
    import Control.Monad.State
    import Data.Char
    import Data.List (intersperse, isPrefixOf)
    import Data.List.NonEmpty qualified as NE
    import Data.Map qualified as M
    import Data.Maybe
    import Data.Text qualified as T
    import Data.Text.IO qualified as T
    import Data.Version
    import Futhark.Compiler
    import Futhark.Format (parseFormatString)
    import Futhark.MonadFreshNames
    import Futhark.Util (fancyTerminal, showText)
    import Futhark.Util.Options
    import Futhark.Util.Pretty (AnsiStyle, Color (..), Doc, align, annotate, bgColorDull, bold, brackets, color, docText, docTextForHandle, hardline, italicized, oneLine, pretty, putDoc, putDocLn, unAnnotate, (<+>))
    import Futhark.Version
    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 T
    import NeatInterpolation (text)
    import System.Console.Haskeline qualified as Haskeline
    import System.Directory
    import System.IO (stdout)
    import Text.Read (readMaybe)

    banner :: Doc AnsiStyle
    banner :: Doc AnsiStyle
    banner =
      [Doc AnsiStyle] -> Doc AnsiStyle
    forall a. Monoid a => [a] -> a
    mconcat ([Doc AnsiStyle] -> Doc AnsiStyle)
    -> ([Text] -> [Doc AnsiStyle]) -> [Text] -> Doc AnsiStyle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Doc AnsiStyle) -> [Text] -> [Doc AnsiStyle]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline) (Doc AnsiStyle -> Doc AnsiStyle)
    -> (Text -> Doc AnsiStyle) -> Text -> Doc AnsiStyle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc AnsiStyle -> Doc AnsiStyle
    decorate (Doc AnsiStyle -> Doc AnsiStyle)
    -> (Text -> Doc AnsiStyle) -> Text -> Doc AnsiStyle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Doc AnsiStyle
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty) ([Text] -> Doc AnsiStyle) -> [Text] -> Doc AnsiStyle
    forall a b. (a -> b) -> a -> b
    $
        [ Text
    "┃╱╱ ┃╲    ┃   ┃╲  ┃╲   ╱" :: T.Text,
          Text
    "┃╱  ┃ ╲   ┃╲  ┃╲  ┃╱  ╱ ",
          Text
    "┃   ┃  ╲  ┃╱  ┃   ┃╲  ╲ ",
          Text
    "┃   ┃   ╲ ┃   ┃   ┃ ╲  ╲"
        ]
      where
        decorate :: Doc AnsiStyle -> Doc AnsiStyle
    decorate = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    annotate (Color -> AnsiStyle
    bgColorDull Color
    Red AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> AnsiStyle
    bold AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Color -> AnsiStyle
    color Color
    White)

    -- | Run @futhark repl@.
    main :: String -> [String] -> IO ()
    main :: [Char] -> [[Char]] -> IO ()
    main = ()
    -> [FunOptDescr ()]
    -> [Char]
    -> ([[Char]] -> () -> Maybe (IO ()))
    -> [Char]
    -> [[Char]]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> [Char]
    -> ([[Char]] -> cfg -> Maybe (IO ()))
    -> [Char]
    -> [[Char]]
    -> IO ()
    mainWithOptions () [] [Char]
    "options... [program.fut]" [[Char]] -> () -> Maybe (IO ())
    forall {p}. [[Char]] -> p -> Maybe (IO ())
    run
      where
        run :: [[Char]] -> p -> Maybe (IO ())
    run [] p
    _ = IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ Maybe [Char] -> IO ()
    repl Maybe [Char]
    forall a. Maybe a
    Nothing
        run [[Char]
    prog] p
    _ = IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ Maybe [Char] -> IO ()
    repl (Maybe [Char] -> IO ()) -> Maybe [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    prog
        run [[Char]]
    _ p
    _ = Maybe (IO ())
    forall a. Maybe a
    Nothing

    data StopReason = EOF | Stop | Exit | Load FilePath | Interrupt

    replSettings :: Haskeline.Settings IO
    replSettings :: Settings IO
    replSettings =
      CompletionFunc IO -> Settings IO -> Settings IO
    forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
    Haskeline.setComplete CompletionFunc IO
    replComplete Settings IO
    forall (m :: * -> *). MonadIO m => Settings m
    Haskeline.defaultSettings

    repl :: Maybe FilePath -> IO ()
    repl :: Maybe [Char] -> IO ()
    repl Maybe [Char]
    maybe_prog = do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    fancyTerminal (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Doc AnsiStyle -> IO ()
    putDoc Doc AnsiStyle
    banner
        [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Version " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Version -> [Char]
    showVersion Version
    version [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "."
        [Char] -> IO ()
    putStrLn [Char]
    "Copyright (C) DIKU, University of Copenhagen, released under the ISC license."
        [Char] -> IO ()
    putStrLn [Char]
    ""
        Doc AnsiStyle -> IO ()
    putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle
    "Run" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    annotate AnsiStyle
    bold Doc AnsiStyle
    ":help" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc AnsiStyle
    "for a list of commands."
        [Char] -> IO ()
    putStrLn [Char]
    ""

      let toploop :: FutharkiState -> InputT IO ()
    toploop FutharkiState
    s = do
            (Either StopReason Any
    stop, FutharkiState
    s') <-
              InputT IO (Either StopReason Any, FutharkiState)
    -> InputT IO (Either StopReason Any, FutharkiState)
    -> InputT IO (Either StopReason Any, FutharkiState)
    forall (m :: * -> *) a. MonadMask m => m a -> m a -> m a
    Haskeline.handleInterrupt ((Either StopReason Any, FutharkiState)
    -> InputT IO (Either StopReason Any, FutharkiState)
    forall a. a -> InputT IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (StopReason -> Either StopReason Any
    forall a b. a -> Either a b
    Left StopReason
    Interrupt, FutharkiState
    s))
                (InputT IO (Either StopReason Any, FutharkiState)
     -> InputT IO (Either StopReason Any, FutharkiState))
    -> (InputT IO (Either StopReason Any, FutharkiState)
        -> InputT IO (Either StopReason Any, FutharkiState))
    -> InputT IO (Either StopReason Any, FutharkiState)
    -> InputT IO (Either StopReason Any, FutharkiState)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InputT IO (Either StopReason Any, FutharkiState)
    -> InputT IO (Either StopReason Any, FutharkiState)
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    InputT m a -> InputT m a
    Haskeline.withInterrupt
                (InputT IO (Either StopReason Any, FutharkiState)
     -> InputT IO (Either StopReason Any, FutharkiState))
    -> InputT IO (Either StopReason Any, FutharkiState)
    -> InputT IO (Either StopReason Any, FutharkiState)
    forall a b. (a -> b) -> a -> b
    $ StateT FutharkiState (InputT IO) (Either StopReason Any)
    -> FutharkiState
    -> InputT IO (Either StopReason Any, FutharkiState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
    -> StateT FutharkiState (InputT IO) (Either StopReason Any)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
     -> StateT FutharkiState (InputT IO) (Either StopReason Any))
    -> ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
    -> StateT FutharkiState (InputT IO) (Either StopReason Any)
    forall a b. (a -> b) -> a -> b
    $ FutharkiM Any
    -> ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
    forall a.
    FutharkiM a
    -> ExceptT StopReason (StateT FutharkiState (InputT IO)) a
    runFutharkiM (FutharkiM Any
     -> ExceptT StopReason (StateT FutharkiState (InputT IO)) Any)
    -> FutharkiM Any
    -> ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
    forall a b. (a -> b) -> a -> b
    $ FutharkiM () -> FutharkiM Any
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever FutharkiM ()
    readEvalPrint) FutharkiState
    s

            case Either StopReason Any
    stop of
              Left StopReason
    Stop -> FutharkiState -> InputT IO ()
    forall {f :: * -> *} {p}. Applicative f => p -> f ()
    finish FutharkiState
    s'
              Left StopReason
    EOF -> FutharkiState -> InputT IO ()
    forall {f :: * -> *} {p}. Applicative f => p -> f ()
    finish FutharkiState
    s'
              Left StopReason
    Exit -> FutharkiState -> InputT IO ()
    forall {f :: * -> *} {p}. Applicative f => p -> f ()
    finish FutharkiState
    s'
              Left StopReason
    Interrupt -> do
                IO () -> InputT IO ()
    forall a. IO a -> InputT IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> InputT IO ()) -> IO () -> InputT IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn Text
    "Interrupted"
                FutharkiState -> InputT IO ()
    toploop FutharkiState
    s' {futharkiCount = futharkiCount s' + 1}
              Left (Load [Char]
    file) -> do
                IO () -> InputT IO ()
    forall a. IO a -> InputT IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> InputT IO ()) -> IO () -> InputT IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Loading " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Text
    T.pack [Char]
    file
                Either (Doc AnsiStyle) FutharkiState
    maybe_new_state <-
                  IO (Either (Doc AnsiStyle) FutharkiState)
    -> InputT IO (Either (Doc AnsiStyle) FutharkiState)
    forall a. IO a -> InputT IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either (Doc AnsiStyle) FutharkiState)
     -> InputT IO (Either (Doc AnsiStyle) FutharkiState))
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    -> InputT IO (Either (Doc AnsiStyle) FutharkiState)
    forall a b. (a -> b) -> a -> b
    $ Int
    -> LoadedProg
    -> Maybe [Char]
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    newFutharkiState (FutharkiState -> Int
    futharkiCount FutharkiState
    s) (FutharkiState -> LoadedProg
    futharkiProg FutharkiState
    s) (Maybe [Char] -> IO (Either (Doc AnsiStyle) FutharkiState))
    -> Maybe [Char] -> IO (Either (Doc AnsiStyle) FutharkiState)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    file
                case Either (Doc AnsiStyle) FutharkiState
    maybe_new_state of
                  Right FutharkiState
    new_state -> FutharkiState -> InputT IO ()
    toploop FutharkiState
    new_state
                  Left Doc AnsiStyle
    err -> do
                    IO () -> InputT IO ()
    forall a. IO a -> InputT IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> InputT IO ()) -> IO () -> InputT IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDocLn Doc AnsiStyle
    err
                    FutharkiState -> InputT IO ()
    toploop FutharkiState
    s'
              Right Any
    _ -> () -> InputT IO ()
    forall a. a -> InputT IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

          finish :: p -> f ()
    finish p
    _s = () -> f ()
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

      Either (Doc AnsiStyle) FutharkiState
    maybe_init_state <- IO (Either (Doc AnsiStyle) FutharkiState)
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either (Doc AnsiStyle) FutharkiState)
     -> IO (Either (Doc AnsiStyle) FutharkiState))
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    forall a b. (a -> b) -> a -> b
    $ Int
    -> LoadedProg
    -> Maybe [Char]
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    newFutharkiState Int
    0 LoadedProg
    noLoadedProg Maybe [Char]
    maybe_prog
      FutharkiState
    s <- case Either (Doc AnsiStyle) FutharkiState
    maybe_init_state of
        Left Doc AnsiStyle
    prog_err -> do
          Either (Doc AnsiStyle) FutharkiState
    noprog_init_state <- IO (Either (Doc AnsiStyle) FutharkiState)
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either (Doc AnsiStyle) FutharkiState)
     -> IO (Either (Doc AnsiStyle) FutharkiState))
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    forall a b. (a -> b) -> a -> b
    $ Int
    -> LoadedProg
    -> Maybe [Char]
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    newFutharkiState Int
    0 LoadedProg
    noLoadedProg Maybe [Char]
    forall a. Maybe a
    Nothing
          case Either (Doc AnsiStyle) FutharkiState
    noprog_init_state of
            Left Doc AnsiStyle
    err ->
              [Char] -> IO FutharkiState
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO FutharkiState) -> [Char] -> IO FutharkiState
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Failed to initialise interpreter state: " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Text -> [Char]
    T.unpack (Doc AnsiStyle -> Text
    forall a. Doc a -> Text
    docText Doc AnsiStyle
    err)
            Right FutharkiState
    s -> do
              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
    $ Doc AnsiStyle -> IO ()
    putDocLn Doc AnsiStyle
    prog_err
              FutharkiState -> IO FutharkiState
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FutharkiState
    s {futharkiLoaded = maybe_prog}
        Right FutharkiState
    s ->
          FutharkiState -> IO FutharkiState
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FutharkiState
    s
      Settings IO -> InputT IO () -> IO ()
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    Settings m -> InputT m a -> m a
    Haskeline.runInputT Settings IO
    replSettings (InputT IO () -> IO ()) -> InputT IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FutharkiState -> InputT IO ()
    toploop FutharkiState
    s

      [Char] -> IO ()
    putStrLn [Char]
    "Leaving 'futhark repl'."

    -- | Representation of breaking at a breakpoint, to allow for
    -- navigating through the stack frames and such.
    data Breaking = Breaking
      { Breaking -> NonEmpty StackFrame
    breakingStack :: NE.NonEmpty I.StackFrame,
        -- | Index of the current breakpoint (with 0 being the outermost).
        Breaking -> Int
    breakingAt :: Int
      }

    data FutharkiState = FutharkiState
      { FutharkiState -> LoadedProg
    futharkiProg :: LoadedProg,
        FutharkiState -> Int
    futharkiCount :: Int,
        FutharkiState -> (Env, Ctx)
    futharkiEnv :: (T.Env, I.Ctx),
        -- | Are we currently stopped at a breakpoint?
        FutharkiState -> Maybe Breaking
    futharkiBreaking :: Maybe Breaking,
        -- | Skip breakpoints at these locations.
        FutharkiState -> [Loc]
    futharkiSkipBreaks :: [Loc],
        FutharkiState -> Bool
    futharkiBreakOnNaN :: Bool,
        -- | The currently loaded file.
        FutharkiState -> Maybe [Char]
    futharkiLoaded :: Maybe FilePath
      }

    extendEnvs :: LoadedProg -> (T.Env, I.Ctx) -> [ImportName] -> (T.Env, I.Ctx)
    extendEnvs :: LoadedProg -> (Env, Ctx) -> [ImportName] -> (Env, Ctx)
    extendEnvs LoadedProg
    prog (Env
    tenv, Ctx
    ictx) [ImportName]
    opens = (Env
    tenv', Ctx
    ictx')
      where
        tenv' :: Env
    tenv' = Imports -> Env -> Env
    T.envWithImports Imports
    t_imports Env
    tenv
        ictx' :: Ctx
    ictx' = [Env] -> Ctx -> Ctx
    I.ctxWithImports [Env]
    i_envs Ctx
    ictx
        t_imports :: Imports
    t_imports = ((ImportName, FileModule) -> Bool) -> Imports -> Imports
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((ImportName -> [ImportName] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ImportName]
    opens) (ImportName -> Bool)
    -> ((ImportName, FileModule) -> ImportName)
    -> (ImportName, FileModule)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ImportName, FileModule) -> ImportName
    forall a b. (a, b) -> a
    fst) (Imports -> Imports) -> Imports -> Imports
    forall a b. (a -> b) -> a -> b
    $ LoadedProg -> Imports
    lpImports LoadedProg
    prog
        i_envs :: [Env]
    i_envs = ((ImportName, Env) -> Env) -> [(ImportName, Env)] -> [Env]
    forall a b. (a -> b) -> [a] -> [b]
    map (ImportName, Env) -> Env
    forall a b. (a, b) -> b
    snd ([(ImportName, Env)] -> [Env]) -> [(ImportName, Env)] -> [Env]
    forall a b. (a -> b) -> a -> b
    $ ((ImportName, Env) -> Bool)
    -> [(ImportName, Env)] -> [(ImportName, Env)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((ImportName -> [ImportName] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ImportName]
    opens) (ImportName -> Bool)
    -> ((ImportName, Env) -> ImportName) -> (ImportName, Env) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ImportName, Env) -> ImportName
    forall a b. (a, b) -> a
    fst) ([(ImportName, Env)] -> [(ImportName, Env)])
    -> [(ImportName, Env)] -> [(ImportName, Env)]
    forall a b. (a -> b) -> a -> b
    $ Map ImportName Env -> [(ImportName, Env)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map ImportName Env -> [(ImportName, Env)])
    -> Map ImportName Env -> [(ImportName, Env)]
    forall a b. (a -> b) -> a -> b
    $ Ctx -> Map ImportName Env
    I.ctxImports Ctx
    ictx

    newFutharkiState :: Int -> LoadedProg -> Maybe FilePath -> IO (Either (Doc AnsiStyle) FutharkiState)
    newFutharkiState :: Int
    -> LoadedProg
    -> Maybe [Char]
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    newFutharkiState Int
    count LoadedProg
    prev_prog Maybe [Char]
    maybe_file = ExceptT (Doc AnsiStyle) IO FutharkiState
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT (Doc AnsiStyle) IO FutharkiState
     -> IO (Either (Doc AnsiStyle) FutharkiState))
    -> ExceptT (Doc AnsiStyle) IO FutharkiState
    -> IO (Either (Doc AnsiStyle) FutharkiState)
    forall a b. (a -> b) -> a -> b
    $ do
      let files :: [[Char]]
    files = Maybe [Char] -> [[Char]]
    forall a. Maybe a -> [a]
    maybeToList Maybe [Char]
    maybe_file
      -- Put code through the type checker.
      LoadedProg
    prog <-
        (NonEmpty ProgError -> Doc AnsiStyle)
    -> Either (NonEmpty ProgError) LoadedProg
    -> ExceptT (Doc AnsiStyle) IO LoadedProg
    forall err err' a.
    (err -> err') -> Either err a -> ExceptT err' IO a
    badOnLeft NonEmpty ProgError -> Doc AnsiStyle
    prettyProgErrors
          (Either (NonEmpty ProgError) LoadedProg
     -> ExceptT (Doc AnsiStyle) IO LoadedProg)
    -> ExceptT
         (Doc AnsiStyle) IO (Either (NonEmpty ProgError) LoadedProg)
    -> ExceptT (Doc AnsiStyle) IO LoadedProg
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO (Either (NonEmpty ProgError) LoadedProg)
    -> ExceptT
         (Doc AnsiStyle) IO (Either (NonEmpty ProgError) LoadedProg)
    forall a. IO a -> ExceptT (Doc AnsiStyle) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (LoadedProg
    -> [[Char]] -> VFS -> IO (Either (NonEmpty ProgError) LoadedProg)
    reloadProg LoadedProg
    prev_prog [[Char]]
    files VFS
    forall k a. Map k a
    M.empty)
      IO () -> ExceptT (Doc AnsiStyle) IO ()
    forall a. IO a -> ExceptT (Doc AnsiStyle) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ExceptT (Doc AnsiStyle) IO ())
    -> IO () -> ExceptT (Doc AnsiStyle) IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Warnings -> Doc AnsiStyle
    prettyWarnings (Warnings -> Doc AnsiStyle) -> Warnings -> Doc AnsiStyle
    forall a b. (a -> b) -> a -> b
    $ LoadedProg -> Warnings
    lpWarnings LoadedProg
    prog
      -- Then into the interpreter.
      Ctx
    ictx <-
        (Ctx -> (ImportName, Prog) -> ExceptT (Doc AnsiStyle) IO Ctx)
    -> Ctx -> [(ImportName, Prog)] -> ExceptT (Doc AnsiStyle) IO Ctx
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    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 ([Char] -> Doc AnsiStyle
    forall ann. [Char] -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty ([Char] -> Doc AnsiStyle)
    -> (InterpreterError -> [Char])
    -> InterpreterError
    -> Doc AnsiStyle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InterpreterError -> [Char]
    forall a. Show a => a -> [Char]
    show) (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)
          Ctx
    I.initialCtx
          ([(ImportName, Prog)] -> ExceptT (Doc AnsiStyle) IO Ctx)
    -> [(ImportName, Prog)] -> ExceptT (Doc AnsiStyle) IO Ctx
    forall a b. (a -> b) -> a -> b
    $ ((ImportName, FileModule) -> (ImportName, Prog))
    -> Imports -> [(ImportName, Prog)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((FileModule -> Prog)
    -> (ImportName, FileModule) -> (ImportName, Prog)
    forall a b. (a -> b) -> (ImportName, a) -> (ImportName, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FileModule -> Prog
    fileProg) (LoadedProg -> Imports
    lpImports LoadedProg
    prog)

      let (Env
    tenv, Ctx
    ienv) =
            let (ImportName
    iname, FileModule
    fm) = Imports -> (ImportName, FileModule)
    forall a. HasCallStack => [a] -> a
    last (Imports -> (ImportName, FileModule))
    -> Imports -> (ImportName, FileModule)
    forall a b. (a -> b) -> a -> b
    $ LoadedProg -> Imports
    lpImports LoadedProg
    prog
             in ( FileModule -> Env
    fileScope FileModule
    fm,
                  Ctx
    ictx {I.ctxEnv = I.ctxImports ictx M.! iname}
                )

      FutharkiState -> ExceptT (Doc AnsiStyle) IO FutharkiState
    forall a. a -> ExceptT (Doc AnsiStyle) IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        FutharkiState
          { futharkiProg :: LoadedProg
    futharkiProg = LoadedProg
    prog,
            futharkiCount :: Int
    futharkiCount = Int
    count,
            futharkiEnv :: (Env, Ctx)
    futharkiEnv = (Env
    tenv, Ctx
    ienv),
            futharkiBreaking :: Maybe Breaking
    futharkiBreaking = Maybe Breaking
    forall a. Maybe a
    Nothing,
            futharkiSkipBreaks :: [Loc]
    futharkiSkipBreaks = [Loc]
    forall a. Monoid a => a
    mempty,
            futharkiBreakOnNaN :: Bool
    futharkiBreakOnNaN = Bool
    False,
            futharkiLoaded :: Maybe [Char]
    futharkiLoaded = Maybe [Char]
    maybe_file
          }
      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

    getPrompt :: FutharkiM String
    getPrompt :: FutharkiM [Char]
    getPrompt = do
      Int
    i <- (FutharkiState -> Int) -> FutharkiM Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FutharkiState -> Int
    futharkiCount
      (Text -> [Char]) -> FutharkiM Text -> FutharkiM [Char]
    forall a b. (a -> b) -> FutharkiM a -> FutharkiM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> [Char]
    T.unpack (FutharkiM Text -> FutharkiM [Char])
    -> FutharkiM Text -> FutharkiM [Char]
    forall a b. (a -> b) -> a -> b
    $ IO Text -> FutharkiM Text
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Text -> FutharkiM Text) -> IO Text -> FutharkiM Text
    forall a b. (a -> b) -> a -> b
    $ Handle -> Doc AnsiStyle -> IO Text
    docTextForHandle Handle
    stdout (Doc AnsiStyle -> IO Text) -> Doc AnsiStyle -> IO Text
    forall a b. (a -> b) -> a -> b
    $ AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    annotate AnsiStyle
    bold (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Doc ann -> Doc ann
    brackets (Int -> Doc AnsiStyle
    forall ann. Int -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Int
    i) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    "> "

    -- The ExceptT part is more of a continuation, really.
    newtype FutharkiM a = FutharkiM {forall a.
    FutharkiM a
    -> ExceptT StopReason (StateT FutharkiState (InputT IO)) a
    runFutharkiM :: ExceptT StopReason (StateT FutharkiState (Haskeline.InputT IO)) a}
      deriving
        ( (forall a b. (a -> b) -> FutharkiM a -> FutharkiM b)
    -> (forall a b. a -> FutharkiM b -> FutharkiM a)
    -> Functor FutharkiM
    forall a b. a -> FutharkiM b -> FutharkiM a
    forall a b. (a -> b) -> FutharkiM a -> FutharkiM b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> FutharkiM a -> FutharkiM b
    fmap :: forall a b. (a -> b) -> FutharkiM a -> FutharkiM b
    $c<$ :: forall a b. a -> FutharkiM b -> FutharkiM a
    <$ :: forall a b. a -> FutharkiM b -> FutharkiM a
    Functor,
          Functor FutharkiM
    Functor FutharkiM =>
    (forall a. a -> FutharkiM a)
    -> (forall a b. FutharkiM (a -> b) -> FutharkiM a -> FutharkiM b)
    -> (forall a b c.
        (a -> b -> c) -> FutharkiM a -> FutharkiM b -> FutharkiM c)
    -> (forall a b. FutharkiM a -> FutharkiM b -> FutharkiM b)
    -> (forall a b. FutharkiM a -> FutharkiM b -> FutharkiM a)
    -> Applicative FutharkiM
    forall a. a -> FutharkiM a
    forall a b. FutharkiM a -> FutharkiM b -> FutharkiM a
    forall a b. FutharkiM a -> FutharkiM b -> FutharkiM b
    forall a b. FutharkiM (a -> b) -> FutharkiM a -> FutharkiM b
    forall a b c.
    (a -> b -> c) -> FutharkiM a -> FutharkiM b -> FutharkiM c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> FutharkiM a
    pure :: forall a. a -> FutharkiM a
    $c<*> :: forall a b. FutharkiM (a -> b) -> FutharkiM a -> FutharkiM b
    <*> :: forall a b. FutharkiM (a -> b) -> FutharkiM a -> FutharkiM b
    $cliftA2 :: forall a b c.
    (a -> b -> c) -> FutharkiM a -> FutharkiM b -> FutharkiM c
    liftA2 :: forall a b c.
    (a -> b -> c) -> FutharkiM a -> FutharkiM b -> FutharkiM c
    $c*> :: forall a b. FutharkiM a -> FutharkiM b -> FutharkiM b
    *> :: forall a b. FutharkiM a -> FutharkiM b -> FutharkiM b
    $c<* :: forall a b. FutharkiM a -> FutharkiM b -> FutharkiM a
    <* :: forall a b. FutharkiM a -> FutharkiM b -> FutharkiM a
    Applicative,
          Applicative FutharkiM
    Applicative FutharkiM =>
    (forall a b. FutharkiM a -> (a -> FutharkiM b) -> FutharkiM b)
    -> (forall a b. FutharkiM a -> FutharkiM b -> FutharkiM b)
    -> (forall a. a -> FutharkiM a)
    -> Monad FutharkiM
    forall a. a -> FutharkiM a
    forall a b. FutharkiM a -> FutharkiM b -> FutharkiM b
    forall a b. FutharkiM a -> (a -> FutharkiM b) -> FutharkiM b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. FutharkiM a -> (a -> FutharkiM b) -> FutharkiM b
    >>= :: forall a b. FutharkiM a -> (a -> FutharkiM b) -> FutharkiM b
    $c>> :: forall a b. FutharkiM a -> FutharkiM b -> FutharkiM b
    >> :: forall a b. FutharkiM a -> FutharkiM b -> FutharkiM b
    $creturn :: forall a. a -> FutharkiM a
    return :: forall a. a -> FutharkiM a
    Monad,
          MonadState FutharkiState,
          Monad FutharkiM
    Monad FutharkiM =>
    (forall a. IO a -> FutharkiM a) -> MonadIO FutharkiM
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> FutharkiM a
    liftIO :: forall a. IO a -> FutharkiM a
    MonadIO,
          MonadError StopReason
        )

    readEvalPrint :: FutharkiM ()
    readEvalPrint :: FutharkiM ()
    readEvalPrint = do
      [Char]
    prompt <- FutharkiM [Char]
    getPrompt
      Text
    line <- [Char] -> FutharkiM Text
    inputLine [Char]
    prompt
      Maybe Breaking
    breaking <- (FutharkiState -> Maybe Breaking) -> FutharkiM (Maybe Breaking)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FutharkiState -> Maybe Breaking
    futharkiBreaking
      case Text -> Maybe (Char, Text)
    T.uncons Text
    line of
        Maybe (Char, Text)
    Nothing
          | Maybe Breaking -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Breaking
    breaking -> StopReason -> FutharkiM ()
    forall a. StopReason -> FutharkiM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError StopReason
    Stop
          | Bool
    otherwise -> () -> FutharkiM ()
    forall a. a -> FutharkiM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        Just (Char
    ':', Text
    command) -> do
          let (Text
    cmdname, Text
    rest) = (Char -> Bool) -> Text -> (Text, Text)
    T.break Char -> Bool
    isSpace Text
    command
              arg :: Text
    arg = (Char -> Bool) -> Text -> Text
    T.dropWhileEnd Char -> Bool
    isSpace (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isSpace Text
    rest
          case ((Text, (Command, Text)) -> Bool)
    -> [(Text, (Command, Text))] -> [(Text, (Command, Text))]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Text
    cmdname `T.isPrefixOf`) (Text -> Bool)
    -> ((Text, (Command, Text)) -> Text)
    -> (Text, (Command, Text))
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, (Command, Text)) -> Text
    forall a b. (a, b) -> a
    fst) [(Text, (Command, Text))]
    commands of
            [] -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Unknown command '" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    cmdname Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'"
            [(Text
    _, (Command
    cmdf, Text
    _))] -> Command
    cmdf Text
    arg
            [(Text, (Command, Text))]
    matches ->
              IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> (Text -> IO ()) -> Command
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> IO ()
    T.putStrLn Command -> Command
    forall a b. (a -> b) -> a -> b
    $
                Text
    "Ambiguous command; could be one of "
                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat (Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    intersperse Text
    ", " (((Text, (Command, Text)) -> Text)
    -> [(Text, (Command, Text))] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, (Command, Text)) -> Text
    forall a b. (a, b) -> a
    fst [(Text, (Command, Text))]
    matches))
        Maybe (Char, Text)
    _ -> do
          -- Read a declaration or expression.
          case [Char]
    -> Text -> Either SyntaxError (Either UncheckedDec UncheckedExp)
    parseDecOrExp [Char]
    prompt Text
    line of
            Left (SyntaxError Loc
    _ Text
    err) -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn Text
    err
            Right (Left UncheckedDec
    d) -> UncheckedDec -> FutharkiM ()
    onDec UncheckedDec
    d
            Right (Right UncheckedExp
    e) -> do
              Either (Doc AnsiStyle) Value
    valOrErr <- UncheckedExp -> FutharkiM (Either (Doc AnsiStyle) Value)
    onExp UncheckedExp
    e
              case Either (Doc AnsiStyle) Value
    valOrErr of
                Left Doc AnsiStyle
    err -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDocLn Doc AnsiStyle
    err
                Right Value
    val -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDocLn (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
      (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((FutharkiState -> FutharkiState) -> FutharkiM ())
    -> (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ \FutharkiState
    s -> FutharkiState
    s {futharkiCount = futharkiCount s + 1}
      where
        inputLine :: [Char] -> FutharkiM Text
    inputLine [Char]
    prompt = do
          Maybe [Char]
    inp <- ExceptT
      StopReason (StateT FutharkiState (InputT IO)) (Maybe [Char])
    -> FutharkiM (Maybe [Char])
    forall a.
    ExceptT StopReason (StateT FutharkiState (InputT IO)) a
    -> FutharkiM a
    FutharkiM (ExceptT
       StopReason (StateT FutharkiState (InputT IO)) (Maybe [Char])
     -> FutharkiM (Maybe [Char]))
    -> ExceptT
         StopReason (StateT FutharkiState (InputT IO)) (Maybe [Char])
    -> FutharkiM (Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ StateT FutharkiState (InputT IO) (Maybe [Char])
    -> ExceptT
         StopReason (StateT FutharkiState (InputT IO)) (Maybe [Char])
    forall (m :: * -> *) a. Monad m => m a -> ExceptT StopReason m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT FutharkiState (InputT IO) (Maybe [Char])
     -> ExceptT
          StopReason (StateT FutharkiState (InputT IO)) (Maybe [Char]))
    -> StateT FutharkiState (InputT IO) (Maybe [Char])
    -> ExceptT
         StopReason (StateT FutharkiState (InputT IO)) (Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ InputT IO (Maybe [Char])
    -> StateT FutharkiState (InputT IO) (Maybe [Char])
    forall (m :: * -> *) a. Monad m => m a -> StateT FutharkiState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (InputT IO (Maybe [Char])
     -> StateT FutharkiState (InputT IO) (Maybe [Char]))
    -> InputT IO (Maybe [Char])
    -> StateT FutharkiState (InputT IO) (Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ [Char] -> InputT IO (Maybe [Char])
    forall (m :: * -> *).
    (MonadIO m, MonadMask m) =>
    [Char] -> InputT m (Maybe [Char])
    Haskeline.getInputLine [Char]
    prompt
          case Maybe [Char]
    inp of
            Just [Char]
    s -> Text -> FutharkiM Text
    forall a. a -> FutharkiM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Text -> FutharkiM Text) -> Text -> FutharkiM Text
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack [Char]
    s
            Maybe [Char]
    Nothing -> StopReason -> FutharkiM Text
    forall a. StopReason -> FutharkiM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError StopReason
    EOF

    getIt :: FutharkiM (Imports, VNameSource, T.Env, I.Ctx)
    getIt :: FutharkiM (Imports, VNameSource, Env, Ctx)
    getIt = do
      Imports
    imports <- (FutharkiState -> Imports) -> FutharkiM Imports
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((FutharkiState -> Imports) -> FutharkiM Imports)
    -> (FutharkiState -> Imports) -> FutharkiM Imports
    forall a b. (a -> b) -> a -> b
    $ LoadedProg -> Imports
    lpImports (LoadedProg -> Imports)
    -> (FutharkiState -> LoadedProg) -> FutharkiState -> Imports
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FutharkiState -> LoadedProg
    futharkiProg
      VNameSource
    src <- (FutharkiState -> VNameSource) -> FutharkiM VNameSource
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((FutharkiState -> VNameSource) -> FutharkiM VNameSource)
    -> (FutharkiState -> VNameSource) -> FutharkiM VNameSource
    forall a b. (a -> b) -> a -> b
    $ LoadedProg -> VNameSource
    lpNameSource (LoadedProg -> VNameSource)
    -> (FutharkiState -> LoadedProg) -> FutharkiState -> VNameSource
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FutharkiState -> LoadedProg
    futharkiProg
      (Env
    tenv, Ctx
    ienv) <- (FutharkiState -> (Env, Ctx)) -> FutharkiM (Env, Ctx)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FutharkiState -> (Env, Ctx)
    futharkiEnv
      (Imports, VNameSource, Env, Ctx)
    -> FutharkiM (Imports, VNameSource, Env, Ctx)
    forall a. a -> FutharkiM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Imports
    imports, VNameSource
    src, Env
    tenv, Ctx
    ienv)

    onDec :: UncheckedDec -> FutharkiM ()
    onDec :: UncheckedDec -> FutharkiM ()
    onDec UncheckedDec
    d = do
      Imports
    old_imports <- (FutharkiState -> Imports) -> FutharkiM Imports
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((FutharkiState -> Imports) -> FutharkiM Imports)
    -> (FutharkiState -> Imports) -> FutharkiM Imports
    forall a b. (a -> b) -> a -> b
    $ LoadedProg -> Imports
    lpImports (LoadedProg -> Imports)
    -> (FutharkiState -> LoadedProg) -> FutharkiState -> Imports
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FutharkiState -> LoadedProg
    futharkiProg
      ImportName
    cur_import <- (FutharkiState -> ImportName) -> FutharkiM ImportName
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((FutharkiState -> ImportName) -> FutharkiM ImportName)
    -> (FutharkiState -> ImportName) -> FutharkiM ImportName
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ImportName
    T.mkInitialImport ([Char] -> ImportName)
    -> (FutharkiState -> [Char]) -> FutharkiState -> ImportName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Maybe [Char] -> [Char]
    forall a. a -> Maybe a -> a
    fromMaybe [Char]
    "." (Maybe [Char] -> [Char])
    -> (FutharkiState -> Maybe [Char]) -> FutharkiState -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FutharkiState -> Maybe [Char]
    futharkiLoaded
      let mkImport :: [Char] -> ImportName
    mkImport = ImportName -> [Char] -> ImportName
    T.mkImportFrom ImportName
    cur_import
          files :: [[Char]]
    files = (([Char], Loc) -> [Char]) -> [([Char], Loc)] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map (ImportName -> [Char]
    T.includeToFilePath (ImportName -> [Char])
    -> (([Char], Loc) -> ImportName) -> ([Char], Loc) -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ImportName
    mkImport ([Char] -> ImportName)
    -> (([Char], Loc) -> [Char]) -> ([Char], Loc) -> ImportName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char], Loc) -> [Char]
    forall a b. (a, b) -> a
    fst) ([([Char], Loc)] -> [[Char]]) -> [([Char], Loc)] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ UncheckedDec -> [([Char], Loc)]
    forall (f :: * -> *) vn. DecBase f vn -> [([Char], Loc)]
    decImports UncheckedDec
    d

      LoadedProg
    cur_prog <- (FutharkiState -> LoadedProg) -> FutharkiM LoadedProg
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FutharkiState -> LoadedProg
    futharkiProg
      Either (NonEmpty ProgError) LoadedProg
    imp_r <- IO (Either (NonEmpty ProgError) LoadedProg)
    -> FutharkiM (Either (NonEmpty ProgError) LoadedProg)
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either (NonEmpty ProgError) LoadedProg)
     -> FutharkiM (Either (NonEmpty ProgError) LoadedProg))
    -> IO (Either (NonEmpty ProgError) LoadedProg)
    -> FutharkiM (Either (NonEmpty ProgError) LoadedProg)
    forall a b. (a -> b) -> a -> b
    $ LoadedProg
    -> [[Char]] -> VFS -> IO (Either (NonEmpty ProgError) LoadedProg)
    extendProg LoadedProg
    cur_prog [[Char]]
    files VFS
    forall k a. Map k a
    M.empty
      case Either (NonEmpty ProgError) LoadedProg
    imp_r of
        Left NonEmpty ProgError
    e -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ NonEmpty ProgError -> Doc AnsiStyle
    prettyProgErrors NonEmpty ProgError
    e
        Right LoadedProg
    prog -> do
          (Env, Ctx)
    env <- (FutharkiState -> (Env, Ctx)) -> FutharkiM (Env, Ctx)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FutharkiState -> (Env, Ctx)
    futharkiEnv
          let (Env
    tenv, Ctx
    ienv) =
                LoadedProg -> (Env, Ctx) -> [ImportName] -> (Env, Ctx)
    extendEnvs LoadedProg
    prog (Env, Ctx)
    env ([ImportName] -> (Env, Ctx)) -> [ImportName] -> (Env, Ctx)
    forall a b. (a -> b) -> a -> b
    $ (([Char], Loc) -> ImportName) -> [([Char], Loc)] -> [ImportName]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char] -> ImportName
    T.mkInitialImport ([Char] -> ImportName)
    -> (([Char], Loc) -> [Char]) -> ([Char], Loc) -> ImportName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char], Loc) -> [Char]
    forall a b. (a, b) -> a
    fst) ([([Char], Loc)] -> [ImportName])
    -> [([Char], Loc)] -> [ImportName]
    forall a b. (a -> b) -> a -> b
    $ UncheckedDec -> [([Char], Loc)]
    forall (f :: * -> *) vn. DecBase f vn -> [([Char], Loc)]
    decImports UncheckedDec
    d
              imports :: Imports
    imports = LoadedProg -> Imports
    lpImports LoadedProg
    prog
              src :: VNameSource
    src = LoadedProg -> VNameSource
    lpNameSource LoadedProg
    prog
          case Imports
    -> VNameSource
    -> Env
    -> ImportName
    -> UncheckedDec
    -> (Warnings, Either TypeError (Env, Dec, VNameSource))
    T.checkDec Imports
    imports VNameSource
    src Env
    tenv ImportName
    cur_import UncheckedDec
    d of
            (Warnings
    _, Left TypeError
    e) -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> Doc AnsiStyle
    T.prettyTypeErrorNoLoc TypeError
    e
            (Warnings
    _, Right (Env
    tenv', Dec
    d', VNameSource
    src')) -> do
              let new_imports :: Imports
    new_imports =
                    ((ImportName, FileModule) -> Bool) -> Imports -> Imports
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((ImportName -> [ImportName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` ((ImportName, FileModule) -> ImportName) -> Imports -> [ImportName]
    forall a b. (a -> b) -> [a] -> [b]
    map (ImportName, FileModule) -> ImportName
    forall a b. (a, b) -> a
    fst Imports
    old_imports) (ImportName -> Bool)
    -> ((ImportName, FileModule) -> ImportName)
    -> (ImportName, FileModule)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ImportName, FileModule) -> ImportName
    forall a b. (a, b) -> a
    fst) Imports
    imports
              Either InterpreterError Ctx
    int_r <- F ExtOp Ctx -> FutharkiM (Either InterpreterError Ctx)
    forall a. F ExtOp a -> FutharkiM (Either InterpreterError a)
    runInterpreter (F ExtOp Ctx -> FutharkiM (Either InterpreterError Ctx))
    -> F ExtOp Ctx -> FutharkiM (Either InterpreterError Ctx)
    forall a b. (a -> b) -> a -> b
    $ do
                let onImport :: Ctx -> (ImportName, FileModule) -> F ExtOp Ctx
    onImport Ctx
    ienv' (ImportName
    s, FileModule
    imp) =
                      Ctx -> (ImportName, Prog) -> F ExtOp Ctx
    I.interpretImport Ctx
    ienv' (ImportName
    s, FileModule -> Prog
    T.fileProg FileModule
    imp)
                Ctx
    ienv' <- (Ctx -> (ImportName, FileModule) -> F ExtOp Ctx)
    -> Ctx -> Imports -> F ExtOp Ctx
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Ctx -> (ImportName, FileModule) -> F ExtOp Ctx
    onImport Ctx
    ienv Imports
    new_imports
                Ctx -> Dec -> F ExtOp Ctx
    I.interpretDec Ctx
    ienv' Dec
    d'
              case Either InterpreterError Ctx
    int_r of
                Left InterpreterError
    err -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ InterpreterError -> IO ()
    forall a. Show a => a -> IO ()
    print InterpreterError
    err
                Right Ctx
    ienv' -> (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((FutharkiState -> FutharkiState) -> FutharkiM ())
    -> (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ \FutharkiState
    s ->
                  FutharkiState
    s
                    { futharkiEnv = (tenv', ienv'),
                      futharkiProg = prog {lpNameSource = src'}
                    }

    onExp :: UncheckedExp -> FutharkiM (Either (Doc AnsiStyle) I.Value)
    onExp :: UncheckedExp -> FutharkiM (Either (Doc AnsiStyle) Value)
    onExp UncheckedExp
    e = do
      (Imports
    imports, VNameSource
    src, Env
    tenv, Ctx
    ienv) <- FutharkiM (Imports, VNameSource, Env, Ctx)
    getIt
      case Imports
    -> VNameSource
    -> Env
    -> UncheckedExp
    -> (Warnings, Either TypeError ([TypeParam], ExpBase Info VName))
    T.checkExp Imports
    imports VNameSource
    src Env
    tenv UncheckedExp
    e of
        (Warnings
    _, Left TypeError
    err) -> Either (Doc AnsiStyle) Value
    -> FutharkiM (Either (Doc AnsiStyle) Value)
    forall a. a -> FutharkiM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either (Doc AnsiStyle) Value
     -> FutharkiM (Either (Doc AnsiStyle) Value))
    -> Either (Doc AnsiStyle) Value
    -> FutharkiM (Either (Doc AnsiStyle) Value)
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> Either (Doc AnsiStyle) Value
    forall a b. a -> Either a b
    Left (Doc AnsiStyle -> Either (Doc AnsiStyle) Value)
    -> Doc AnsiStyle -> Either (Doc AnsiStyle) Value
    forall a b. (a -> b) -> a -> b
    $ TypeError -> Doc AnsiStyle
    T.prettyTypeErrorNoLoc TypeError
    err
        (Warnings
    _, Right ([TypeParam]
    tparams, ExpBase Info VName
    e'))
          | [TypeParam] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TypeParam]
    tparams -> do
              Either InterpreterError Value
    r <- F ExtOp Value -> FutharkiM (Either InterpreterError Value)
    forall a. F ExtOp a -> FutharkiM (Either InterpreterError a)
    runInterpreter (F ExtOp Value -> FutharkiM (Either InterpreterError Value))
    -> F ExtOp Value -> FutharkiM (Either InterpreterError Value)
    forall a b. (a -> b) -> a -> b
    $ Ctx -> ExpBase Info VName -> F ExtOp Value
    I.interpretExp Ctx
    ienv ExpBase Info VName
    e'
              case Either InterpreterError Value
    r of
                Left InterpreterError
    err -> Either (Doc AnsiStyle) Value
    -> FutharkiM (Either (Doc AnsiStyle) Value)
    forall a. a -> FutharkiM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either (Doc AnsiStyle) Value
     -> FutharkiM (Either (Doc AnsiStyle) Value))
    -> Either (Doc AnsiStyle) Value
    -> FutharkiM (Either (Doc AnsiStyle) Value)
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> Either (Doc AnsiStyle) Value
    forall a b. a -> Either a b
    Left (Doc AnsiStyle -> Either (Doc AnsiStyle) Value)
    -> Doc AnsiStyle -> Either (Doc AnsiStyle) Value
    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 -> Doc AnsiStyle) -> Text -> Doc AnsiStyle
    forall a b. (a -> b) -> a -> b
    $ InterpreterError -> Text
    forall a. Show a => a -> Text
    showText InterpreterError
    err
                Right Value
    v -> Either (Doc AnsiStyle) Value
    -> FutharkiM (Either (Doc AnsiStyle) Value)
    forall a. a -> FutharkiM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either (Doc AnsiStyle) Value
     -> FutharkiM (Either (Doc AnsiStyle) Value))
    -> Either (Doc AnsiStyle) Value
    -> FutharkiM (Either (Doc AnsiStyle) Value)
    forall a b. (a -> b) -> a -> b
    $ Value -> Either (Doc AnsiStyle) Value
    forall a b. b -> Either a b
    Right Value
    v
          | Bool
    otherwise ->
              Either (Doc AnsiStyle) Value
    -> FutharkiM (Either (Doc AnsiStyle) Value)
    forall a. a -> FutharkiM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either (Doc AnsiStyle) Value
     -> FutharkiM (Either (Doc AnsiStyle) Value))
    -> Either (Doc AnsiStyle) Value
    -> FutharkiM (Either (Doc AnsiStyle) Value)
    forall a b. (a -> b) -> a -> b
    $
                Doc AnsiStyle -> Either (Doc AnsiStyle) Value
    forall a b. a -> Either a b
    Left (Doc AnsiStyle -> Either (Doc AnsiStyle) Value)
    -> Doc AnsiStyle -> Either (Doc AnsiStyle) Value
    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')))
                    Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline
                    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
                      ( 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)
                      )
                    Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline

    prettyBreaking :: Breaking -> T.Text
    prettyBreaking :: Breaking -> Text
    prettyBreaking Breaking
    b =
      Int -> [Text] -> Text
    prettyStacktrace (Breaking -> Int
    breakingAt Breaking
    b) ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (StackFrame -> Text) -> [StackFrame] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map StackFrame -> Text
    forall a. Located a => a -> Text
    locText ([StackFrame] -> [Text]) -> [StackFrame] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ NonEmpty StackFrame -> [StackFrame]
    forall a. NonEmpty a -> [a]
    NE.toList (NonEmpty StackFrame -> [StackFrame])
    -> NonEmpty StackFrame -> [StackFrame]
    forall a b. (a -> b) -> a -> b
    $ Breaking -> NonEmpty StackFrame
    breakingStack Breaking
    b

    -- Are we currently willing to break for this reason?  Among othe
    -- things, we do not want recursive breakpoints.  It could work fine
    -- technically, but is probably too confusing to be useful.
    breakForReason :: FutharkiState -> I.StackFrame -> I.BreakReason -> Bool
    breakForReason :: FutharkiState -> StackFrame -> BreakReason -> Bool
    breakForReason FutharkiState
    s StackFrame
    _ BreakReason
    I.BreakNaN
      | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ FutharkiState -> Bool
    futharkiBreakOnNaN FutharkiState
    s = Bool
    False
    breakForReason FutharkiState
    s StackFrame
    top BreakReason
    _ =
      Maybe Breaking -> Bool
    forall a. Maybe a -> Bool
    isNothing (FutharkiState -> Maybe Breaking
    futharkiBreaking FutharkiState
    s)
        Bool -> Bool -> Bool
    && StackFrame -> Loc
    forall a. Located a => a -> Loc
    locOf StackFrame
    top Loc -> [Loc] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` FutharkiState -> [Loc]
    futharkiSkipBreaks FutharkiState
    s

    runInterpreter :: F I.ExtOp a -> FutharkiM (Either I.InterpreterError a)
    runInterpreter :: forall a. F ExtOp a -> FutharkiM (Either InterpreterError a)
    runInterpreter 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 -> FutharkiM (Either InterpreterError a)
    forall a. a -> FutharkiM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either InterpreterError a
     -> FutharkiM (Either InterpreterError a))
    -> (a -> Either InterpreterError a)
    -> a
    -> FutharkiM (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 (FutharkiM (Either InterpreterError a))
    -> FutharkiM (Either InterpreterError a)
    forall {b}.
    ExtOp (FutharkiM (Either InterpreterError b))
    -> FutharkiM (Either InterpreterError b)
    intOp
      where
        intOp :: ExtOp (FutharkiM (Either InterpreterError b))
    -> FutharkiM (Either InterpreterError b)
    intOp (I.ExtOpError InterpreterError
    err) =
          Either InterpreterError b -> FutharkiM (Either InterpreterError b)
    forall a. a -> FutharkiM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either InterpreterError b
     -> FutharkiM (Either InterpreterError b))
    -> Either InterpreterError b
    -> FutharkiM (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 FutharkiM (Either InterpreterError b)
    c) = do
          IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    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 () -> Doc AnsiStyle
    forall ann xxx. Doc ann -> Doc xxx
    unAnnotate Doc ()
    v
          FutharkiM (Either InterpreterError b)
    c
        intOp (I.ExtOpBreak Loc
    w BreakReason
    why NonEmpty StackFrame
    callstack FutharkiM (Either InterpreterError b)
    c) = do
          FutharkiState
    s <- FutharkiM FutharkiState
    forall s (m :: * -> *). MonadState s m => m s
    get

          let why' :: Text
    why' = case BreakReason
    why of
                BreakReason
    I.BreakPoint -> Text
    "Breakpoint"
                BreakReason
    I.BreakNaN -> Text
    "NaN produced"
              top :: StackFrame
    top = NonEmpty StackFrame -> StackFrame
    forall a. NonEmpty a -> a
    NE.head NonEmpty StackFrame
    callstack
              ctx :: Ctx
    ctx = StackFrame -> Ctx
    I.stackFrameCtx StackFrame
    top
              tenv :: Env
    tenv = Env -> Env
    I.typeCheckerEnv (Env -> Env) -> Env -> Env
    forall a b. (a -> b) -> a -> b
    $ Ctx -> Env
    I.ctxEnv Ctx
    ctx
              breaking :: Breaking
    breaking = NonEmpty StackFrame -> Int -> Breaking
    Breaking NonEmpty StackFrame
    callstack Int
    0

          -- Are we supposed to respect this breakpoint?
          Bool -> FutharkiM () -> FutharkiM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (FutharkiState -> StackFrame -> BreakReason -> Bool
    breakForReason FutharkiState
    s StackFrame
    top BreakReason
    why) (FutharkiM () -> FutharkiM ()) -> FutharkiM () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ do
            IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text
    why' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " at " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Loc -> Text
    forall a. Located a => a -> Text
    locText Loc
    w
            IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Breaking -> Text
    prettyBreaking Breaking
    breaking
            IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn Text
    "<Enter> to continue."

            -- Note the cleverness to preserve the Haskeline session (for
            -- line history and such).
            (Either StopReason Any
    stop, FutharkiState
    s') <-
              ExceptT
      StopReason
      (StateT FutharkiState (InputT IO))
      (Either StopReason Any, FutharkiState)
    -> FutharkiM (Either StopReason Any, FutharkiState)
    forall a.
    ExceptT StopReason (StateT FutharkiState (InputT IO)) a
    -> FutharkiM a
    FutharkiM (ExceptT
       StopReason
       (StateT FutharkiState (InputT IO))
       (Either StopReason Any, FutharkiState)
     -> FutharkiM (Either StopReason Any, FutharkiState))
    -> (InputT IO (Either StopReason Any, FutharkiState)
        -> ExceptT
             StopReason
             (StateT FutharkiState (InputT IO))
             (Either StopReason Any, FutharkiState))
    -> InputT IO (Either StopReason Any, FutharkiState)
    -> FutharkiM (Either StopReason Any, FutharkiState)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT
      FutharkiState (InputT IO) (Either StopReason Any, FutharkiState)
    -> ExceptT
         StopReason
         (StateT FutharkiState (InputT IO))
         (Either StopReason Any, FutharkiState)
    forall (m :: * -> *) a. Monad m => m a -> ExceptT StopReason m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT
       FutharkiState (InputT IO) (Either StopReason Any, FutharkiState)
     -> ExceptT
          StopReason
          (StateT FutharkiState (InputT IO))
          (Either StopReason Any, FutharkiState))
    -> (InputT IO (Either StopReason Any, FutharkiState)
        -> StateT
             FutharkiState (InputT IO) (Either StopReason Any, FutharkiState))
    -> InputT IO (Either StopReason Any, FutharkiState)
    -> ExceptT
         StopReason
         (StateT FutharkiState (InputT IO))
         (Either StopReason Any, FutharkiState)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InputT IO (Either StopReason Any, FutharkiState)
    -> StateT
         FutharkiState (InputT IO) (Either StopReason Any, FutharkiState)
    forall (m :: * -> *) a. Monad m => m a -> StateT FutharkiState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (InputT IO (Either StopReason Any, FutharkiState)
     -> FutharkiM (Either StopReason Any, FutharkiState))
    -> InputT IO (Either StopReason Any, FutharkiState)
    -> FutharkiM (Either StopReason Any, FutharkiState)
    forall a b. (a -> b) -> a -> b
    $
                StateT FutharkiState (InputT IO) (Either StopReason Any)
    -> FutharkiState
    -> InputT IO (Either StopReason Any, FutharkiState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT
                  (ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
    -> StateT FutharkiState (InputT IO) (Either StopReason Any)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
     -> StateT FutharkiState (InputT IO) (Either StopReason Any))
    -> ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
    -> StateT FutharkiState (InputT IO) (Either StopReason Any)
    forall a b. (a -> b) -> a -> b
    $ FutharkiM Any
    -> ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
    forall a.
    FutharkiM a
    -> ExceptT StopReason (StateT FutharkiState (InputT IO)) a
    runFutharkiM (FutharkiM Any
     -> ExceptT StopReason (StateT FutharkiState (InputT IO)) Any)
    -> FutharkiM Any
    -> ExceptT StopReason (StateT FutharkiState (InputT IO)) Any
    forall a b. (a -> b) -> a -> b
    $ FutharkiM () -> FutharkiM Any
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever FutharkiM ()
    readEvalPrint)
                  FutharkiState
    s
                    { futharkiEnv = (tenv, ctx),
                      futharkiCount = futharkiCount s + 1,
                      futharkiBreaking = Just breaking
                    }

            case Either StopReason Any
    stop of
              Left (Load [Char]
    file) -> StopReason -> FutharkiM ()
    forall a. StopReason -> FutharkiM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (StopReason -> FutharkiM ()) -> StopReason -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> StopReason
    Load [Char]
    file
              Either StopReason Any
    _ -> do
                IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn [Char]
    "Continuing..."
                FutharkiState -> FutharkiM ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put
                  FutharkiState
    s
                    { futharkiCount =
                        futharkiCount s',
                      futharkiSkipBreaks =
                        futharkiSkipBreaks s' <> futharkiSkipBreaks s,
                      futharkiBreakOnNaN =
                        futharkiBreakOnNaN s'
                    }

          FutharkiM (Either InterpreterError b)
    c

    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
    I.BreakNaN NonEmpty StackFrame
    _ f (Either InterpreterError b)
    c) = f (Either InterpreterError b)
    c
        intOp (I.ExtOpBreak Loc
    w BreakReason
    _ NonEmpty StackFrame
    _ 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
    $
            Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
              Loc -> Text
    forall a. Located a => a -> Text
    locText Loc
    w Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ": " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "ignoring breakpoint when computating constant."
          f (Either InterpreterError b)
    c

    replComplete :: Haskeline.CompletionFunc IO
    replComplete :: CompletionFunc IO
    replComplete = CompletionFunc IO
    forall {m :: * -> *}.
    MonadIO m =>
    ([Char], [Char]) -> m ([Char], [Completion])
    loadComplete
      where
        loadComplete :: ([Char], [Char]) -> m ([Char], [Completion])
    loadComplete ([Char]
    prev, [Char]
    aft)
          | [Char]
    ":load " [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char] -> [Char]
    forall a. [a] -> [a]
    reverse [Char]
    prev =
              ([Char], [Char]) -> m ([Char], [Completion])
    forall {m :: * -> *}.
    MonadIO m =>
    ([Char], [Char]) -> m ([Char], [Completion])
    Haskeline.completeFilename ([Char]
    prev, [Char]
    aft)
          | Bool
    otherwise =
              ([Char], [Char]) -> m ([Char], [Completion])
    forall (m :: * -> *). Monad m => CompletionFunc m
    Haskeline.noCompletion ([Char]
    prev, [Char]
    aft)

    type Command = T.Text -> FutharkiM ()

    loadCommand :: Command
    loadCommand :: Command
    loadCommand Text
    file = do
      Maybe [Char]
    loaded <- (FutharkiState -> Maybe [Char]) -> FutharkiM (Maybe [Char])
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FutharkiState -> Maybe [Char]
    futharkiLoaded
      case (Text -> Bool
    T.null Text
    file, Maybe [Char]
    loaded) of
        (Bool
    True, Just [Char]
    loaded') -> StopReason -> FutharkiM ()
    forall a. StopReason -> FutharkiM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (StopReason -> FutharkiM ()) -> StopReason -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> StopReason
    Load [Char]
    loaded'
        (Bool
    True, Maybe [Char]
    Nothing) -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn Text
    "No file specified and no file previously loaded."
        (Bool
    False, Maybe [Char]
    _) -> StopReason -> FutharkiM ()
    forall a. StopReason -> FutharkiM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (StopReason -> FutharkiM ()) -> StopReason -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> StopReason
    Load ([Char] -> StopReason) -> [Char] -> StopReason
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack Text
    file

    genTypeCommand ::
      (String -> T.Text -> Either SyntaxError a) ->
      (Imports -> VNameSource -> T.Env -> a -> (Warnings, Either T.TypeError b)) ->
      (b -> Doc AnsiStyle) ->
      Command
    genTypeCommand :: forall a b.
    ([Char] -> Text -> Either SyntaxError a)
    -> (Imports
        -> VNameSource -> Env -> a -> (Warnings, Either TypeError b))
    -> (b -> Doc AnsiStyle)
    -> Command
    genTypeCommand [Char] -> Text -> Either SyntaxError a
    f Imports
    -> VNameSource -> Env -> a -> (Warnings, Either TypeError b)
    g b -> Doc AnsiStyle
    h Text
    e = do
      [Char]
    prompt <- FutharkiM [Char]
    getPrompt
      case [Char] -> Text -> Either SyntaxError a
    f [Char]
    prompt Text
    e of
        Left (SyntaxError Loc
    _ Text
    err) -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn Text
    err
        Right a
    e' -> do
          (Imports
    imports, VNameSource
    src, Env
    tenv, Ctx
    _) <- FutharkiM (Imports, VNameSource, Env, Ctx)
    getIt
          case (Warnings, Either TypeError b) -> Either TypeError b
    forall a b. (a, b) -> b
    snd ((Warnings, Either TypeError b) -> Either TypeError b)
    -> (Warnings, Either TypeError b) -> Either TypeError b
    forall a b. (a -> b) -> a -> b
    $ Imports
    -> VNameSource -> Env -> a -> (Warnings, Either TypeError b)
    g Imports
    imports VNameSource
    src Env
    tenv a
    e' of
            Left TypeError
    err -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TypeError -> Doc AnsiStyle
    T.prettyTypeErrorNoLoc TypeError
    err
            Right b
    x -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDocLn (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ b -> Doc AnsiStyle
    h b
    x

    typeCommand :: Command
    typeCommand :: Command
    typeCommand = ([Char] -> Text -> Either SyntaxError UncheckedExp)
    -> (Imports
        -> VNameSource
        -> Env
        -> UncheckedExp
        -> (Warnings, Either TypeError ([TypeParam], ExpBase Info VName)))
    -> (([TypeParam], ExpBase Info VName) -> Doc AnsiStyle)
    -> Command
    forall a b.
    ([Char] -> Text -> Either SyntaxError a)
    -> (Imports
        -> VNameSource -> Env -> a -> (Warnings, Either TypeError b))
    -> (b -> Doc AnsiStyle)
    -> Command
    genTypeCommand [Char] -> Text -> Either SyntaxError UncheckedExp
    parseExp Imports
    -> VNameSource
    -> Env
    -> UncheckedExp
    -> (Warnings, Either TypeError ([TypeParam], ExpBase Info VName))
    T.checkExp ((([TypeParam], ExpBase Info VName) -> Doc AnsiStyle) -> Command)
    -> (([TypeParam], ExpBase Info VName) -> Doc AnsiStyle) -> Command
    forall a b. (a -> b) -> a -> b
    $ \([TypeParam]
    ps, ExpBase Info VName
    e) ->
      Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Doc ann -> Doc ann
    oneLine (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))
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> if Bool -> Bool
    not ([TypeParam] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TypeParam]
    ps)
          then
            AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    annotate AnsiStyle
    italicized (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
    forall a b. (a -> b) -> a -> b
    $
              Doc AnsiStyle
    "\n\nPolymorphic in"
                Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> [Doc AnsiStyle] -> Doc AnsiStyle
    forall a. Monoid a => [a] -> a
    mconcat (Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
    forall a. a -> [a] -> [a]
    intersperse Doc AnsiStyle
    " " ([Doc AnsiStyle] -> [Doc AnsiStyle])
    -> [Doc AnsiStyle] -> [Doc AnsiStyle]
    forall a b. (a -> b) -> a -> b
    $ (TypeParam -> Doc AnsiStyle) -> [TypeParam] -> [Doc AnsiStyle]
    forall a b. (a -> b) -> [a] -> [b]
    map TypeParam -> Doc AnsiStyle
    forall a ann. Pretty a => a -> Doc ann
    forall ann. TypeParam -> Doc ann
    pretty [TypeParam]
    ps)
                Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    "."
          else Doc AnsiStyle
    forall a. Monoid a => a
    mempty

    mtypeCommand :: Command
    mtypeCommand :: Command
    mtypeCommand = ([Char] -> Text -> Either SyntaxError (ModExpBase NoInfo Name))
    -> (Imports
        -> VNameSource
        -> Env
        -> ModExpBase NoInfo Name
        -> (Warnings, Either TypeError (MTy, ModExpBase Info VName)))
    -> ((MTy, ModExpBase Info VName) -> Doc AnsiStyle)
    -> Command
    forall a b.
    ([Char] -> Text -> Either SyntaxError a)
    -> (Imports
        -> VNameSource -> Env -> a -> (Warnings, Either TypeError b))
    -> (b -> Doc AnsiStyle)
    -> Command
    genTypeCommand [Char] -> Text -> Either SyntaxError (ModExpBase NoInfo Name)
    parseModExp Imports
    -> VNameSource
    -> Env
    -> ModExpBase NoInfo Name
    -> (Warnings, Either TypeError (MTy, ModExpBase Info VName))
    T.checkModExp (((MTy, ModExpBase Info VName) -> Doc AnsiStyle) -> Command)
    -> ((MTy, ModExpBase Info VName) -> Doc AnsiStyle) -> Command
    forall a b. (a -> b) -> a -> b
    $ MTy -> Doc AnsiStyle
    forall a ann. Pretty a => a -> Doc ann
    forall ann. MTy -> Doc ann
    pretty (MTy -> Doc AnsiStyle)
    -> ((MTy, ModExpBase Info VName) -> MTy)
    -> (MTy, ModExpBase Info VName)
    -> Doc AnsiStyle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (MTy, ModExpBase Info VName) -> MTy
    forall a b. (a, b) -> a
    fst

    formatCommand :: Command
    formatCommand :: Command
    formatCommand Text
    input = do
      case Text -> Either Text [Either Text Text]
    parseFormatString Text
    input of
        Left Text
    err -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn Text
    err
        Right [Either Text Text]
    parts -> do
          [Char]
    prompt <- FutharkiM [Char]
    getPrompt
          case (Either Text Text -> Either SyntaxError (Either Text UncheckedExp))
    -> [Either Text Text]
    -> Either SyntaxError [Either Text UncheckedExp]
    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 ((Text -> Either SyntaxError UncheckedExp)
    -> Either Text Text
    -> Either SyntaxError (Either Text UncheckedExp)
    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) -> Either Text a -> f (Either Text b)
    traverse ((Text -> Either SyntaxError UncheckedExp)
     -> Either Text Text
     -> Either SyntaxError (Either Text UncheckedExp))
    -> (Text -> Either SyntaxError UncheckedExp)
    -> Either Text Text
    -> Either SyntaxError (Either Text UncheckedExp)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text -> Either SyntaxError UncheckedExp
    parseExp [Char]
    prompt) [Either Text Text]
    parts of
            Left (SyntaxError Loc
    _ Text
    err) ->
              IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStr Text
    err
            Right [Either Text UncheckedExp]
    parts' -> do
              Either (Doc AnsiStyle) [Either Text Value]
    parts'' <- (Either Text (Either (Doc AnsiStyle) Value)
     -> Either (Doc AnsiStyle) (Either Text Value))
    -> [Either Text (Either (Doc AnsiStyle) Value)]
    -> Either (Doc AnsiStyle) [Either Text Value]
    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 Either Text (Either (Doc AnsiStyle) Value)
    -> Either (Doc AnsiStyle) (Either Text Value)
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a.
    Applicative f =>
    Either Text (f a) -> f (Either Text a)
    sequenceA ([Either Text (Either (Doc AnsiStyle) Value)]
     -> Either (Doc AnsiStyle) [Either Text Value])
    -> FutharkiM [Either Text (Either (Doc AnsiStyle) Value)]
    -> FutharkiM (Either (Doc AnsiStyle) [Either Text Value])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Either Text UncheckedExp
     -> FutharkiM (Either Text (Either (Doc AnsiStyle) Value)))
    -> [Either Text UncheckedExp]
    -> FutharkiM [Either Text (Either (Doc AnsiStyle) Value)]
    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 ((UncheckedExp -> FutharkiM (Either (Doc AnsiStyle) Value))
    -> Either Text UncheckedExp
    -> FutharkiM (Either Text (Either (Doc AnsiStyle) Value))
    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) -> Either Text a -> f (Either Text b)
    traverse UncheckedExp -> FutharkiM (Either (Doc AnsiStyle) Value)
    onExp) [Either Text UncheckedExp]
    parts'
              case Either (Doc AnsiStyle) [Either Text Value]
    parts'' of
                Left Doc AnsiStyle
    err -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> IO ()
    putDoc Doc AnsiStyle
    err
                Right [Either Text Value]
    parts''' ->
                  IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ())
    -> ([Text] -> IO ()) -> [Text] -> FutharkiM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> IO ()
    T.putStrLn (Text -> IO ()) -> ([Text] -> Text) -> [Text] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> FutharkiM ()) -> [Text] -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $
                    (Either Text Value -> Text) -> [Either Text Value] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text -> Text) -> (Value -> Text) -> Either Text Value -> Text
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Text -> Text
    forall a. a -> a
    id (Doc Any -> Text
    forall a. Doc a -> Text
    docText (Doc Any -> Text) -> (Value -> Doc Any) -> Value -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> Doc Any
    forall (m :: * -> *) a. Value m -> Doc a
    I.prettyValue)) [Either Text Value]
    parts'''

    unbreakCommand :: Command
    unbreakCommand :: Command
    unbreakCommand Text
    _ = do
      Maybe StackFrame
    top <- (FutharkiState -> Maybe StackFrame) -> FutharkiM (Maybe StackFrame)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((FutharkiState -> Maybe StackFrame)
     -> FutharkiM (Maybe StackFrame))
    -> (FutharkiState -> Maybe StackFrame)
    -> FutharkiM (Maybe StackFrame)
    forall a b. (a -> b) -> a -> b
    $ (Breaking -> StackFrame) -> Maybe Breaking -> Maybe StackFrame
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (NonEmpty StackFrame -> StackFrame
    forall a. NonEmpty a -> a
    NE.head (NonEmpty StackFrame -> StackFrame)
    -> (Breaking -> NonEmpty StackFrame) -> Breaking -> StackFrame
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Breaking -> NonEmpty StackFrame
    breakingStack) (Maybe Breaking -> Maybe StackFrame)
    -> (FutharkiState -> Maybe Breaking)
    -> FutharkiState
    -> Maybe StackFrame
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FutharkiState -> Maybe Breaking
    futharkiBreaking
      case Maybe StackFrame
    top of
        Maybe StackFrame
    Nothing -> IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn [Char]
    "Not currently stopped at a breakpoint."
        Just StackFrame
    top' -> do
          (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((FutharkiState -> FutharkiState) -> FutharkiM ())
    -> (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ \FutharkiState
    s -> FutharkiState
    s {futharkiSkipBreaks = locOf top' : futharkiSkipBreaks s}
          StopReason -> FutharkiM ()
    forall a. StopReason -> FutharkiM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError StopReason
    Stop

    nanbreakCommand :: Command
    nanbreakCommand :: Command
    nanbreakCommand Text
    _ = do
      (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((FutharkiState -> FutharkiState) -> FutharkiM ())
    -> (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ \FutharkiState
    s -> FutharkiState
    s {futharkiBreakOnNaN = not $ futharkiBreakOnNaN s}
      Bool
    b <- (FutharkiState -> Bool) -> FutharkiM Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FutharkiState -> Bool
    futharkiBreakOnNaN
      IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $
        [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          if Bool
    b
            then [Char]
    "Now treating NaNs as breakpoints."
            else [Char]
    "No longer treating NaNs as breakpoints."

    frameCommand :: Command
    frameCommand :: Command
    frameCommand Text
    which = do
      Maybe (NonEmpty StackFrame)
    maybe_stack <- (FutharkiState -> Maybe (NonEmpty StackFrame))
    -> FutharkiM (Maybe (NonEmpty StackFrame))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((FutharkiState -> Maybe (NonEmpty StackFrame))
     -> FutharkiM (Maybe (NonEmpty StackFrame)))
    -> (FutharkiState -> Maybe (NonEmpty StackFrame))
    -> FutharkiM (Maybe (NonEmpty StackFrame))
    forall a b. (a -> b) -> a -> b
    $ (Breaking -> NonEmpty StackFrame)
    -> Maybe Breaking -> Maybe (NonEmpty StackFrame)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Breaking -> NonEmpty StackFrame
    breakingStack (Maybe Breaking -> Maybe (NonEmpty StackFrame))
    -> (FutharkiState -> Maybe Breaking)
    -> FutharkiState
    -> Maybe (NonEmpty StackFrame)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FutharkiState -> Maybe Breaking
    futharkiBreaking
      case (Maybe (NonEmpty StackFrame)
    maybe_stack, [Char] -> Maybe Int
    forall a. Read a => [Char] -> Maybe a
    readMaybe ([Char] -> Maybe Int) -> [Char] -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack Text
    which) of
        (Just NonEmpty StackFrame
    stack, Just Int
    i)
          | StackFrame
    frame : [StackFrame]
    _ <- Int -> NonEmpty StackFrame -> [StackFrame]
    forall a. Int -> NonEmpty a -> [a]
    NE.drop Int
    i NonEmpty StackFrame
    stack -> do
              let breaking :: Breaking
    breaking = NonEmpty StackFrame -> Int -> Breaking
    Breaking NonEmpty StackFrame
    stack Int
    i
                  ctx :: Ctx
    ctx = StackFrame -> Ctx
    I.stackFrameCtx StackFrame
    frame
                  tenv :: Env
    tenv = Env -> Env
    I.typeCheckerEnv (Env -> Env) -> Env -> Env
    forall a b. (a -> b) -> a -> b
    $ Ctx -> Env
    I.ctxEnv Ctx
    ctx
              (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((FutharkiState -> FutharkiState) -> FutharkiM ())
    -> (FutharkiState -> FutharkiState) -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ \FutharkiState
    s ->
                FutharkiState
    s
                  { futharkiEnv = (tenv, ctx),
                    futharkiBreaking = Just breaking
                  }
              IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Breaking -> Text
    prettyBreaking Breaking
    breaking
        (Just NonEmpty StackFrame
    _, Maybe Int
    _) ->
          IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Invalid stack index: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    T.unpack Text
    which
        (Maybe (NonEmpty StackFrame)
    Nothing, Maybe Int
    _) ->
          IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn [Char]
    "Not stopped at a breakpoint."

    pwdCommand :: Command
    pwdCommand :: Command
    pwdCommand Text
    _ = IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> IO [Char] -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO [Char]
    getCurrentDirectory

    cdCommand :: Command
    cdCommand :: Command
    cdCommand Text
    dir
      | Text -> Bool
    T.null Text
    dir = IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn [Char]
    "Usage: ':cd <dir>'."
      | Bool
    otherwise =
          IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $
            [Char] -> IO ()
    setCurrentDirectory (Text -> [Char]
    T.unpack Text
    dir)
              IO () -> (IOException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \(IOException
    err :: IOException) -> IOException -> IO ()
    forall a. Show a => a -> IO ()
    print IOException
    err

    helpCommand :: Command
    helpCommand :: Command
    helpCommand Text
    _ = IO () -> FutharkiM ()
    forall a. IO a -> FutharkiM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
    forall a b. (a -> b) -> a -> b
    $
      [(Text, (Command, Text))]
    -> ((Text, (Command, Text)) -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Text, (Command, Text))]
    commands (((Text, (Command, Text)) -> IO ()) -> IO ())
    -> ((Text, (Command, Text)) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Text
    cmd, (Command
    _, Text
    desc)) -> do
        Doc AnsiStyle -> IO ()
    putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    annotate AnsiStyle
    bold (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle
    ":" 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 Text
    cmd Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline
        Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.replicate (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Text -> Int
    T.length Text
    cmd) Text
    "─"
        Text -> IO ()
    T.putStr Text
    desc
        Text -> IO ()
    T.putStrLn Text
    ""
        Text -> IO ()
    T.putStrLn Text
    ""

    quitCommand :: Command
    quitCommand :: Command
    quitCommand Text
    _ = StopReason -> FutharkiM ()
    forall a. StopReason -> FutharkiM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError StopReason
    Exit

    commands :: [(T.Text, (Command, T.Text))]
    commands :: [(Text, (Command, Text))]
    commands =
      [ ( Text
    "load",
          ( Command
    loadCommand,
            [text|
    Load a Futhark source file.  Usage:

      > :load foo.fut

    If the loading succeeds, any expressions entered subsequently can use the
    declarations in the source file.

    Only one source file can be loaded at a time.  Using the :load command a
    second time will replace the previously loaded file.  It will also replace
    any declarations entered at the REPL.

    |]
          )
        ),
        ( Text
    "format",
          ( Command
    formatCommand,
            [text|
    Use format strings to print arbitrary futhark expressions. Usage:

      > :format The value of foo: {foo}. The value of 2+2={2+2}
    |]
          )
        ),
        ( Text
    "type",
          ( Command
    typeCommand,
            [text|
    Show the type of an expression, which must fit on a single line.
    |]
          )
        ),
        ( Text
    "mtype",
          ( Command
    mtypeCommand,
            [text|
    Show the type of a module expression, which must fit on a single line.
    |]
          )
        ),
        ( Text
    "unbreak",
          ( Command
    unbreakCommand,
            [text|
    Skip all future occurrences of the current breakpoint.
    |]
          )
        ),
        ( Text
    "nanbreak",
          ( Command
    nanbreakCommand,
            [text|
    Toggle treating operators that produce new NaNs as breakpoints.  We consider a NaN
    to be "new" if none of the arguments to the operator in question is a NaN.
    |]
          )
        ),
        ( Text
    "frame",
          ( Command
    frameCommand,
            [text|
    While at a break point, jump to another stack frame, whose variables can then
    be inspected.  Resuming from the breakpoint will jump back to the innermost
    stack frame.
    |]
          )
        ),
        ( Text
    "pwd",
          ( Command
    pwdCommand,
            [text|
    Print the current working directory.
    |]
          )
        ),
        ( Text
    "cd",
          ( Command
    cdCommand,
            [text|
    Change the current working directory.
    |]
          )
        ),
        ( Text
    "help",
          ( Command
    helpCommand,
            [text|
    Print a list of commands and a description of their behaviour.
    |]
          )
        ),
        ( Text
    "quit",
          ( Command
    quitCommand,
            [text|
    Exit REPL.
    |]
          )
        )
      ]