{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Inferno.Eval where

-- import Control.Monad (foldM, when)
import Control.Monad.Catch (MonadCatch, SomeException, try)
import Control.Monad.Except
  ( Except,
    ExceptT,
    MonadError (throwError),
    forM,
    runExcept,
    runExceptT,
  )
import Control.Monad.Identity (Identity)
import Control.Monad.Reader (ask, local)
import Data.Foldable (foldrM)
import Data.List.NonEmpty (NonEmpty (..), toList)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import qualified Data.Text as Text
import Inferno.Eval.Error
  ( EvalError (AssertionFailed, RuntimeError),
  )
import Inferno.Module.Builtin (enumBoolHash)
import Inferno.Types.Syntax
  ( BaseType (..),
    Expr (..),
    ExtIdent (..),
    Ident (..),
    ImplExpl (..),
    InfernoType (TBase),
    Lit (LDouble, LHex, LInt, LText),
    Pat (..),
    tListToList,
    toEitherList,
  )
import Inferno.Types.Value
  ( ImplEnvM,
    Value
      ( VArray,
        VDouble,
        VEmpty,
        VEnum,
        VFun,
        VInt,
        VOne,
        VText,
        VTuple,
        VTypeRep,
        VWord64
      ),
    runImplEnvM,
  )
import Inferno.Types.VersionControl (VCObjectHash)
import Inferno.Utils.Prettyprinter (renderPretty)
import Prettyprinter
  ( LayoutOptions (LayoutOptions),
    PageWidth (Unbounded),
    Pretty (pretty),
    layoutPretty,
  )
import Prettyprinter.Render.Text (renderStrict)

type TermEnv hash c m = (Map.Map ExtIdent (Value c m), Map.Map hash (Value c m))

type Interpreter t = Except EvalError t

emptyTmenv :: TermEnv hash c m
emptyTmenv :: forall hash c (m :: * -> *). TermEnv hash c m
emptyTmenv = (forall k a. Map k a
Map.empty, forall k a. Map k a
Map.empty)

eval :: (MonadError EvalError m, MonadError EvalError (ImplEnvM m c), Pretty c) => TermEnv VCObjectHash c (ImplEnvM m c) -> Expr (Maybe VCObjectHash) a -> ImplEnvM m c (Value c (ImplEnvM m c))
eval :: forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval env :: (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env@(Map ExtIdent (Value c (ImplEnvM m c))
localEnv, Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv) Expr (Maybe VCObjectHash) a
expr = case Expr (Maybe VCObjectHash) a
expr of
  Lit_ (LInt Int64
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    forall custom (m :: * -> *).
(Value custom m -> m (Value custom m)) -> Value custom m
VFun forall a b. (a -> b) -> a -> b
$ \case
      VTypeRep (TBase BaseType
TInt) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *). Int64 -> Value custom m
VInt Int64
k
      VTypeRep (TBase BaseType
TDouble) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *). Double -> Value custom m
VDouble forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
k
      Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"Invalid runtime rep for numeric constant."
  Lit_ (LDouble Double
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *). Double -> Value custom m
VDouble Double
k
  Lit_ (LHex Word64
w) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *). Word64 -> Value custom m
VWord64 Word64
w
  Lit_ (LText Text
t) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *). Text -> Value custom m
VText Text
t
  InterpolatedString_ SomeIStr (a, Expr (Maybe VCObjectHash) a, a)
es -> do
    [Value c (ImplEnvM m c)]
res <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall e. SomeIStr e -> [Either Text e]
toEitherList SomeIStr (a, Expr (Maybe VCObjectHash) a, a)
es) forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). Text -> Value custom m
VText) (\(a
_, Expr (Maybe VCObjectHash) a
e, a
_) -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *). Text -> Value custom m
VText forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {custom} {m :: * -> *}.
Pretty custom =>
Value custom m -> Text
toText [Value c (ImplEnvM m c)]
res
    where
      toText :: Value custom m -> Text
toText (VText Text
t) = Text
t
      toText Value custom m
