{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | @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 (intercalate, intersperse)
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Version
import Futhark.Compiler
import Futhark.MonadFreshNames
import Futhark.Pipeline
import Futhark.Util (toPOSIX)
import Futhark.Util.Options
import Futhark.Version
import Language.Futhark
import qualified Language.Futhark.Interpreter as I
import Language.Futhark.Parser hiding (EOF)
import qualified Language.Futhark.Semantic as T
import qualified Language.Futhark.TypeChecker as T
import NeatInterpolation (text)
import qualified System.Console.Haskeline as Haskeline
import System.Directory
import System.FilePath
import Text.Read (readMaybe)

banner :: String
banner :: String
banner =
  [String] -> String
unlines
    [ String
"|// |\\    |   |\\  |\\   /",
      String
"|/  | \\   |\\  |\\  |/  /",
      String
"|   |  \\  |/  |   |\\  \\",
      String
"|   |   \\ |   |   | \\  \\"
    ]

-- | Run @futhark repl@.
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... [program.fut]" [String] -> InterpreterConfig -> Maybe (IO ())
forall p. [String] -> p -> Maybe (IO ())
run
  where
    run :: [String] -> 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 String -> IO ()
repl Maybe String
forall a. Maybe a
Nothing
    run [String
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 String -> IO ()
repl (Maybe String -> IO ()) -> Maybe String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
prog
    run [String]
_ p
_ = Maybe (IO ())
forall a. Maybe a
Nothing

data StopReason = EOF | Stop | Exit | Load FilePath

repl :: Maybe FilePath -> IO ()
repl :: Maybe String -> IO ()
repl Maybe String
maybe_prog = do
  String -> IO ()
putStr String
banner
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
  String -> IO ()
putStrLn String
"Copyright (C) DIKU, University of Copenhagen, released under the ISC license."
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStrLn String
"Run :help for a list of commands."
  String -> IO ()
putStrLn String
""

  let toploop :: FutharkiState -> InputT IO ()
toploop FutharkiState
s = do
        (Either StopReason Any
stop, FutharkiState
s') <- 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 ()
finish FutharkiState
s'
          Left StopReason
EOF -> FutharkiState -> InputT IO ()
finish FutharkiState
s'
          Left StopReason
Exit -> FutharkiState -> InputT IO ()
finish FutharkiState
s'
          Left (Load String
file) -> do
            IO () -> InputT IO ()
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
<> String -> Text
T.pack String
file
            Either String FutharkiState
maybe_new_state <-
              IO (Either String FutharkiState)
-> InputT IO (Either String FutharkiState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String FutharkiState)
 -> InputT IO (Either String FutharkiState))
-> IO (Either String FutharkiState)
-> InputT IO (Either String FutharkiState)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe String -> IO (Either String FutharkiState)
newFutharkiState (FutharkiState -> Int
futharkiCount FutharkiState
s) (Maybe String -> IO (Either String FutharkiState))
-> Maybe String -> IO (Either String FutharkiState)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
file
            case Either String FutharkiState
maybe_new_state of
              Right FutharkiState
new_state -> FutharkiState -> InputT IO ()
toploop FutharkiState
new_state
              Left String
err -> do
                IO () -> InputT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT IO ()) -> IO () -> InputT IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
err
                FutharkiState -> InputT IO ()
toploop FutharkiState
s'
          Right Any
_ -> () -> InputT IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      finish :: FutharkiState -> InputT IO ()
finish FutharkiState
s = do
        Bool
quit <- InputT IO Bool
confirmQuit
        if Bool
quit then () -> InputT IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else FutharkiState -> InputT IO ()
toploop FutharkiState
s

  Either String FutharkiState
maybe_init_state <- IO (Either String FutharkiState)
-> IO (Either String FutharkiState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String FutharkiState)
 -> IO (Either String FutharkiState))
-> IO (Either String FutharkiState)
-> IO (Either String FutharkiState)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe String -> IO (Either String FutharkiState)
newFutharkiState Int
0 Maybe String
maybe_prog
  FutharkiState
s <- case Either String FutharkiState
maybe_init_state of
    Left String
prog_err -> do
      Either String FutharkiState
noprog_init_state <- IO (Either String FutharkiState)
-> IO (Either String FutharkiState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String FutharkiState)
 -> IO (Either String FutharkiState))
-> IO (Either String FutharkiState)
-> IO (Either String FutharkiState)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe String -> IO (Either String FutharkiState)
newFutharkiState Int
0 Maybe String
forall a. Maybe a
Nothing
      case Either String FutharkiState
noprog_init_state of
        Left String
err ->
          String -> IO FutharkiState
forall a. HasCallStack => String -> a
error (String -> IO FutharkiState) -> String -> IO FutharkiState
forall a b. (a -> b) -> a -> b
$ String
"Failed to initialise interpreter state: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
        Right FutharkiState
s -> do
          IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
prog_err
          FutharkiState -> IO FutharkiState
forall (m :: * -> *) a. Monad m => a -> m a
return FutharkiState
s {futharkiLoaded :: Maybe String
futharkiLoaded = Maybe String
maybe_prog}
    Right FutharkiState
s ->
      FutharkiState -> IO FutharkiState
forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall (m :: * -> *). MonadIO m => Settings m
Haskeline.defaultSettings (InputT IO () -> IO ()) -> InputT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FutharkiState -> InputT IO ()
toploop FutharkiState
s

  String -> IO ()
