{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ViewPatterns        #-}

module Dovetail.Core.Data.Array where

import Data.Foldable (fold)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.Text (Text)
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Vector.Mutable qualified as Mutable
import Dovetail
import Dovetail.Evaluate (builtIn)
import Language.PureScript qualified as P

env :: forall ctx. Env ctx
env :: Env ctx
env = do
  let _ModuleName :: ModuleName
_ModuleName = Text -> ModuleName
P.ModuleName Text
"Data.Array"

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- fromFoldableImpl
      --   :: forall f a
      --    . (forall b. (a -> b -> b) -> b -> f a -> b)
      --   -> f a
      --   -> Array a
      ModuleName
-> Text
-> (((Value ctx
      -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
     -> Vector (Value ctx)
     -> Value ctx
     -> Eval ctx (Vector (Value ctx)))
    -> Value ctx -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(((Value ctx -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx))) -> Vector (Value ctx) -> Value ctx -> Eval ctx (Vector (Value ctx))) -> Value ctx -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"fromFoldableImpl"
        \(Value ctx -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
-> Vector (Value ctx) -> Value ctx -> Eval ctx (Vector (Value ctx))
_foldr Value ctx
xs ->
          (Value ctx -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
-> Vector (Value ctx) -> Value ctx -> Eval ctx (Vector (Value ctx))
_foldr (\Value ctx
y Vector (Value ctx)
ys -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value ctx -> Vector (Value ctx) -> Vector (Value ctx)
forall a. a -> Vector a -> Vector a
Vector.cons Value ctx
y Vector (Value ctx)
ys)) Vector (Value ctx)
forall a. Vector a
Vector.empty Value ctx
xs
      -- range :: Int -> Int -> Array Int
    , ModuleName
-> Text
-> (Integer -> Integer -> Eval ctx (Vector Integer))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx (Vector Integer))
        ModuleName
_ModuleName Text
"range"
        \Integer
from Integer
to -> 
          Vector Integer -> Eval ctx (Vector Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Integer] -> Vector Integer
forall a. [a] -> Vector a
Vector.fromList [Integer
from..Integer
to])
      -- replicate :: forall a. Int -> a -> Array a
    , ModuleName
-> Text
-> (Integer -> Value ctx -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Value ctx -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"replicate"
        \Integer
n Value ctx
a ->
          Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Value ctx -> Vector (Value ctx)
forall a. Int -> a -> Vector a
Vector.replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) Value ctx
a)
      -- length :: forall a. Array a -> Int
    , ModuleName
-> Text -> (Vector (Value ctx) -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector (Value ctx) -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"length"
        \Vector (Value ctx)
v ->
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (Value ctx) -> Int
forall a. Vector a -> Int
Vector.length Vector (Value ctx)
v))
      -- unconsImpl :: forall a b
      --    . (Unit -> b)
      --   -> (a -> Array a -> b)
      --   -> Array a
      --   -> b
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx (Value ctx))
    -> (Value ctx -> Vector (Value ctx) -> Eval ctx (Value ctx))
    -> Vector (Value ctx)
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx (Value ctx)) -> (Value ctx -> Vector (Value ctx) -> Eval ctx (Value ctx)) -> Vector (Value ctx) -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"unconsImpl"
        \Value ctx -> Eval ctx (Value ctx)
_nothing Value ctx -> Vector (Value ctx) -> Eval ctx (Value ctx)
_just Vector (Value ctx)
xs ->
          case Vector (Value ctx)
xs Vector (Value ctx) -> Int -> Maybe (Value ctx)
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
0 of
            Maybe (Value ctx)
Nothing -> Value ctx -> Eval ctx (Value ctx)
_nothing (HashMap Text (Value ctx) -> Value ctx
forall ctx. HashMap Text (Value ctx) -> Value ctx
Object HashMap Text (Value ctx)
forall a. Monoid a => a
mempty)
            Just Value ctx