e = forall ann. SimpleDocStream ann -> Text
renderStrict forall a b. (a -> b) -> a -> b
$ forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty (PageWidth -> LayoutOptions
LayoutOptions PageWidth
Unbounded) forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty Value custom m
e
  Array_ [(Expr (Maybe VCObjectHash) a, Maybe a)]
es ->
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (\(Expr (Maybe VCObjectHash) a
e, Maybe a
_) [Value c (ImplEnvM m c)]
vs -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: [Value c (ImplEnvM m c)]
vs)) [] [(Expr (Maybe VCObjectHash) a, Maybe a)]
es forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). [Value custom m] -> Value custom m
VArray
  ArrayComp_ Expr (Maybe VCObjectHash) a
e NonEmpty (a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a)
srcs Maybe (a, Expr (Maybe VCObjectHash) a)
mCond -> do
    [[(ExtIdent, Value c (ImplEnvM m c))]]
vals <- forall (m :: * -> *) c a.
(MonadError EvalError m, Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> NonEmpty (a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a)
-> ImplEnvM m c [[(ExtIdent, Value c (ImplEnvM m c))]]
sequence' (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env NonEmpty (a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a)
srcs
    forall custom (m :: * -> *). [Value custom m] -> Value custom m
VArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe (a, Expr (Maybe VCObjectHash) a)
mCond of
      Maybe (a, Expr (Maybe VCObjectHash) a)
Nothing ->
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[(ExtIdent, Value c (ImplEnvM m c))]]
vals forall a b. (a -> b) -> a -> b
$ \[(ExtIdent, Value c (ImplEnvM m c))]
vs ->
          let nenv :: Map ExtIdent (Value c (ImplEnvM m c))
nenv = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert) Map ExtIdent (Value c (ImplEnvM m c))
localEnv [(ExtIdent, Value c (ImplEnvM m c))]
vs in forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c))
nenv, Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv) Expr (Maybe VCObjectHash) a
e
      Just (a
_, Expr (Maybe VCObjectHash) a
cond) ->
        forall a. [Maybe a] -> [a]
catMaybes
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[(ExtIdent, Value c (ImplEnvM m c))]]
vals forall a b. (a -> b) -> a -> b
$ \[(ExtIdent, Value c (ImplEnvM m c))]
vs -> do
                  let nenv :: Map ExtIdent (Value c (ImplEnvM m c))
nenv = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert) Map ExtIdent (Value c (ImplEnvM m c))
localEnv [(ExtIdent, Value c (ImplEnvM m c))]
vs
                  forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c))
nenv, Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv) Expr (Maybe VCObjectHash) a
cond forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    VEnum VCObjectHash
hash Ident
"true" ->
                      if VCObjectHash
hash forall a. Eq a => a -> a -> Bool
== VCObjectHash
enumBoolHash
                        then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c))
nenv, Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv) Expr (Maybe VCObjectHash) a
e)
                        else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a bool"
                    VEnum VCObjectHash
hash Ident
"false" ->
                      if VCObjectHash
hash forall a. Eq a => a -> a -> Bool
== VCObjectHash
enumBoolHash
                        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                        else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a bool"
                    Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a bool"
              )
    where
      sequence' :: (MonadError EvalError m, Pretty c) => TermEnv VCObjectHash c (ImplEnvM m c) -> NonEmpty (a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a) -> ImplEnvM m c [[(ExtIdent, Value c (ImplEnvM m c))]]
      sequence' :: forall (m :: * -> *) c a.
(MonadError EvalError m, Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> NonEmpty (a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a)
-> ImplEnvM m c [[(ExtIdent, Value c (ImplEnvM m c))]]
sequence' env' :: TermEnv VCObjectHash c (ImplEnvM m c)
env'@(Map ExtIdent (Value c (ImplEnvM m c))
localEnv', Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv') = \case
        (a
_, Ident Text
x, a
_, Expr (Maybe VCObjectHash) a
e_s, Maybe a
_) :| [] -> do
          forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval TermEnv VCObjectHash c (ImplEnvM m c)
env' Expr (Maybe VCObjectHash) a
e_s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            VArray [Value c (ImplEnvM m c)]
vals -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
x,)) [Value c (ImplEnvM m c)]
vals
            Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with an array"
        (a
_, Ident Text
x, a
_, Expr (Maybe VCObjectHash) a
e_s, Maybe a
_) :| ((a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a)
r : [(a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a)]
rs) -> do
          forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval TermEnv VCObjectHash c (ImplEnvM m c)