putStrLn String
"Leaving 'futhark repl'."

confirmQuit :: Haskeline.InputT IO Bool
confirmQuit :: InputT IO Bool
confirmQuit = do
  Maybe Char
c <- String -> InputT IO (Maybe Char)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe Char)
Haskeline.getInputChar String
"Quit REPL? (y/n) "
  case Maybe Char
c of
    Maybe Char
Nothing -> Bool -> InputT IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True -- EOF
    Just Char
'y' -> Bool -> InputT IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just Char
'n' -> Bool -> InputT IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Maybe Char
_ -> InputT IO Bool
confirmQuit

newtype InterpreterConfig = InterpreterConfig {InterpreterConfig -> Name
interpreterEntryPoint :: Name}

interpreterConfig :: InterpreterConfig
interpreterConfig :: InterpreterConfig
interpreterConfig = Name -> InterpreterConfig
InterpreterConfig Name
defaultEntryPoint

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
"e"
      [String
"entry-point"]
      ( (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 {interpreterEntryPoint :: Name
interpreterEntryPoint = String -> Name
nameFromString String
entry}
          )
          String
"NAME"
      )
      String
"The entry point to execute."
  ]

-- | 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 -> Imports
futharkiImports :: Imports,
    FutharkiState -> VNameSource
futharkiNameSource :: VNameSource,
    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 String
futharkiLoaded :: Maybe FilePath
  }

newFutharkiState :: Int -> Maybe FilePath -> IO (Either String FutharkiState)
newFutharkiState :: Int -> Maybe String -> IO (Either String FutharkiState)
newFutharkiState Int
count Maybe String
maybe_file = ExceptT String IO FutharkiState -> IO (Either String FutharkiState)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO FutharkiState
 -> IO (Either String FutharkiState))
-> ExceptT String IO FutharkiState
-> IO (Either String FutharkiState)
forall a b. (a -> b) -> a -> b
$ do
  (Imports
imports, VNameSource
src, Env
tenv, Ctx
ienv) <- case Maybe String
maybe_file of
    Maybe String
Nothing -> do
      -- Load the builtins through the type checker.
      (Warnings
_, Imports
imports, VNameSource
src) <- (CompilerError -> String)
-> Either CompilerError (Warnings, Imports, VNameSource)
-> ExceptT String IO (Warnings, Imports, VNameSource)
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft CompilerError -> String
forall a. Show a => a -> String
show (Either CompilerError (Warnings, Imports, VNameSource)
 -> ExceptT String IO (Warnings, Imports, VNameSource))
-> ExceptT
     String IO (Either CompilerError (Warnings, Imports, VNameSource))
-> ExceptT String IO (Warnings, Imports, VNameSource)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptT
  CompilerError (ExceptT String IO) (Warnings, Imports, VNameSource)
-> ExceptT
     String IO (Either CompilerError (Warnings, Imports, VNameSource))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ([Name]
-> [String]
-> ExceptT
     CompilerError (ExceptT String IO) (Warnings, Imports, VNameSource)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[Name] -> [String] -> m (Warnings, Imports, VNameSource)
readLibrary [] [])
      -- Then into the interpreter.
      Ctx
ienv <-
        (Ctx -> (String, Prog) -> ExceptT String IO Ctx)