hd -> Value ctx -> Vector (Value ctx) -> Eval ctx (Value ctx)
_just Value ctx
hd (Vector (Value ctx) -> Vector (Value ctx)
forall a. Vector a -> Vector a
Vector.tail Vector (Value ctx)
xs)
      -- indexImpl :: forall a
      --    . (forall r. r -> Maybe r)
      --   -> (forall r. Maybe r)
      --   -> Array a
      --   -> Int
      --   -> Maybe a
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx (Value ctx))
    -> Value ctx
    -> Vector (Value ctx)
    -> Integer
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx (Value ctx)) -> Value ctx -> Vector (Value ctx) -> Integer -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"indexImpl"
        \Value ctx -> Eval ctx (Value ctx)
_just Value ctx
_nothing Vector (Value ctx)
xs Integer
i ->
          case Vector (Value ctx)
xs Vector (Value ctx) -> Int -> Maybe (Value ctx)
forall a. Vector a -> Int -> Maybe a
Vector.!? Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i of
            Maybe (Value ctx)
Nothing -> Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing
            Just Value ctx
x -> Value ctx -> Eval ctx (Value ctx)
_just Value ctx
x
      -- findMapImpl :: forall a b
      --    . (forall c. Maybe c)
      --   -> (forall c. Maybe c -> Boolean)
      --   -> (a -> Maybe b)
      --   -> Array a
      --   -> Maybe b
    , ModuleName
-> Text
-> (Value ctx
    -> (Value ctx -> Eval ctx Bool)
    -> (Value ctx -> Eval ctx (Value ctx))
    -> Vector (Value ctx)
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Value ctx -> (Value ctx -> Eval ctx Bool) -> (Value ctx -> Eval ctx (Value ctx)) -> Vector (Value ctx) -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"findMapImpl"
        \Value ctx
_nothing Value ctx -> Eval ctx Bool
_isJust Value ctx -> Eval ctx (Value ctx)
_f Vector (Value ctx)
_xs ->
          EvaluationErrorType ctx -> Eval ctx (Value ctx)
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"findMapImpl is not implemented")
      -- findIndexImpl :: forall a
      --    . (forall b. b -> Maybe b)
      --   -> (forall b. Maybe b)
      --   -> (a -> Boolean)
      --   -> Array a
      --   -> Maybe Int
    , ModuleName
-> Text
-> ((Integer -> Eval ctx (Value ctx))
    -> Value ctx
    -> (Value ctx -> Eval ctx Bool)
    -> Vector (Value ctx)
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Integer -> Eval ctx (Value ctx)) -> Value ctx -> (Value ctx -> Eval ctx Bool) -> Vector (Value ctx) -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"findIndexImpl"
        \Integer -> Eval ctx (Value ctx)
_just Value ctx
_nothing Value ctx -> Eval ctx Bool
_p Vector (Value ctx)
_xs ->
          EvaluationErrorType ctx -> Eval ctx (Value ctx)
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"findIndexImpl is not implemented")
      -- findLastIndexImpl :: forall a
      --    . (forall b. b -> Maybe b)
      --   -> (forall b. Maybe b)
      --   -> (a -> Boolean)
      --   -> Array a
      --   -> Maybe Int
    , ModuleName
-> Text
-> ((Integer -> Eval ctx (Value ctx))
    -> Value ctx
    -> (Value ctx -> Eval ctx Bool)
    -> Vector (Value ctx)
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Integer -> Eval ctx (Value ctx)) -> Value ctx -> (Value ctx -> Eval ctx Bool) -> Vector (Value ctx) -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"findLastIndexImpl"
        \Integer -> Eval ctx (Value ctx)