env' Expr (Maybe VCObjectHash) a
e_s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            VArray [Value c (ImplEnvM m c)]
vals ->
              forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value c (ImplEnvM m c)]
vals forall a b. (a -> b) -> a -> b
$ \Value c (ImplEnvM m c)
v -> do
                        [[(ExtIdent, Value c (ImplEnvM m c))]]
res <- forall (m :: * -> *) c a.
(MonadError EvalError m, Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> NonEmpty (a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a)
-> ImplEnvM m c [[(ExtIdent, Value c (ImplEnvM m c))]]
sequence' (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
x) Value c (ImplEnvM m c)
v Map ExtIdent (Value c (ImplEnvM m c))
localEnv', Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv') ((a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a)
r forall a. a -> [a] -> NonEmpty a
:| [(a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a)]
rs)
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
x, Value c (ImplEnvM m c)
v) forall a. a -> [a] -> [a]
:) [[(ExtIdent, Value c (ImplEnvM m c))]]
res
                    )
            Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with an array"
  Enum_ (Just VCObjectHash
hash) Scoped ModuleName
_ Ident
i -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *).
VCObjectHash -> Ident -> Value custom m
VEnum VCObjectHash
hash Ident
i
  Enum_ Maybe VCObjectHash
Nothing Scoped ModuleName
_ Ident
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"All enums must be pinned"
  Var_ (Just VCObjectHash
hash) Scoped ModuleName
_ ImplExpl
x ->
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VCObjectHash
hash Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv of
      Just Value c (ImplEnvM m c)
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Value c (ImplEnvM m c)
v
      Maybe (Value c (ImplEnvM m c))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ImplExpl
x forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VCObjectHash
hash forall a. Semigroup a => a -> a -> a
<> String
") not found in the pinned env"
  Var_ Maybe VCObjectHash
Nothing Scoped ModuleName
_ (Expl ExtIdent
x) -> do
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExtIdent
x Map ExtIdent (Value c (ImplEnvM m c))
localEnv of
      Just Value c (ImplEnvM m c)
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Value c (ImplEnvM m c)
v
      Maybe (Value c (ImplEnvM m c))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ExtIdent
x forall a. Semigroup a => a -> a -> a
<> String
" not found in the unpinned env"
  Var_ Maybe VCObjectHash
Nothing Scoped ModuleName
_ (Impl ExtIdent
x) -> do
    Map ExtIdent (Value c (ImplEnvM m c))
implEnv <- forall r (m :: * -> *). MonadReader r m => m r
ask
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExtIdent
x Map ExtIdent (Value c (ImplEnvM m c))
implEnv of
      Just Value c (ImplEnvM m c)
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Value c (ImplEnvM m c)
v
      Maybe (Value c (ImplEnvM m c))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ExtIdent
x forall a. Semigroup a => a -> a -> a
<> String
" not found in the implicit env"
  OpVar_ (Just VCObjectHash
hash) Scoped ModuleName
_ Ident
x ->
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VCObjectHash
hash Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv of
      Just Value c (ImplEnvM m c)
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Value c (ImplEnvM m c)
v
      Maybe (Value c (ImplEnvM m c))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ident
x forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VCObjectHash
hash forall a. Semigroup a => a -> a -> a
<> String
") not found in the pinned env"
  OpVar_ Maybe VCObjectHash
Nothing Scoped ModuleName
_ (Ident Text
x) -> do
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
x) Map ExtIdent (Value c (ImplEnvM m c))
localEnv of
      Just Value c (ImplEnvM m c)
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Value c (ImplEnvM m c)
v
      Maybe (Value c (ImplEnvM m c))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Text
x forall a. Semigroup a => a -> a -> a
<> String
" not found in env"
  TypeRep_ InfernoType
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *). InfernoType -> Value custom m
VTypeRep InfernoType
t
  Op_ Expr (Maybe VCObjectHash) a
