module Futhark.CLI.Eval (main) where

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

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

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

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

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

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

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

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

  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 InterpreterError -> Doc AnsiStyle
I.prettyInterpreterError (Either InterpreterError Ctx -> ExceptT (Doc AnsiStyle) IO Ctx)
-> ((ImportName, Prog)
    -> ExceptT (Doc AnsiStyle) IO (Either InterpreterError Ctx))
-> (ImportName, Prog)
-> ExceptT (Doc AnsiStyle) IO Ctx
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< F ExtOp Ctx
-> ExceptT (Doc AnsiStyle) IO (Either InterpreterError Ctx)
forall (m :: * -> *) a.
MonadIO m =>
F ExtOp a -> m (Either InterpreterError a)
runInterpreterNoBreak (F ExtOp Ctx
 -> ExceptT (Doc AnsiStyle) IO (Either InterpreterError Ctx))
-> ((ImportName, Prog) -> F ExtOp Ctx)
-> (ImportName, Prog)
-> ExceptT (Doc AnsiStyle) IO (Either InterpreterError Ctx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> (ImportName, Prog) -> F ExtOp Ctx
I.interpretImport Ctx
ctx) 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) Imports
imports

  let (Env
tenv, Ctx
ienv) =
        let (ImportName
iname, FileModule
fm) = Imports -> (ImportName, FileModule)
forall a. HasCallStack => [a] -> a
last Imports
imports
         in ( FileModule -> Env
fileScope FileModule
fm,
              Ctx
ictx {ctxEnv :: Env
I.ctxEnv = Ctx -> Map ImportName Env
I.ctxImports Ctx
ictx Map ImportName Env -> ImportName -> Env
forall k a. Ord k => Map k a -> k -> a
M.! ImportName
iname}
            )

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

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