    -- | FutharkScript is a (tiny) subset of Futhark used to write small
    -- expressions that are evaluated by server executables.  The @futhark
    -- literate@ command is the main user.
    module Futhark.Script
      ( -- * Server
        ScriptServer,
        withScriptServer,
        withScriptServer',

        -- * Expressions, values, and types
        Func (..),
        Exp (..),
        parseExp,
        parseExpFromText,
        varsInExp,
        ScriptValueType (..),
        ScriptValue (..),
        scriptValueType,
        serverVarsInValue,
        ValOrVar (..),
        ExpValue,

        -- * Evaluation
        EvalBuiltin,
        scriptBuiltin,
        evalExp,
        getExpValue,
        evalExpToGround,
        valueToExp,
        freeValue,
      )
    where

    import Control.Monad
    import Control.Monad.Except (MonadError (..))
    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Data.Bifunctor (bimap)
    import Data.ByteString qualified as BS
    import Data.ByteString.Lazy qualified as LBS
    import Data.Char
    import Data.Foldable (toList)
    import Data.Functor
    import Data.IORef
    import Data.List (intersperse)
    import Data.Map qualified as M
    import Data.Set qualified as S
    import Data.Text qualified as T
    import Data.Traversable
    import Data.Vector.Storable qualified as SVec
    import Data.Void
    import Data.Word (Word8)
    import Futhark.Data.Parser qualified as V
    import Futhark.Server
    import Futhark.Server.Values (getValue, putValue)
    import Futhark.Test.Values qualified as V
    import Futhark.Util (nubOrd)
    import Futhark.Util.Pretty hiding (line, sep, space, (</>))
    import Language.Futhark.Core (Name, nameFromText, nameToText)
    import Language.Futhark.Tuple (areTupleFields)
    import System.FilePath ((</>))
    import Text.Megaparsec
    import Text.Megaparsec.Char (space)
    import Text.Megaparsec.Char.Lexer (charLiteral)

    type TypeMap = M.Map TypeName (Maybe [(Name, TypeName)])

    typeMap :: (MonadIO m) => Server -> m TypeMap
    typeMap :: forall (m :: * -> *). MonadIO m => Server -> m TypeMap
    typeMap Server
    server = do
      IO TypeMap -> m TypeMap
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO TypeMap -> m TypeMap) -> IO TypeMap -> m TypeMap
    forall a b. (a -> b) -> a -> b
    $ (CmdFailure -> IO TypeMap)
    -> ([EntryName] -> IO TypeMap)
    -> Either CmdFailure [EntryName]
    -> IO TypeMap
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (IO TypeMap -> CmdFailure -> IO TypeMap
    forall a. a -> CmdFailure -> a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure IO TypeMap
    forall a. Monoid a => a
    mempty) [EntryName] -> IO TypeMap
    onTypes (Either CmdFailure [EntryName] -> IO TypeMap)
    -> IO (Either CmdFailure [EntryName]) -> IO TypeMap
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Server -> IO (Either CmdFailure [EntryName])
    cmdTypes Server
    server
      where
        onTypes :: [EntryName] -> IO TypeMap
    onTypes [EntryName]
    types = [(EntryName, Maybe [(Name, EntryName)])] -> TypeMap
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(EntryName, Maybe [(Name, EntryName)])] -> TypeMap)
    -> ([Maybe [(Name, EntryName)]]
        -> [(EntryName, Maybe [(Name, EntryName)])])
    -> [Maybe [(Name, EntryName)]]
    -> TypeMap
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [EntryName]
    -> [Maybe [(Name, EntryName)]]
    -> [(EntryName, Maybe [(Name, EntryName)])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [EntryName]
    types ([Maybe [(Name, EntryName)]] -> TypeMap)
    -> IO [Maybe [(Name, EntryName)]] -> IO TypeMap
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (EntryName -> IO (Maybe [(Name, EntryName)]))
    -> [EntryName] -> IO [Maybe [(Name, EntryName)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM EntryName -> IO (Maybe [(Name, EntryName)])
    onType [EntryName]
    types
        onType :: EntryName -> IO (Maybe [(Name, EntryName)])
    onType EntryName
    t =
          (CmdFailure -> Maybe [(Name, EntryName)])
    -> ([EntryName] -> Maybe [(Name, EntryName)])
    -> Either CmdFailure [EntryName]
    -> Maybe [(Name, EntryName)]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe [(Name, EntryName)]
    -> CmdFailure -> Maybe [(Name, EntryName)]
    forall a b. a -> b -> a
    const Maybe [(Name, EntryName)]
    forall a. Maybe a
    Nothing) ([(Name, EntryName)] -> Maybe [(Name, EntryName)]
    forall a. a -> Maybe a
    Just ([(Name, EntryName)] -> Maybe [(Name, EntryName)])
    -> ([EntryName] -> [(Name, EntryName)])
    -> [EntryName]
    -> Maybe [(Name, EntryName)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (EntryName -> (Name, EntryName))
    -> [EntryName] -> [(Name, EntryName)]
    forall a b. (a -> b) -> [a] -> [b]
    map EntryName -> (Name, EntryName)
    onField) (Either CmdFailure [EntryName] -> Maybe [(Name, EntryName)])
    -> IO (Either CmdFailure [EntryName])
    -> IO (Maybe [(Name, EntryName)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Server -> EntryName -> IO (Either CmdFailure [EntryName])
    cmdFields Server
    server EntryName
    t
        onField :: EntryName -> (Name, EntryName)
    onField = (EntryName -> Name)
    -> (EntryName -> EntryName)
    -> (EntryName, EntryName)
    -> (Name, EntryName)
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap EntryName -> Name
    nameFromText (Int -> EntryName -> EntryName
    T.drop Int
    1) ((EntryName, EntryName) -> (Name, EntryName))
    -> (EntryName -> (EntryName, EntryName))
    -> EntryName
    -> (Name, EntryName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => EntryName -> EntryName -> (EntryName, EntryName)
    EntryName -> EntryName -> (EntryName, EntryName)
    T.breakOn EntryName
    " "

    isRecord :: TypeName -> TypeMap -> Maybe [(Name, TypeName)]
    isRecord :: EntryName -> TypeMap -> Maybe [(Name, EntryName)]
    isRecord EntryName
    t TypeMap
    m = Maybe (Maybe [(Name, EntryName)]) -> Maybe [(Name, EntryName)]
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (Maybe (Maybe [(Name, EntryName)]) -> Maybe [(Name, EntryName)])
    -> Maybe (Maybe [(Name, EntryName)]) -> Maybe [(Name, EntryName)]
    forall a b. (a -> b) -> a -> b
    $ EntryName -> TypeMap -> Maybe (Maybe [(Name, EntryName)])
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup EntryName
    t TypeMap
    m

    isTuple :: TypeName -> TypeMap -> Maybe [TypeName]
    isTuple :: EntryName -> TypeMap -> Maybe [EntryName]
    isTuple EntryName
    t TypeMap
    m = Map Name EntryName -> Maybe [EntryName]
    forall a. Map Name a -> Maybe [a]
    areTupleFields (Map Name EntryName -> Maybe [EntryName])
    -> ([(Name, EntryName)] -> Map Name EntryName)
    -> [(Name, EntryName)]
    -> Maybe [EntryName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Name, EntryName)] -> Map Name EntryName
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Name, EntryName)] -> Maybe [EntryName])
    -> Maybe [(Name, EntryName)] -> Maybe [EntryName]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< EntryName -> TypeMap -> Maybe [(Name, EntryName)]
    isRecord EntryName
    t TypeMap
    m

    -- | Like a 'Server', but keeps a bit more state to make FutharkScript
    -- more convenient.
    data ScriptServer = ScriptServer
      { ScriptServer -> Server
    scriptServer :: Server,
        ScriptServer -> IORef Int
    scriptCounter :: IORef Int,
        ScriptServer -> TypeMap
    scriptTypes :: TypeMap
      }

    -- | Run an action with a 'ScriptServer' produced by an existing
    -- 'Server', without shutting it down at the end.
    withScriptServer' :: (MonadIO m) => Server -> (ScriptServer -> m a) -> m a
    withScriptServer' :: forall (m :: * -> *) a.
    MonadIO m =>
    Server -> (ScriptServer -> m a) -> m a
    withScriptServer' Server
    server ScriptServer -> m a
    f = do
      IORef Int
    counter <- IO (IORef Int) -> m (IORef Int)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef Int) -> m (IORef Int))
    -> IO (IORef Int) -> m (IORef Int)
    forall a b. (a -> b) -> a -> b
    $ Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef Int
    0
      TypeMap
    types <- Server -> m TypeMap
    forall (m :: * -> *). MonadIO m => Server -> m TypeMap
    typeMap Server
    server
      ScriptServer -> m a
    f (ScriptServer -> m a) -> ScriptServer -> m a
    forall a b. (a -> b) -> a -> b
    $ Server -> IORef Int -> TypeMap -> ScriptServer
    ScriptServer Server
    server IORef Int
    counter TypeMap
    types

    -- | Start a server, execute an action, then shut down the server.
    -- Similar to 'withServer'.
    withScriptServer :: ServerCfg -> (ScriptServer -> IO a) -> IO a
    withScriptServer :: forall a. ServerCfg -> (ScriptServer -> IO a) -> IO a
    withScriptServer ServerCfg
    cfg ScriptServer -> IO a
    f =
      ServerCfg -> (Server -> IO a) -> IO a
    forall a. ServerCfg -> (Server -> IO a) -> IO a
    withServer ServerCfg
    cfg ((Server -> IO a) -> IO a) -> (Server -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ (Server -> (ScriptServer -> IO a) -> IO a)
    -> (ScriptServer -> IO a) -> Server -> IO a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Server -> (ScriptServer -> IO a) -> IO a
    forall (m :: * -> *) a.
    MonadIO m =>
    Server -> (ScriptServer -> m a) -> m a
    withScriptServer' ScriptServer -> IO a
    f

    -- | A function called in a 'Call' expression can be either a Futhark
    -- function or a builtin function.
    data Func = FuncFut EntryName | FuncBuiltin T.Text
      deriving (Int -> Func -> ShowS
    [Func] -> ShowS
    Func -> String
    (Int -> Func -> ShowS)
    -> (Func -> String) -> ([Func] -> ShowS) -> Show Func
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Func -> ShowS
    showsPrec :: Int -> Func -> ShowS
    $cshow :: Func -> String
    show :: Func -> String
    $cshowList :: [Func] -> ShowS
    showList :: [Func] -> ShowS
    Show)

    -- | A FutharkScript expression.  This is a simple AST that might not
    -- correspond exactly to what the user wrote (e.g. no parentheses or
    -- source locations).  This is fine for small expressions, which is
    -- all this is meant for.
    data Exp
      = Call Func [Exp]
      | Const V.Value
      | Tuple [Exp]
      | Record [(T.Text, Exp)]
      | StringLit T.Text
      | Let [VarName] Exp Exp
      | -- | Server-side variable, *not* Futhark variable (these are
        -- handled in 'Call').
        ServerVar TypeName VarName
      deriving (Int -> Exp -> ShowS
    [Exp] -> ShowS
    Exp -> String
    (Int -> Exp -> ShowS)
    -> (Exp -> String) -> ([Exp] -> ShowS) -> Show Exp
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Exp -> ShowS
    showsPrec :: Int -> Exp -> ShowS
    $cshow :: Exp -> String
    show :: Exp -> String
    $cshowList :: [Exp] -> ShowS
    showList :: [Exp] -> ShowS
    Show)

    instance Pretty Func where
      pretty :: forall ann. Func -> Doc ann
    pretty (FuncFut EntryName
    f) = EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty EntryName
    f
      pretty (FuncBuiltin EntryName
    f) = Doc ann
    "$" Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty EntryName
    f

    instance Pretty Exp where
      pretty :: forall ann. Exp -> Doc ann
    pretty = Int -> Exp -> Doc ann
    forall {t} {ann}. (Ord t, Num t) => t -> Exp -> Doc ann
    pprPrec (Int
    0 :: Int)
        where
          pprPrec :: t -> Exp -> Doc ann
    pprPrec t
    _ (ServerVar EntryName
    _ EntryName
    v) = Doc ann
    "$" Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty EntryName
    v
          pprPrec t
    _ (Const Value
    v) = [Doc ann] -> Doc ann
    forall a. [Doc a] -> Doc a
    stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ (EntryName -> Doc ann) -> [EntryName] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty ([EntryName] -> [Doc ann]) -> [EntryName] -> [Doc ann]
    forall a b. (a -> b) -> a -> b
    $ EntryName -> [EntryName]
    T.lines (EntryName -> [EntryName]) -> EntryName -> [EntryName]
    forall a b. (a -> b) -> a -> b
    $ Value -> EntryName
    V.valueText Value
    v
          pprPrec t
    i (Let [EntryName]
    pat Exp
    e1 Exp
    e2) =
            Bool -> Doc ann -> Doc ann
    forall a. Bool -> Doc a -> Doc a
    parensIf (t
    i t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    > t
    0) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ Doc ann
    "let" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc ann
    forall {ann}. Doc ann
    pat' Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc ann
    forall {ann}. Doc ann
    equals Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Exp -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    pretty Exp
    e1 Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc ann
    "in" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Exp -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    pretty Exp
    e2
            where
              pat' :: Doc ann
    pat' = case [EntryName]
    pat of
                [EntryName
    x] -> EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty EntryName
    x
                [EntryName]
    _ -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ [Doc ann] -> Doc ann
    forall a. [Doc a] -> Doc a
    commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ (EntryName -> Doc ann) -> [EntryName] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty [EntryName]
    pat
          pprPrec t
    _ (Call Func
    v []) = Func -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Func -> Doc ann
    pretty Func
    v
          pprPrec t
    i (Call Func
    v [Exp]
    args) =
            Bool -> Doc ann -> Doc ann
    forall a. Bool -> Doc a -> Doc a
    parensIf (t
    i t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    > t
    0) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ Func -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Func -> Doc ann
    pretty Func
    v Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> [Doc ann] -> Doc ann
    forall a. [Doc a] -> Doc a
    hsep ((Exp -> Doc ann) -> [Exp] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map (Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    align (Doc ann -> Doc ann) -> (Exp -> Doc ann) -> Exp -> Doc ann
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . t -> Exp -> Doc ann
    pprPrec t
    1) [Exp]
    args)
          pprPrec t
    _ (Tuple [Exp]
    vs) =
            Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ [Doc ann] -> Doc ann
    forall a. [Doc a] -> Doc a
    commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ (Exp -> Doc ann) -> [Exp] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map (Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    align (Doc ann -> Doc ann) -> (Exp -> Doc ann) -> Exp -> Doc ann
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Exp -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    pretty) [Exp]
    vs
          pprPrec t
    _ (StringLit EntryName
    s) = String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (String -> Doc ann) -> String -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ EntryName -> String
    forall a. Show a => a -> String
    show EntryName
    s
          pprPrec t
    _ (Record [(EntryName, Exp)]
    m) = Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    braces (Doc ann -> Doc ann) -> Doc ann -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ [Doc ann] -> Doc ann
    forall a. [Doc a] -> Doc a
    commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ ((EntryName, Exp) -> Doc ann) -> [(EntryName, Exp)] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map (EntryName, Exp) -> Doc ann
    forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
    field [(EntryName, Exp)]
    m
            where
              field :: (a, a) -> Doc ann
    field (a
    k, a
    v) = Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    align (a -> Doc ann
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty a
    k Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Doc ann
    forall {ann}. Doc ann
    equals Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> a -> Doc ann
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty a
    v)

    type Parser = Parsec Void T.Text

    lexeme :: Parser () -> Parser a -> Parser a
    lexeme :: forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser a
    p = Parser a
    p Parser a -> Parser () -> Parser a
    forall a b.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    -> ParsecT Void EntryName Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ()
    sep

    inParens :: Parser () -> Parser a -> Parser a
    inParens :: forall a. Parser () -> Parser a -> Parser a
    inParens Parser ()
    sep = Parser EntryName
    -> Parser EntryName
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity a
    forall (m :: * -> *) open close a.
    Applicative m =>
    m open -> m close -> m a -> m a
    between (Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser EntryName
    "(") (Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser EntryName
    ")")

    inBraces :: Parser () -> Parser a -> Parser a
    inBraces :: forall a. Parser () -> Parser a -> Parser a
    inBraces Parser ()
    sep = Parser EntryName
    -> Parser EntryName
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity a
    forall (m :: * -> *) open close a.
    Applicative m =>
    m open -> m close -> m a -> m a
    between (Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser EntryName
    "{") (Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser EntryName
    "}")

    -- | Parse a FutharkScript expression, given a whitespace parser.
    parseExp :: Parsec Void T.Text () -> Parsec Void T.Text Exp
    parseExp :: Parser () -> Parsec Void EntryName Exp
    parseExp Parser ()
    sep =
      [Parsec Void EntryName Exp] -> Parsec Void EntryName Exp
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
        [ Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser EntryName
    "let"
            Parser EntryName
    -> ([EntryName] -> Exp -> Exp -> Exp)
    -> ParsecT
         Void EntryName Identity ([EntryName] -> Exp -> Exp -> Exp)
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> [EntryName] -> Exp -> Exp -> Exp
    Let
            ParsecT Void EntryName Identity ([EntryName] -> Exp -> Exp -> Exp)
    -> ParsecT Void EntryName Identity [EntryName]
    -> ParsecT Void EntryName Identity (Exp -> Exp -> Exp)
    forall a b.
    ParsecT Void EntryName Identity (a -> b)
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParsecT Void EntryName Identity [EntryName]
    pPat
            ParsecT Void EntryName Identity (Exp -> Exp -> Exp)
    -> Parser EntryName
    -> ParsecT Void EntryName Identity (Exp -> Exp -> Exp)
    forall a b.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    -> ParsecT Void EntryName Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser EntryName
    "="
            ParsecT Void EntryName Identity (Exp -> Exp -> Exp)
    -> Parsec Void EntryName Exp
    -> ParsecT Void EntryName Identity (Exp -> Exp)
    forall a b.
    ParsecT Void EntryName Identity (a -> b)
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser () -> Parsec Void EntryName Exp
    parseExp Parser ()
    sep
            ParsecT Void EntryName Identity (Exp -> Exp)
    -> Parser EntryName -> ParsecT Void EntryName Identity (Exp -> Exp)
    forall a b.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    -> ParsecT Void EntryName Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser EntryName
    "in"
            ParsecT Void EntryName Identity (Exp -> Exp)
    -> Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a b.
    ParsecT Void EntryName Identity (a -> b)
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser () -> Parsec Void EntryName Exp
    parseExp Parser ()
    sep,
          Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (Parsec Void EntryName Exp -> Parsec Void EntryName Exp)
    -> Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a b. (a -> b) -> a -> b
    $ Func -> [Exp] -> Exp
    Call (Func -> [Exp] -> Exp)
    -> ParsecT Void EntryName Identity Func
    -> ParsecT Void EntryName Identity ([Exp] -> Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void EntryName Identity Func
    parseFunc ParsecT Void EntryName Identity ([Exp] -> Exp)
    -> ParsecT Void EntryName Identity [Exp]
    -> Parsec Void EntryName Exp
    forall a b.
    ParsecT Void EntryName Identity (a -> b)
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parsec Void EntryName Exp -> ParsecT Void EntryName Identity [Exp]
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    many Parsec Void EntryName Exp
    pAtom,
          Parsec Void EntryName Exp
    pAtom
        ]
        Parsec Void EntryName Exp -> String -> Parsec Void EntryName Exp
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    m a -> String -> m a
    <?> String
    "expression"
      where
        pField :: ParsecT Void EntryName Identity (EntryName, Exp)
    pField = (,) (EntryName -> Exp -> (EntryName, Exp))
    -> Parser EntryName
    -> ParsecT Void EntryName Identity (Exp -> (EntryName, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser EntryName
    pVarName ParsecT Void EntryName Identity (Exp -> (EntryName, Exp))
    -> Parsec Void EntryName Exp
    -> ParsecT Void EntryName Identity (EntryName, Exp)
    forall a b.
    ParsecT Void EntryName Identity (a -> b)
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Parser EntryName
    pEquals Parser EntryName
    -> Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a b.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser () -> Parsec Void EntryName Exp
    parseExp Parser ()
    sep)
        pEquals :: Parser EntryName
    pEquals = Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser EntryName
    "="
        pComma :: Parser EntryName
    pComma = Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep Parser EntryName
    ","
        mkTuple :: [Exp] -> Exp
    mkTuple [Exp
    v] = Exp
    v
        mkTuple [Exp]
    vs = [Exp] -> Exp
    Tuple [Exp]
    vs

        pAtom :: Parsec Void EntryName Exp
    pAtom =
          [Parsec Void EntryName Exp] -> Parsec Void EntryName Exp
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
            [ Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (Parsec Void EntryName Exp -> Parsec Void EntryName Exp)
    -> Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a b. (a -> b) -> a -> b
    $ Parser () -> Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a. Parser () -> Parser a -> Parser a
    inParens Parser ()
    sep ([Exp] -> Exp
    mkTuple ([Exp] -> Exp)
    -> ParsecT Void EntryName Identity [Exp]
    -> Parsec Void EntryName Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Parser () -> Parsec Void EntryName Exp
    parseExp Parser ()
    sep Parsec Void EntryName Exp
    -> Parser EntryName -> ParsecT Void EntryName Identity [Exp]
    forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
    `sepEndBy` Parser EntryName
    pComma)),
              Parser () -> Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a. Parser () -> Parser a -> Parser a
    inParens Parser ()
    sep (Parsec Void EntryName Exp -> Parsec Void EntryName Exp)
    -> Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a b. (a -> b) -> a -> b
    $ Parser () -> Parsec Void EntryName Exp
    parseExp Parser ()
    sep,
              Parser () -> Parsec Void EntryName Exp -> Parsec Void EntryName Exp
    forall a. Parser () -> Parser a -> Parser a
    inBraces Parser ()
    sep ([(EntryName, Exp)] -> Exp
    Record ([(EntryName, Exp)] -> Exp)
    -> ParsecT Void EntryName Identity [(EntryName, Exp)]
    -> Parsec Void EntryName Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParsecT Void EntryName Identity (EntryName, Exp)
    pField ParsecT Void EntryName Identity (EntryName, Exp)
    -> Parser EntryName
    -> ParsecT Void EntryName Identity [(EntryName, Exp)]
    forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
    `sepEndBy` Parser EntryName
    pComma)),
              EntryName -> Exp
    StringLit (EntryName -> Exp) -> (String -> EntryName) -> String -> Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> EntryName
    T.pack (String -> Exp)
    -> ParsecT Void EntryName Identity String
    -> Parsec Void EntryName Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ()
    -> ParsecT Void EntryName Identity String
    -> ParsecT Void EntryName Identity String
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep (Parser EntryName
    "\"" Parser EntryName
    -> ParsecT Void EntryName Identity String
    -> ParsecT Void EntryName Identity String
    forall a b.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void EntryName Identity Char
    -> Parser EntryName -> ParsecT Void EntryName Identity String
    forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
    manyTill ParsecT Void EntryName Identity Char
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m Char
    charLiteral Parser EntryName
    "\""),
              Value -> Exp
    Const (Value -> Exp)
    -> ParsecT Void EntryName Identity Value
    -> Parsec Void EntryName Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser () -> ParsecT Void EntryName Identity Value
    V.parseValue Parser ()
    sep,
              Func -> [Exp] -> Exp
    Call (Func -> [Exp] -> Exp)
    -> ParsecT Void EntryName Identity Func
    -> ParsecT Void EntryName Identity ([Exp] -> Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void EntryName Identity Func
    parseFunc ParsecT Void EntryName Identity ([Exp] -> Exp)
    -> ParsecT Void EntryName Identity [Exp]
    -> Parsec Void EntryName Exp
    forall a b.
    ParsecT Void EntryName Identity (a -> b)
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Exp] -> ParsecT Void EntryName Identity [Exp]
    forall a. a -> ParsecT Void EntryName Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
            ]

        pPat :: ParsecT Void EntryName Identity [EntryName]
    pPat =
          [ParsecT Void EntryName Identity [EntryName]]
    -> ParsecT Void EntryName Identity [EntryName]
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
            [ Parser ()
    -> ParsecT Void EntryName Identity [EntryName]
    -> ParsecT Void EntryName Identity [EntryName]
    forall a. Parser () -> Parser a -> Parser a
    inParens Parser ()
    sep (ParsecT Void EntryName Identity [EntryName]
     -> ParsecT Void EntryName Identity [EntryName])
    -> ParsecT Void EntryName Identity [EntryName]
    -> ParsecT Void EntryName Identity [EntryName]
    forall a b. (a -> b) -> a -> b
    $ Parser EntryName
    pVarName Parser EntryName
    -> Parser EntryName -> ParsecT Void EntryName Identity [EntryName]
    forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
    `sepEndBy` Parser EntryName
    pComma,
              EntryName -> [EntryName]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (EntryName -> [EntryName])
    -> Parser EntryName -> ParsecT Void EntryName Identity [EntryName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser EntryName
    pVarName
            ]

        parseFunc :: ParsecT Void EntryName Identity Func
    parseFunc =
          [ParsecT Void EntryName Identity Func]
    -> ParsecT Void EntryName Identity Func
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
            [ EntryName -> Func
    FuncBuiltin (EntryName -> Func)
    -> Parser EntryName -> ParsecT Void EntryName Identity Func
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Parser EntryName
    "$" Parser EntryName -> Parser EntryName -> Parser EntryName
    forall a b.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser EntryName
    pVarName),
              EntryName -> Func
    FuncFut (EntryName -> Func)
    -> Parser EntryName -> ParsecT Void EntryName Identity Func
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser EntryName
    pVarName
            ]

        reserved :: [EntryName]
    reserved = [EntryName
    "let", EntryName
    "in"]

        pVarName :: Parser EntryName
    pVarName = Parser () -> Parser EntryName -> Parser EntryName
    forall a. Parser () -> Parser a -> Parser a
    lexeme Parser ()
    sep (Parser EntryName -> Parser EntryName)
    -> (Parser EntryName -> Parser EntryName)
    -> Parser EntryName
    -> Parser EntryName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Parser EntryName -> Parser EntryName
    forall a.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (Parser EntryName -> Parser EntryName)
    -> Parser EntryName -> Parser EntryName
    forall a b. (a -> b) -> a -> b
    $ do
          EntryName
    v <- (String -> EntryName)
    -> ParsecT Void EntryName Identity String -> Parser EntryName
    forall a b.
    (a -> b)
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> EntryName
    T.pack (ParsecT Void EntryName Identity String -> Parser EntryName)
    -> ParsecT Void EntryName Identity String -> Parser EntryName
    forall a b. (a -> b) -> a -> b
    $ (:) (Char -> ShowS)
    -> ParsecT Void EntryName Identity Char
    -> ParsecT Void EntryName Identity ShowS
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Token EntryName -> Bool)
    -> ParsecT Void EntryName Identity (Token EntryName)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    (Token s -> Bool) -> m (Token s)
    satisfy Char -> Bool
    Token EntryName -> Bool
    isAlpha ParsecT Void EntryName Identity ShowS
    -> ParsecT Void EntryName Identity String
    -> ParsecT Void EntryName Identity String
    forall a b.
    ParsecT Void EntryName Identity (a -> b)
    -> ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParsecT Void EntryName Identity Char
    -> ParsecT Void EntryName Identity String
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    many ((Token EntryName -> Bool)
    -> ParsecT Void EntryName Identity (Token EntryName)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    (Token s -> Bool) -> m (Token s)
    satisfy Char -> Bool
    Token EntryName -> Bool
    constituent)
          Bool -> Parser ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Parser ()) -> Bool -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ EntryName
    v EntryName -> [EntryName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [EntryName]
    reserved
          EntryName -> Parser EntryName
    forall a. a -> ParsecT Void EntryName Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure EntryName
    v
          where
            constituent :: Char -> Bool
    constituent Char
    c = Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\'' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'

    -- | Parse a FutharkScript expression with normal whitespace handling.
    parseExpFromText :: FilePath -> T.Text -> Either T.Text Exp
    parseExpFromText :: String -> EntryName -> Either EntryName Exp
    parseExpFromText String
    f EntryName
    s =
      (ParseErrorBundle EntryName Void -> Either EntryName Exp)
    -> (Exp -> Either EntryName Exp)
    -> Either (ParseErrorBundle EntryName Void) Exp
    -> Either EntryName Exp
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (EntryName -> Either EntryName Exp
    forall a b. a -> Either a b
    Left (EntryName -> Either EntryName Exp)
    -> (ParseErrorBundle EntryName Void -> EntryName)
    -> ParseErrorBundle EntryName Void
    -> Either EntryName Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> EntryName
    T.pack (String -> EntryName)
    -> (ParseErrorBundle EntryName Void -> String)
    -> ParseErrorBundle EntryName Void
    -> EntryName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseErrorBundle EntryName Void -> String
    forall s e.
    (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
    ParseErrorBundle s e -> String
    errorBundlePretty) Exp -> Either EntryName Exp
    forall a b. b -> Either a b
    Right (Either (ParseErrorBundle EntryName Void) Exp
     -> Either EntryName Exp)
    -> Either (ParseErrorBundle EntryName Void) Exp
    -> Either EntryName Exp
    forall a b. (a -> b) -> a -> b
    $ Parsec Void EntryName Exp
    -> String
    -> EntryName
    -> Either (ParseErrorBundle EntryName Void) Exp
    forall e s a.
    Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
    parse (Parser () -> Parsec Void EntryName Exp
    parseExp Parser ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    space Parsec Void EntryName Exp -> Parser () -> Parsec Void EntryName Exp
    forall a b.
    ParsecT Void EntryName Identity a
    -> ParsecT Void EntryName Identity b
    -> ParsecT Void EntryName Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof) String
    f EntryName
    s

    readVar :: (MonadError T.Text m, MonadIO m) => Server -> VarName -> m V.Value
    readVar :: forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    Server -> EntryName -> m Value
    readVar Server
    server EntryName
    v =
      (EntryName -> m Value)
    -> (Value -> m Value) -> Either EntryName Value -> m Value
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either EntryName -> m Value
    forall a. EntryName -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError Value -> m Value
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either EntryName Value -> m Value)
    -> m (Either EntryName Value) -> m Value
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO (Either EntryName Value) -> m (Either EntryName Value)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Server -> EntryName -> IO (Either EntryName Value)
    getValue Server
    server EntryName
    v)

    writeVar :: (MonadError T.Text m, MonadIO m) => Server -> VarName -> V.Value -> m ()
    writeVar :: forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    Server -> EntryName -> Value -> m ()
    writeVar Server
    server EntryName
    v Value
    val =
      IO (Maybe CmdFailure) -> m ()
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    cmdMaybe (IO (Maybe CmdFailure) -> m ()) -> IO (Maybe CmdFailure) -> m ()
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe CmdFailure) -> IO (Maybe CmdFailure)
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Server -> EntryName -> Value -> IO (Maybe CmdFailure)
    putValue Server
    server EntryName
    v Value
    val)

    -- | A ScriptValue is either a base value or a partially applied
    -- function.  We don't have real first-class functions in
    -- FutharkScript, but we sort of have closures.
    data ScriptValue v
      = SValue TypeName v
      | -- | Ins, then outs.  Yes, this is the opposite of more or less
        -- everywhere else.
        SFun EntryName [TypeName] [TypeName] [ScriptValue v]
      deriving (Int -> ScriptValue v -> ShowS
    [ScriptValue v] -> ShowS
    ScriptValue v -> String
    (Int -> ScriptValue v -> ShowS)
    -> (ScriptValue v -> String)
    -> ([ScriptValue v] -> ShowS)
    -> Show (ScriptValue v)
    forall v. Show v => Int -> ScriptValue v -> ShowS
    forall v. Show v => [ScriptValue v] -> ShowS
    forall v. Show v => ScriptValue v -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall v. Show v => Int -> ScriptValue v -> ShowS
    showsPrec :: Int -> ScriptValue v -> ShowS
    $cshow :: forall v. Show v => ScriptValue v -> String
    show :: ScriptValue v -> String
    $cshowList :: forall v. Show v => [ScriptValue v] -> ShowS
    showList :: [ScriptValue v] -> ShowS
    Show)

    instance Functor ScriptValue where
      fmap :: forall a b. (a -> b) -> ScriptValue a -> ScriptValue b
    fmap = (a -> b) -> ScriptValue a -> ScriptValue b
    forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
    fmapDefault

    instance Foldable ScriptValue where
      foldMap :: forall m a. Monoid m => (a -> m) -> ScriptValue a -> m
    foldMap = (a -> m) -> ScriptValue a -> m
    forall (t :: * -> *) m a.
    (Traversable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMapDefault

    instance Traversable ScriptValue where
      traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ScriptValue a -> f (ScriptValue b)
    traverse a -> f b
    f (SValue EntryName
    t a
    v) = EntryName -> b -> ScriptValue b
    forall v. EntryName -> v -> ScriptValue v
    SValue EntryName
    t (b -> ScriptValue b) -> f b -> f (ScriptValue b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f b
    f a
    v
      traverse a -> f b
    f (SFun EntryName
    fname [EntryName]
    ins [EntryName]
    outs [ScriptValue a]
    vs) =
        EntryName
    -> [EntryName] -> [EntryName] -> [ScriptValue b] -> ScriptValue b
    forall v.
    EntryName
    -> [EntryName] -> [EntryName] -> [ScriptValue v] -> ScriptValue v
    SFun EntryName
    fname [EntryName]
    ins [EntryName]
    outs ([ScriptValue b] -> ScriptValue b)
    -> f [ScriptValue b] -> f (ScriptValue b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ScriptValue a -> f (ScriptValue b))
    -> [ScriptValue a] -> f [ScriptValue b]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((a -> f b) -> ScriptValue a -> f (ScriptValue b)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ScriptValue a -> f (ScriptValue b)
    traverse a -> f b
    f) [ScriptValue a]
    vs

    -- | The type of a 'ScriptValue' - either a value type or a function type.
    data ScriptValueType
      = STValue TypeName
      | -- | Ins, then outs.
        STFun [TypeName] [TypeName]
      deriving (ScriptValueType -> ScriptValueType -> Bool
    (ScriptValueType -> ScriptValueType -> Bool)
    -> (ScriptValueType -> ScriptValueType -> Bool)
    -> Eq ScriptValueType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ScriptValueType -> ScriptValueType -> Bool
    == :: ScriptValueType -> ScriptValueType -> Bool
    $c/= :: ScriptValueType -> ScriptValueType -> Bool
    /= :: ScriptValueType -> ScriptValueType -> Bool
    Eq, Int -> ScriptValueType -> ShowS
    [ScriptValueType] -> ShowS
    ScriptValueType -> String
    (Int -> ScriptValueType -> ShowS)
    -> (ScriptValueType -> String)
    -> ([ScriptValueType] -> ShowS)
    -> Show ScriptValueType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ScriptValueType -> ShowS
    showsPrec :: Int -> ScriptValueType -> ShowS
    $cshow :: ScriptValueType -> String
    show :: ScriptValueType -> String
    $cshowList :: [ScriptValueType] -> ShowS
    showList :: [ScriptValueType] -> ShowS
    Show)

    instance Pretty ScriptValueType where
      pretty :: forall ann. ScriptValueType -> Doc ann
    pretty (STValue EntryName
    t) = EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty EntryName
    t
      pretty (STFun [EntryName]
    ins [EntryName]
    outs) =
        [Doc ann] -> Doc ann
    forall a. [Doc a] -> Doc a
    hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ Doc ann -> [Doc ann] -> [Doc ann]
    forall a. a -> [a] -> [a]
    intersperse Doc ann
    "->" ((EntryName -> Doc ann) -> [EntryName] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty [EntryName]
    ins [Doc ann] -> [Doc ann] -> [Doc ann]
    forall a. [a] -> [a] -> [a]
    ++ [Doc ann
    forall {ann}. Doc ann
    outs'])
        where
          outs' :: Doc ann
    outs' = case [EntryName]
    outs of
            [EntryName
    out] -> EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty EntryName
    out
            [EntryName]
    _ -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ [Doc ann] -> Doc ann
    forall a. [Doc a] -> Doc a
    commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ (EntryName -> Doc ann) -> [EntryName] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map EntryName -> Doc ann
    forall ann. EntryName -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty [EntryName]
    outs

    -- | A Haskell-level value or a variable on the server.
    data ValOrVar = VVal V.Value | VVar VarName
      deriving (Int -> ValOrVar -> ShowS
    [ValOrVar] -> ShowS
    ValOrVar -> String
    (Int -> ValOrVar -> ShowS)
    -> (ValOrVar -> String) -> ([ValOrVar] -> ShowS) -> Show ValOrVar
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ValOrVar -> ShowS
    showsPrec :: Int -> ValOrVar -> ShowS
    $cshow :: ValOrVar -> String
    show :: ValOrVar -> String
    $cshowList :: [ValOrVar] -> ShowS
    showList :: [ValOrVar] -> ShowS
    Show)

    -- | The intermediate values produced by an expression - in
    -- particular, these may not be on the server.
    type ExpValue = V.Compound (ScriptValue ValOrVar)

    -- | The type of a 'ScriptValue'.
    scriptValueType :: ScriptValue v -> ScriptValueType
    scriptValueType :: forall v. ScriptValue v -> ScriptValueType
    scriptValueType (SValue EntryName
    t v
    _) = EntryName -> ScriptValueType
    STValue EntryName
    t
    scriptValueType (SFun EntryName
    _ [EntryName]
    ins [EntryName]
    outs [ScriptValue v]
    _) = [EntryName] -> [EntryName] -> ScriptValueType
    STFun [EntryName]
    ins [EntryName]
    outs

    -- | The set of server-side variables in the value.
    serverVarsInValue :: ExpValue -> S.Set VarName
    serverVarsInValue :: ExpValue -> Set EntryName
    serverVarsInValue = [EntryName] -> Set EntryName
    forall a. Ord a => [a] -> Set a
    S.fromList ([EntryName] -> Set EntryName)
    -> (ExpValue -> [EntryName]) -> ExpValue -> Set EntryName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ScriptValue ValOrVar -> [EntryName])
    -> [ScriptValue ValOrVar] -> [EntryName]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ScriptValue ValOrVar -> [EntryName]
    isVar ([ScriptValue ValOrVar] -> [EntryName])
    -> (ExpValue -> [ScriptValue ValOrVar]) -> ExpValue -> [EntryName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExpValue -> [ScriptValue ValOrVar]
    forall a. Compound a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList
      where
        isVar :: ScriptValue ValOrVar -> [EntryName]
    isVar (SValue EntryName
    _ (VVar EntryName
    x)) = [EntryName
    x]
        isVar (SValue EntryName
    _ (VVal Value
    _)) = []
        isVar (SFun EntryName
    _ [EntryName]
    _ [EntryName]
    _ [ScriptValue ValOrVar]
    closure) = (ScriptValue ValOrVar -> [EntryName])
    -> [ScriptValue ValOrVar] -> [EntryName]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ScriptValue ValOrVar -> [EntryName]
    isVar ([ScriptValue ValOrVar] -> [EntryName])
    -> [ScriptValue ValOrVar] -> [EntryName]
    forall a b. (a -> b) -> a -> b
    $ [ScriptValue ValOrVar] -> [ScriptValue ValOrVar]
    forall a. [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList [ScriptValue ValOrVar]
    closure

    -- | Convert a value into a corresponding expression.
    valueToExp :: ExpValue -> Exp
    valueToExp :: ExpValue -> Exp
    valueToExp (V.ValueAtom (SValue EntryName
    t (VVar EntryName
    v))) =
      EntryName -> EntryName -> Exp
    ServerVar EntryName
    t EntryName
    v
    valueToExp (V.ValueAtom (SValue EntryName
    _ (VVal Value
    v))) =
      Value -> Exp
    Const Value
    v
    valueToExp (V.ValueAtom (SFun EntryName
    fname [EntryName]
    _ [EntryName]
    _ [ScriptValue ValOrVar]
    closure)) =
      Func -> [Exp] -> Exp
    Call (EntryName -> Func
    FuncFut EntryName
    fname) ([Exp] -> Exp) -> [Exp] -> Exp
    forall a b. (a -> b) -> a -> b
    $ (ScriptValue ValOrVar -> Exp) -> [ScriptValue ValOrVar] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map (ExpValue -> Exp
    valueToExp (ExpValue -> Exp)
    -> (ScriptValue ValOrVar -> ExpValue)
    -> ScriptValue ValOrVar
    -> Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ScriptValue ValOrVar -> ExpValue
    forall v. v -> Compound v
    V.ValueAtom) [ScriptValue ValOrVar]
    closure
    valueToExp (V.ValueRecord Map EntryName ExpValue
    fs) =
      [(EntryName, Exp)] -> Exp
    Record ([(EntryName, Exp)] -> Exp) -> [(EntryName, Exp)] -> Exp
    forall a b. (a -> b) -> a -> b
    $ Map EntryName Exp -> [(EntryName, Exp)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map EntryName Exp -> [(EntryName, Exp)])
    -> Map EntryName Exp -> [(EntryName, Exp)]
    forall a b. (a -> b) -> a -> b
    $ (ExpValue -> Exp) -> Map EntryName ExpValue -> Map EntryName Exp
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map ExpValue -> Exp
    valueToExp Map EntryName ExpValue
    fs
    valueToExp (V.ValueTuple [ExpValue]
    fs) =
      [Exp] -> Exp
    Tuple ([Exp] -> Exp) -> [Exp] -> Exp
    forall a b. (a -> b) -> a -> b
    $ (ExpValue -> Exp) -> [ExpValue] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map ExpValue -> Exp
    valueToExp [ExpValue]
    fs

    -- Decompose a type name into a rank and an element type.
    parseTypeName :: TypeName -> Maybe (Int, V.PrimType)
    parseTypeName :: EntryName -> Maybe (Int, PrimType)
    parseTypeName EntryName
    s
      | Just PrimType
    pt <- EntryName -> [(EntryName, PrimType)] -> Maybe PrimType
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup EntryName
    s [(EntryName, PrimType)]
    m =
          (Int, PrimType) -> Maybe (Int, PrimType)
    forall a. a -> Maybe a
    Just (Int
    0, PrimType
    pt)
      | EntryName
    "[]" EntryName -> EntryName -> Bool
    `T.isPrefixOf` EntryName
    s = do
          (Int
    d, PrimType
    pt) <- EntryName -> Maybe (Int, PrimType)
    parseTypeName (Int -> EntryName -> EntryName
    T.drop Int
    2 EntryName
    s)
          (Int, PrimType) -> Maybe (Int, PrimType)
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1, PrimType
    pt)
      | Bool
    otherwise = Maybe (Int, PrimType)
    forall a. Maybe a
    Nothing
      where
        prims :: [PrimType]
    prims = [PrimType
    forall a. Bounded a => a
    minBound .. PrimType
    forall a. Bounded a => a
    maxBound]
        primtexts :: [EntryName]
    primtexts = (PrimType -> EntryName) -> [PrimType] -> [EntryName]
    forall a b. (a -> b) -> [a] -> [b]
    map (ValueType -> EntryName
    V.valueTypeText (ValueType -> EntryName)
    -> (PrimType -> ValueType) -> PrimType -> EntryName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> PrimType -> ValueType
    V.ValueType []) [PrimType]
    prims
        m :: [(EntryName, PrimType)]
    m = [EntryName] -> [PrimType] -> [(EntryName, PrimType)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [EntryName]
    primtexts [PrimType]
    prims

    coerceValue :: TypeName -> V.Value -> Maybe V.Value
    coerceValue :: EntryName -> Value -> Maybe Value
    coerceValue EntryName
    t Value
    v = do
      (Int
    _, PrimType
    pt) <- EntryName -> Maybe (Int, PrimType)
    parseTypeName EntryName
    t
      case Value
    v of
        V.I8Value Vector Int
    shape Vector Int8
    vs ->
          PrimType -> Vector Int -> [Integer] -> Maybe Value
    coerceInts PrimType
    pt Vector Int
    shape ([Integer] -> Maybe Value) -> [Integer] -> Maybe Value
    forall a b. (a -> b) -> a -> b
    $ (Int8 -> Integer) -> [Int8] -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map Int8 -> Integer
    forall a. Integral a => a -> Integer
    toInteger ([Int8] -> [Integer]) -> [Int8] -> [Integer]
    forall a b. (a -> b) -> a -> b
    $ Vector Int8 -> [Int8]
    forall a. Storable a => Vector a -> [a]
    SVec.toList Vector Int8
    vs
        V.I16Value Vector Int
    shape Vector Int16
    vs ->
          PrimType -> Vector Int -> [Integer] -> Maybe Value
    coerceInts PrimType
    pt Vector Int
    shape ([Integer] -> Maybe Value) -> [Integer] -> Maybe Value
    forall a b. (a -> b) -> a -> b
    $ (Int16 -> Integer) -> [Int16] -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map Int16 -> Integer
    forall a. Integral a => a -> Integer
    toInteger ([Int16] -> [Integer]) -> [Int16] -> [Integer]
    forall a b. (a -> b) -> a -> b
    $ Vector Int16 -> [Int16]
    forall a. Storable a => Vector a -> [a]
    SVec.toList Vector Int16
    vs
        V.I32Value Vector Int
    shape Vector Int32
    vs ->
          PrimType -> Vector Int -> [Integer] -> Maybe Value
    coerceInts PrimType
    pt Vector Int
    shape ([Integer] -> Maybe Value) -> [Integer] -> Maybe Value
    forall a b. (a -> b) -> a -> b
    $ (Int32 -> Integer) -> [Int32] -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map Int32 -> Integer
    forall a. Integral a => a -> Integer
    toInteger ([Int32] -> [Integer]) -> [Int32] -> [Integer]
    forall a b. (a -> b) -> a -> b
    $ Vector Int32 -> [Int32]
    forall a. Storable a => Vector a -> [a]
    SVec.toList Vector Int32
    vs
        V.I64Value Vector Int
    shape Vector Int64
    vs ->
          PrimType -> Vector Int -> [Integer] -> Maybe Value
    coerceInts PrimType
    pt Vector Int
    shape ([Integer] -> Maybe Value) -> [Integer] -> Maybe Value
    forall a b. (a -> b) -> a -> b
    $ (Int64 -> Integer) -> [Int64] -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map Int64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger ([Int64] -> [Integer]) -> [Int64] -> [Integer]
    forall a b. (a -> b) -> a -> b
    $ Vector Int64 -> [Int64]
    forall a. Storable a => Vector a -> [a]
    SVec.toList Vector Int64
    vs
        Value
    _ ->
          Maybe Value
    forall a. Maybe a
    Nothing
      where
        coerceInts :: PrimType -> Vector Int -> [Integer] -> Maybe Value
    coerceInts PrimType
    V.I8 Vector Int
    shape =
          Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value)
    -> ([Integer] -> Value) -> [Integer] -> Maybe Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Int -> Vector Int8 -> Value
    V.I8Value Vector Int
    shape (Vector Int8 -> Value)
    -> ([Integer] -> Vector Int8) -> [Integer] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int8] -> Vector Int8
    forall a. Storable a => [a] -> Vector a
    SVec.fromList ([Int8] -> Vector Int8)
    -> ([Integer] -> [Int8]) -> [Integer] -> Vector Int8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> Int8) -> [Integer] -> [Int8]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> Int8
    forall a. Num a => Integer -> a
    fromInteger
        coerceInts PrimType
    V.I16 Vector Int
    shape =
          Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value)
    -> ([Integer] -> Value) -> [Integer] -> Maybe Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Int -> Vector Int16 -> Value
    V.I16Value Vector Int
    shape (Vector Int16 -> Value)
    -> ([Integer] -> Vector Int16) -> [Integer] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int16] -> Vector Int16
    forall a. Storable a => [a] -> Vector a
    SVec.fromList ([Int16] -> Vector Int16)
    -> ([Integer] -> [Int16]) -> [Integer] -> Vector Int16
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> Int16) -> [Integer] -> [Int16]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> Int16
    forall a. Num a => Integer -> a
    fromInteger
        coerceInts PrimType
    V.I32 Vector Int
    shape =
          Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value)
    -> ([Integer] -> Value) -> [Integer] -> Maybe Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Int -> Vector Int32 -> Value
    V.I32Value Vector Int
    shape (Vector Int32 -> Value)
    -> ([Integer] -> Vector Int32) -> [Integer] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int32] -> Vector Int32
    forall a. Storable a => [a] -> Vector a
    SVec.fromList ([Int32] -> Vector Int32)
    -> ([Integer] -> [Int32]) -> [Integer] -> Vector Int32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> Int32) -> [Integer] -> [Int32]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> Int32
    forall a. Num a => Integer -> a
    fromInteger
        coerceInts PrimType
    V.I64 Vector Int
    shape =
          Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value)
    -> ([Integer] -> Value) -> [Integer] -> Maybe Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Int -> Vector Int64 -> Value
    V.I64Value Vector Int
    shape (Vector Int64 -> Value)
    -> ([Integer] -> Vector Int64) -> [Integer] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int64] -> Vector Int64
    forall a. Storable a => [a] -> Vector a
    SVec.fromList ([Int64] -> Vector Int64)
    -> ([Integer] -> [Int64]) -> [Integer] -> Vector Int64
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> Int64) -> [Integer] -> [Int64]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> Int64
    forall a. Num a => Integer -> a
    fromInteger
        coerceInts PrimType
    V.F32 Vector Int
    shape =
          Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value)
    -> ([Integer] -> Value) -> [Integer] -> Maybe Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Int -> Vector Float -> Value
    V.F32Value Vector Int
    shape (Vector Float -> Value)
    -> ([Integer] -> Vector Float) -> [Integer] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Float] -> Vector Float
    forall a. Storable a => [a] -> Vector a
    SVec.fromList ([Float] -> Vector Float)
    -> ([Integer] -> [Float]) -> [Integer] -> Vector Float
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> Float) -> [Integer] -> [Float]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> Float
    forall a. Num a => Integer -> a
    fromInteger
        coerceInts PrimType
    V.F64 Vector Int
    shape =
          Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value)
    -> ([Integer] -> Value) -> [Integer] -> Maybe Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Int -> Vector Double -> Value
    V.F64Value Vector Int
    shape (Vector Double -> Value)
    -> ([Integer] -> Vector Double) -> [Integer] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Double] -> Vector Double
    forall a. Storable a => [a] -> Vector a
    SVec.fromList ([Double] -> Vector Double)
    -> ([Integer] -> [Double]) -> [Integer] -> Vector Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> Double) -> [Integer] -> [Double]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger
        coerceInts PrimType
    _ Vector Int
    _ =
          Maybe Value -> [Integer] -> Maybe Value
    forall a b. a -> b -> a
    const Maybe Value
    forall a. Maybe a
    Nothing

    -- | How to evaluate a builtin function.
    type EvalBuiltin m = T.Text -> [V.CompoundValue] -> m V.CompoundValue

    loadData ::
      (MonadIO m, MonadError T.Text m) =>
      FilePath ->
      m (V.Compound V.Value)
    loadData :: forall (m :: * -> *).
    (MonadIO m, MonadError EntryName m) =>
    String -> m (Compound Value)
    loadData String
    datafile = do
      ByteString
    contents <- IO ByteString -> m ByteString
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> IO ByteString
    LBS.readFile String
    datafile
      let maybe_vs :: Maybe [Value]
    maybe_vs = ByteString -> Maybe [Value]
    V.readValues ByteString
    contents
      case Maybe [Value]
    maybe_vs of
        Maybe [Value]
    Nothing ->
          EntryName -> m (Compound Value)
    forall a. EntryName -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EntryName -> m (Compound Value))
    -> EntryName -> m (Compound Value)
    forall a b. (a -> b) -> a -> b
    $ EntryName
    "Failed to read data file " EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> String -> EntryName
    T.pack String
    datafile
        Just [Value
    v] ->
          Compound Value -> m (Compound Value)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Compound Value -> m (Compound Value))
    -> Compound Value -> m (Compound Value)
    forall a b. (a -> b) -> a -> b
    $ Value -> Compound Value
    forall v. v -> Compound v
    V.ValueAtom Value
    v
        Just [Value]
    vs ->
          Compound Value -> m (Compound Value)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Compound Value -> m (Compound Value))
    -> Compound Value -> m (Compound Value)
    forall a b. (a -> b) -> a -> b
    $ [Compound Value] -> Compound Value
    forall v. [Compound v] -> Compound v
    V.ValueTuple ([Compound Value] -> Compound Value)
    -> [Compound Value] -> Compound Value
    forall a b. (a -> b) -> a -> b
    $ (Value -> Compound Value) -> [Value] -> [Compound Value]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Compound Value
    forall v. v -> Compound v
    V.ValueAtom [Value]
    vs

    pathArg ::
      (MonadError T.Text f) =>
      FilePath ->
      T.Text ->
      [V.Compound V.Value] ->
      f FilePath
    pathArg :: forall (f :: * -> *).
    MonadError EntryName f =>
    String -> EntryName -> [Compound Value] -> f String
    pathArg String
    dir EntryName
    cmd [Compound Value]
    vs =
      case [Compound Value]
    vs of
        [V.ValueAtom Value
    v]
          | Just [Word8]
    path <- Value -> Maybe [Word8]
    forall t. GetValue t => Value -> Maybe t
    V.getValue Value
    v ->
              String -> f String
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> f String) -> String -> f String
    forall a b. (a -> b) -> a -> b
    $ String
    dir String -> ShowS
    </> (Word8 -> Char) -> [Word8] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Char
    chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) ([Word8]
    path :: [Word8])
        [Compound Value]
    _ ->
          EntryName -> f String
    forall a. EntryName -> f a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EntryName -> f String) -> EntryName -> f String
    forall a b. (a -> b) -> a -> b
    $
            EntryName
    "$"
              EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    cmd
              EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    " does not accept arguments of types: "
              EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName -> [EntryName] -> EntryName
    T.intercalate EntryName
    ", " ((Compound Value -> EntryName) -> [Compound Value] -> [EntryName]
    forall a b. (a -> b) -> [a] -> [b]
    map (Compound ValueType -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyText (Compound ValueType -> EntryName)
    -> (Compound Value -> Compound ValueType)
    -> Compound Value
    -> EntryName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> ValueType) -> Compound Value -> Compound ValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Value -> ValueType
    V.valueType) [Compound Value]
    vs)

    -- | Handles the following builtin functions: @loaddata@, @loadbytes@.
    -- Fails for everything else. The 'FilePath' indicates the directory
    -- that files should be read relative to.
    scriptBuiltin :: (MonadIO m, MonadError T.Text m) => FilePath -> EvalBuiltin m
    scriptBuiltin :: forall (m :: * -> *).
    (MonadIO m, MonadError EntryName m) =>
    String -> EvalBuiltin m
    scriptBuiltin String
    dir EntryName
    "loaddata" [Compound Value]
    vs = do
      String -> m (Compound Value)
    forall (m :: * -> *).
    (MonadIO m, MonadError EntryName m) =>
    String -> m (Compound Value)
    loadData (String -> m (Compound Value)) -> m String -> m (Compound Value)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> EntryName -> [Compound Value] -> m String
    forall (f :: * -> *).
    MonadError EntryName f =>
    String -> EntryName -> [Compound Value] -> f String
    pathArg String
    dir EntryName
    "loaddata" [Compound Value]
    vs
    scriptBuiltin String
    dir EntryName
    "loadbytes" [Compound Value]
    vs = do
      (ByteString -> Compound Value)
    -> m ByteString -> m (Compound Value)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Value -> Compound Value
    forall v. v -> Compound v
    V.ValueAtom (Value -> Compound Value)
    -> (ByteString -> Value) -> ByteString -> Compound Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Value
    forall t. PutValue1 t => t -> Value
    V.putValue1) (m ByteString -> m (Compound Value))
    -> (String -> m ByteString) -> String -> m (Compound Value)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO ByteString -> m ByteString
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> m ByteString)
    -> (String -> IO ByteString) -> String -> m ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO ByteString
    BS.readFile
        (String -> m (Compound Value)) -> m String -> m (Compound Value)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> EntryName -> [Compound Value] -> m String
    forall (f :: * -> *).
    MonadError EntryName f =>
    String -> EntryName -> [Compound Value] -> f String
    pathArg String
    dir EntryName
    "loadbytes" [Compound Value]
    vs
    scriptBuiltin String
    _ EntryName
    f [Compound Value]
    _ =
      EntryName -> m (Compound Value)
    forall a. EntryName -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EntryName -> m (Compound Value))
    -> EntryName -> m (Compound Value)
    forall a b. (a -> b) -> a -> b
    $ EntryName
    "Unknown builtin function $" EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyText EntryName
    f

    -- | Symbol table used for local variable lookups during expression evaluation.
    type VTable = M.Map VarName ExpValue

    -- | Evaluate a FutharkScript expression relative to some running server.
    evalExp ::
      forall m.
      (MonadError T.Text m, MonadIO m) =>
      EvalBuiltin m ->
      ScriptServer ->
      Exp ->
      m ExpValue
    evalExp :: forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    EvalBuiltin m -> ScriptServer -> Exp -> m ExpValue
    evalExp EvalBuiltin m
    builtin ScriptServer
    sserver Exp
    top_level_e = do
      IORef [EntryName]
    vars <- IO (IORef [EntryName]) -> m (IORef [EntryName])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef [EntryName]) -> m (IORef [EntryName]))
    -> IO (IORef [EntryName]) -> m (IORef [EntryName])
    forall a b. (a -> b) -> a -> b
    $ [EntryName] -> IO (IORef [EntryName])
    forall a. a -> IO (IORef a)
    newIORef []
      let ( ScriptServer
              { scriptServer :: ScriptServer -> Server
    scriptServer = Server
    server,
                scriptCounter :: ScriptServer -> IORef Int
    scriptCounter = IORef Int
    counter,
                scriptTypes :: ScriptServer -> TypeMap
    scriptTypes = TypeMap
    types
              }
            ) = ScriptServer
    sserver
          newVar :: EntryName -> m EntryName
    newVar EntryName
    base = IO EntryName -> m EntryName
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO EntryName -> m EntryName) -> IO EntryName -> m EntryName
    forall a b. (a -> b) -> a -> b
    $ do
            Int
    x <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    readIORef IORef Int
    counter
            IORef Int -> (Int -> Int) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef Int
    counter (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            let v :: EntryName
    v = EntryName
    base EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> Int -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyText Int
    x
            IORef [EntryName] -> ([EntryName] -> [EntryName]) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef [EntryName]
    vars (EntryName
    v :)
            EntryName -> IO EntryName
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure EntryName
    v

          mkRecord :: EntryName -> [EntryName] -> m EntryName
    mkRecord EntryName
    t [EntryName]
    vs = do
            EntryName
    v <- EntryName -> m EntryName
    forall {m :: * -> *}. MonadIO m => EntryName -> m EntryName
    newVar EntryName
    "record"
            IO (Maybe CmdFailure) -> m ()
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    cmdMaybe (IO (Maybe CmdFailure) -> m ()) -> IO (Maybe CmdFailure) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Server
    -> EntryName -> EntryName -> [EntryName] -> IO (Maybe CmdFailure)
    cmdNew Server
    server EntryName
    v EntryName
    t [EntryName]
    vs
            EntryName -> m EntryName
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure EntryName
    v

          getField :: EntryName -> (Name, b) -> m EntryName
    getField EntryName
    from (Name
    f, b
    _) = do
            EntryName
    to <- EntryName -> m EntryName
    forall {m :: * -> *}. MonadIO m => EntryName -> m EntryName
    newVar EntryName
    "field"
            IO (Maybe CmdFailure) -> m ()
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    cmdMaybe (IO (Maybe CmdFailure) -> m ()) -> IO (Maybe CmdFailure) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Server
    -> EntryName -> EntryName -> EntryName -> IO (Maybe CmdFailure)
    cmdProject Server
    server EntryName
    to EntryName
    from (EntryName -> IO (Maybe CmdFailure))
    -> EntryName -> IO (Maybe CmdFailure)
    forall a b. (a -> b) -> a -> b
    $ Name -> EntryName
    nameToText Name
    f
            EntryName -> m EntryName
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure EntryName
    to

          toVal :: ValOrVar -> m V.Value
          toVal :: ValOrVar -> m Value
    toVal (VVal Value
    v) = Value -> m Value
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Value
    v
          toVal (VVar EntryName
    v) = Server -> EntryName -> m Value
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    Server -> EntryName -> m Value
    readVar Server
    server EntryName
    v

          toVar :: ValOrVar -> m VarName
          toVar :: ValOrVar -> m EntryName
    toVar (VVar EntryName
    v) = EntryName -> m EntryName
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure EntryName
    v
          toVar (VVal Value
    val) = do
            EntryName
    v <- EntryName -> m EntryName
    forall {m :: * -> *}. MonadIO m => EntryName -> m EntryName
    newVar EntryName
    "const"
            Server -> EntryName -> Value -> m ()
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    Server -> EntryName -> Value -> m ()
    writeVar Server
    server EntryName
    v Value
    val
            EntryName -> m EntryName
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure EntryName
    v

          scriptValueToValOrVar :: ScriptValue a -> m a
    scriptValueToValOrVar (SFun EntryName
    f [EntryName]
    _ [EntryName]
    _ [ScriptValue a]
    _) =
            EntryName -> m a
    forall a. EntryName -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EntryName -> m a) -> EntryName -> m a
    forall a b. (a -> b) -> a -> b
    $ EntryName
    "Function " EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    f EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    " not fully applied."
          scriptValueToValOrVar (SValue EntryName
    _ a
    v) =
            a -> m a
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    v

          scriptValueToVal :: ScriptValue ValOrVar -> m V.Value
          scriptValueToVal :: ScriptValue ValOrVar -> m Value
    scriptValueToVal = ValOrVar -> m Value
    toVal (ValOrVar -> m Value)
    -> (ScriptValue ValOrVar -> m ValOrVar)
    -> ScriptValue ValOrVar
    -> m Value
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< ScriptValue ValOrVar -> m ValOrVar
    forall {m :: * -> *} {a}.
    MonadError EntryName m =>
    ScriptValue a -> m a
    scriptValueToValOrVar

          scriptValueToVar :: ScriptValue ValOrVar -> m VarName
          scriptValueToVar :: ScriptValue ValOrVar -> m EntryName
    scriptValueToVar = ValOrVar -> m EntryName
    toVar (ValOrVar -> m EntryName)
    -> (ScriptValue ValOrVar -> m ValOrVar)
    -> ScriptValue ValOrVar
    -> m EntryName
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< ScriptValue ValOrVar -> m ValOrVar
    forall {m :: * -> *} {a}.
    MonadError EntryName m =>
    ScriptValue a -> m a
    scriptValueToValOrVar

          interValToVal :: ExpValue -> m V.CompoundValue
          interValToVal :: ExpValue -> m (Compound Value)
    interValToVal = (ScriptValue ValOrVar -> m Value) -> ExpValue -> m (Compound Value)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Compound a -> f (Compound b)
    traverse ScriptValue ValOrVar -> m Value
    scriptValueToVal

          -- Apart from type checking, this function also converts
          -- FutharkScript tuples/records to Futhark-level tuples/records,
          -- as well as maps between different names for the same
          -- tuple/record.
          --
          -- We also implicitly convert the types of constants.
          interValToVar :: m VarName -> TypeName -> ExpValue -> m VarName
          interValToVar :: m EntryName -> EntryName -> ExpValue -> m EntryName
    interValToVar m EntryName
    _ EntryName
    t (V.ValueAtom ScriptValue ValOrVar
    v)
            | EntryName -> ScriptValueType
    STValue EntryName
    t ScriptValueType -> ScriptValueType -> Bool
    forall a. Eq a => a -> a -> Bool
    == ScriptValue ValOrVar -> ScriptValueType
    forall v. ScriptValue v -> ScriptValueType
    scriptValueType ScriptValue ValOrVar
    v = ScriptValue ValOrVar -> m EntryName
    scriptValueToVar ScriptValue ValOrVar
    v
          interValToVar m EntryName
    bad EntryName
    t (V.ValueTuple [ExpValue]
    vs)
            | Just [EntryName]
    ts <- EntryName -> TypeMap -> Maybe [EntryName]
    isTuple EntryName
    t TypeMap
    types,
              [ExpValue] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ExpValue]
    vs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EntryName]
    ts =
                EntryName -> [EntryName] -> m EntryName
    forall {m :: * -> *}.
    (MonadIO m, MonadError EntryName m) =>
    EntryName -> [EntryName] -> m EntryName
    mkRecord EntryName
    t ([EntryName] -> m EntryName) -> m [EntryName] -> m EntryName
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (EntryName -> ExpValue -> m EntryName)
    -> [EntryName] -> [ExpValue] -> m [EntryName]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (m EntryName -> EntryName -> ExpValue -> m EntryName
    interValToVar m EntryName
    bad) [EntryName]
    ts [ExpValue]
    vs
          interValToVar m EntryName
    bad EntryName
    t (V.ValueRecord Map EntryName ExpValue
    vs)
            | Just [(Name, EntryName)]
    fs <- EntryName -> TypeMap -> Maybe [(Name, EntryName)]
    isRecord EntryName
    t TypeMap
    types,
              Just [ExpValue]
    vs' <- ((Name, EntryName) -> Maybe ExpValue)
    -> [(Name, EntryName)] -> Maybe [ExpValue]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((EntryName -> Map EntryName ExpValue -> Maybe ExpValue
    forall k a. Ord k => k -> Map k a -> Maybe a
    `M.lookup` Map EntryName ExpValue
    vs) (EntryName -> Maybe ExpValue)
    -> ((Name, EntryName) -> EntryName)
    -> (Name, EntryName)
    -> Maybe ExpValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> EntryName
    nameToText (Name -> EntryName)
    -> ((Name, EntryName) -> Name) -> (Name, EntryName) -> EntryName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, EntryName) -> Name
    forall a b. (a, b) -> a
    fst) [(Name, EntryName)]
    fs =
                EntryName -> [EntryName] -> m EntryName
    forall {m :: * -> *}.
    (MonadIO m, MonadError EntryName m) =>
    EntryName -> [EntryName] -> m EntryName
    mkRecord EntryName
    t ([EntryName] -> m EntryName) -> m [EntryName] -> m EntryName
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (EntryName -> ExpValue -> m EntryName)
    -> [EntryName] -> [ExpValue] -> m [EntryName]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (m EntryName -> EntryName -> ExpValue -> m EntryName
    interValToVar m EntryName
    bad) (((Name, EntryName) -> EntryName)
    -> [(Name, EntryName)] -> [EntryName]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, EntryName) -> EntryName
    forall a b. (a, b) -> b
    snd [(Name, EntryName)]
    fs) [ExpValue]
    vs'
          interValToVar m EntryName
    _ EntryName
    t (V.ValueAtom (SValue EntryName
    vt (VVar EntryName
    v)))
            | Just [(Name, EntryName)]
    t_fs <- EntryName -> TypeMap -> Maybe [(Name, EntryName)]
    isRecord EntryName
    t TypeMap
    types,
              Just [(Name, EntryName)]
    vt_fs <- EntryName -> TypeMap -> Maybe [(Name, EntryName)]
    isRecord EntryName
    vt TypeMap
    types,
              [(Name, EntryName)]
    vt_fs [(Name, EntryName)] -> [(Name, EntryName)] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [(Name, EntryName)]
    t_fs =
                EntryName -> [EntryName] -> m EntryName
    forall {m :: * -> *}.
    (MonadIO m, MonadError EntryName m) =>
    EntryName -> [EntryName] -> m EntryName
    mkRecord EntryName
    t ([EntryName] -> m EntryName) -> m [EntryName] -> m EntryName
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ((Name, EntryName) -> m EntryName)
    -> [(Name, EntryName)] -> m [EntryName]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (EntryName -> (Name, EntryName) -> m EntryName
    forall {m :: * -> *} {b}.
    (MonadIO m, MonadError EntryName m) =>
    EntryName -> (Name, b) -> m EntryName
    getField EntryName
    v) [(Name, EntryName)]
    vt_fs
          interValToVar m EntryName
    _ EntryName
    t (V.ValueAtom (SValue EntryName
    _ (VVal Value
    v)))
            | Just Value
    v' <- EntryName -> Value -> Maybe Value
    coerceValue EntryName
    t Value
    v =
                ScriptValue ValOrVar -> m EntryName
    scriptValueToVar (ScriptValue ValOrVar -> m EntryName)
    -> ScriptValue ValOrVar -> m EntryName
    forall a b. (a -> b) -> a -> b
    $ EntryName -> ValOrVar -> ScriptValue ValOrVar
    forall v. EntryName -> v -> ScriptValue v
    SValue EntryName
    t (ValOrVar -> ScriptValue ValOrVar)
    -> ValOrVar -> ScriptValue ValOrVar
    forall a b. (a -> b) -> a -> b
    $ Value -> ValOrVar
    VVal Value
    v'
          interValToVar m EntryName
    bad EntryName
    _ ExpValue
    _ = m EntryName
    bad

          valToInterVal :: V.CompoundValue -> ExpValue
          valToInterVal :: Compound Value -> ExpValue
    valToInterVal = (Value -> ScriptValue ValOrVar) -> Compound Value -> ExpValue
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Value -> ScriptValue ValOrVar) -> Compound Value -> ExpValue)
    -> (Value -> ScriptValue ValOrVar) -> Compound Value -> ExpValue
    forall a b. (a -> b) -> a -> b
    $ \Value
    v ->
            EntryName -> ValOrVar -> ScriptValue ValOrVar
    forall v. EntryName -> v -> ScriptValue v
    SValue (ValueType -> EntryName
    V.valueTypeTextNoDims (Value -> ValueType
    V.valueType Value
    v)) (ValOrVar -> ScriptValue ValOrVar)
    -> ValOrVar -> ScriptValue ValOrVar
    forall a b. (a -> b) -> a -> b
    $ Value -> ValOrVar
    VVal Value
    v

          letMatch :: [VarName] -> ExpValue -> m VTable
          letMatch :: [EntryName] -> ExpValue -> m (Map EntryName ExpValue)
    letMatch [EntryName]
    vs ExpValue
    val
            | [ExpValue]
    vals <- ExpValue -> [ExpValue]
    forall v. Compound v -> [Compound v]
    V.unCompound ExpValue
    val,
              [EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EntryName]
    vs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [ExpValue] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ExpValue]
    vals =
                Map EntryName ExpValue -> m (Map EntryName ExpValue)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map EntryName ExpValue -> m (Map EntryName ExpValue))
    -> Map EntryName ExpValue -> m (Map EntryName ExpValue)
    forall a b. (a -> b) -> a -> b
    $ [(EntryName, ExpValue)] -> Map EntryName ExpValue
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([EntryName] -> [ExpValue] -> [(EntryName, ExpValue)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [EntryName]
    vs [ExpValue]
    vals)
            | Bool
    otherwise =
                EntryName -> m (Map EntryName ExpValue)
    forall a. EntryName -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EntryName -> m (Map EntryName ExpValue))
    -> EntryName -> m (Map EntryName ExpValue)
    forall a b. (a -> b) -> a -> b
    $
                  EntryName
    "Pat: "
                    EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> [EntryName] -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyTextOneLine [EntryName]
    vs
                    EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    "\nDoes not match value of type: "
                    EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> Compound ScriptValueType -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyTextOneLine ((ScriptValue ValOrVar -> ScriptValueType)
    -> ExpValue -> Compound ScriptValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ScriptValue ValOrVar -> ScriptValueType
    forall v. ScriptValue v -> ScriptValueType
    scriptValueType ExpValue
    val)

          evalExp' :: VTable -> Exp -> m ExpValue
          evalExp' :: Map EntryName ExpValue -> Exp -> m ExpValue
    evalExp' Map EntryName ExpValue
    _ (ServerVar EntryName
    t EntryName
    v) =
            ExpValue -> m ExpValue
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExpValue -> m ExpValue) -> ExpValue -> m ExpValue
    forall a b. (a -> b) -> a -> b
    $ ScriptValue ValOrVar -> ExpValue
    forall v. v -> Compound v
    V.ValueAtom (ScriptValue ValOrVar -> ExpValue)
    -> ScriptValue ValOrVar -> ExpValue
    forall a b. (a -> b) -> a -> b
    $ EntryName -> ValOrVar -> ScriptValue ValOrVar
    forall v. EntryName -> v -> ScriptValue v
    SValue EntryName
    t (ValOrVar -> ScriptValue ValOrVar)
    -> ValOrVar -> ScriptValue ValOrVar
    forall a b. (a -> b) -> a -> b
    $ EntryName -> ValOrVar
    VVar EntryName
    v
          evalExp' Map EntryName ExpValue
    vtable (Call (FuncBuiltin EntryName
    name) [Exp]
    es) = do
            Compound Value
    v <- EvalBuiltin m
    builtin EntryName
    name ([Compound Value] -> m (Compound Value))
    -> m [Compound Value] -> m (Compound Value)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (Exp -> m (Compound Value)) -> [Exp] -> m [Compound Value]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (ExpValue -> m (Compound Value)
    interValToVal (ExpValue -> m (Compound Value))
    -> (Exp -> m ExpValue) -> Exp -> m (Compound Value)
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Map EntryName ExpValue -> Exp -> m ExpValue
    evalExp' Map EntryName ExpValue
    vtable) [Exp]
    es
            ExpValue -> m ExpValue
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExpValue -> m ExpValue) -> ExpValue -> m ExpValue
    forall a b. (a -> b) -> a -> b
    $ Compound Value -> ExpValue
    valToInterVal Compound Value
    v
          evalExp' Map EntryName ExpValue
    vtable (Call (FuncFut EntryName
    name) [Exp]
    es)
            | Just ExpValue
    e <- EntryName -> Map EntryName ExpValue -> Maybe ExpValue
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup EntryName
    name Map EntryName ExpValue
    vtable = do
                Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([Exp] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Exp]
    es) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                  EntryName -> m ()
    forall a. EntryName -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EntryName -> m ()) -> EntryName -> m ()
    forall a b. (a -> b) -> a -> b
    $
                    EntryName
    "Locally bound name cannot be invoked as a function: " EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyText EntryName
    name
                ExpValue -> m ExpValue
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ExpValue
    e
          evalExp' Map EntryName ExpValue
    vtable (Call (FuncFut EntryName
    name) [Exp]
    es) = do
            [EntryName]
    in_types <- ([InputType] -> [EntryName]) -> m [InputType] -> m [EntryName]
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((InputType -> EntryName) -> [InputType] -> [EntryName]
    forall a b. (a -> b) -> [a] -> [b]
    map InputType -> EntryName
    inputType) (m [InputType] -> m [EntryName]) -> m [InputType] -> m [EntryName]
    forall a b. (a -> b) -> a -> b
    $ IO (Either CmdFailure [InputType]) -> m [InputType]
    forall (m :: * -> *) a.
    (MonadError EntryName m, MonadIO m) =>
    IO (Either CmdFailure a) -> m a
    cmdEither (IO (Either CmdFailure [InputType]) -> m [InputType])
    -> IO (Either CmdFailure [InputType]) -> m [InputType]
    forall a b. (a -> b) -> a -> b
    $ Server -> EntryName -> IO (Either CmdFailure [InputType])
    cmdInputs Server
    server EntryName
    name
            [EntryName]
    out_types <- ([OutputType] -> [EntryName]) -> m [OutputType] -> m [EntryName]
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((OutputType -> EntryName) -> [OutputType] -> [EntryName]
    forall a b. (a -> b) -> [a] -> [b]
    map OutputType -> EntryName
    outputType) (m [OutputType] -> m [EntryName])
    -> m [OutputType] -> m [EntryName]
    forall a b. (a -> b) -> a -> b
    $ IO (Either CmdFailure [OutputType]) -> m [OutputType]
    forall (m :: * -> *) a.
    (MonadError EntryName m, MonadIO m) =>
    IO (Either CmdFailure a) -> m a
    cmdEither (IO (Either CmdFailure [OutputType]) -> m [OutputType])
    -> IO (Either CmdFailure [OutputType]) -> m [OutputType]
    forall a b. (a -> b) -> a -> b
    $ Server -> EntryName -> IO (Either CmdFailure [OutputType])
    cmdOutputs Server
    server EntryName
    name

            [ExpValue]
    es' <- (Exp -> m ExpValue) -> [Exp] -> m [ExpValue]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Map EntryName ExpValue -> Exp -> m ExpValue
    evalExp' Map EntryName ExpValue
    vtable) [Exp]
    es
            let es_types :: [Compound ScriptValueType]
    es_types = (ExpValue -> Compound ScriptValueType)
    -> [ExpValue] -> [Compound ScriptValueType]
    forall a b. (a -> b) -> [a] -> [b]
    map ((ScriptValue ValOrVar -> ScriptValueType)
    -> ExpValue -> Compound ScriptValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ScriptValue ValOrVar -> ScriptValueType
    forall v. ScriptValue v -> ScriptValueType
    scriptValueType) [ExpValue]
    es'

            let cannotApply :: m a
    cannotApply =
                  EntryName -> m a
    forall a. EntryName -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EntryName -> m a) -> EntryName -> m a
    forall a b. (a -> b) -> a -> b
    $
                    EntryName
    "Function \""
                      EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    name
                      EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    "\" expects "
                      EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> Int -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyText ([EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EntryName]
    in_types)
                      EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    " argument(s) of types:\n"
                      EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName -> [EntryName] -> EntryName
    T.intercalate EntryName
    "\n" ((EntryName -> EntryName) -> [EntryName] -> [EntryName]
    forall a b. (a -> b) -> [a] -> [b]
    map EntryName -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyTextOneLine [EntryName]
    in_types)
                      EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    "\nBut applied to "
                      EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> Int -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyText ([Compound ScriptValueType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Compound ScriptValueType]
    es_types)
                      EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    " argument(s) of types:\n"
                      EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName -> [EntryName] -> EntryName
    T.intercalate EntryName
    "\n" ((Compound ScriptValueType -> EntryName)
    -> [Compound ScriptValueType] -> [EntryName]
    forall a b. (a -> b) -> [a] -> [b]
    map Compound ScriptValueType -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyTextOneLine [Compound ScriptValueType]
    es_types)

                tryApply :: [ExpValue] -> m ExpValue
    tryApply [ExpValue]
    args = do
                  [EntryName]
    arg_types <- (EntryName -> ExpValue -> m EntryName)
    -> [EntryName] -> [ExpValue] -> m [EntryName]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (m EntryName -> EntryName -> ExpValue -> m EntryName
    interValToVar m EntryName
    forall {a}. m a
    cannotApply) [EntryName]
    in_types [ExpValue]
    args

                  if [EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EntryName]
    in_types Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EntryName]
    arg_types
                    then do
                      [EntryName]
    outs <- Int -> m EntryName -> m [EntryName]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EntryName]
    out_types) (m EntryName -> m [EntryName]) -> m EntryName -> m [EntryName]
    forall a b. (a -> b) -> a -> b
    $ EntryName -> m EntryName
    forall {m :: * -> *}. MonadIO m => EntryName -> m EntryName
    newVar EntryName
    "out"
                      m [EntryName] -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m [EntryName] -> m ()) -> m [EntryName] -> m ()
    forall a b. (a -> b) -> a -> b
    $ IO (Either CmdFailure [EntryName]) -> m [EntryName]
    forall (m :: * -> *) a.
    (MonadError EntryName m, MonadIO m) =>
    IO (Either CmdFailure a) -> m a
    cmdEither (IO (Either CmdFailure [EntryName]) -> m [EntryName])
    -> IO (Either CmdFailure [EntryName]) -> m [EntryName]
    forall a b. (a -> b) -> a -> b
    $ Server
    -> EntryName
    -> [EntryName]
    -> [EntryName]
    -> IO (Either CmdFailure [EntryName])
    cmdCall Server
    server EntryName
    name [EntryName]
    outs [EntryName]
    arg_types
                      ExpValue -> m ExpValue
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExpValue -> m ExpValue) -> ExpValue -> m ExpValue
    forall a b. (a -> b) -> a -> b
    $ [ExpValue] -> ExpValue
    forall v. [Compound v] -> Compound v
    V.mkCompound ([ExpValue] -> ExpValue) -> [ExpValue] -> ExpValue
    forall a b. (a -> b) -> a -> b
    $ (ScriptValue ValOrVar -> ExpValue)
    -> [ScriptValue ValOrVar] -> [ExpValue]
    forall a b. (a -> b) -> [a] -> [b]
    map ScriptValue ValOrVar -> ExpValue
    forall v. v -> Compound v
    V.ValueAtom ([ScriptValue ValOrVar] -> [ExpValue])
    -> [ScriptValue ValOrVar] -> [ExpValue]
    forall a b. (a -> b) -> a -> b
    $ (EntryName -> ValOrVar -> ScriptValue ValOrVar)
    -> [EntryName] -> [ValOrVar] -> [ScriptValue ValOrVar]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith EntryName -> ValOrVar -> ScriptValue ValOrVar
    forall v. EntryName -> v -> ScriptValue v
    SValue [EntryName]
    out_types ([ValOrVar] -> [ScriptValue ValOrVar])
    -> [ValOrVar] -> [ScriptValue ValOrVar]
    forall a b. (a -> b) -> a -> b
    $ (EntryName -> ValOrVar) -> [EntryName] -> [ValOrVar]
    forall a b. (a -> b) -> [a] -> [b]
    map EntryName -> ValOrVar
    VVar [EntryName]
    outs
                    else
                      ExpValue -> m ExpValue
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExpValue -> m ExpValue)
    -> ([ScriptValue ValOrVar] -> ExpValue)
    -> [ScriptValue ValOrVar]
    -> m ExpValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ScriptValue ValOrVar -> ExpValue
    forall v. v -> Compound v
    V.ValueAtom (ScriptValue ValOrVar -> ExpValue)
    -> ([ScriptValue ValOrVar] -> ScriptValue ValOrVar)
    -> [ScriptValue ValOrVar]
    -> ExpValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntryName
    -> [EntryName]
    -> [EntryName]
    -> [ScriptValue ValOrVar]
    -> ScriptValue ValOrVar
    forall v.
    EntryName
    -> [EntryName] -> [EntryName] -> [ScriptValue v] -> ScriptValue v
    SFun EntryName
    name [EntryName]
    in_types [EntryName]
    out_types ([ScriptValue ValOrVar] -> m ExpValue)
    -> [ScriptValue ValOrVar] -> m ExpValue
    forall a b. (a -> b) -> a -> b
    $
                        (EntryName -> ValOrVar -> ScriptValue ValOrVar)
    -> [EntryName] -> [ValOrVar] -> [ScriptValue ValOrVar]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith EntryName -> ValOrVar -> ScriptValue ValOrVar
    forall v. EntryName -> v -> ScriptValue v
    SValue [EntryName]
    in_types ([ValOrVar] -> [ScriptValue ValOrVar])
    -> [ValOrVar] -> [ScriptValue ValOrVar]
    forall a b. (a -> b) -> a -> b
    $
                          (EntryName -> ValOrVar) -> [EntryName] -> [ValOrVar]
    forall a b. (a -> b) -> [a] -> [b]
    map EntryName -> ValOrVar
    VVar [EntryName]
    arg_types

            -- Careful to not require saturated application, but do still
            -- check for over-saturation.
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Compound ScriptValueType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Compound ScriptValueType]
    es_types Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > [EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EntryName]
    in_types) m ()
    forall {a}. m a
    cannotApply

            -- Allow automatic uncurrying if applicable.
            case [ExpValue]
    es' of
              [V.ValueTuple [ExpValue]
    es''] | [ExpValue] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ExpValue]
    es'' Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EntryName]
    in_types -> [ExpValue] -> m ExpValue
    tryApply [ExpValue]
    es''
              [ExpValue]
    _ -> [ExpValue] -> m ExpValue
    tryApply [ExpValue]
    es'
          evalExp' Map EntryName ExpValue
    _ (StringLit EntryName
    s) =
            case EntryName -> Maybe Value
    forall t. PutValue t => t -> Maybe Value
    V.putValue EntryName
    s of
              Just Value
    s' ->
                ExpValue -> m ExpValue
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExpValue -> m ExpValue) -> ExpValue -> m ExpValue
    forall a b. (a -> b) -> a -> b
    $ ScriptValue ValOrVar -> ExpValue
    forall v. v -> Compound v
    V.ValueAtom (ScriptValue ValOrVar -> ExpValue)
    -> ScriptValue ValOrVar -> ExpValue
    forall a b. (a -> b) -> a -> b
    $ EntryName -> ValOrVar -> ScriptValue ValOrVar
    forall v. EntryName -> v -> ScriptValue v
    SValue (ValueType -> EntryName
    V.valueTypeTextNoDims (Value -> ValueType
    V.valueType Value
    s')) (ValOrVar -> ScriptValue ValOrVar)
    -> ValOrVar -> ScriptValue ValOrVar
    forall a b. (a -> b) -> a -> b
    $ Value -> ValOrVar
    VVal Value
    s'
              Maybe Value
    Nothing -> String -> m ExpValue
    forall a. HasCallStack => String -> a
    error (String -> m ExpValue) -> String -> m ExpValue
    forall a b. (a -> b) -> a -> b
    $ String
    "Unable to write value " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ EntryName -> String
    forall a. Pretty a => a -> String
    prettyString EntryName
    s
          evalExp' Map EntryName ExpValue
    _ (Const Value
    val) =
            ExpValue -> m ExpValue
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExpValue -> m ExpValue) -> ExpValue -> m ExpValue
    forall a b. (a -> b) -> a -> b
    $ ScriptValue ValOrVar -> ExpValue
    forall v. v -> Compound v
    V.ValueAtom (ScriptValue ValOrVar -> ExpValue)
    -> ScriptValue ValOrVar -> ExpValue
    forall a b. (a -> b) -> a -> b
    $ EntryName -> ValOrVar -> ScriptValue ValOrVar
    forall v. EntryName -> v -> ScriptValue v
    SValue (ValueType -> EntryName
    V.valueTypeTextNoDims (Value -> ValueType
    V.valueType Value
    val)) (ValOrVar -> ScriptValue ValOrVar)
    -> ValOrVar -> ScriptValue ValOrVar
    forall a b. (a -> b) -> a -> b
    $ Value -> ValOrVar
    VVal Value
    val
          evalExp' Map EntryName ExpValue
    vtable (Tuple [Exp]
    es) =
            [ExpValue] -> ExpValue
    forall v. [Compound v] -> Compound v
    V.ValueTuple ([ExpValue] -> ExpValue) -> m [ExpValue] -> m ExpValue
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Exp -> m ExpValue) -> [Exp] -> m [ExpValue]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Map EntryName ExpValue -> Exp -> m ExpValue
    evalExp' Map EntryName ExpValue
    vtable) [Exp]
    es
          evalExp' Map EntryName ExpValue
    vtable e :: Exp
    e@(Record [(EntryName, Exp)]
    m) = do
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([EntryName] -> [EntryName]
    forall a. Ord a => [a] -> [a]
    nubOrd (((EntryName, Exp) -> EntryName)
    -> [(EntryName, Exp)] -> [EntryName]
    forall a b. (a -> b) -> [a] -> [b]
    map (EntryName, Exp) -> EntryName
    forall a b. (a, b) -> a
    fst [(EntryName, Exp)]
    m)) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [EntryName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (((EntryName, Exp) -> EntryName)
    -> [(EntryName, Exp)] -> [EntryName]
    forall a b. (a -> b) -> [a] -> [b]
    map (EntryName, Exp) -> EntryName
    forall a b. (a, b) -> a
    fst [(EntryName, Exp)]
    m)) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
              EntryName -> m ()
    forall a. EntryName -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EntryName -> m ()) -> EntryName -> m ()
    forall a b. (a -> b) -> a -> b
    $
                EntryName
    "Record " EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> Exp -> EntryName
    forall a. Pretty a => a -> EntryName
    prettyText Exp
    e EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    " has duplicate fields."
            Map EntryName ExpValue -> ExpValue
    forall v. Map EntryName (Compound v) -> Compound v
    V.ValueRecord (Map EntryName ExpValue -> ExpValue)
    -> m (Map EntryName ExpValue) -> m ExpValue
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Exp -> m ExpValue)
    -> Map EntryName Exp -> m (Map EntryName ExpValue)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map EntryName a -> f (Map EntryName b)
    traverse (Map EntryName ExpValue -> Exp -> m ExpValue
    evalExp' Map EntryName ExpValue
    vtable) ([(EntryName, Exp)] -> Map EntryName Exp
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(EntryName, Exp)]
    m)
          evalExp' Map EntryName ExpValue
    vtable (Let [EntryName]
    pat Exp
    e1 Exp
    e2) = do
            ExpValue
    v <- Map EntryName ExpValue -> Exp -> m ExpValue
    evalExp' Map EntryName ExpValue
    vtable Exp
    e1
            Map EntryName ExpValue
    pat_vtable <- [EntryName] -> ExpValue -> m (Map EntryName ExpValue)
    letMatch [EntryName]
    pat ExpValue
    v
            Map EntryName ExpValue -> Exp -> m ExpValue
    evalExp' (Map EntryName ExpValue
    pat_vtable Map EntryName ExpValue
    -> Map EntryName ExpValue -> Map EntryName ExpValue
    forall a. Semigroup a => a -> a -> a
    <> Map EntryName ExpValue
    vtable) Exp
    e2

      let freeNonresultVars :: ExpValue -> m ExpValue
    freeNonresultVars ExpValue
    v = do
            let v_vars :: Set EntryName
    v_vars = ExpValue -> Set EntryName
    serverVarsInValue ExpValue
    v
            [EntryName]
    to_free <- IO [EntryName] -> m [EntryName]
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [EntryName] -> m [EntryName])
    -> IO [EntryName] -> m [EntryName]
    forall a b. (a -> b) -> a -> b
    $ (EntryName -> Bool) -> [EntryName] -> [EntryName]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (EntryName -> Set EntryName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.notMember` Set EntryName
    v_vars) ([EntryName] -> [EntryName]) -> IO [EntryName] -> IO [EntryName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef [EntryName] -> IO [EntryName]
    forall a. IORef a -> IO a
    readIORef IORef [EntryName]
    vars
            IO (Maybe CmdFailure) -> m ()
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    cmdMaybe (IO (Maybe CmdFailure) -> m ()) -> IO (Maybe CmdFailure) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Server -> [EntryName] -> IO (Maybe CmdFailure)
    cmdFree Server
    server [EntryName]
    to_free
            ExpValue -> m ExpValue
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ExpValue
    v
          freeVarsOnError :: e -> m b
    freeVarsOnError e
    e = do
            -- We are intentionally ignoring any errors produced by
            -- cmdFree, because we already have another error to
            -- propagate.  Also, not all of the variables that we put in
            -- 'vars' might actually exist server-side, if we failed in a
            -- Call.
            m (Maybe CmdFailure) -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m (Maybe CmdFailure) -> m ()) -> m (Maybe CmdFailure) -> m ()
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe CmdFailure) -> m (Maybe CmdFailure)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe CmdFailure) -> m (Maybe CmdFailure))
    -> IO (Maybe CmdFailure) -> m (Maybe CmdFailure)
    forall a b. (a -> b) -> a -> b
    $ Server -> [EntryName] -> IO (Maybe CmdFailure)
    cmdFree Server
    server ([EntryName] -> IO (Maybe CmdFailure))
    -> IO [EntryName] -> IO (Maybe CmdFailure)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IORef [EntryName] -> IO [EntryName]
    forall a. IORef a -> IO a
    readIORef IORef [EntryName]
    vars
            e -> m b
    forall a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError e
    e
      (ExpValue -> m ExpValue
    forall {m :: * -> *}.
    (MonadIO m, MonadError EntryName m) =>
    ExpValue -> m ExpValue
    freeNonresultVars (ExpValue -> m ExpValue) -> m ExpValue -> m ExpValue
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Map EntryName ExpValue -> Exp -> m ExpValue
    evalExp' Map EntryName ExpValue
    forall a. Monoid a => a
    mempty Exp
    top_level_e) m ExpValue -> (EntryName -> m ExpValue) -> m ExpValue
    forall a. m a -> (EntryName -> m a) -> m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` EntryName -> m ExpValue
    forall {m :: * -> *} {e} {b}.
    (MonadIO m, MonadError e m) =>
    e -> m b
    freeVarsOnError

    -- | Read actual values from the server.  Fails for values that have
    -- no well-defined external representation.
    getExpValue ::
      (MonadError T.Text m, MonadIO m) => ScriptServer -> ExpValue -> m V.CompoundValue
    getExpValue :: forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    ScriptServer -> ExpValue -> m (Compound Value)
    getExpValue ScriptServer
    server ExpValue
    e =
      (ScriptValue Value -> m Value)
    -> Compound (ScriptValue Value) -> m (Compound Value)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Compound a -> f (Compound b)
    traverse ScriptValue Value -> m Value
    forall {m :: * -> *} {a}.
    MonadError EntryName m =>
    ScriptValue a -> m a
    toGround (Compound (ScriptValue Value) -> m (Compound Value))
    -> m (Compound (ScriptValue Value)) -> m (Compound Value)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (ScriptValue ValOrVar -> m (ScriptValue Value))
    -> ExpValue -> m (Compound (ScriptValue Value))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Compound a -> f (Compound b)
    traverse ((ValOrVar -> m Value)
    -> ScriptValue ValOrVar -> m (ScriptValue Value)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ScriptValue a -> f (ScriptValue b)
    traverse ValOrVar -> m Value
    forall {m :: * -> *}.
    (MonadError EntryName m, MonadIO m) =>
    ValOrVar -> m Value
    onLeaf) ExpValue
    e
      where
        onLeaf :: ValOrVar -> m Value
    onLeaf (VVar EntryName
    v) = Server -> EntryName -> m Value
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    Server -> EntryName -> m Value
    readVar (ScriptServer -> Server
    scriptServer ScriptServer
    server) EntryName
    v
        onLeaf (VVal Value
    v) = Value -> m Value
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Value
    v
        toGround :: ScriptValue a -> m a
    toGround (SFun EntryName
    fname [EntryName]
    _ [EntryName]
    _ [ScriptValue a]
    _) =
          EntryName -> m a
    forall a. EntryName -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EntryName -> m a) -> EntryName -> m a
    forall a b. (a -> b) -> a -> b
    $ EntryName
    "Function " EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    fname EntryName -> EntryName -> EntryName
    forall a. Semigroup a => a -> a -> a
    <> EntryName
    " not fully applied."
        toGround (SValue EntryName
    _ a
    v) = a -> m a
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    v

    -- | Like 'evalExp', but requires all values to be non-functional.  If
    -- the value has a bad type, return that type instead.  Other
    -- evaluation problems (e.g. type failures) raise errors.
    evalExpToGround ::
      (MonadError T.Text m, MonadIO m) =>
      EvalBuiltin m ->
      ScriptServer ->
      Exp ->
      m (Either (V.Compound ScriptValueType) V.CompoundValue)
    evalExpToGround :: forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    EvalBuiltin m
    -> ScriptServer
    -> Exp
    -> m (Either (Compound ScriptValueType) (Compound Value))
    evalExpToGround EvalBuiltin m
    builtin ScriptServer
    server Exp
    e = do
      ExpValue
    v <- EvalBuiltin m -> ScriptServer -> Exp -> m ExpValue
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    EvalBuiltin m -> ScriptServer -> Exp -> m ExpValue
    evalExp EvalBuiltin m
    builtin ScriptServer
    server Exp
    e
      -- This assumes that the only error that can occur during
      -- getExpValue is trying to read an opaque.
      (Compound Value
    -> Either (Compound ScriptValueType) (Compound Value)
    forall a b. b -> Either a b
    Right (Compound Value
     -> Either (Compound ScriptValueType) (Compound Value))
    -> m (Compound Value)
    -> m (Either (Compound ScriptValueType) (Compound Value))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ScriptServer -> ExpValue -> m (Compound Value)
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    ScriptServer -> ExpValue -> m (Compound Value)
    getExpValue ScriptServer
    server ExpValue
    v)
        m (Either (Compound ScriptValueType) (Compound Value))
    -> (EntryName
        -> m (Either (Compound ScriptValueType) (Compound Value)))
    -> m (Either (Compound ScriptValueType) (Compound Value))
    forall a. m a -> (EntryName -> m a) -> m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` m (Either (Compound ScriptValueType) (Compound Value))
    -> EntryName
    -> m (Either (Compound ScriptValueType) (Compound Value))
    forall a b. a -> b -> a
    const (Either (Compound ScriptValueType) (Compound Value)
    -> m (Either (Compound ScriptValueType) (Compound Value))
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either (Compound ScriptValueType) (Compound Value)
     -> m (Either (Compound ScriptValueType) (Compound Value)))
    -> Either (Compound ScriptValueType) (Compound Value)
    -> m (Either (Compound ScriptValueType) (Compound Value))
    forall a b. (a -> b) -> a -> b
    $ Compound ScriptValueType
    -> Either (Compound ScriptValueType) (Compound Value)
    forall a b. a -> Either a b
    Left (Compound ScriptValueType
     -> Either (Compound ScriptValueType) (Compound Value))
    -> Compound ScriptValueType
    -> Either (Compound ScriptValueType) (Compound Value)
    forall a b. (a -> b) -> a -> b
    $ (ScriptValue ValOrVar -> ScriptValueType)
    -> ExpValue -> Compound ScriptValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ScriptValue ValOrVar -> ScriptValueType
    forall v. ScriptValue v -> ScriptValueType
    scriptValueType ExpValue
    v)

    -- | The set of Futhark variables that are referenced by the
    -- expression - these will have to be entry points in the Futhark
    -- program.
    varsInExp :: Exp -> S.Set EntryName
    varsInExp :: Exp -> Set EntryName
    varsInExp ServerVar {} = Set EntryName
    forall a. Monoid a => a
    mempty
    varsInExp (Call (FuncFut EntryName
    v) [Exp]
    es) = EntryName -> Set EntryName -> Set EntryName
    forall a. Ord a => a -> Set a -> Set a
    S.insert EntryName
    v (Set EntryName -> Set EntryName) -> Set EntryName -> Set EntryName
    forall a b. (a -> b) -> a -> b
    $ (Exp -> Set EntryName) -> [Exp] -> Set EntryName
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Exp -> Set EntryName
    varsInExp [Exp]
    es
    varsInExp (Call (FuncBuiltin EntryName
    _) [Exp]
    es) = (Exp -> Set EntryName) -> [Exp] -> Set EntryName
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Exp -> Set EntryName
    varsInExp [Exp]
    es
    varsInExp (Tuple [Exp]
    es) = (Exp -> Set EntryName) -> [Exp] -> Set EntryName
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Exp -> Set EntryName
    varsInExp [Exp]
    es
    varsInExp (Record [(EntryName, Exp)]
    fs) = ((EntryName, Exp) -> Set EntryName)
    -> [(EntryName, Exp)] -> Set EntryName
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ((Exp -> Set EntryName) -> (EntryName, Exp) -> Set EntryName
    forall m a. Monoid m => (a -> m) -> (EntryName, a) -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Exp -> Set EntryName
    varsInExp) [(EntryName, Exp)]
    fs
    varsInExp Const {} = Set EntryName
    forall a. Monoid a => a
    mempty
    varsInExp StringLit {} = Set EntryName
    forall a. Monoid a => a
    mempty
    varsInExp (Let [EntryName]
    pat Exp
    e1 Exp
    e2) = Exp -> Set EntryName
    varsInExp Exp
    e1 Set EntryName -> Set EntryName -> Set EntryName
    forall a. Semigroup a => a -> a -> a
    <> (EntryName -> Bool) -> Set EntryName -> Set EntryName
    forall a. (a -> Bool) -> Set a -> Set a
    S.filter (EntryName -> [EntryName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [EntryName]
    pat) (Exp -> Set EntryName
    varsInExp Exp
    e2)

    -- | Release all the server-side variables in the value.  Yes,
    -- FutharkScript has manual memory management...
    freeValue :: (MonadError T.Text m, MonadIO m) => ScriptServer -> ExpValue -> m ()
    freeValue :: forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    ScriptServer -> ExpValue -> m ()
    freeValue ScriptServer
    server =
      IO (Maybe CmdFailure) -> m ()
    forall (m :: * -> *).
    (MonadError EntryName m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    cmdMaybe (IO (Maybe CmdFailure) -> m ())
    -> (ExpValue -> IO (Maybe CmdFailure)) -> ExpValue -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Server -> [EntryName] -> IO (Maybe CmdFailure)
    cmdFree (ScriptServer -> Server
    scriptServer ScriptServer
    server) ([EntryName] -> IO (Maybe CmdFailure))
    -> (ExpValue -> [EntryName]) -> ExpValue -> IO (Maybe CmdFailure)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Set EntryName -> [EntryName]
    forall a. Set a -> [a]
    S.toList (Set EntryName -> [EntryName])
    -> (ExpValue -> Set EntryName) -> ExpValue -> [EntryName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExpValue -> Set EntryName
    serverVarsInValue