_ Maybe VCObjectHash
Nothing Scoped ModuleName
_ Ident
op Expr (Maybe VCObjectHash) a
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ident
op forall a. Semigroup a => a -> a -> a
<> String
" should be pinned"
  Op_ Expr (Maybe VCObjectHash) a
a (Just VCObjectHash
hash) Scoped ModuleName
_ns Ident
op Expr (Maybe VCObjectHash) a
b -> do
    Value c (ImplEnvM m c)
a' <- forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
a
    Value c (ImplEnvM m c)
b' <- forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
b
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VCObjectHash
hash Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv of
      Maybe (Value c (ImplEnvM m c))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ident
op forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VCObjectHash
hash forall a. Semigroup a => a -> a -> a
<> String
") not found in the pinned env"
      Just (VFun Value c (ImplEnvM m c) -> ImplEnvM m c (Value c (ImplEnvM m c))
f) ->
        Value c (ImplEnvM m c) -> ImplEnvM m c (Value c (ImplEnvM m c))
f Value c (ImplEnvM m c)
a' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          VFun Value c (ImplEnvM m c) -> ImplEnvM m c (Value c (ImplEnvM m c))
f' -> Value c (ImplEnvM m c) -> ImplEnvM m c (Value c (ImplEnvM m c))
f' Value c (ImplEnvM m c)
b'
          Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ident
op forall a. Semigroup a => a -> a -> a
<> String
" not bound to a binary function in env"
      Just Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ident
op forall a. Semigroup a => a -> a -> a
<> String
" not bound to a function in env"
  PreOp_ Maybe VCObjectHash
Nothing Scoped ModuleName
_ Ident
op Expr (Maybe VCObjectHash) a
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ident
op forall a. Semigroup a => a -> a -> a
<> String
" should be pinned"
  PreOp_ (Just VCObjectHash
hash) Scoped ModuleName
_ns Ident
op Expr (Maybe VCObjectHash) a
a -> do
    Value c (ImplEnvM m c)
a' <- forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
a
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VCObjectHash
hash Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv of
      Maybe (Value c (ImplEnvM m c))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ident
op forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VCObjectHash
hash forall a. Semigroup a => a -> a -> a
<> String
") not found in the pinned env"
      Just (VFun Value c (ImplEnvM m c) -> ImplEnvM m c (Value c (ImplEnvM m c))
f) -> Value c (ImplEnvM m c) -> ImplEnvM m c (Value c (ImplEnvM m c))
f Value c (ImplEnvM m c)
a'
      Just Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ident
op forall a. Semigroup a => a -> a -> a
<> String
" not bound to a function in env"
  Lam_ NonEmpty (a, Maybe ExtIdent)
args Expr (Maybe VCObjectHash) a
body -> Map ExtIdent (Value c (ImplEnvM m c))
-> [(a, Maybe ExtIdent)] -> ImplEnvM m c (Value c (ImplEnvM m c))
go Map ExtIdent (Value c (ImplEnvM m c))
localEnv forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty (a, Maybe ExtIdent)
args
    where
      go :: Map ExtIdent (Value c (ImplEnvM m c))
-> [(a, Maybe ExtIdent)] -> ImplEnvM m c (Value c (ImplEnvM m c))
go Map ExtIdent (Value c (ImplEnvM m c))
nenv = \case
        [] -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c))
nenv, Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv) Expr (Maybe VCObjectHash) a
body
        (a
_, Just ExtIdent
x) : [(a, Maybe ExtIdent)]
xs ->
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *).
(Value custom m -> m (Value custom m)) -> Value custom m
VFun forall a b. (a -> b) -> a -> b
$ \Value c (ImplEnvM m c)
arg -> Map ExtIdent (Value c (ImplEnvM m c))
-> [(a, Maybe ExtIdent)] -> ImplEnvM m c (Value c (ImplEnvM m c))
go (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ExtIdent
x Value c (ImplEnvM m c)
arg Map ExtIdent (Value c (ImplEnvM m c))
nenv) [(a, Maybe ExtIdent)]
xs
        (a
_, Maybe ExtIdent
Nothing) : [(a, Maybe ExtIdent)]
xs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *).
(Value custom m -> m (Value custom m)) -> Value custom m
VFun forall a b. (a -> b) -> a -> b
$ \Value c (ImplEnvM m c)
_arg -> Map ExtIdent (Value c (ImplEnvM m c))
-> [(a, Maybe ExtIdent)] -> ImplEnvM m c (Value c (ImplEnvM m c))
go Map ExtIdent (Value c (ImplEnvM m c))
nenv [(a, Maybe ExtIdent)]
xs
  App_ Expr (Maybe VCObjectHash) a