-> Ctx -> [(String, Prog)] -> ExceptT String IO Ctx
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
          (\Ctx
ctx -> (InterpreterError -> String)
-> Either InterpreterError Ctx -> ExceptT String IO Ctx
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft InterpreterError -> String
forall a. Show a => a -> String
show (Either InterpreterError Ctx -> ExceptT String IO Ctx)
-> ((String, Prog)
    -> ExceptT String IO (Either InterpreterError Ctx))
-> (String, Prog)
-> ExceptT String IO Ctx
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< F ExtOp Ctx -> ExceptT String IO (Either InterpreterError Ctx)
forall (m :: * -> *) a.
MonadIO m =>
F ExtOp a -> m (Either InterpreterError a)
runInterpreter' (F ExtOp Ctx -> ExceptT String IO (Either InterpreterError Ctx))
-> ((String, Prog) -> F ExtOp Ctx)
-> (String, Prog)
-> ExceptT String IO (Either InterpreterError Ctx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> (String, Prog) -> F ExtOp Ctx
I.interpretImport Ctx
ctx)
          Ctx
I.initialCtx
          ([(String, Prog)] -> ExceptT String IO Ctx)
-> [(String, Prog)] -> ExceptT String IO Ctx
forall a b. (a -> b) -> a -> b
$ ((String, FileModule) -> (String, Prog))
-> Imports -> [(String, Prog)]
forall a b. (a -> b) -> [a] -> [b]
map ((FileModule -> Prog) -> (String, FileModule) -> (String, Prog)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileModule -> Prog
fileProg) Imports
imports

      -- Then make the prelude available in the type checker.
      (Env
tenv, Dec
d, VNameSource
src') <-
        (TypeError -> String)
-> Either TypeError (Env, Dec, VNameSource)
-> ExceptT String IO (Env, Dec, VNameSource)
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft TypeError -> String
forall a. Pretty a => a -> String
pretty (Either TypeError (Env, Dec, VNameSource)
 -> ExceptT String IO (Env, Dec, VNameSource))
-> Either TypeError (Env, Dec, VNameSource)
-> ExceptT String IO (Env, Dec, VNameSource)
forall a b. (a -> b) -> a -> b
$
          (Warnings, Either TypeError (Env, Dec, VNameSource))
-> Either TypeError (Env, Dec, VNameSource)
forall a b. (a, b) -> b
snd ((Warnings, Either TypeError (Env, Dec, VNameSource))
 -> Either TypeError (Env, Dec, VNameSource))
-> (Warnings, Either TypeError (Env, Dec, VNameSource))
-> Either TypeError (Env, Dec, VNameSource)
forall a b. (a -> b) -> a -> b
$
            Imports
-> VNameSource
-> Env
-> ImportName
-> UncheckedDec
-> (Warnings, Either TypeError (Env, Dec, VNameSource))
T.checkDec
              Imports
imports
              VNameSource
src
              Env
T.initialEnv
              (String -> ImportName
T.mkInitialImport String
".")
              (UncheckedDec
 -> (Warnings, Either TypeError (Env, Dec, VNameSource)))
-> UncheckedDec
-> (Warnings, Either TypeError (Env, Dec, VNameSource))
forall a b. (a -> b) -> a -> b
$ String -> UncheckedDec
mkOpen String
"/prelude/prelude"
      -- Then in the interpreter.
      Ctx
ienv' <- (InterpreterError -> String)
-> Either InterpreterError Ctx -> ExceptT String IO Ctx
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft InterpreterError -> String
forall a. Show a => a -> String
show (Either InterpreterError Ctx -> ExceptT String IO Ctx)
-> ExceptT String IO (Either InterpreterError Ctx)
-> ExceptT String IO Ctx
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< F ExtOp Ctx -> ExceptT String IO (Either InterpreterError Ctx)
forall (m :: * -> *) a.
MonadIO m =>
F ExtOp a -> m (Either InterpreterError a)
runInterpreter' (Ctx -> Dec -> F ExtOp Ctx
I.interpretDec Ctx
ienv Dec
d)
      (Imports, VNameSource, Env, Ctx)
-> ExceptT String IO (Imports, VNameSource, Env, Ctx)
forall (m :: * -> *) a. Monad m => a -> m a
return (Imports
imports, VNameSource
src', Env
tenv, Ctx
ienv')
    Just String
file -> do
      (Warnings
ws, Imports
imports, VNameSource
src) <-
        (CompilerError -> String)
-> Either CompilerError (Warnings, Imports, VNameSource)
-> ExceptT String IO (Warnings, Imports, VNameSource)
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft CompilerError -> String
forall a. Show a => a -> String
show
          (Either CompilerError (Warnings, Imports, VNameSource)
 -> ExceptT String IO (Warnings, Imports, VNameSource))
-> ExceptT
     String IO (Either CompilerError (Warnings, Imports, VNameSource))
-> ExceptT String IO (Warnings, Imports, VNameSource)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either CompilerError (Warnings, Imports, VNameSource))
-> ExceptT
     String IO (Either CompilerError (Warnings, Imports, VNameSource))
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)
readProgram [] String
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 (m :: * -> *) a. Monad m => a -> m a
return (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))
            )
      IO () -> ExceptT String IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT String IO ()) -> IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Warnings -> String
forall a. Pretty a => a -> String
pretty Warnings
ws

      let imp :: ImportName
imp = String -> ImportName
T.mkInitialImport String
"."
      Ctx
ienv1 <-
        (Ctx -> (String, Prog) -> ExceptT String IO Ctx)
-> Ctx -> [(String, Prog)] -> ExceptT String IO Ctx
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Ctx
ctx -> (InterpreterError -> String)
-> Either InterpreterError Ctx -> ExceptT String IO Ctx
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft InterpreterError -> String
forall a. Show a => a -> String
show (Either InterpreterError Ctx -> ExceptT String IO Ctx)
-> ((String, Prog)
    -> ExceptT String IO (Either InterpreterError Ctx))
-> (String, Prog)
-> ExceptT String IO Ctx
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< F ExtOp Ctx -> ExceptT String IO (Either InterpreterError Ctx)
forall (m :: * -> *) a.
MonadIO m =>
F ExtOp a -> m (Either InterpreterError a)
runInterpreter' (F ExtOp Ctx -> ExceptT String IO (Either InterpreterError Ctx))
-> ((String, Prog) -> F ExtOp Ctx)
-> (String, Prog)
-> ExceptT String IO (Either InterpreterError Ctx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> (String, Prog) -> F ExtOp Ctx
I.interpretImport Ctx
ctx) Ctx
I.initialCtx ([(String, Prog)] -> ExceptT String IO Ctx)
-> [(String, Prog)] -> ExceptT String IO Ctx
forall a b. (a -> b) -> a -> b
$
          ((String, FileModule) -> (String, Prog))