_just Value ctx
_nothing Value ctx -> Eval ctx Bool
_p Vector (Value ctx)
_xs ->
          EvaluationErrorType ctx -> Eval ctx (Value ctx)
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"findLastIndexImpl is not implemented")
      -- _insertAt :: forall a
      --    . (forall b. b -> Maybe b)
      --   -> (forall b. Maybe b)
      --   -> Int
      --   -> a
      --   -> Array a
      --   -> Maybe (Array a)
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx (Value ctx))
    -> Value ctx
    -> Integer
    -> Value ctx
    -> Vector (Value ctx)
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx (Value ctx)) -> Value ctx -> Integer -> Value ctx -> Vector (Value ctx) -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"_insertAt"
        \Value ctx -> Eval ctx (Value ctx)
_just Value ctx
_nothing Integer
_i Value ctx
_x Vector (Value ctx)
_xs ->
          EvaluationErrorType ctx -> Eval ctx (Value ctx)
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"_insertAt is not implemented")
      -- _deleteAt :: forall a
      --    . (forall b. b -> Maybe b)
      --   -> (forall b. Maybe b)
      --   -> Int
      --   -> Array a
      --   -> Maybe (Array a)
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx (Value ctx))
    -> Value ctx
    -> Integer
    -> Vector (Value ctx)
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx (Value ctx)) -> Value ctx -> Integer -> Vector (Value ctx) -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"_deleteAt"
        \Value ctx -> Eval ctx (Value ctx)
_just Value ctx
_nothing Integer
_i Vector (Value ctx)
_xs ->
          EvaluationErrorType ctx -> Eval ctx (Value ctx)
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"_deleteAt is not implemented")
      -- _updateAt :: forall a
      --    . (forall b. b -> Maybe b)
      --   -> (forall b. Maybe b)
      --   -> Int
      --   -> a
      --   -> Array a
      --   -> Maybe (Array a)
    , ModuleName
-> Text
-> ((Vector (Value ctx) -> Eval ctx (Value ctx))
    -> Value ctx
    -> Integer
    -> Value ctx
    -> Vector (Value ctx)
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Vector (Value ctx) -> Eval ctx (Value ctx)) -> Value ctx -> Integer -> Value ctx -> Vector (Value ctx) -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"_updateAt"
        \Vector (Value ctx) -> Eval ctx (Value ctx)
_just Value ctx
_nothing Integer
i Value ctx
x Vector (Value ctx)
xs ->
          if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector (Value ctx) -> Int
forall a. Vector a -> Int
Vector.length Vector (Value ctx)
xs 
            then Vector (Value ctx) -> Eval ctx (Value ctx)
_just (Vector (Value ctx) -> Eval ctx (Value ctx))
-> Vector (Value ctx) -> Eval ctx (Value ctx)
forall a b. (a -> b) -> a -> b
$ (forall s. MVector s (Value ctx) -> ST s ())
-> Vector (Value ctx) -> Vector (Value ctx)
forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
Vector.modify (\MVector s (Value ctx)
mut -> MVector (PrimState (ST s)) (Value ctx)
-> Int -> Value ctx -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
Mutable.write MVector s (Value ctx)
MVector (PrimState (ST s)) (Value ctx)
mut (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Value ctx
x) Vector (Value ctx)
xs
            else Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing
      -- reverse :: forall a. Array a -> Array a
    , ModuleName
-> Text
-> (Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"reverse"
        \Vector (Value ctx)
xs ->
          Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector (Value ctx) -> Vector (Value ctx)
forall a. Vector a -> Vector a
Vector.reverse Vector (Value ctx)
xs)
      -- concat :: forall a. Array (Array a) -> Array a
    , ModuleName
-> Text
-> (Vector (Vector (Value ctx)) -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector (Vector (Value ctx)) -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"concat"
        \Vector (Vector (Value ctx))
xss ->
          Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Vector (Value ctx)] -> Vector (Value ctx)
forall a. [Vector a] -> Vector a
Vector.concat (Vector (Vector (Value ctx)) -> [Vector (Value ctx)]
forall a. Vector a -> [a]
Vector.toList Vector (Vector (Value ctx))
xss))
      -- filter :: forall a. (a -> Boolean) -> Array a -> Array a
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx Bool)
    -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx Bool) -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"filter"
        \Value ctx -> Eval ctx Bool