fun Expr (Maybe VCObjectHash) a
arg -> do
    forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
fun forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      VFun Value c (ImplEnvM m c) -> ImplEnvM m c (Value c (ImplEnvM m c))
f -> do
        Value c (ImplEnvM m c)
argv <- forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
arg
        Value c (ImplEnvM m c) -> ImplEnvM m c (Value c (ImplEnvM m c))
f Value c (ImplEnvM m c)
argv
      Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a function"
  Let_ (Expl ExtIdent
x) Expr (Maybe VCObjectHash) a
e Expr (Maybe VCObjectHash) a
body -> do
    Value c (ImplEnvM m c)
e' <- forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e
    let nenv :: Map ExtIdent (Value c (ImplEnvM m c))
nenv = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ExtIdent
x Value c (ImplEnvM m c)
e' Map ExtIdent (Value c (ImplEnvM m c))
localEnv
    forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c))
nenv, Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv) Expr (Maybe VCObjectHash) a
body
  Let_ (Impl ExtIdent
x) Expr (Maybe VCObjectHash) a
e Expr (Maybe VCObjectHash) a
body -> do
    Value c (ImplEnvM m c)
e' <- forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Map ExtIdent (Value c (ImplEnvM m c))
impEnv -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ExtIdent
x Value c (ImplEnvM m c)
e' Map ExtIdent (Value c (ImplEnvM m c))
impEnv) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
body
  If_ Expr (Maybe VCObjectHash) a
cond Expr (Maybe VCObjectHash) a
tr Expr (Maybe VCObjectHash) a
fl ->
    forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
cond forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      VEnum VCObjectHash
hash Ident
"true" ->
        if VCObjectHash
hash forall a. Eq a => a -> a -> Bool
== VCObjectHash
enumBoolHash
          then forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
tr
          else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a bool"
      VEnum VCObjectHash
hash Ident
"false" ->
        if VCObjectHash
hash forall a. Eq a => a -> a -> Bool
== VCObjectHash
enumBoolHash
          then forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
fl
          else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a bool"
      Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a bool"
  Tuple_ TList (Expr (Maybe VCObjectHash) a, Maybe a)
es ->
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (\(Expr (Maybe VCObjectHash) a
e, Maybe a
_) [Value c (ImplEnvM m c)]
vs -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: [Value c (ImplEnvM m c)]
vs)) [] (forall a. TList a -> [a]
tListToList TList (Expr (Maybe VCObjectHash) a, Maybe a)
es) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). [Value custom m] -> Value custom m
VTuple
  One_ Expr (Maybe VCObjectHash) a
e -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). Value custom m -> Value custom m
VOne
  Expr (Maybe VCObjectHash) a
Empty_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *). Value custom m
VEmpty
  Assert_ Expr (Maybe VCObjectHash) a
cond Expr (Maybe VCObjectHash) a
e ->
    forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
cond forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      VEnum VCObjectHash
hash Ident
"false" ->
        if VCObjectHash
hash forall a. Eq a => a -> a -> Bool
== VCObjectHash
enumBoolHash
          then forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EvalError
AssertionFailed
          else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a bool"
      VEnum VCObjectHash
hash Ident
"true" ->
        if VCObjectHash
hash forall a. Eq a => a -> a -> Bool
== VCObjectHash
enumBoolHash
          then forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e
          else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a bool"
      Value c (ImplEnvM m c)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError String
"failed to match with a bool"
  Case_ Expr (Maybe VCObjectHash) a
e NonEmpty
  (a, Pat (Maybe VCObjectHash) a, a, Expr (Maybe VCObjectHash) a)
pats -> do
    Value c (ImplEnvM m c)
v <- forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e
    Value c (ImplEnvM m c)
-> NonEmpty
     (a, Pat (Maybe VCObjectHash) a, a, Expr (Maybe VCObjectHash) a)