-> Imports -> [(String, Prog)]
forall a b. (a -> b) -> [a] -> [b]
map ((FileModule -> Prog) -> (String, FileModule) -> (String, Prog)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileModule -> Prog
fileProg) Imports
imports
      (Env
tenv1, Dec
d1, VNameSource
src') <-
        (TypeError -> String)
-> Either TypeError (Env, Dec, VNameSource)
-> ExceptT String IO (Env, Dec, VNameSource)
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft TypeError -> String
forall a. Pretty a => a -> String
pretty (Either TypeError (Env, Dec, VNameSource)
 -> ExceptT String IO (Env, Dec, VNameSource))
-> Either TypeError (Env, Dec, VNameSource)
-> ExceptT String IO (Env, Dec, VNameSource)
forall a b. (a -> b) -> a -> b
$
          (Warnings, Either TypeError (Env, Dec, VNameSource))
-> Either TypeError (Env, Dec, VNameSource)
forall a b. (a, b) -> b
snd ((Warnings, Either TypeError (Env, Dec, VNameSource))
 -> Either TypeError (Env, Dec, VNameSource))
-> (Warnings, Either TypeError (Env, Dec, VNameSource))
-> Either TypeError (Env, Dec, VNameSource)
forall a b. (a -> b) -> a -> b
$
            Imports
-> VNameSource
-> Env
-> ImportName
-> UncheckedDec
-> (Warnings, Either TypeError (Env, Dec, VNameSource))
T.checkDec Imports
imports VNameSource
src Env
T.initialEnv ImportName
imp (UncheckedDec
 -> (Warnings, Either TypeError (Env, Dec, VNameSource)))
-> UncheckedDec
-> (Warnings, Either TypeError (Env, Dec, VNameSource))
forall a b. (a -> b) -> a -> b
$
              String -> UncheckedDec
mkOpen String
"/prelude/prelude"
      (Env
tenv2, Dec
d2, VNameSource
src'') <-
        (TypeError -> String)
-> Either TypeError (Env, Dec, VNameSource)
-> ExceptT String IO (Env, Dec, VNameSource)
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft TypeError -> String
forall a. Pretty a => a -> String
pretty (Either TypeError (Env, Dec, VNameSource)
 -> ExceptT String IO (Env, Dec, VNameSource))
-> Either TypeError (Env, Dec, VNameSource)
-> ExceptT String IO (Env, Dec, VNameSource)
forall a b. (a -> b) -> a -> b
$
          (Warnings, Either TypeError (Env, Dec, VNameSource))
-> Either TypeError (Env, Dec, VNameSource)
forall a b. (a, b) -> b
snd ((Warnings, Either TypeError (Env, Dec, VNameSource))
 -> Either TypeError (Env, Dec, VNameSource))
-> (Warnings, Either TypeError (Env, Dec, VNameSource))
-> Either TypeError (Env, Dec, VNameSource)
forall a b. (a -> b) -> a -> b
$
            Imports
-> VNameSource
-> Env
-> ImportName
-> UncheckedDec
-> (Warnings, Either TypeError (Env, Dec, VNameSource))
T.checkDec Imports
imports VNameSource
src' Env
tenv1 ImportName
imp (UncheckedDec
 -> (Warnings, Either TypeError (Env, Dec, VNameSource)))
-> UncheckedDec
-> (Warnings, Either TypeError (Env, Dec, VNameSource))
forall a b. (a -> b) -> a -> b
$
              String -> UncheckedDec
mkOpen (String -> UncheckedDec) -> String -> UncheckedDec
forall a b. (a -> b) -> a -> b
$ String -> String
toPOSIX (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
file
      Ctx
ienv2 <- (InterpreterError -> String)
-> Either InterpreterError Ctx -> ExceptT String IO Ctx
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft InterpreterError -> String
forall a. Show a => a -> String
show (Either InterpreterError Ctx -> ExceptT String IO Ctx)
-> ExceptT String IO (Either InterpreterError Ctx)
-> ExceptT String IO Ctx
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< F ExtOp Ctx -> ExceptT String IO (Either InterpreterError Ctx)
forall (m :: * -> *) a.
MonadIO m =>
F ExtOp a -> m (Either InterpreterError a)
runInterpreter' (Ctx -> Dec -> F ExtOp Ctx
I.interpretDec Ctx
ienv1 Dec
d1)
      Ctx
ienv3 <- (InterpreterError -> String)
-> Either InterpreterError Ctx -> ExceptT String IO Ctx
forall err a.
(err -> String) -> Either err a -> ExceptT String IO a
badOnLeft InterpreterError -> String
forall a. Show a => a -> String
show (Either InterpreterError Ctx -> ExceptT String IO Ctx)
-> ExceptT String IO (Either InterpreterError Ctx)
-> ExceptT String IO Ctx
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< F ExtOp Ctx -> ExceptT String IO (Either InterpreterError Ctx)
forall (m :: * -> *) a.
MonadIO m =>
F ExtOp a -> m (Either InterpreterError a)
runInterpreter' (Ctx -> Dec -> F ExtOp Ctx
I.interpretDec Ctx
ienv2 Dec
d2)
      (Imports, VNameSource, Env, Ctx)
-> ExceptT String IO (Imports, VNameSource, Env, Ctx)
forall (m :: * -> *) a. Monad m => a -> m a
return (Imports
imports, VNameSource
src'', Env
tenv2, Ctx
ienv3)

  FutharkiState -> ExceptT String IO FutharkiState
forall (m :: * -> *) a. Monad m => a -> m a
return
    FutharkiState :: Imports
-> VNameSource
-> Int
-> (Env, Ctx)
-> Maybe Breaking
-> [Loc]
-> Bool
-> Maybe String
-> FutharkiState
FutharkiState
      { futharkiImports :: Imports
futharkiImports = Imports
imports,
        futharkiNameSource :: VNameSource
futharkiNameSource = VNameSource
src,
        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 String
futharkiLoaded = Maybe String
maybe_file
      }
  where
    badOnLeft :: (err -> String) -> Either err a -> ExceptT String IO a
    badOnLeft :: (err -> String) -> Either err a -> ExceptT String IO a