p Vector (Value ctx)
xs ->
          (Value ctx -> Eval ctx Bool)
-> Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
Vector.filterM Value ctx -> Eval ctx Bool
p Vector (Value ctx)
xs
      -- partition :: forall a
      --    . (a -> Boolean)
      --   -> Array a
      --   -> { yes :: Array a, no :: Array a }
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx Bool)
    -> Vector (Value ctx)
    -> Eval ctx (HashMap Text (Vector (Value ctx))))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx Bool) -> Vector (Value ctx) -> Eval ctx (HashMap Text (Vector (Value ctx))))
        ModuleName
_ModuleName Text
"partition"
        \Value ctx -> Eval ctx Bool
p Vector (Value ctx)
xs ->
          let mkV :: v -> v -> HashMap k v
mkV v
yes v
no = [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(k
"yes", v
yes), (k
"no", v
no)]
           in Vector (Value ctx)
-> Vector (Value ctx) -> HashMap Text (Vector (Value ctx))
forall k v. (Eq k, Hashable k, IsString k) => v -> v -> HashMap k v
mkV (Vector (Value ctx)
 -> Vector (Value ctx) -> HashMap Text (Vector (Value ctx)))
-> Eval ctx (Vector (Value ctx))
-> Eval
     ctx (Vector (Value ctx) -> HashMap Text (Vector (Value ctx)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value ctx -> Eval ctx Bool)
-> Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
Vector.filterM Value ctx -> Eval ctx Bool
p Vector (Value ctx)
xs Eval ctx (Vector (Value ctx) -> HashMap Text (Vector (Value ctx)))
-> Eval ctx (Vector (Value ctx))
-> Eval ctx (HashMap Text (Vector (Value ctx)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value ctx -> Eval ctx Bool)
-> Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
Vector.filterM ((Bool -> Bool) -> Eval ctx Bool -> Eval ctx Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Eval ctx Bool -> Eval ctx Bool)
-> (Value ctx -> Eval ctx Bool) -> Value ctx -> Eval ctx Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value ctx -> Eval ctx Bool
p) Vector (Value ctx)
xs
      -- scanl :: forall a b. (b -> a -> b) -> b -> Array a -> Array b
    , ModuleName
-> Text
-> ((Value ctx -> Value ctx -> Eval ctx (Value ctx))
    -> Value ctx
    -> Vector (Value ctx)
    -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Value ctx -> Eval ctx (Value ctx)) -> Value ctx -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"scanl"
        \Value ctx -> Value ctx -> Eval ctx (Value ctx)
_f Value ctx
_b Vector (Value ctx)
_xs ->
          EvaluationErrorType ctx -> Eval ctx (Vector (Value ctx))
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"scanl is not implemented")
      -- scanr :: forall a b. (a -> b -> b) -> b -> Array a -> Array b
    , ModuleName
-> Text
-> ((Value ctx -> Value ctx -> Eval ctx (Value ctx))
    -> Value ctx
    -> Vector (Value ctx)
    -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Value ctx -> Eval ctx (Value ctx)) -> Value ctx -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"scanr"
        \Value ctx -> Value ctx -> Eval ctx (Value ctx)
_f Value ctx
_b Vector (Value ctx)
_xs ->
          EvaluationErrorType ctx -> Eval ctx (Vector (Value ctx))
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"scanr is not implemented")
      -- sortByImpl :: forall a. (a -> a -> Ordering) -> (Ordering -> Int) -> Array a -> Array a
    , ModuleName
-> Text
-> ((Value ctx -> Value ctx -> Eval ctx (Value ctx))
    -> (Value ctx -> Eval ctx Integer)
    -> Vector (Value ctx)
    -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Value ctx -> Eval ctx (Value ctx)) -> (Value ctx -> Eval ctx Integer) -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"sortByImpl"
        \Value ctx -> Value ctx -> Eval ctx (Value ctx)