-> ImplEnvM m c (Value c (ImplEnvM m c))
matchAny Value c (ImplEnvM m c)
v NonEmpty
  (a, Pat (Maybe VCObjectHash) a, a, Expr (Maybe VCObjectHash) a)
pats
    where
      matchAny :: Value c (ImplEnvM m c)
-> NonEmpty
     (a, Pat (Maybe VCObjectHash) a, a, Expr (Maybe VCObjectHash) a)
-> ImplEnvM m c (Value c (ImplEnvM m c))
matchAny Value c (ImplEnvM m c)
v ((a
_, Pat (Maybe VCObjectHash) a
p, a
_, Expr (Maybe VCObjectHash) a
body) :| []) = case Value c (ImplEnvM m c)
-> Pat (Maybe VCObjectHash) a
-> Maybe
     (Map ExtIdent (Value c (ImplEnvM m c)),
      Map VCObjectHash (Value c (ImplEnvM m c)))
match Value c (ImplEnvM m c)
v Pat (Maybe VCObjectHash) a
p of
        Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
nenv -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
nenv Expr (Maybe VCObjectHash) a
body
        Maybe
  (Map ExtIdent (Value c (ImplEnvM m c)),
   Map VCObjectHash (Value c (ImplEnvM m c)))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ String
"non-exhaustive patterns in case detected in " forall a. Semigroup a => a -> a -> a
<> (Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Text
renderPretty Value c (ImplEnvM m c)
v)
      matchAny Value c (ImplEnvM m c)
v ((a
_, Pat (Maybe VCObjectHash) a
p, a
_, Expr (Maybe VCObjectHash) a
body) :| ((a, Pat (Maybe VCObjectHash) a, a, Expr (Maybe VCObjectHash) a)
r : [(a, Pat (Maybe VCObjectHash) a, a, Expr (Maybe VCObjectHash) a)]
rs)) = case Value c (ImplEnvM m c)
-> Pat (Maybe VCObjectHash) a
-> Maybe
     (Map ExtIdent (Value c (ImplEnvM m c)),
      Map VCObjectHash (Value c (ImplEnvM m c)))
match Value c (ImplEnvM m c)
v Pat (Maybe VCObjectHash) a
p of
        Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
nenv -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
nenv Expr (Maybe VCObjectHash) a
body
        Maybe
  (Map ExtIdent (Value c (ImplEnvM m c)),
   Map VCObjectHash (Value c (ImplEnvM m c)))
Nothing -> Value c (ImplEnvM m c)
-> NonEmpty
     (a, Pat (Maybe VCObjectHash) a, a, Expr (Maybe VCObjectHash) a)
-> ImplEnvM m c (Value c (ImplEnvM m c))
matchAny Value c (ImplEnvM m c)
v ((a, Pat (Maybe VCObjectHash) a, a, Expr (Maybe VCObjectHash) a)
r forall a. a -> [a] -> NonEmpty a
:| [(a, Pat (Maybe VCObjectHash) a, a, Expr (Maybe VCObjectHash) a)]
rs)

      match :: Value c (ImplEnvM m c)
-> Pat (Maybe VCObjectHash) a
-> Maybe
     (Map ExtIdent (Value c (ImplEnvM m c)),
      Map VCObjectHash (Value c (ImplEnvM m c)))
match Value c (ImplEnvM m c)
v Pat (Maybe VCObjectHash) a
p = case (Value c (ImplEnvM m c)
v, Pat (Maybe VCObjectHash) a
p) of
        (Value c (ImplEnvM m c)
_, PVar a
_ (Just (Ident Text
x))) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
x) Value c (ImplEnvM m c)
v Map ExtIdent (Value c (ImplEnvM m c))
localEnv, Map VCObjectHash (Value c (ImplEnvM m c))
pinnedEnv)
        (Value c (ImplEnvM m c)
_, PVar a
_ Maybe Ident
Nothing) -> forall a. a -> Maybe a
Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env
        (VEnum VCObjectHash
h1 Ident
_, PEnum a
_ (Just VCObjectHash
h2) Scoped ModuleName
_ Ident
_) ->
          if VCObjectHash