badOnLeft err -> String
_ (Right a
x) = a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    badOnLeft err -> String
p (Left err
err) = String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO a) -> String -> ExceptT String IO a
forall a b. (a -> b) -> a -> b
$ err -> String
p err
err

getPrompt :: FutharkiM String
getPrompt :: FutharkiM String
getPrompt = do
  Int
i <- (FutharkiState -> Int) -> FutharkiM Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FutharkiState -> Int
futharkiCount
  String -> FutharkiM String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FutharkiM String) -> String -> FutharkiM String
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]> "

mkOpen :: FilePath -> UncheckedDec
mkOpen :: String -> UncheckedDec
mkOpen String
f = ModExpBase NoInfo Name -> SrcLoc -> UncheckedDec
forall (f :: * -> *) vn. ModExpBase f vn -> SrcLoc -> DecBase f vn
OpenDec (String -> NoInfo String -> SrcLoc -> ModExpBase NoInfo Name
forall (f :: * -> *) vn.
String -> f String -> SrcLoc -> ModExpBase f vn
ModImport String
f NoInfo String
forall a. NoInfo a
NoInfo SrcLoc
forall a. Monoid a => a
mempty) SrcLoc
forall a. Monoid a => a
mempty

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

readEvalPrint :: FutharkiM ()
readEvalPrint :: FutharkiM ()
readEvalPrint = do
  String
prompt <- FutharkiM String
getPrompt
  Text
line <- String -> FutharkiM Text
inputLine String
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 e (m :: * -> *) a. MonadError e m => e -> m a
throwError StopReason
Stop
      | Bool