_f Value ctx -> Eval ctx Integer
_g Vector (Value ctx)
_xs ->
          EvaluationErrorType ctx -> Eval ctx (Vector (Value ctx))
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"sortByImpl is not implemented")
      -- slice :: forall a. Int -> Int -> Array a -> Array a
    , ModuleName
-> Text
-> (Integer
    -> Integer -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"slice"
        \Integer
startAt Integer
len Vector (Value ctx)
xs ->
          Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Vector (Value ctx) -> Vector (Value ctx)
forall a. Int -> Int -> Vector a -> Vector a
Vector.slice (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
startAt) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
len) Vector (Value ctx)
xs)
      -- zipWith :: forall a b c
      --    . (a -> b -> c)
      --   -> Array a
      --   -> Array b
      --   -> Array c
    , ModuleName
-> Text
-> ((Value ctx -> Value ctx -> Eval ctx (Value ctx))
    -> Vector (Value ctx)
    -> Vector (Value ctx)
    -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Value ctx -> Eval ctx (Value ctx)) -> Vector (Value ctx) -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"zipWith"
        \Value ctx -> Value ctx -> Eval ctx (Value ctx)
f Vector (Value ctx)
xs Vector (Value ctx)
ys ->
          (Value ctx -> Value ctx -> Eval ctx (Value ctx))
-> Vector (Value ctx)
-> Vector (Value ctx)
-> Eval ctx (Vector (Value ctx))
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)
Vector.zipWithM Value ctx -> Value ctx -> Eval ctx (Value ctx)
f Vector (Value ctx)
xs Vector (Value ctx)
ys
      -- any :: forall a. (a -> Boolean) -> Array a -> Boolean
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx Bool)
    -> Vector (Value ctx) -> Eval ctx Bool)
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx Bool) -> Vector (Value ctx) -> Eval ctx Bool)
        ModuleName
_ModuleName Text
"any"
        \Value ctx -> Eval ctx Bool
f Vector (Value ctx)
xs ->
          Vector Bool -> Bool
Vector.or (Vector Bool -> Bool) -> Eval ctx (Vector Bool) -> Eval ctx Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value ctx -> Eval ctx Bool)
-> Vector (Value ctx) -> Eval ctx (Vector Bool)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value ctx -> Eval ctx Bool
f Vector (Value ctx)
xs
      -- all :: forall a. (a -> Boolean) -> Array a -> Boolean
      , ModuleName
-> Text
-> ((Value ctx -> Eval ctx Bool)
    -> Vector (Value ctx) -> Eval ctx Bool)
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx Bool) -> Vector (Value ctx) -> Eval ctx Bool)
        ModuleName
_ModuleName Text
"all"
        \Value ctx -> Eval ctx Bool
f Vector (Value ctx)
xs ->
          Vector Bool -> Bool
Vector.and (Vector Bool -> Bool) -> Eval ctx (Vector Bool) -> Eval ctx Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value ctx -> Eval ctx Bool)
-> Vector (Value ctx) -> Eval ctx (Vector Bool)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value ctx -> Eval ctx Bool
f Vector (Value ctx)
xs
      -- unsafeIndexImpl :: forall a. Array a -> Int -> a
    , ModuleName
-> Text
-> (Vector (Value ctx) -> Integer -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector (Value ctx) -> Integer -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"unsafeIndexImpl"
        \Vector (Value ctx)
xs Integer
i ->
          case Vector (Value ctx)
xs Vector (Value ctx) -> Int -> Maybe (Value ctx)
forall a. Vector a -> Int -> Maybe a
Vector.!? Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i of
            Maybe (Value ctx)
Nothing -> EvaluationErrorType ctx -> Eval ctx (Value ctx)
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"unsafeIndexImpl: index out of range")
            Just Value ctx
a -> Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
a
    ]