h1 forall a. Eq a => a -> a -> Bool
== VCObjectHash
h2
            then forall a. a -> Maybe a
Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env
            else forall a. Maybe a
Nothing
        (VInt Int64
i1, PLit a
_ (LInt Int64
i2)) ->
          if Int64
i1 forall a. Eq a => a -> a -> Bool
== Int64
i2
            then forall a. a -> Maybe a
Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env
            else forall a. Maybe a
Nothing
        (VDouble Double
d1, PLit a
_ (LDouble Double
d2)) ->
          if Double
d1 forall a. Eq a => a -> a -> Bool
== Double
d2
            then forall a. a -> Maybe a
Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env
            else forall a. Maybe a
Nothing
        (VText Text
t1, PLit a
_ (LText Text
t2)) ->
          if Text
t1 forall a. Eq a => a -> a -> Bool
== Text
t2
            then forall a. a -> Maybe a
Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env
            else forall a. Maybe a
Nothing
        (VWord64 Word64
h1, PLit a
_ (LHex Word64
h2)) ->
          if Word64
h1 forall a. Eq a => a -> a -> Bool
== Word64
h2
            then forall a. a -> Maybe a
Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env
            else forall a. Maybe a
Nothing
        (VOne Value c (ImplEnvM m c)
v', POne a
_ Pat (Maybe VCObjectHash) a
p') -> Value c (ImplEnvM m c)
-> Pat (Maybe VCObjectHash) a
-> Maybe
     (Map ExtIdent (Value c (ImplEnvM m c)),
      Map VCObjectHash (Value c (ImplEnvM m c)))
match Value c (ImplEnvM m c)
v' Pat (Maybe VCObjectHash) a
p'
        (Value c (ImplEnvM m c)
VEmpty, PEmpty a
_) -> forall a. a -> Maybe a
Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env
        (VTuple [Value c (ImplEnvM m c)]
vs, PTuple a
_ TList (Pat (Maybe VCObjectHash) a, Maybe a)
ps a
_) -> [Value c (ImplEnvM m c)]
-> [(Pat (Maybe VCObjectHash) a, Maybe a)]
-> Maybe
     (Map ExtIdent (Value c (ImplEnvM m c)),
      Map VCObjectHash (Value c (ImplEnvM m c)))
matchTuple [Value c (ImplEnvM m c)]
vs forall a b. (a -> b) -> a -> b
$ forall a. TList a -> [a]
tListToList TList (Pat (Maybe VCObjectHash) a, Maybe a)
ps
        (Value c (ImplEnvM m c), Pat (Maybe VCObjectHash) a)
_ -> forall a. Maybe a
Nothing

      matchTuple :: [Value c (ImplEnvM m c)]
-> [(Pat (Maybe VCObjectHash) a, Maybe a)]
-> Maybe
     (Map ExtIdent (Value c (ImplEnvM m c)),
      Map VCObjectHash (Value c (ImplEnvM m c)))
matchTuple [] [] = forall a. a -> Maybe a
Just (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env
      matchTuple (Value c (ImplEnvM m c)
v' : [Value c (ImplEnvM m c)]
vs) ((Pat (Maybe VCObjectHash) a
p', Maybe a
_) : [(Pat (Maybe VCObjectHash) a, Maybe a)]
ps) = do
        (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env1 <- Value c (ImplEnvM m c)
-> Pat (Maybe VCObjectHash) a
-> Maybe
     (Map ExtIdent (Value c (ImplEnvM m c)),
      Map VCObjectHash (Value c (ImplEnvM m c)))
match Value c (ImplEnvM m c)
v' Pat (Maybe VCObjectHash) a
p'
        (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env2 <- [Value c (ImplEnvM m c)]
-> [(Pat (Maybe VCObjectHash) a, Maybe a)]
-> Maybe
     (Map ExtIdent (Value c (ImplEnvM m c)),
      Map VCObjectHash (Value c (ImplEnvM m c)))
matchTuple [Value c (ImplEnvM m c)]
vs [(Pat (Maybe VCObjectHash) a, Maybe a)]
ps
        -- since variables in patterns must be linear,
        -- env1 and env2 should not overlap
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env1 forall a. Semigroup a => a -> a -> a
<> (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env2
      matchTuple [Value c (ImplEnvM m c)]
_ [(Pat (Maybe VCObjectHash) a, Maybe a)]
_ = forall a. Maybe a
Nothing
  CommentAbove Comment a
_ Expr (Maybe VCObjectHash) a
e -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e
  CommentAfter Expr (Maybe VCObjectHash) a
e Comment a
_ -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e
  CommentBelow Expr (Maybe VCObjectHash) a
e Comment a
_ -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e
  Bracketed_ Expr (Maybe VCObjectHash) a
e -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e
  RenameModule_ ModuleName
_ ModuleName
_ Expr (Maybe VCObjectHash) a
e -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e
  OpenModule_ ModuleName
_ [(Import a, Maybe a)]
_ Expr (Maybe VCObjectHash) a
e -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval (Map ExtIdent (Value c (ImplEnvM m c)),
 Map VCObjectHash (Value c (ImplEnvM m c)))
env Expr (Maybe VCObjectHash) a
e

runEvalIO ::
  (MonadCatch m, Pretty c) =>
  ImplEnvM (ExceptT EvalError m) c (TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError m) c)) ->
  Map.Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError m) c)) ->
  Expr (Maybe VCObjectHash) a ->
  m (Either EvalError (Value c (ImplEnvM (ExceptT EvalError m) c)))