otherwise -> () -> FutharkiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    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 Text -> Text -> Bool
`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 (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 (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
"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.
      Either ParseError (Either UncheckedDec UncheckedExp)
maybe_dec_or_e <- FutharkiM Text
-> String
-> Text
-> FutharkiM (Either ParseError (Either UncheckedDec UncheckedExp))
forall (m :: * -> *).
Monad m =>
m Text
-> String
-> Text
-> m (Either ParseError (Either UncheckedDec UncheckedExp))
parseDecOrExpIncrM (String -> FutharkiM Text
inputLine String
"  ") String
prompt Text
line

      case Either ParseError (Either UncheckedDec UncheckedExp)
maybe_dec_or_e of
        Left ParseError
err -> IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ ParseError -> IO ()
forall a. Show a => a -> IO ()
print ParseError
err
        Right (Left UncheckedDec
d) -> UncheckedDec -> FutharkiM ()
onDec UncheckedDec
d
        Right (Right UncheckedExp
e) -> UncheckedExp -> FutharkiM ()
onExp UncheckedExp
e
  (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 :: Int
futharkiCount = FutharkiState -> Int
futharkiCount FutharkiState
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
  where
    inputLine :: String -> FutharkiM Text
inputLine String
prompt = do
      Maybe String
inp <- ExceptT
  StopReason (StateT FutharkiState (InputT IO)) (Maybe String)
-> FutharkiM (Maybe String)
forall a.
ExceptT StopReason (StateT FutharkiState (InputT IO)) a
-> FutharkiM a
FutharkiM (ExceptT
   StopReason (StateT FutharkiState (InputT IO)) (Maybe String)
 -> FutharkiM (Maybe String))
-> ExceptT
     StopReason (StateT FutharkiState (InputT IO)) (Maybe String)
-> FutharkiM (Maybe String)
forall a b. (a -> b) -> a -> b
$ StateT FutharkiState (InputT IO) (Maybe String)
-> ExceptT
     StopReason (StateT FutharkiState (InputT IO)) (Maybe String)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT FutharkiState (InputT IO) (Maybe String)
 -> ExceptT
      StopReason (StateT FutharkiState (InputT IO)) (Maybe String))
-> StateT FutharkiState (InputT IO) (Maybe String)
-> ExceptT
     StopReason (StateT FutharkiState (InputT IO)) (Maybe String)
forall a b. (a -> b) -> a -> b
$ InputT IO (Maybe String)
-> StateT FutharkiState (InputT IO) (Maybe String)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (InputT IO (Maybe String)
 -> StateT FutharkiState (InputT IO) (Maybe String))
-> InputT IO (Maybe String)
-> StateT FutharkiState (InputT IO) (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Haskeline.getInputLine String
prompt
      case Maybe String
inp of
        Just String
s -> Text -> FutharkiM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> FutharkiM Text) -> Text -> FutharkiM Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
        Maybe String
Nothing -> StopReason -> FutharkiM Text
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
futharkiImports
  VNameSource
src <- (FutharkiState -> VNameSource) -> FutharkiM VNameSource
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FutharkiState -> VNameSource
futharkiNameSource
  (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 (m :: * -> *) a. Monad m => a -> m a
return (Imports
imports, VNameSource
src, Env
tenv, Ctx
ienv)

onDec :: UncheckedDec -> FutharkiM ()
onDec :: UncheckedDec -> FutharkiM ()
onDec UncheckedDec
d = do
  (Imports
imports, VNameSource
src, Env
tenv, Ctx
ienv) <- FutharkiM (Imports, VNameSource, Env, Ctx)
getIt
  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
$ String -> ImportName
T.mkInitialImport (String -> ImportName)
-> (FutharkiState -> String) -> FutharkiState -> ImportName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"." (Maybe String -> String)
-> (FutharkiState -> Maybe String) -> FutharkiState -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FutharkiState -> Maybe String
futharkiLoaded

  -- Most of the complexity here concerns the dealing with the fact
  -- that 'import "foo"' is a declaration.  We have to involve a lot
  -- of machinery to load this external code before executing the
  -- declaration itself.
  let basis :: Basis
basis = Imports -> VNameSource -> [String] -> Basis
Basis Imports
imports VNameSource
src [String
"/prelude/prelude"]
      mkImport :: (String, SrcLoc) -> ImportName
mkImport = (String -> SrcLoc -> ImportName) -> (String, SrcLoc) -> ImportName
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> SrcLoc -> ImportName)
 -> (String, SrcLoc) -> ImportName)
-> (String -> SrcLoc -> ImportName)
-> (String, SrcLoc)
-> ImportName
forall a b. (a -> b) -> a -> b
$ ImportName -> String -> SrcLoc -> ImportName
T.mkImportFrom ImportName
cur_import
  Either CompilerError (Warnings, Imports, VNameSource)
imp_r <- ExceptT CompilerError FutharkiM (Warnings, Imports, VNameSource)
-> FutharkiM
     (Either CompilerError (Warnings, Imports, VNameSource))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CompilerError FutharkiM (Warnings, Imports, VNameSource)
 -> FutharkiM
      (Either CompilerError (Warnings, Imports, VNameSource)))
-> ExceptT CompilerError FutharkiM (Warnings, Imports, VNameSource)
-> FutharkiM
     (Either CompilerError (Warnings, Imports, VNameSource))
forall a b. (a -> b) -> a -> b
$ Basis
-> [ImportName]
-> ExceptT CompilerError FutharkiM (Warnings, Imports, VNameSource)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
Basis -> [ImportName] -> m (Warnings, Imports, VNameSource)
readImports Basis
basis (((String, SrcLoc) -> ImportName)
-> [(String, SrcLoc)] -> [ImportName]
forall a b. (a -> b) -> [a] -> [b]
map (String, SrcLoc) -> ImportName
mkImport ([(String, SrcLoc)] -> [ImportName])
-> [(String, SrcLoc)] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ UncheckedDec -> [(String, SrcLoc)]
forall (f :: * -> *) vn. DecBase f vn -> [(String, SrcLoc)]
decImports UncheckedDec
d)

  case Either CompilerError (Warnings, Imports, VNameSource)
imp_r of
    Left CompilerError
e -> IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ CompilerError -> IO ()
forall a. Show a => a -> IO ()
print CompilerError
e
    Right (Warnings
_, Imports
imports', VNameSource
src') ->
      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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ TypeError -> String
forall a. Pretty a => a -> String
pretty TypeError
e
        (Warnings
_, Right (Env
tenv', Dec
d', VNameSource
src'')) -> do
          let new_imports :: Imports
new_imports = ((String, FileModule) -> Bool) -> Imports -> Imports
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((String, FileModule) -> String) -> Imports -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, FileModule) -> String
forall a b. (a, b) -> a
fst Imports
imports) (String -> Bool)
-> ((String, FileModule) -> String) -> (String, FileModule) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FileModule) -> String
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 -> (String, FileModule) -> F ExtOp Ctx
onImport Ctx
ienv' (String
s, FileModule
imp) =
                  Ctx -> (String, Prog) -> F ExtOp Ctx
I.interpretImport Ctx
ienv' (String
s, FileModule -> Prog
T.fileProg FileModule
imp)
            Ctx
ienv' <- (Ctx -> (String, 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 -> (String, 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 (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 :: (Env, Ctx)
futharkiEnv = (Env
tenv', Ctx
ienv'),
                  futharkiImports :: Imports
futharkiImports = Imports
imports',
                  futharkiNameSource :: VNameSource
futharkiNameSource = VNameSource
src''
                }

onExp :: UncheckedExp -> FutharkiM ()
onExp :: UncheckedExp -> FutharkiM ()
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], Exp))
T.checkExp Imports
imports VNameSource
src Env
tenv UncheckedExp
e of
    (Warnings
_, Left TypeError
err) -> IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ TypeError -> String
forall a. Pretty a => a -> String
pretty TypeError
err
    (Warnings
_, Right ([TypeParam]
tparams, Exp
e'))
      | [TypeParam] -> 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 -> Exp -> F ExtOp Value
I.interpretExp Ctx
ienv Exp
e'
        case Either InterpreterError Value
r of
          Left InterpreterError
err -> IO () -> FutharkiM ()
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 Value
v -> IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Pretty a => a -> String
pretty Value
v
      | Bool
otherwise -> IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Inferred type of expression: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PatternType -> String
forall a. Pretty a => a -> String
pretty (Exp -> PatternType
typeOf Exp
e')
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
          String
"The following types are ambiguous: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((TypeParam -> String) -> [TypeParam] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (VName -> String
forall v. IsName v => v -> String
prettyName (VName -> String) -> (TypeParam -> VName) -> TypeParam -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParam -> VName
forall vn. TypeParamBase vn -> vn
typeParamName) [TypeParam]
tparams)

prettyBreaking :: Breaking -> String
prettyBreaking :: Breaking -> String
prettyBreaking Breaking
b =
  Int -> [String] -> String
prettyStacktrace (Breaking -> Int
breakingAt Breaking
b) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (StackFrame -> String) -> [StackFrame] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map StackFrame -> String
forall a. Located a => a -> String
locStr ([StackFrame] -> [String]) -> [StackFrame] -> [String]
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 :: F ExtOp a -> FutharkiM (Either InterpreterError a)
runInterpreter F ExtOp a
m = F ExtOp a
-> (a -> FutharkiM (Either InterpreterError a))
-> (ExtOp (FutharkiM (Either InterpreterError a))
    -> FutharkiM (Either InterpreterError a))
-> FutharkiM (Either InterpreterError a)
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 (m :: * -> *) a. Monad m => a -> m a
return (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 (m :: * -> *) a. Monad m => a -> m a
return (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 Loc
w String
v FutharkiM (Either InterpreterError b)
c) = do
      IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Trace at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
forall a. Located a => a -> String
locStr (Loc -> SrcLoc
forall a. Located a => a -> SrcLoc
srclocOf Loc
w) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v
      FutharkiM (Either InterpreterError b)
c
    intOp (I.ExtOpBreak 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' :: String
why' = case BreakReason
why of
            BreakReason
I.BreakPoint -> String
"Breakpoint"
            BreakReason
I.BreakNaN -> String
"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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
why' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ StackFrame -> String
forall a. Located a => a -> String
locStr StackFrame
top
        IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Breaking -> String
prettyBreaking Breaking
breaking
        IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"<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))
-> ExceptT
     StopReason
     (StateT 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)
-> ExceptT
     StopReason
     (StateT FutharkiState (InputT IO))
     (Either StopReason Any, FutharkiState)
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))
-> StateT
     FutharkiState (InputT IO) (Either StopReason Any, FutharkiState)
-> ExceptT
     StopReason
     (StateT FutharkiState (InputT IO))
     (Either StopReason Any, FutharkiState)
forall a b. (a -> b) -> a -> b
$
              InputT IO (Either StopReason Any, FutharkiState)
-> StateT
     FutharkiState (InputT IO) (Either StopReason Any, FutharkiState)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (InputT IO (Either StopReason Any, FutharkiState)
 -> StateT
      FutharkiState (InputT IO) (Either StopReason Any, FutharkiState))
-> InputT IO (Either StopReason Any, FutharkiState)
-> StateT
     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
                    { futharkiEnv :: (Env, Ctx)
futharkiEnv = (Env
tenv, Ctx
ctx),
                      futharkiCount :: Int
futharkiCount = FutharkiState -> Int
futharkiCount FutharkiState
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
                      futharkiBreaking :: Maybe Breaking
futharkiBreaking = Breaking -> Maybe Breaking
forall a. a -> Maybe a
Just Breaking
breaking
                    }

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

      FutharkiM (Either InterpreterError b)
c

runInterpreter' :: MonadIO m => F I.ExtOp a -> m (Either I.InterpreterError a)
runInterpreter' :: F ExtOp a -> m (Either InterpreterError a)
runInterpreter' F ExtOp a
m = F ExtOp a
-> (a -> m (Either InterpreterError a))
-> (ExtOp (m (Either InterpreterError a))
    -> m (Either InterpreterError a))
-> m (Either InterpreterError a)
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 (m :: * -> *) a. Monad m => a -> m a
return (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 (m :: * -> *) b.
MonadIO m =>
ExtOp (m (Either InterpreterError b))
-> m (Either InterpreterError b)
intOp
  where
    intOp :: ExtOp (m (Either InterpreterError b))
-> m (Either InterpreterError b)
intOp (I.ExtOpError InterpreterError
err) = Either InterpreterError b -> m (Either InterpreterError b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either InterpreterError b -> m (Either InterpreterError b))
-> Either InterpreterError b -> m (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 Loc
w String
v m (Either InterpreterError b)
c) = do
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Trace at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Loc -> String
forall a. Located a => a -> String
locStr Loc
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v
      m (Either InterpreterError b)
c
    intOp (I.ExtOpBreak BreakReason
_ NonEmpty StackFrame
_ m (Either InterpreterError b)
c) = m (Either InterpreterError b)
c

type Command = T.Text -> FutharkiM ()

loadCommand :: Command
loadCommand :: Command
loadCommand Text
file = do
  Maybe String
loaded <- (FutharkiState -> Maybe String) -> FutharkiM (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FutharkiState -> Maybe String
futharkiLoaded
  case (Text -> Bool
T.null Text
file, Maybe String
loaded) of
    (Bool
True, Just String
loaded') -> StopReason -> FutharkiM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StopReason -> FutharkiM ()) -> StopReason -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> StopReason
Load String
loaded'
    (Bool
True, Maybe String
Nothing) -> IO () -> FutharkiM ()
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 String
_) -> StopReason -> FutharkiM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StopReason -> FutharkiM ()) -> StopReason -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> StopReason
Load (String -> StopReason) -> String -> StopReason
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
file

genTypeCommand ::
  Show err =>
  (String -> T.Text -> Either err a) ->
  (Imports -> VNameSource -> T.Env -> a -> (Warnings, Either T.TypeError b)) ->
  (b -> String) ->
  Command
genTypeCommand :: (String -> Text -> Either err a)
-> (Imports
    -> VNameSource -> Env -> a -> (Warnings, Either TypeError b))
-> (b -> String)
-> Command
genTypeCommand String -> Text -> Either err a
f Imports
-> VNameSource -> Env -> a -> (Warnings, Either TypeError b)
g b -> String
h Text
e = do
  String
prompt <- FutharkiM String
getPrompt
  case String -> Text -> Either err a
f String
prompt Text
e of
    Left err
err -> IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ err -> IO ()
forall a. Show a => a -> IO ()
print err
err
    Right a
e' -> do
      Imports
imports <- (FutharkiState -> Imports) -> FutharkiM Imports
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FutharkiState -> Imports
futharkiImports
      VNameSource
src <- (FutharkiState -> VNameSource) -> FutharkiM VNameSource
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FutharkiState -> VNameSource
futharkiNameSource
      (Env
tenv, Ctx
_) <- (FutharkiState -> (Env, Ctx)) -> FutharkiM (Env, Ctx)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FutharkiState -> (Env, Ctx)
futharkiEnv
      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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ TypeError -> String
forall a. Pretty a => a -> String
pretty TypeError
err
        Right b
x -> IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ b -> String
h b
x

typeCommand :: Command
typeCommand :: Command
typeCommand = (String -> Text -> Either ParseError UncheckedExp)
-> (Imports
    -> VNameSource
    -> Env
    -> UncheckedExp
    -> (Warnings, Either TypeError ([TypeParam], Exp)))
-> (([TypeParam], Exp) -> String)
-> Command
forall err a b.
Show err =>
(String -> Text -> Either err a)
-> (Imports
    -> VNameSource -> Env -> a -> (Warnings, Either TypeError b))
-> (b -> String)
-> Command
genTypeCommand String -> Text -> Either ParseError UncheckedExp
parseExp Imports
-> VNameSource
-> Env
-> UncheckedExp
-> (Warnings, Either TypeError ([TypeParam], Exp))
T.checkExp ((([TypeParam], Exp) -> String) -> Command)
-> (([TypeParam], Exp) -> String) -> Command
forall a b. (a -> b) -> a -> b
$ \([TypeParam]
ps, Exp
e) ->
  Exp -> String
forall a. Pretty a => a -> String
pretty Exp
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (TypeParam -> String) -> [TypeParam] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (TypeParam -> String) -> TypeParam -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParam -> String
forall a. Pretty a => a -> String
pretty) [TypeParam]
ps
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" : "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> PatternType -> String
forall a. Pretty a => a -> String
pretty (Exp -> PatternType
typeOf Exp
e)

mtypeCommand :: Command
mtypeCommand :: Command
mtypeCommand = (String -> Text -> Either ParseError (ModExpBase NoInfo Name))
-> (Imports
    -> VNameSource
    -> Env
    -> ModExpBase NoInfo Name
    -> (Warnings, Either TypeError (MTy, ModExpBase Info VName)))
-> ((MTy, ModExpBase Info VName) -> String)
-> Command
forall err a b.
Show err =>
(String -> Text -> Either err a)
-> (Imports
    -> VNameSource -> Env -> a -> (Warnings, Either TypeError b))
-> (b -> String)
-> Command
genTypeCommand String -> Text -> Either ParseError (ModExpBase NoInfo Name)
parseModExp Imports
-> VNameSource
-> Env
-> ModExpBase NoInfo Name
-> (Warnings, Either TypeError (MTy, ModExpBase Info VName))
T.checkModExp (((MTy, ModExpBase Info VName) -> String) -> Command)
-> ((MTy, ModExpBase Info VName) -> String) -> Command
forall a b. (a -> b) -> a -> b
$ MTy -> String
forall a. Pretty a => a -> String
pretty (MTy -> String)
-> ((MTy, ModExpBase Info VName) -> MTy)
-> (MTy, ModExpBase Info VName)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MTy, ModExpBase Info VName) -> MTy
forall a b. (a, b) -> a
fst

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 (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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"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 :: [Loc]
futharkiSkipBreaks = StackFrame -> Loc
forall a. Located a => a -> Loc
locOf StackFrame
top' Loc -> [Loc] -> [Loc]
forall a. a -> [a] -> [a]
: FutharkiState -> [Loc]
futharkiSkipBreaks FutharkiState
s}
      StopReason -> FutharkiM ()
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 :: Bool
futharkiBreakOnNaN = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FutharkiState -> Bool
futharkiBreakOnNaN FutharkiState
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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      if Bool
b
        then String
"Now treating NaNs as breakpoints."
        else String
"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 (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, String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
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 :: (Env, Ctx)
futharkiEnv = (Env
tenv, Ctx
ctx),
              futharkiBreaking :: Maybe Breaking
futharkiBreaking = Breaking -> Maybe Breaking
forall a. a -> Maybe a
Just Breaking
breaking
            }
        IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Breaking -> String
prettyBreaking Breaking
breaking
    (Just NonEmpty StackFrame
_, Maybe Int
_) ->
      IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid stack index: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
which
    (Maybe (NonEmpty StackFrame)
Nothing, Maybe Int
_) ->
      IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Not stopped at a breakpoint."

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

cdCommand :: Command
cdCommand :: Command
cdCommand Text
dir
  | Text -> Bool
T.null Text
dir = IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Usage: ':cd <dir>'."
  | Bool
otherwise =
    IO () -> FutharkiM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkiM ()) -> IO () -> FutharkiM ()
forall a b. (a -> b) -> a -> b
$
      String -> IO ()
setCurrentDirectory (Text -> String
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 (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
    Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd
    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 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
"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 occurences 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.
|]
      )
    )
  ]