runEvalIO :: forall (m :: * -> *) c a.
(MonadCatch m, Pretty c) =>
ImplEnvM
  (ExceptT EvalError m)
  c
  (TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError m) c))
-> Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError m) c))
-> Expr (Maybe VCObjectHash) a
-> m (Either
        EvalError (Value c (ImplEnvM (ExceptT EvalError m) c)))
runEvalIO ImplEnvM
  (ExceptT EvalError m)
  c
  (TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError m) c))
env Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError m) c))
implicitEnv Expr (Maybe VCObjectHash) a
ex = do
  Either
  SomeException
  (Either EvalError (Value c (ImplEnvM (ExceptT EvalError m) c)))
input <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *) a.
Map ExtIdent (Value c (ImplEnvM m c)) -> ImplEnvM m c a -> m a
runImplEnvM Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError m) c))
implicitEnv forall a b. (a -> b) -> a -> b
$ (ImplEnvM
  (ExceptT EvalError m)
  c
  (TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError m) c))
env forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError m) c)
env' -> forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError m) c)
env' Expr (Maybe VCObjectHash) a
ex)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either
  SomeException
  (Either EvalError (Value c (ImplEnvM (ExceptT EvalError m) c)))
input of
    Left (SomeException
e :: SomeException) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> EvalError
RuntimeError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show SomeException
e
    Right Either EvalError (Value c (ImplEnvM (ExceptT EvalError m) c))
res -> Either EvalError (Value c (ImplEnvM (ExceptT EvalError m) c))
res

pureEval ::
  (Pretty c) =>
  TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError Identity) c) ->
  Map.Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError Identity) c)) ->
  Expr (Maybe VCObjectHash) a ->
  Either EvalError (Value c (ImplEnvM (ExceptT EvalError Identity) c))
pureEval :: forall c a.
Pretty c =>
TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError Identity) c)
-> Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError Identity) c))
-> Expr (Maybe VCObjectHash) a
-> Either
     EvalError (Value c (ImplEnvM (ExceptT EvalError Identity) c))
pureEval TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError Identity) c)
env Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError Identity) c))
implicitEnv Expr (Maybe VCObjectHash) a
ex = forall e a. Except e a -> Either e a
runExcept forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *) a.
Map ExtIdent (Value c (ImplEnvM m c)) -> ImplEnvM m c a -> m a
runImplEnvM Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError Identity) c))
implicitEnv forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) c a.
(MonadError EvalError m, MonadError EvalError (ImplEnvM m c),
 Pretty c) =>
TermEnv VCObjectHash c (ImplEnvM m c)
-> Expr (Maybe VCObjectHash) a
-> ImplEnvM m c (Value c (ImplEnvM m c))
eval TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError Identity) c)
env Expr (Maybe VCObjectHash) a
ex