{-# LANGUAGE LambdaCase    #-}
{-# LANGUAGE MultiWayIf    #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns  #-}

{- |
Module      : Language.Egison.Core
Licence     : MIT

This module provides functions to evaluate various objects.
-}

module Language.Egison.Core
    (
    -- * Evaluation
      evalExprShallow
    , evalExprDeep
    , evalWHNF
    -- * Environment
    , recursiveBind
    -- * Pattern matching
    , patternMatch
    ) where

import           Prelude                         hiding (mapM, mappend, mconcat)

import           Control.Arrow
import           Control.Monad                   (forM_, when, zipWithM, (>=>))
import           Control.Monad.Except            (throwError)
import           Control.Monad.State
import           Control.Monad.Trans.Maybe

import           Data.Char                       (isUpper)
import           Data.Foldable                   (toList)
import           Data.IORef
import           Data.List                       (partition)
import           Data.Maybe
import qualified Data.Sequence                   as Sq
import           Data.Traversable                (mapM)

import qualified Data.HashMap.Lazy               as HL
import qualified Data.Vector                     as V

import           Language.Egison.Data
import           Language.Egison.Data.Collection
import           Language.Egison.Data.Utils
import           Language.Egison.EvalState       (MonadEval (..), mLabelFuncName)
import           Language.Egison.IExpr
import           Language.Egison.MList
import           Language.Egison.Match
import           Language.Egison.Math
import           Language.Egison.RState
import           Language.Egison.Tensor

evalConstant :: ConstantExpr -> EgisonValue
evalConstant :: ConstantExpr -> EgisonValue
evalConstant (CharExpr Char
c)    = Char -> EgisonValue
Char Char
c
evalConstant (StringExpr Text
s)  = Text -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison Text
s
evalConstant (BoolExpr Bool
b)    = Bool -> EgisonValue
Bool Bool
b
evalConstant (IntegerExpr Integer
x) = Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison Integer
x
evalConstant (FloatExpr Double
x)   = Double -> EgisonValue
Float Double
x
evalConstant ConstantExpr
SomethingExpr   = EgisonValue
Something
evalConstant ConstantExpr
UndefinedExpr   = EgisonValue
Undefined

evalExprShallow :: Env -> IExpr -> EvalM WHNFData
evalExprShallow :: Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
_ (IConstantExpr ConstantExpr
c) = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (ConstantExpr -> EgisonValue
evalConstant ConstantExpr
c)

evalExprShallow Env
env (IQuoteExpr IExpr
expr) = do
  WHNFData
whnf <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
  case WHNFData
whnf of
    Value (ScalarData ScalarData
s) -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (ScalarData -> WHNFData) -> ScalarData -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> (ScalarData -> EgisonValue) -> ScalarData -> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarData -> EgisonValue
ScalarData (ScalarData -> EvalM WHNFData) -> ScalarData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Integer -> Monomial -> ScalarData
SingleTerm Integer
1 [(ScalarData -> SymbolExpr
Quote ScalarData
s, Integer
1)]
    WHNFData
_                    -> (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"scalar in quote" WHNFData
whnf)

evalExprShallow Env
env (IQuoteSymbolExpr IExpr
expr) = do
  WHNFData
whnf <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
  case WHNFData
whnf of
    Value (Func (Just (Var String
name [])) Env
_ CallStack
_ IExpr
_) -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ String -> String -> EgisonValue
symbolScalarData String
"" String
name
    Value (ScalarData ScalarData
_)                    -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
whnf
    WHNFData
_                                       -> (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"value in quote-function" WHNFData
whnf)

evalExprShallow Env
env (IVarExpr String
name) =
  case Env -> Var -> Maybe ObjectRef
refVar Env
env (String -> [Index (Maybe Var)] -> Var
Var String
name []) of
    Maybe ObjectRef
Nothing | Char -> Bool
isUpper (String -> Char
forall a. HasCallStack => [a] -> a
head String
name) ->
      WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (String -> [EgisonValue] -> EgisonValue
InductiveData String
name [])
    Maybe ObjectRef
Nothing  -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (String -> String -> EgisonValue
symbolScalarData String
"" String
name)
    Just ObjectRef
ref -> ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref

evalExprShallow Env
_ (ITupleExpr []) = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ [EgisonValue] -> EgisonValue
Tuple []
evalExprShallow Env
env (ITupleExpr [IExpr
expr]) = Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
evalExprShallow Env
env (ITupleExpr [IExpr]
exprs) = [ObjectRef] -> WHNFData
ITuple ([ObjectRef] -> WHNFData)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
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 (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env) [IExpr]
exprs

evalExprShallow Env
_ (ICollectionExpr []) = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Seq EgisonValue -> EgisonValue
Collection Seq EgisonValue
forall a. Seq a
Sq.empty

evalExprShallow Env
env (ICollectionExpr [IExpr]
inners) = do
  [Inner]
inners' <- (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) Inner)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Inner]
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 ((ObjectRef -> Inner
IElement <$>) (StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Inner)
-> (IExpr
    -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) Inner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env) [IExpr]
inners
  IORef (Seq Inner)
innersSeq <- IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Seq Inner))
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner)))
-> IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a b. (a -> b) -> a -> b
$ Seq Inner -> IO (IORef (Seq Inner))
forall a. a -> IO (IORef a)
newIORef (Seq Inner -> IO (IORef (Seq Inner)))
-> Seq Inner -> IO (IORef (Seq Inner))
forall a b. (a -> b) -> a -> b
$ [Inner] -> Seq Inner
forall a. [a] -> Seq a
Sq.fromList [Inner]
inners'
  WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ IORef (Seq Inner) -> WHNFData
ICollection IORef (Seq Inner)
innersSeq

evalExprShallow Env
env (IConsExpr IExpr
x IExpr
xs) = do
  ObjectRef
x' <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env IExpr
x
  ObjectRef
xs' <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env IExpr
xs
  IORef (Seq Inner)
innersSeq <- IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Seq Inner))
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner)))
-> IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a b. (a -> b) -> a -> b
$ Seq Inner -> IO (IORef (Seq Inner))
forall a. a -> IO (IORef a)
newIORef (Seq Inner -> IO (IORef (Seq Inner)))
-> Seq Inner -> IO (IORef (Seq Inner))
forall a b. (a -> b) -> a -> b
$ [Inner] -> Seq Inner
forall a. [a] -> Seq a
Sq.fromList [ObjectRef -> Inner
IElement ObjectRef
x', ObjectRef -> Inner
ISubCollection ObjectRef
xs']
  WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ IORef (Seq Inner) -> WHNFData
ICollection IORef (Seq Inner)
innersSeq

evalExprShallow Env
env (IJoinExpr IExpr
xs IExpr
ys) = do
  ObjectRef
xs' <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env IExpr
xs
  ObjectRef
ys' <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env IExpr
ys
  IORef (Seq Inner)
innersSeq <- IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Seq Inner))
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner)))
-> IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a b. (a -> b) -> a -> b
$ Seq Inner -> IO (IORef (Seq Inner))
forall a. a -> IO (IORef a)
newIORef (Seq Inner -> IO (IORef (Seq Inner)))
-> Seq Inner -> IO (IORef (Seq Inner))
forall a b. (a -> b) -> a -> b
$ [Inner] -> Seq Inner
forall a. [a] -> Seq a
Sq.fromList [ObjectRef -> Inner
ISubCollection ObjectRef
xs', ObjectRef -> Inner
ISubCollection ObjectRef
ys']
  WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ IORef (Seq Inner) -> WHNFData
ICollection IORef (Seq Inner)
innersSeq

evalExprShallow Env
env (IVectorExpr [IExpr]
exprs) = do
  let n :: Integer
n = Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([IExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IExpr]
exprs)
  [WHNFData]
whnfs <- (IExpr -> EvalM WHNFData)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 (Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env) [IExpr]
exprs
  case [WHNFData]
whnfs of
    ITensor Tensor{}:[WHNFData]
_ ->
      (WHNFData
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef))
-> [WHNFData]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Tensor ObjectRef]
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 WHNFData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
f [WHNFData]
whnfs StateT EvalState (ExceptT EgisonError RuntimeM) [Tensor ObjectRef]
-> ([Tensor ObjectRef]
    -> StateT
         EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Tensor ObjectRef]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a. [Tensor a] -> EvalM (Tensor a)
tConcat' StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    [WHNFData]
_ -> [Integer] -> [WHNFData] -> EvalM WHNFData
makeITensorFromWHNF [Integer
n] [WHNFData]
whnfs
  where
    f :: WHNFData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
f (ITensor (Tensor [Integer]
ns Vector ObjectRef
xs [Index EgisonValue]
indices)) = do
      Vector WHNFData
xs' <- (ObjectRef -> EvalM WHNFData)
-> Vector ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Vector WHNFData)
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) -> Vector a -> m (Vector b)
mapM ObjectRef -> EvalM WHNFData
evalRef Vector ObjectRef
xs
      Vector ObjectRef
xs'' <- (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Vector WHNFData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Vector ObjectRef)
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) -> Vector a -> m (Vector b)
mapM WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef Vector WHNFData
xs'
      Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tensor ObjectRef
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef))
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> b) -> a -> b
$ [Integer]
-> Vector ObjectRef -> [Index EgisonValue] -> Tensor ObjectRef
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
ns Vector ObjectRef
xs'' [Index EgisonValue]
indices
    f WHNFData
x = ObjectRef -> Tensor ObjectRef
forall a. a -> Tensor a
Scalar (ObjectRef -> Tensor ObjectRef)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
x

evalExprShallow Env
env (ITensorExpr IExpr
nsExpr IExpr
xsExpr) = do
  WHNFData
nsWhnf <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
nsExpr
  [Integer]
ns <- (WHNFData
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
collectionToRefs WHNFData
nsWhnf EvalM
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall (m :: * -> *) a. Monad m => MList m a -> m [a]
fromMList StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> ([ObjectRef]
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
-> ([EgisonValue]
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [Integer])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Integer]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Integer]
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 EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison) :: EvalM [Integer]
  WHNFData
xsWhnf <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
xsExpr
  [WHNFData]
xs <- WHNFData
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
collectionToRefs WHNFData
xsWhnf EvalM
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall (m :: * -> *) a. Monad m => MList m a -> m [a]
fromMList StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> ([ObjectRef]
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ObjectRef -> EvalM WHNFData)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 ObjectRef -> EvalM WHNFData
evalRef
  if [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Integer]
ns Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([WHNFData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WHNFData]
xs)
    then [Integer] -> [WHNFData] -> EvalM WHNFData
makeITensorFromWHNF [Integer]
ns [WHNFData]
xs
    else (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace CallStack -> EgisonError
InconsistentTensorShape

evalExprShallow Env
env (IHashExpr [(IExpr, IExpr)]
assocs) = do
  let ([IExpr]
keyExprs, [IExpr]
exprs) = [(IExpr, IExpr)] -> ([IExpr], [IExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(IExpr, IExpr)]
assocs
  [WHNFData]
keyWhnfs <- (IExpr -> EvalM WHNFData)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 (Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env) [IExpr]
keyExprs
  [EgisonHashKey]
keys <- (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonHashKey)
-> [WHNFData]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonHashKey]
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 WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonHashKey
makeHashKey [WHNFData]
keyWhnfs
  [ObjectRef]
refs <- (IExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
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 (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env) [IExpr]
exprs
  case [EgisonHashKey]
keys of
    CharKey Char
_ : [EgisonHashKey]
_ -> do
      let keys' :: String
keys' = (EgisonHashKey -> Char) -> [EgisonHashKey] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\case CharKey Char
c -> Char
c) [EgisonHashKey]
keys
      WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (HashMap Char ObjectRef -> WHNFData)
-> HashMap Char ObjectRef
-> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Char ObjectRef -> WHNFData
ICharHash (HashMap Char ObjectRef -> EvalM WHNFData)
-> HashMap Char ObjectRef -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ [(Char, ObjectRef)] -> HashMap Char ObjectRef
forall k v. Hashable k => [(k, v)] -> HashMap k v
HL.fromList ([(Char, ObjectRef)] -> HashMap Char ObjectRef)
-> [(Char, ObjectRef)] -> HashMap Char ObjectRef
forall a b. (a -> b) -> a -> b
$ String -> [ObjectRef] -> [(Char, ObjectRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
keys' [ObjectRef]
refs
    StrKey Text
_ : [EgisonHashKey]
_ -> do
      let keys' :: [Text]
keys' = (EgisonHashKey -> Text) -> [EgisonHashKey] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\case StrKey Text
s -> Text
s) [EgisonHashKey]
keys
      WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (HashMap Text ObjectRef -> WHNFData)
-> HashMap Text ObjectRef
-> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text ObjectRef -> WHNFData
IStrHash (HashMap Text ObjectRef -> EvalM WHNFData)
-> HashMap Text ObjectRef -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ [(Text, ObjectRef)] -> HashMap Text ObjectRef
forall k v. Hashable k => [(k, v)] -> HashMap k v
HL.fromList ([(Text, ObjectRef)] -> HashMap Text ObjectRef)
-> [(Text, ObjectRef)] -> HashMap Text ObjectRef
forall a b. (a -> b) -> a -> b
$ [Text] -> [ObjectRef] -> [(Text, ObjectRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
keys' [ObjectRef]
refs
    [EgisonHashKey]
_ -> do
      let keys' :: [Integer]
keys' = (EgisonHashKey -> Integer) -> [EgisonHashKey] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\case IntKey Integer
i -> Integer
i) [EgisonHashKey]
keys
      WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (HashMap Integer ObjectRef -> WHNFData)
-> HashMap Integer ObjectRef
-> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Integer ObjectRef -> WHNFData
IIntHash (HashMap Integer ObjectRef -> EvalM WHNFData)
-> HashMap Integer ObjectRef -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ [(Integer, ObjectRef)] -> HashMap Integer ObjectRef
forall k v. Hashable k => [(k, v)] -> HashMap k v
HL.fromList ([(Integer, ObjectRef)] -> HashMap Integer ObjectRef)
-> [(Integer, ObjectRef)] -> HashMap Integer ObjectRef
forall a b. (a -> b) -> a -> b
$ [Integer] -> [ObjectRef] -> [(Integer, ObjectRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
keys' [ObjectRef]
refs
 where
  makeHashKey :: WHNFData -> EvalM EgisonHashKey
  makeHashKey :: WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonHashKey
makeHashKey (Value EgisonValue
val) =
    case EgisonValue
val of
      ScalarData ScalarData
_ -> Integer -> EgisonHashKey
IntKey (Integer -> EgisonHashKey)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonHashKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
      Char Char
c       -> EgisonHashKey
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonHashKey
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> EgisonHashKey
CharKey Char
c)
      String Text
str   -> EgisonHashKey
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonHashKey
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> EgisonHashKey
StrKey Text
str)
      EgisonValue
_            -> (CallStack -> EgisonError)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonHashKey
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"integer or string" (EgisonValue -> WHNFData
Value EgisonValue
val))
  makeHashKey WHNFData
whnf = (CallStack -> EgisonError)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonHashKey
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"integer or string" WHNFData
whnf)

evalExprShallow env :: Env
env@(Env [HashMap Var ObjectRef]
fs Maybe (String, [Index (Maybe ScalarData)])
_) (IIndexedExpr Bool
override IExpr
expr [Index IExpr]
indices) = do
  -- Tensor or hash
  WHNFData
whnf <- case IExpr
expr of
              IVarExpr String
v -> do
                let mObjRef :: Maybe ObjectRef
mObjRef = Env -> Var -> Maybe ObjectRef
refVar Env
env (String -> [Index (Maybe Var)] -> Var
Var String
v ((Index IExpr -> Index (Maybe Var))
-> [Index IExpr] -> [Index (Maybe Var)]
forall a b. (a -> b) -> [a] -> [b]
map ((IExpr -> Maybe Var) -> Index IExpr -> Index (Maybe Var)
forall a b. (a -> b) -> Index a -> Index b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Var -> IExpr -> Maybe Var
forall a b. a -> b -> a
const Maybe Var
forall a. Maybe a
Nothing)) [Index IExpr]
indices))
                case Maybe ObjectRef
mObjRef of
                  Just ObjectRef
objRef -> ObjectRef -> EvalM WHNFData
evalRef ObjectRef
objRef
                  Maybe ObjectRef
Nothing     -> Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
              IExpr
_ -> Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
  case WHNFData
whnf of
    Value (ScalarData (SingleTerm Integer
1 [(Symbol String
id String
name [Index ScalarData]
js', Integer
1)])) -> do
      [Index ScalarData]
js2 <- (Index IExpr
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData))
-> [Index IExpr]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Index ScalarData]
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 Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
evalIndexToScalar [Index IExpr]
indices
      WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (ScalarData -> EgisonValue
ScalarData (Integer -> Monomial -> ScalarData
SingleTerm Integer
1 [(String -> String -> [Index ScalarData] -> SymbolExpr
Symbol String
id String
name ([Index ScalarData]
js' [Index ScalarData] -> [Index ScalarData] -> [Index ScalarData]
forall a. [a] -> [a] -> [a]
++ [Index ScalarData]
js2), Integer
1)]))
    Value (Func v :: Maybe Var
v@(Just (Var String
fnName [Index (Maybe Var)]
is)) Env
env CallStack
args IExpr
body) -> do
      [Index EgisonValue]
js <- (Index IExpr
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue))
-> [Index IExpr]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Index EgisonValue]
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 Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue)
evalIndex [Index IExpr]
indices
      [Binding]
frame <- [Index (Maybe Var)] -> [Index EgisonValue] -> EvalM [Binding]
pmIndices [Index (Maybe Var)]
is [Index EgisonValue]
js
      let env' :: Env
env' = Env -> [Binding] -> Env
extendEnv Env
env [Binding]
frame
      WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (Maybe Var -> Env -> CallStack -> IExpr -> EgisonValue
Func Maybe Var
v Env
env' CallStack
args IExpr
body)
    Value (TensorData t :: Tensor EgisonValue
t@Tensor{}) -> do
      [Index EgisonValue]
js <- (Index IExpr
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue))
-> [Index IExpr]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Index EgisonValue]
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 Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue)
evalIndex [Index IExpr]
indices
      EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> [Index EgisonValue]
-> Tensor EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
TensorComponent a b =>
Bool -> [Index EgisonValue] -> Tensor b -> EvalM a
refTensorWithOverride Bool
override [Index EgisonValue]
js Tensor EgisonValue
t
    ITensor t :: Tensor ObjectRef
t@Tensor{} -> do
      [Index EgisonValue]
js <- (Index IExpr
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue))
-> [Index IExpr]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Index EgisonValue]
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 Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue)
evalIndex [Index IExpr]
indices
      Bool -> [Index EgisonValue] -> Tensor ObjectRef -> EvalM WHNFData
forall a b.
TensorComponent a b =>
Bool -> [Index EgisonValue] -> Tensor b -> EvalM a
refTensorWithOverride Bool
override [Index EgisonValue]
js Tensor ObjectRef
t
    WHNFData
_ -> do
      [Index EgisonValue]
js <- (Index IExpr
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue))
-> [Index IExpr]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Index EgisonValue]
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 Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue)
evalIndex [Index IExpr]
indices
      WHNFData -> [EgisonValue] -> EvalM WHNFData
refHash WHNFData
whnf ((Index EgisonValue -> EgisonValue)
-> [Index EgisonValue] -> [EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map Index EgisonValue -> EgisonValue
forall a. Index a -> a
extractIndex [Index EgisonValue]
js)
 where
  evalIndex :: Index IExpr -> EvalM (Index EgisonValue)
  evalIndex :: Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue)
evalIndex Index IExpr
index = (IExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index EgisonValue)
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) -> Index a -> f (Index b)
traverse (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env) Index IExpr
index

  evalIndexToScalar :: Index IExpr -> EvalM (Index ScalarData)
  evalIndexToScalar :: Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
evalIndexToScalar Index IExpr
index = (IExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData)
-> Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
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) -> Index a -> f (Index b)
traverse ((EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
extractScalar =<<) (StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData)
-> (IExpr
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env) Index IExpr
index

evalExprShallow Env
env (ISubrefsExpr Bool
override IExpr
expr IExpr
jsExpr) = do
  [Index EgisonValue]
js <- (EgisonValue -> Index EgisonValue)
-> [EgisonValue] -> [Index EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map EgisonValue -> Index EgisonValue
forall a. a -> Index a
Sub ([EgisonValue] -> [Index EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Index EgisonValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
jsExpr StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
collectionToList)
  WHNFData
tensor <- case IExpr
expr of
              IVarExpr String
xs -> do
                let mObjRef :: Maybe ObjectRef
mObjRef = Env -> Var -> Maybe ObjectRef
refVar Env
env (String -> [Index (Maybe Var)] -> Var
Var String
xs ((Index EgisonValue -> Index (Maybe Var))
-> [Index EgisonValue] -> [Index (Maybe Var)]
forall a b. (a -> b) -> [a] -> [b]
map (\Index EgisonValue
_ -> Maybe Var -> Index (Maybe Var)
forall a. a -> Index a
Sub Maybe Var
forall a. Maybe a
Nothing) [Index EgisonValue]
js))
                case Maybe ObjectRef
mObjRef of
                  Just ObjectRef
objRef -> ObjectRef -> EvalM WHNFData
evalRef ObjectRef
objRef
                  Maybe ObjectRef
Nothing     -> Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
              IExpr
_ -> Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
  case WHNFData
tensor of
    Value (ScalarData ScalarData
_)          -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
tensor
    Value (TensorData t :: Tensor EgisonValue
t@Tensor{}) -> EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> [Index EgisonValue]
-> Tensor EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
TensorComponent a b =>
Bool -> [Index EgisonValue] -> Tensor b -> EvalM a
refTensorWithOverride Bool
override [Index EgisonValue]
js Tensor EgisonValue
t
    ITensor t :: Tensor ObjectRef
t@Tensor{}            -> Bool -> [Index EgisonValue] -> Tensor ObjectRef -> EvalM WHNFData
forall a b.
TensorComponent a b =>
Bool -> [Index EgisonValue] -> Tensor b -> EvalM a
refTensorWithOverride Bool
override [Index EgisonValue]
js Tensor ObjectRef
t
    WHNFData
_                             -> (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
NotImplemented String
"subrefs")

evalExprShallow Env
env (ISuprefsExpr Bool
override IExpr
expr IExpr
jsExpr) = do
  [Index EgisonValue]
js <- (EgisonValue -> Index EgisonValue)
-> [EgisonValue] -> [Index EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map EgisonValue -> Index EgisonValue
forall a. a -> Index a
Sup ([EgisonValue] -> [Index EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Index EgisonValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
jsExpr StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
collectionToList)
  WHNFData
tensor <- case IExpr
expr of
              IVarExpr String
xs -> do
                let mObjRef :: Maybe ObjectRef
mObjRef = Env -> Var -> Maybe ObjectRef
refVar Env
env (String -> [Index (Maybe Var)] -> Var
Var String
xs ((Index EgisonValue -> Index (Maybe Var))
-> [Index EgisonValue] -> [Index (Maybe Var)]
forall a b. (a -> b) -> [a] -> [b]
map (\Index EgisonValue
_ -> Maybe Var -> Index (Maybe Var)
forall a. a -> Index a
Sup Maybe Var
forall a. Maybe a
Nothing) [Index EgisonValue]
js))
                case Maybe ObjectRef
mObjRef of
                  Just ObjectRef
objRef -> ObjectRef -> EvalM WHNFData
evalRef ObjectRef
objRef
                  Maybe ObjectRef
Nothing     -> Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
              IExpr
_ -> Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
  case WHNFData
tensor of
    Value (ScalarData ScalarData
_)          -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
tensor
    Value (TensorData t :: Tensor EgisonValue
t@Tensor{}) -> EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> [Index EgisonValue]
-> Tensor EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
TensorComponent a b =>
Bool -> [Index EgisonValue] -> Tensor b -> EvalM a
refTensorWithOverride Bool
override [Index EgisonValue]
js Tensor EgisonValue
t
    ITensor t :: Tensor ObjectRef
t@Tensor{}            -> Bool -> [Index EgisonValue] -> Tensor ObjectRef -> EvalM WHNFData
forall a b.
TensorComponent a b =>
Bool -> [Index EgisonValue] -> Tensor b -> EvalM a
refTensorWithOverride Bool
override [Index EgisonValue]
js Tensor ObjectRef
t
    WHNFData
_                             -> (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
NotImplemented String
"suprefs")

evalExprShallow Env
env (IUserrefsExpr Bool
_ IExpr
expr IExpr
jsExpr) = do
  EgisonValue
val <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
expr
  [Index ScalarData]
js <- (ScalarData -> Index ScalarData)
-> [ScalarData] -> [Index ScalarData]
forall a b. (a -> b) -> [a] -> [b]
map ScalarData -> Index ScalarData
forall a. a -> Index a
User ([ScalarData] -> [Index ScalarData])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ScalarData]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Index ScalarData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
jsExpr StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
collectionToList StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
-> ([EgisonValue]
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [ScalarData])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ScalarData]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ScalarData]
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 EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
extractScalar)
  case EgisonValue
val of
    ScalarData (SingleTerm Integer
1 [(Symbol String
id String
name [Index ScalarData]
is, Integer
1)]) ->
      WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (ScalarData -> EgisonValue
ScalarData (Integer -> Monomial -> ScalarData
SingleTerm Integer
1 [(String -> String -> [Index ScalarData] -> SymbolExpr
Symbol String
id String
name ([Index ScalarData]
is [Index ScalarData] -> [Index ScalarData] -> [Index ScalarData]
forall a. [a] -> [a] -> [a]
++ [Index ScalarData]
js), Integer
1)]))
    ScalarData (SingleTerm Integer
1 [(FunctionData ScalarData
sym [ScalarData]
argnames [ScalarData]
args, Integer
1)]) ->
      case ScalarData
sym of
        SingleTerm Integer
1 [(Symbol String
id String
name [Index ScalarData]
is, Integer
1)] -> do
          let sym' :: ScalarData
sym' = Integer -> Monomial -> ScalarData
SingleTerm Integer
1 [(String -> String -> [Index ScalarData] -> SymbolExpr
Symbol String
id String
name ([Index ScalarData]
is [Index ScalarData] -> [Index ScalarData] -> [Index ScalarData]
forall a. [a] -> [a] -> [a]
++ [Index ScalarData]
js), Integer
1)]
          WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (ScalarData -> EgisonValue
ScalarData (Integer -> Monomial -> ScalarData
SingleTerm Integer
1 [(ScalarData -> [ScalarData] -> [ScalarData] -> SymbolExpr
FunctionData ScalarData
sym' [ScalarData]
argnames [ScalarData]
args, Integer
1)]))
        ScalarData
_ -> (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
NotImplemented String
"user-refs")
    EgisonValue
_ -> (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
NotImplemented String
"user-refs")

evalExprShallow Env
env (ILambdaExpr Maybe Var
vwi CallStack
names IExpr
expr) = do
  WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Maybe Var -> Env -> CallStack -> IExpr -> EgisonValue
Func Maybe Var
vwi Env
env CallStack
names IExpr
expr

evalExprShallow Env
env (IMemoizedLambdaExpr [String]
names IExpr
body) = do
  IORef (HashMap [Integer] WHNFData)
hashRef <- IO (IORef (HashMap [Integer] WHNFData))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (IORef (HashMap [Integer] WHNFData))
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HashMap [Integer] WHNFData))
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      (IORef (HashMap [Integer] WHNFData)))
-> IO (IORef (HashMap [Integer] WHNFData))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (IORef (HashMap [Integer] WHNFData))
forall a b. (a -> b) -> a -> b
$ HashMap [Integer] WHNFData
-> IO (IORef (HashMap [Integer] WHNFData))
forall a. a -> IO (IORef a)
newIORef HashMap [Integer] WHNFData
forall k v. HashMap k v
HL.empty
  WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ IORef (HashMap [Integer] WHNFData)
-> Env -> [String] -> IExpr -> EgisonValue
MemoizedFunc IORef (HashMap [Integer] WHNFData)
hashRef Env
env [String]
names IExpr
body

evalExprShallow Env
env (ICambdaExpr String
name IExpr
expr) = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Env -> String -> IExpr -> EgisonValue
CFunc Env
env String
name IExpr
expr

evalExprShallow Env
env (IPatternFunctionExpr [String]
names IPattern
pattern) = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Env -> [String] -> IPattern -> EgisonValue
PatternFunc Env
env [String]
names IPattern
pattern

evalExprShallow (Env [HashMap Var ObjectRef]
_ Maybe (String, [Index (Maybe ScalarData)])
Nothing) (IFunctionExpr [String]
_) = EgisonError -> EvalM WHNFData
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM WHNFData) -> EgisonError -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"function symbol is not bound to a variable"

evalExprShallow env :: Env
env@(Env [HashMap Var ObjectRef]
_ (Just (String
name, [Index (Maybe ScalarData)]
is))) (IFunctionExpr [String]
args) = do
  [ScalarData]
args' <- (String
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [String]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env (IExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> (String -> IExpr)
-> String
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IExpr
IVarExpr) [String]
args StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
-> ([EgisonValue]
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [ScalarData])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ScalarData]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ScalarData]
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 EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
extractScalar
  [Index ScalarData]
is' <- (Index (Maybe ScalarData)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData))
-> [Index (Maybe ScalarData)]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Index ScalarData]
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 Index (Maybe ScalarData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
unwrapMaybeFromIndex [Index (Maybe ScalarData)]
is
  WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ ScalarData -> EgisonValue
ScalarData (Integer -> Monomial -> ScalarData
SingleTerm Integer
1 [(ScalarData -> [ScalarData] -> [ScalarData] -> SymbolExpr
FunctionData (Integer -> Monomial -> ScalarData
SingleTerm Integer
1 [(String -> String -> [Index ScalarData] -> SymbolExpr
Symbol String
"" String
name [Index ScalarData]
is', Integer
1)]) ((String -> ScalarData) -> [String] -> [ScalarData]
forall a b. (a -> b) -> [a] -> [b]
map String -> ScalarData
symbolScalarData' [String]
args) [ScalarData]
args', Integer
1)])
 where
  unwrapMaybeFromIndex :: Index (Maybe ScalarData) -> EvalM (Index ScalarData) -- Maybe we can refactor this function
--  unwrapMaybeFromIndex = return . (fmap fromJust)
  unwrapMaybeFromIndex :: Index (Maybe ScalarData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
unwrapMaybeFromIndex (Sub Maybe ScalarData
Nothing) = EgisonError
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData))
-> EgisonError
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"function symbol can be used only with generateTensor"
  unwrapMaybeFromIndex (Sup Maybe ScalarData
Nothing) = EgisonError
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData))
-> EgisonError
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"function symbol can be used only with generateTensor"
  unwrapMaybeFromIndex (Sub (Just ScalarData
i)) = Index ScalarData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScalarData -> Index ScalarData
forall a. a -> Index a
Sub ScalarData
i)
  unwrapMaybeFromIndex (Sup (Just ScalarData
i)) = Index ScalarData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScalarData -> Index ScalarData
forall a. a -> Index a
Sup ScalarData
i)

evalExprShallow Env
env (IIfExpr IExpr
test IExpr
expr IExpr
expr') = do
  Bool
test <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
test StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison
  Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env (IExpr -> EvalM WHNFData) -> IExpr -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ if Bool
test then IExpr
expr else IExpr
expr'

evalExprShallow Env
env (ILetExpr [IBindingExpr]
bindings IExpr
expr) = do
  [Binding]
binding <- [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Binding]] -> [Binding])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [[Binding]]
-> EvalM [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IBindingExpr -> EvalM [Binding])
-> [IBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [[Binding]]
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 IBindingExpr -> EvalM [Binding]
extractBindings [IBindingExpr]
bindings
  Env -> IExpr -> EvalM WHNFData
evalExprShallow (Env -> [Binding] -> Env
extendEnv Env
env [Binding]
binding) IExpr
expr
 where
  extractBindings :: IBindingExpr -> EvalM [Binding]
  extractBindings :: IBindingExpr -> EvalM [Binding]
extractBindings (PDPatVar Var
var, IExpr
expr) =
    Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef (Env -> Var -> Env
memorizeVarInEnv Env
env Var
var) IExpr
expr StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
-> (ObjectRef -> EvalM [Binding]) -> EvalM [Binding]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CallStack -> [ObjectRef] -> EvalM [Binding]
makeBindings [Var
var] ([ObjectRef] -> EvalM [Binding])
-> (ObjectRef -> [ObjectRef]) -> ObjectRef -> EvalM [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjectRef -> [ObjectRef] -> [ObjectRef]
forall a. a -> [a] -> [a]
:[])
  extractBindings (PDPatternBase Var
pdp, IExpr
expr) = do
    ObjectRef
thunk <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env IExpr
expr
    PDPatternBase Var -> ObjectRef -> EvalM [Binding]
bindPrimitiveDataPattern PDPatternBase Var
pdp ObjectRef
thunk

evalExprShallow Env
env (ILetRecExpr [IBindingExpr]
bindings IExpr
expr) = do
  Env
env' <- Env -> [IBindingExpr] -> EvalM Env
recursiveMatchBind Env
env [IBindingExpr]
bindings
  Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env' IExpr
expr

evalExprShallow Env
env (ITransposeExpr IExpr
vars IExpr
expr) = do
  [EgisonValue]
syms <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
vars StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
collectionToList
  WHNFData
whnf <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
  case WHNFData
whnf of
    ITensor Tensor ObjectRef
t            -> Tensor ObjectRef -> WHNFData
ITensor (Tensor ObjectRef -> WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EgisonValue]
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a. [EgisonValue] -> Tensor a -> EvalM (Tensor a)
tTranspose' [EgisonValue]
syms Tensor ObjectRef
t
    Value (TensorData Tensor EgisonValue
t) -> EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> (Tensor EgisonValue -> EgisonValue)
-> Tensor EgisonValue
-> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor EgisonValue -> EgisonValue
TensorData (Tensor EgisonValue -> WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor EgisonValue)
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EgisonValue]
-> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor EgisonValue)
forall a. [EgisonValue] -> Tensor a -> EvalM (Tensor a)
tTranspose' [EgisonValue]
syms Tensor EgisonValue
t
    WHNFData
_                    -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
whnf

evalExprShallow Env
env (IFlipIndicesExpr IExpr
expr) = do
  WHNFData
whnf <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
  case WHNFData
whnf of
    ITensor Tensor ObjectRef
t            -> Tensor ObjectRef -> WHNFData
ITensor (Tensor ObjectRef -> WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a. Tensor a -> EvalM (Tensor a)
tFlipIndices Tensor ObjectRef
t
    Value (TensorData Tensor EgisonValue
t) -> EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> (Tensor EgisonValue -> EgisonValue)
-> Tensor EgisonValue
-> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor EgisonValue -> EgisonValue
TensorData (Tensor EgisonValue -> WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor EgisonValue)
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor EgisonValue)
forall a. Tensor a -> EvalM (Tensor a)
tFlipIndices Tensor EgisonValue
t
    WHNFData
_                    -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
whnf

evalExprShallow Env
env (IWithSymbolsExpr [String]
vars IExpr
expr) = do
  String
symId <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  [ObjectRef]
syms <- (String
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> [String]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
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 (WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> (String -> WHNFData)
-> String
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> (String -> EgisonValue) -> String -> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> EgisonValue
symbolScalarData String
symId) [String]
vars
  WHNFData
whnf <- Env -> IExpr -> EvalM WHNFData
evalExprShallow (Env -> [Binding] -> Env
extendEnv Env
env ([String] -> [ObjectRef] -> [Binding]
makeBindings' [String]
vars [ObjectRef]
syms)) IExpr
expr
  case WHNFData
whnf of
    Value (TensorData t :: Tensor EgisonValue
t@Tensor{}) ->
      EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> (Tensor EgisonValue -> EgisonValue)
-> Tensor EgisonValue
-> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor EgisonValue -> EgisonValue
TensorData (Tensor EgisonValue -> WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor EgisonValue)
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor EgisonValue)
forall a. String -> Tensor a -> EvalM (Tensor a)
removeTmpScripts String
symId Tensor EgisonValue
t
    ITensor t :: Tensor ObjectRef
t@Tensor{} ->
      Tensor ObjectRef -> WHNFData
ITensor (Tensor ObjectRef -> WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a. String -> Tensor a -> EvalM (Tensor a)
removeTmpScripts String
symId Tensor ObjectRef
t
    WHNFData
_ -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
whnf
 where
  isTmpSymbol :: String -> Index EgisonValue -> Bool
  isTmpSymbol :: String -> Index EgisonValue -> Bool
isTmpSymbol String
symId Index EgisonValue
index = String
symId String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== EgisonValue -> String
getSymId (Index EgisonValue -> EgisonValue
forall a. Index a -> a
extractIndex Index EgisonValue
index)

  removeTmpScripts :: String -> Tensor a -> EvalM (Tensor a)
  removeTmpScripts :: forall a. String -> Tensor a -> EvalM (Tensor a)
removeTmpScripts String
symId (Tensor [Integer]
s Vector a
xs [Index EgisonValue]
is) = do
    let ([Index EgisonValue]
ds, [Index EgisonValue]
js) = (Index EgisonValue -> Bool)
-> [Index EgisonValue]
-> ([Index EgisonValue], [Index EgisonValue])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> Index EgisonValue -> Bool
isTmpSymbol String
symId) [Index EgisonValue]
is
    Tensor [Integer]
s Vector a
ys [Index EgisonValue]
_ <- [Index EgisonValue] -> Tensor a -> EvalM (Tensor a)
forall a. [Index EgisonValue] -> Tensor a -> EvalM (Tensor a)
tTranspose ([Index EgisonValue]
js [Index EgisonValue] -> [Index EgisonValue] -> [Index EgisonValue]
forall a. [a] -> [a] -> [a]
++ [Index EgisonValue]
ds) ([Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
s Vector a
xs [Index EgisonValue]
is)
    Tensor a -> EvalM (Tensor a)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
s Vector a
ys [Index EgisonValue]
js)


evalExprShallow Env
env (IDoExpr [IBindingExpr]
bindings IExpr
expr) = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData) -> EgisonValue -> WHNFData
forall a b. (a -> b) -> a -> b
$ EvalM WHNFData -> EgisonValue
IOFunc (EvalM WHNFData -> EgisonValue) -> EvalM WHNFData -> EgisonValue
forall a b. (a -> b) -> a -> b
$ do
  let body :: IExpr
body = (IBindingExpr -> IExpr -> IExpr)
-> IExpr -> [IBindingExpr] -> IExpr
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IBindingExpr -> IExpr -> IExpr
genLet (IExpr -> [IExpr] -> IExpr
IApplyExpr IExpr
expr [String -> IExpr
IVarExpr String
"#1"]) [IBindingExpr]
bindings
  Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env (EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData) -> EgisonValue -> WHNFData
forall a b. (a -> b) -> a -> b
$ Maybe Var -> Env -> CallStack -> IExpr -> EgisonValue
Func Maybe Var
forall a. Maybe a
Nothing Env
env [String -> Var
stringToVar String
"#1"] IExpr
body) [WHNFData -> Object
WHNF (EgisonValue -> WHNFData
Value EgisonValue
World)]
 where
  genLet :: IBindingExpr -> IExpr -> IExpr
genLet (PDPatternBase Var
names, IExpr
expr) IExpr
expr' =
    [IBindingExpr] -> IExpr -> IExpr
ILetExpr [([PDPatternBase Var] -> PDPatternBase Var
forall var. [PDPatternBase var] -> PDPatternBase var
PDTuplePat ((Var -> PDPatternBase Var) -> CallStack -> [PDPatternBase Var]
forall a b. (a -> b) -> [a] -> [b]
map Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar [String -> Var
stringToVar String
"#1", String -> Var
stringToVar String
"#2"]), IExpr -> [IExpr] -> IExpr
IApplyExpr IExpr
expr [String -> IExpr
IVarExpr String
"#1"])] (IExpr -> IExpr) -> IExpr -> IExpr
forall a b. (a -> b) -> a -> b
$
    [IBindingExpr] -> IExpr -> IExpr
ILetExpr [(PDPatternBase Var
names, String -> IExpr
IVarExpr String
"#2")] IExpr
expr'

evalExprShallow Env
env (IMatchAllExpr PMMode
pmmode IExpr
target IExpr
matcher [IMatchClause]
clauses) = do
  WHNFData
target <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
target
  EgisonValue
matcher <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
matcher EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF
  EgisonValue
-> WHNFData
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
f EgisonValue
matcher WHNFData
target StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
    -> EvalM WHNFData)
-> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
-> EvalM WHNFData
fromMList
 where
  fromMList :: MList EvalM WHNFData -> EvalM WHNFData
  fromMList :: MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
-> EvalM WHNFData
fromMList MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
MNil = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Seq EgisonValue -> EgisonValue
Collection Seq EgisonValue
forall a. Seq a
Sq.empty
  fromMList (MCons WHNFData
val StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
m) = do
    Inner
head <- ObjectRef -> Inner
IElement (ObjectRef -> Inner)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) Inner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
val
    Inner
tail <- ObjectRef -> Inner
ISubCollection (ObjectRef -> Inner)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) Inner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> (EvalM WHNFData -> IO ObjectRef)
-> EvalM WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> IO ObjectRef
forall a. a -> IO (IORef a)
newIORef (Object -> IO ObjectRef)
-> (EvalM WHNFData -> Object) -> EvalM WHNFData -> IO ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalM WHNFData -> Object
Thunk (EvalM WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> EvalM WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b. (a -> b) -> a -> b
$ StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
m StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
    -> EvalM WHNFData)
-> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
-> EvalM WHNFData
fromMList)
    IORef (Seq Inner)
seqRef <- IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Seq Inner))
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner)))
-> (Seq Inner -> IO (IORef (Seq Inner)))
-> Seq Inner
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Inner -> IO (IORef (Seq Inner))
forall a. a -> IO (IORef a)
newIORef (Seq Inner
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner)))
-> Seq Inner
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a b. (a -> b) -> a -> b
$ [Inner] -> Seq Inner
forall a. [a] -> Seq a
Sq.fromList [Inner
head, Inner
tail]
    WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ IORef (Seq Inner) -> WHNFData
ICollection IORef (Seq Inner)
seqRef
  f :: EgisonValue
-> WHNFData
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
f EgisonValue
matcher WHNFData
target = do
      let tryMatchClause :: IMatchClause
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
tryMatchClause (IPattern
pattern, IExpr
expr) StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
results = do
            MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
result <- PMMode
-> Env
-> IPattern
-> WHNFData
-> EgisonValue
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
patternMatch PMMode
pmmode Env
env IPattern
pattern WHNFData
target EgisonValue
matcher
            ([Binding] -> EvalM WHNFData)
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MList m a -> m (MList m b)
mmap ((Env -> IExpr -> EvalM WHNFData) -> IExpr -> Env -> EvalM WHNFData
forall a b c. (a -> b -> c) -> b -> a -> c
flip Env -> IExpr -> EvalM WHNFData
evalExprShallow IExpr
expr (Env -> EvalM WHNFData)
-> ([Binding] -> Env) -> [Binding] -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> [Binding] -> Env
extendEnv Env
env) MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
result StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
    -> StateT
         EvalState
         (ExceptT EgisonError RuntimeM)
         (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
forall (m :: * -> *) a.
Monad m =>
MList m a -> m (MList m a) -> m (MList m a)
`mappend` StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
results)
      (IMatchClause
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) IMatchClause
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b -> m b) -> m b -> MList m a -> m b
mfoldr IMatchClause
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
tryMatchClause (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return MList (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall (m :: * -> *) a. MList m a
MNil) ([IMatchClause]
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) IMatchClause
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [IMatchClause]
clauses)

evalExprShallow Env
env (IMatchExpr PMMode
pmmode IExpr
target IExpr
matcher [IMatchClause]
clauses) = do
  WHNFData
target <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
target
  EgisonValue
matcher <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
matcher EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF
  EgisonValue -> WHNFData -> EvalM WHNFData
f EgisonValue
matcher WHNFData
target
 where
  f :: EgisonValue -> WHNFData -> EvalM WHNFData
f EgisonValue
matcher WHNFData
target = do
      let tryMatchClause :: IMatchClause -> EvalM WHNFData -> EvalM WHNFData
tryMatchClause (IPattern
pattern, IExpr
expr) EvalM WHNFData
cont = do
            MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
result <- PMMode
-> Env
-> IPattern
-> WHNFData
-> EgisonValue
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
patternMatch PMMode
pmmode Env
env IPattern
pattern WHNFData
target EgisonValue
matcher
            case MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
result of
              MCons [Binding]
bindings EvalM
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
_ -> Env -> IExpr -> EvalM WHNFData
evalExprShallow (Env -> [Binding] -> Env
extendEnv Env
env [Binding]
bindings) IExpr
expr
              MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
MNil             -> EvalM WHNFData
cont
      CallStack
callstack <- StateT EvalState (ExceptT EgisonError RuntimeM) CallStack
forall (m :: * -> *). MonadEval m => m CallStack
getFuncNameStack
      (IMatchClause -> EvalM WHNFData -> EvalM WHNFData)
-> EvalM WHNFData -> [IMatchClause] -> EvalM WHNFData
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IMatchClause -> EvalM WHNFData -> EvalM WHNFData
tryMatchClause (EgisonError -> EvalM WHNFData
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM WHNFData) -> EgisonError -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ CallStack -> EgisonError
MatchFailure CallStack
callstack) [IMatchClause]
clauses

evalExprShallow Env
env (ISeqExpr IExpr
expr1 IExpr
expr2) = do
  EgisonValue
_ <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
expr1
  Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr2

evalExprShallow Env
env (ICApplyExpr IExpr
func IExpr
arg) = do
  WHNFData
func <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
func
  [EgisonValue]
args <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
arg StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
collectionToList
  case WHNFData
func of
    Value (MemoizedFunc IORef (HashMap [Integer] WHNFData)
hashRef Env
env [String]
names IExpr
body) ->
      IORef (HashMap [Integer] WHNFData)
-> Env -> [String] -> IExpr -> [EgisonValue] -> EvalM WHNFData
evalMemoizedFunc IORef (HashMap [Integer] WHNFData)
hashRef Env
env [String]
names IExpr
body [EgisonValue]
args
    WHNFData
_ -> Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
func ((EgisonValue -> Object) -> [EgisonValue] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (WHNFData -> Object
WHNF (WHNFData -> Object)
-> (EgisonValue -> WHNFData) -> EgisonValue -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value) [EgisonValue]
args)

evalExprShallow Env
env (IApplyExpr IExpr
func [IExpr]
args) = do
  WHNFData
func <- Integer -> WHNFData -> WHNFData
appendDF Integer
0 (WHNFData -> WHNFData) -> EvalM WHNFData -> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
func
  case WHNFData
func of
    Value (InductiveData String
name []) ->
      String -> [ObjectRef] -> WHNFData
IInductiveData String
name ([ObjectRef] -> WHNFData)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
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 (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env) [IExpr]
args
    Value (TensorData t :: Tensor EgisonValue
t@Tensor{}) -> do
      let args' :: [Object]
args' = (IExpr -> Object) -> [IExpr] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> IExpr -> Object
newThunk Env
env) [IExpr]
args
      (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\EgisonValue
f -> Env
-> WHNFData
-> [Object]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyObjThunkRef Env
env (EgisonValue -> WHNFData
Value EgisonValue
f) [Object]
args') Tensor EgisonValue
t StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor EvalM WHNFData -> (WHNFData -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData -> EvalM WHNFData
removeDF
    ITensor t :: Tensor ObjectRef
t@Tensor{} -> do
      let args' :: [Object]
args' = (IExpr -> Object) -> [IExpr] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> IExpr -> Object
newThunk Env
env) [IExpr]
args
      (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\ObjectRef
f -> do
        WHNFData
f <- ObjectRef -> EvalM WHNFData
evalRef ObjectRef
f
        Env
-> WHNFData
-> [Object]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyObjThunkRef Env
env WHNFData
f [Object]
args') Tensor ObjectRef
t StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor EvalM WHNFData -> (WHNFData -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData -> EvalM WHNFData
removeDF
    Value (MemoizedFunc IORef (HashMap [Integer] WHNFData)
hashRef Env
env' [String]
names IExpr
body) -> do
      [EgisonValue]
args <- (IExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env) [IExpr]
args
      IORef (HashMap [Integer] WHNFData)
-> Env -> [String] -> IExpr -> [EgisonValue] -> EvalM WHNFData
evalMemoizedFunc IORef (HashMap [Integer] WHNFData)
hashRef Env
env' [String]
names IExpr
body [EgisonValue]
args
    WHNFData
_ -> do
      let args' :: [Object]
args' = (IExpr -> Object) -> [IExpr] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> IExpr -> Object
newThunk Env
env) [IExpr]
args
      Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
func [Object]
args' EvalM WHNFData -> (WHNFData -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData -> EvalM WHNFData
removeDF

evalExprShallow Env
env (IWedgeApplyExpr IExpr
func [IExpr]
args) = do
  WHNFData
func <- Integer -> WHNFData -> WHNFData
appendDF Integer
0 (WHNFData -> WHNFData) -> EvalM WHNFData -> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
func
  [WHNFData]
args <- (IExpr -> EvalM WHNFData)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 (Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env) [IExpr]
args
  let args' :: [Object]
args' = (WHNFData -> Object) -> [WHNFData] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map WHNFData -> Object
WHNF ((Integer -> WHNFData -> WHNFData)
-> [Integer] -> [WHNFData] -> [WHNFData]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> WHNFData -> WHNFData
appendDF [Integer
1..] [WHNFData]
args)
  case WHNFData
func of
    Value (TensorData t :: Tensor EgisonValue
t@Tensor{}) ->
      (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\EgisonValue
f -> Env
-> WHNFData
-> [Object]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyObjThunkRef Env
env (EgisonValue -> WHNFData
Value EgisonValue
f) [Object]
args') Tensor EgisonValue
t StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    ITensor t :: Tensor ObjectRef
t@Tensor{} ->
      (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\ObjectRef
f -> do
        WHNFData
f <- ObjectRef -> EvalM WHNFData
evalRef ObjectRef
f
        Env
-> WHNFData
-> [Object]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyObjThunkRef Env
env WHNFData
f [Object]
args') Tensor ObjectRef
t StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    Value (MemoizedFunc IORef (HashMap [Integer] WHNFData)
hashRef Env
env [String]
names IExpr
body) -> do
      [EgisonValue]
args <- (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [WHNFData]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF [WHNFData]
args
      IORef (HashMap [Integer] WHNFData)
-> Env -> [String] -> IExpr -> [EgisonValue] -> EvalM WHNFData
evalMemoizedFunc IORef (HashMap [Integer] WHNFData)
hashRef Env
env [String]
names IExpr
body [EgisonValue]
args
    WHNFData
_ -> Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
func [Object]
args' EvalM WHNFData -> (WHNFData -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData -> EvalM WHNFData
removeDF

evalExprShallow Env
env (IMatcherExpr [IPatternDef]
info) = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData) -> EgisonValue -> WHNFData
forall a b. (a -> b) -> a -> b
$ Env -> [IPatternDef] -> EgisonValue
UserMatcher Env
env [IPatternDef]
info

evalExprShallow Env
env (IGenerateTensorExpr IExpr
fnExpr IExpr
shapeExpr) = do
  [EgisonValue]
shape <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
shapeExpr StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
collectionToList
  [Integer]
ns    <- (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Integer]
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 EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison [EgisonValue]
shape :: EvalM Shape
  [ObjectRef]
xs    <- ([Integer]
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> [[Integer]]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
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 (Env
-> [ScalarData]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
evalWithIndex Env
env ([ScalarData]
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> ([Integer] -> [ScalarData])
-> [Integer]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> ScalarData) -> [Integer] -> [ScalarData]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
n -> Integer -> Monomial -> ScalarData
SingleTerm Integer
n [])) ([Integer] -> [[Integer]]
enumTensorIndices [Integer]
ns)
  WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ [Integer] -> [ObjectRef] -> WHNFData
newITensor [Integer]
ns [ObjectRef]
xs
 where
  evalWithIndex :: Env -> [ScalarData] {- index -} -> EvalM ObjectRef
  evalWithIndex :: Env
-> [ScalarData]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
evalWithIndex env :: Env
env@(Env [HashMap Var ObjectRef]
frame Maybe (String, [Index (Maybe ScalarData)])
maybe_vwi) [ScalarData]
ms = do
    let env' :: Env
env' = Env
-> ((String, [Index (Maybe ScalarData)]) -> Env)
-> Maybe (String, [Index (Maybe ScalarData)])
-> Env
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Env
env (\(String
name, [Index (Maybe ScalarData)]
indices) -> [HashMap Var ObjectRef]
-> Maybe (String, [Index (Maybe ScalarData)]) -> Env
Env [HashMap Var ObjectRef]
frame (Maybe (String, [Index (Maybe ScalarData)]) -> Env)
-> Maybe (String, [Index (Maybe ScalarData)]) -> Env
forall a b. (a -> b) -> a -> b
$ (String, [Index (Maybe ScalarData)])
-> Maybe (String, [Index (Maybe ScalarData)])
forall a. a -> Maybe a
Just (String
name, (Index (Maybe ScalarData)
 -> ScalarData -> Index (Maybe ScalarData))
-> [Index (Maybe ScalarData)]
-> [ScalarData]
-> [Index (Maybe ScalarData)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Index (Maybe ScalarData) -> ScalarData -> Index (Maybe ScalarData)
forall a. Index (Maybe a) -> a -> Index (Maybe a)
changeIndex [Index (Maybe ScalarData)]
indices [ScalarData]
ms)) Maybe (String, [Index (Maybe ScalarData)])
maybe_vwi
    WHNFData
fn <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env' IExpr
fnExpr
    Env
-> WHNFData
-> [Object]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyObjThunkRef Env
env WHNFData
fn [WHNFData -> Object
WHNF (EgisonValue -> WHNFData
Value (Seq EgisonValue -> EgisonValue
Collection ([EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList ((ScalarData -> EgisonValue) -> [ScalarData] -> [EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map ScalarData -> EgisonValue
ScalarData [ScalarData]
ms))))]
  changeIndex :: Index (Maybe a) -> a -> Index (Maybe a) -- Maybe we can refactor this function
  changeIndex :: forall a. Index (Maybe a) -> a -> Index (Maybe a)
changeIndex (Sup Maybe a
Nothing) a
m = Maybe a -> Index (Maybe a)
forall a. a -> Index a
Sup (a -> Maybe a
forall a. a -> Maybe a
Just a
m)
  changeIndex (Sub Maybe a
Nothing) a
m = Maybe a -> Index (Maybe a)
forall a. a -> Index a
Sub (a -> Maybe a
forall a. a -> Maybe a
Just a
m)

evalExprShallow Env
env (ITensorContractExpr IExpr
tExpr) = do
  WHNFData
whnf <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
tExpr
  case WHNFData
whnf of
    ITensor t :: Tensor ObjectRef
t@Tensor{} -> do
      [WHNFData]
ts <- Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Tensor ObjectRef]
forall a. Tensor a -> EvalM [Tensor a]
tContract Tensor ObjectRef
t StateT EvalState (ExceptT EgisonError RuntimeM) [Tensor ObjectRef]
-> ([Tensor ObjectRef]
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tensor ObjectRef -> EvalM WHNFData)
-> [Tensor ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
      [WHNFData] -> EvalM WHNFData
makeICollection [WHNFData]
ts
    Value (TensorData t :: Tensor EgisonValue
t@Tensor{}) -> do
      [EgisonValue]
ts <- Tensor EgisonValue -> EvalM [Tensor EgisonValue]
forall a. Tensor a -> EvalM [Tensor a]
tContract Tensor EgisonValue
t EvalM [Tensor EgisonValue]
-> ([Tensor EgisonValue]
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tensor EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [Tensor EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 Tensor EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
      WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData) -> EgisonValue -> WHNFData
forall a b. (a -> b) -> a -> b
$ Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue) -> Seq EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList [EgisonValue]
ts
    WHNFData
_ -> [WHNFData] -> EvalM WHNFData
makeICollection [WHNFData
whnf]

evalExprShallow Env
env (ITensorMapExpr IExpr
fnExpr IExpr
tExpr) = do
  WHNFData
fn <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
fnExpr
  WHNFData
whnf <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
tExpr
  case WHNFData
whnf of
    ITensor Tensor ObjectRef
t ->
      (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\ObjectRef
x -> Env
-> WHNFData
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyThunkRef Env
env WHNFData
fn [ObjectRef
x]) Tensor ObjectRef
t StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    Value (TensorData Tensor EgisonValue
t) ->
      (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\EgisonValue
x -> Env
-> WHNFData
-> [Object]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyObjThunkRef Env
env WHNFData
fn [WHNFData -> Object
WHNF (EgisonValue -> WHNFData
Value EgisonValue
x)]) Tensor EgisonValue
t StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    WHNFData
_ -> Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
fn [WHNFData -> Object
WHNF WHNFData
whnf]

evalExprShallow Env
env (ITensorMap2Expr IExpr
fnExpr IExpr
t1Expr IExpr
t2Expr) = do
  WHNFData
fn <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
fnExpr
  WHNFData
whnf1 <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
t1Expr
  WHNFData
whnf2 <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
t2Expr
  case (WHNFData
whnf1, WHNFData
whnf2) of
    -- both of arguments are tensors
    (ITensor Tensor ObjectRef
t1, ITensor Tensor ObjectRef
t2) ->
      (ObjectRef
 -> ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor ObjectRef
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b c.
(a -> b -> EvalM c) -> Tensor a -> Tensor b -> EvalM (Tensor c)
tMap2 (\ObjectRef
x ObjectRef
y -> Env
-> WHNFData
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyThunkRef Env
env WHNFData
fn [ObjectRef
x, ObjectRef
y]) Tensor ObjectRef
t1 Tensor ObjectRef
t2 StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    (ITensor Tensor ObjectRef
t1, Value (TensorData Tensor EgisonValue
t2)) -> do
      (ObjectRef
 -> EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor ObjectRef
-> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b c.
(a -> b -> EvalM c) -> Tensor a -> Tensor b -> EvalM (Tensor c)
tMap2 (\ObjectRef
x EgisonValue
y -> do
        ObjectRef
y <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef (EgisonValue -> WHNFData
Value EgisonValue
y)
        Env
-> WHNFData
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyThunkRef Env
env WHNFData
fn [ObjectRef
x, ObjectRef
y]) Tensor ObjectRef
t1 Tensor EgisonValue
t2 StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    (Value (TensorData Tensor EgisonValue
t1), ITensor Tensor ObjectRef
t2) -> do
      (EgisonValue
 -> ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor EgisonValue
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b c.
(a -> b -> EvalM c) -> Tensor a -> Tensor b -> EvalM (Tensor c)
tMap2 (\EgisonValue
x ObjectRef
y -> do
        ObjectRef
x <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef (EgisonValue -> WHNFData
Value EgisonValue
x)
        Env
-> WHNFData
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyThunkRef Env
env WHNFData
fn [ObjectRef
x, ObjectRef
y]) Tensor EgisonValue
t1 Tensor ObjectRef
t2 StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    (Value (TensorData Tensor EgisonValue
t1), Value (TensorData Tensor EgisonValue
t2)) ->
      (EgisonValue
 -> EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor EgisonValue
-> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b c.
(a -> b -> EvalM c) -> Tensor a -> Tensor b -> EvalM (Tensor c)
tMap2 (\EgisonValue
x EgisonValue
y -> Env
-> WHNFData
-> [Object]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyObjThunkRef Env
env WHNFData
fn [WHNFData -> Object
WHNF (EgisonValue -> WHNFData
Value EgisonValue
x), WHNFData -> Object
WHNF (EgisonValue -> WHNFData
Value EgisonValue
y)]) Tensor EgisonValue
t1 Tensor EgisonValue
t2 StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    -- an argument is scalar
    (ITensor Tensor ObjectRef
t1, WHNFData
_) -> do
      ObjectRef
y <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
whnf2
      (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\ObjectRef
x -> Env
-> WHNFData
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyThunkRef Env
env WHNFData
fn [ObjectRef
x, ObjectRef
y]) Tensor ObjectRef
t1 StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    (WHNFData
_, ITensor Tensor ObjectRef
t2) -> do
      ObjectRef
x <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
whnf1
      (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\ObjectRef
y -> Env
-> WHNFData
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyThunkRef Env
env WHNFData
fn [ObjectRef
x, ObjectRef
y]) Tensor ObjectRef
t2 StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    (Value (TensorData Tensor EgisonValue
t1), WHNFData
_) -> do
      ObjectRef
y <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
whnf2
      (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\EgisonValue
x -> do
        ObjectRef
x <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef (EgisonValue -> WHNFData
Value EgisonValue
x)
        Env
-> WHNFData
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyThunkRef Env
env WHNFData
fn [ObjectRef
x, ObjectRef
y]) Tensor EgisonValue
t1 StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    (WHNFData
_, Value (TensorData Tensor EgisonValue
t2)) -> do
      ObjectRef
x <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
whnf1
      (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Tensor EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. (a -> EvalM b) -> Tensor a -> EvalM (Tensor b)
tMap (\EgisonValue
y -> do
        ObjectRef
y <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef (EgisonValue -> WHNFData
Value EgisonValue
y)
        Env
-> WHNFData
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyThunkRef Env
env WHNFData
fn [ObjectRef
x, ObjectRef
y]) Tensor EgisonValue
t2 StateT EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
-> (Tensor ObjectRef -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor ObjectRef -> EvalM WHNFData
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    (WHNFData, WHNFData)
_ -> Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
fn [WHNFData -> Object
WHNF WHNFData
whnf1, WHNFData -> Object
WHNF WHNFData
whnf2]

evalExprShallow Env
_ IExpr
expr = (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
NotImplemented (String
"evalExprShallow for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IExpr -> String
forall a. Show a => a -> String
show IExpr
expr))

evalExprDeep :: Env -> IExpr -> EvalM EgisonValue
evalExprDeep :: Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env IExpr
expr = Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF

evalRefDeep :: ObjectRef -> EvalM EgisonValue
evalRefDeep :: ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep ObjectRef
ref = do
  Object
obj <- IO Object -> StateT EvalState (ExceptT EgisonError RuntimeM) Object
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Object)
-> IO Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) Object
forall a b. (a -> b) -> a -> b
$ ObjectRef -> IO Object
forall a. IORef a -> IO a
readIORef ObjectRef
ref
  case Object
obj of
    WHNF (Value EgisonValue
val) -> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return EgisonValue
val
    WHNF WHNFData
val -> do
      EgisonValue
val <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF WHNFData
val
      ObjectRef -> WHNFData -> EvalM ()
writeObjectRef ObjectRef
ref (WHNFData -> EvalM ()) -> WHNFData -> EvalM ()
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value EgisonValue
val
      EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return EgisonValue
val
    Thunk EvalM WHNFData
thunk -> do
      EgisonValue
val <- EvalM WHNFData
thunk EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF
      ObjectRef -> WHNFData -> EvalM ()
writeObjectRef ObjectRef
ref (WHNFData -> EvalM ()) -> WHNFData -> EvalM ()
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value EgisonValue
val
      EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return EgisonValue
val

evalMemoizedFunc
  :: IORef (HL.HashMap [Integer] WHNFData) -> Env -> [String] -> IExpr
  -> [EgisonValue] -> EvalM WHNFData
evalMemoizedFunc :: IORef (HashMap [Integer] WHNFData)
-> Env -> [String] -> IExpr -> [EgisonValue] -> EvalM WHNFData
evalMemoizedFunc IORef (HashMap [Integer] WHNFData)
hashRef Env
env [String]
names IExpr
body [EgisonValue]
args = do
  [Integer]
indices <- (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Integer]
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 EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison [EgisonValue]
args
  HashMap [Integer] WHNFData
hash <- IO (HashMap [Integer] WHNFData)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (HashMap [Integer] WHNFData)
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap [Integer] WHNFData)
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      (HashMap [Integer] WHNFData))
-> IO (HashMap [Integer] WHNFData)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (HashMap [Integer] WHNFData)
forall a b. (a -> b) -> a -> b
$ IORef (HashMap [Integer] WHNFData)
-> IO (HashMap [Integer] WHNFData)
forall a. IORef a -> IO a
readIORef IORef (HashMap [Integer] WHNFData)
hashRef
  case [Integer] -> HashMap [Integer] WHNFData -> Maybe WHNFData
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HL.lookup [Integer]
indices HashMap [Integer] WHNFData
hash of
    Just WHNFData
whnf -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
whnf
    Maybe WHNFData
Nothing -> do
      WHNFData
whnf <- Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env (EgisonValue -> WHNFData
Value (Maybe Var -> Env -> CallStack -> IExpr -> EgisonValue
Func Maybe Var
forall a. Maybe a
Nothing Env
env ((String -> Var) -> [String] -> CallStack
forall a b. (a -> b) -> [a] -> [b]
map String -> Var
stringToVar [String]
names) IExpr
body)) ((EgisonValue -> Object) -> [EgisonValue] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (WHNFData -> Object
WHNF (WHNFData -> Object)
-> (EgisonValue -> WHNFData) -> EgisonValue -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value) [EgisonValue]
args)
      IO () -> EvalM ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ IORef (HashMap [Integer] WHNFData)
-> (HashMap [Integer] WHNFData -> HashMap [Integer] WHNFData)
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (HashMap [Integer] WHNFData)
hashRef ([Integer]
-> WHNFData
-> HashMap [Integer] WHNFData
-> HashMap [Integer] WHNFData
forall k v. Hashable k => k -> v -> HashMap k v -> HashMap k v
HL.insert [Integer]
indices WHNFData
whnf)
      WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
whnf

evalWHNF :: WHNFData -> EvalM EgisonValue
evalWHNF :: WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF (Value EgisonValue
val) = EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return EgisonValue
val
evalWHNF (IInductiveData String
name [ObjectRef]
refs) =
  String -> [EgisonValue] -> EgisonValue
InductiveData String
name ([EgisonValue] -> EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep [ObjectRef]
refs
evalWHNF (IIntHash HashMap Integer ObjectRef
refs)  = HashMap Integer EgisonValue -> EgisonValue
IntHash  (HashMap Integer EgisonValue -> EgisonValue)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (HashMap Integer EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> HashMap Integer ObjectRef
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (HashMap Integer EgisonValue)
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) -> HashMap Integer a -> m (HashMap Integer b)
mapM ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep HashMap Integer ObjectRef
refs
evalWHNF (ICharHash HashMap Char ObjectRef
refs) = HashMap Char EgisonValue -> EgisonValue
CharHash (HashMap Char EgisonValue -> EgisonValue)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (HashMap Char EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> HashMap Char ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (HashMap Char EgisonValue)
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) -> HashMap Char a -> m (HashMap Char b)
mapM ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep HashMap Char ObjectRef
refs
evalWHNF (IStrHash HashMap Text ObjectRef
refs)  = HashMap Text EgisonValue -> EgisonValue
StrHash  (HashMap Text EgisonValue -> EgisonValue)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (HashMap Text EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> HashMap Text ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (HashMap Text EgisonValue)
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) -> HashMap Text a -> m (HashMap Text b)
mapM ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep HashMap Text ObjectRef
refs
evalWHNF (ITuple [ObjectRef
ref]) = ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep ObjectRef
ref
evalWHNF (ITuple [ObjectRef]
refs) = [EgisonValue] -> EgisonValue
Tuple ([EgisonValue] -> EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep [ObjectRef]
refs
evalWHNF (ITensor (Tensor [Integer]
ns Vector ObjectRef
whnfs [Index EgisonValue]
js)) = do
  Vector EgisonValue
vals <- (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> Vector ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Vector EgisonValue)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep Vector ObjectRef
whnfs
  EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b. (a -> b) -> a -> b
$ Tensor EgisonValue -> EgisonValue
TensorData (Tensor EgisonValue -> EgisonValue)
-> Tensor EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ [Integer]
-> Vector EgisonValue -> [Index EgisonValue] -> Tensor EgisonValue
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
ns Vector EgisonValue
vals [Index EgisonValue]
js
evalWHNF WHNFData
coll = Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Seq EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WHNFData
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
collectionToRefs WHNFData
coll EvalM
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall (m :: * -> *) a. Monad m => MList m a -> m [a]
fromMList StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> ([ObjectRef]
    -> StateT
         EvalState (ExceptT EgisonError RuntimeM) (Seq EgisonValue))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Seq EgisonValue)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> Seq ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Seq EgisonValue)
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) -> Seq a -> m (Seq b)
mapM ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep (Seq ObjectRef
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Seq EgisonValue))
-> ([ObjectRef] -> Seq ObjectRef)
-> [ObjectRef]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Seq EgisonValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ObjectRef] -> Seq ObjectRef
forall a. [a] -> Seq a
Sq.fromList)

addscript :: (Index EgisonValue, Tensor a) -> Tensor a
addscript :: forall a. (Index EgisonValue, Tensor a) -> Tensor a
addscript (Index EgisonValue
subj, Tensor [Integer]
s Vector a
t [Index EgisonValue]
i) = [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
s Vector a
t ([Index EgisonValue]
i [Index EgisonValue] -> [Index EgisonValue] -> [Index EgisonValue]
forall a. [a] -> [a] -> [a]
++ [Index EgisonValue
subj])

newApplyThunk :: Env -> WHNFData -> [ObjectRef] -> Object
newApplyThunk :: Env -> WHNFData -> [ObjectRef] -> Object
newApplyThunk Env
env WHNFData
fn [ObjectRef]
refs = EvalM WHNFData -> Object
Thunk (EvalM WHNFData -> Object) -> EvalM WHNFData -> Object
forall a b. (a -> b) -> a -> b
$ Env -> WHNFData -> [ObjectRef] -> EvalM WHNFData
applyRef Env
env WHNFData
fn [ObjectRef]
refs

newApplyThunkRef :: Env -> WHNFData -> [ObjectRef] -> EvalM ObjectRef
newApplyThunkRef :: Env
-> WHNFData
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyThunkRef Env
env WHNFData
fn [ObjectRef]
refs = IO ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> (Object -> IO ObjectRef)
-> Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> IO ObjectRef
forall a. a -> IO (IORef a)
newIORef (Object
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b. (a -> b) -> a -> b
$ Env -> WHNFData -> [ObjectRef] -> Object
newApplyThunk Env
env WHNFData
fn [ObjectRef]
refs

newApplyObjThunk :: Env -> WHNFData -> [Object] -> Object
newApplyObjThunk :: Env -> WHNFData -> [Object] -> Object
newApplyObjThunk Env
env WHNFData
fn [Object]
objs = EvalM WHNFData -> Object
Thunk (EvalM WHNFData -> Object) -> EvalM WHNFData -> Object
forall a b. (a -> b) -> a -> b
$ Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
fn [Object]
objs

newApplyObjThunkRef :: Env -> WHNFData -> [Object] -> EvalM ObjectRef
newApplyObjThunkRef :: Env
-> WHNFData
-> [Object]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newApplyObjThunkRef Env
env WHNFData
fn [Object]
objs = IO ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> (Object -> IO ObjectRef)
-> Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> IO ObjectRef
forall a. a -> IO (IORef a)
newIORef (Object
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b. (a -> b) -> a -> b
$ Env -> WHNFData -> [Object] -> Object
newApplyObjThunk Env
env WHNFData
fn [Object]
objs

applyRef :: Env -> WHNFData -> [ObjectRef] -> EvalM WHNFData
applyRef :: Env -> WHNFData -> [ObjectRef] -> EvalM WHNFData
applyRef Env
env (Value (TensorData (Tensor [Integer]
s1 Vector EgisonValue
t1 [Index EgisonValue]
i1))) [ObjectRef]
refs = do
  [WHNFData]
tds <- (ObjectRef -> EvalM WHNFData)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 ObjectRef -> EvalM WHNFData
evalRef [ObjectRef]
refs
  if [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Index EgisonValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index EgisonValue]
i1 Bool -> Bool -> Bool
&& (WHNFData -> Bool) -> [WHNFData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(ITensor (Tensor [Integer]
s Vector ObjectRef
_ [Index EgisonValue]
i)) -> [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Index EgisonValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index EgisonValue]
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) [WHNFData]
tds
    then do
      String
symId <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      let argnum :: Int
argnum = [WHNFData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WHNFData]
tds
          subjs :: [Index EgisonValue]
subjs = (Int -> Index EgisonValue) -> [Int] -> [Index EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map (EgisonValue -> Index EgisonValue
forall a. a -> Index a
Sub (EgisonValue -> Index EgisonValue)
-> (Int -> EgisonValue) -> Int -> Index EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> EgisonValue
symbolScalarData String
symId (String -> EgisonValue) -> (Int -> String) -> Int -> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
1 .. Int
argnum]
          supjs :: [Index EgisonValue]
supjs = (Int -> Index EgisonValue) -> [Int] -> [Index EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map (EgisonValue -> Index EgisonValue
forall a. a -> Index a
Sup (EgisonValue -> Index EgisonValue)
-> (Int -> EgisonValue) -> Int -> Index EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> EgisonValue
symbolScalarData String
symId (String -> EgisonValue) -> (Int -> String) -> Int -> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
1 .. Int
argnum]
      WHNFData
dot <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env (String -> IExpr
IVarExpr String
".")
      [Tensor ObjectRef]
tds' <- (WHNFData
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef))
-> [WHNFData]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Tensor ObjectRef]
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 WHNFData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. TensorComponent a b => a -> EvalM (Tensor b)
toTensor [WHNFData]
tds
      let args' :: [WHNFData]
args' = EgisonValue -> WHNFData
Value (Tensor EgisonValue -> EgisonValue
TensorData ([Integer]
-> Vector EgisonValue -> [Index EgisonValue] -> Tensor EgisonValue
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
s1 Vector EgisonValue
t1 ([Index EgisonValue]
i1 [Index EgisonValue] -> [Index EgisonValue] -> [Index EgisonValue]
forall a. [a] -> [a] -> [a]
++ [Index EgisonValue]
supjs))) WHNFData -> [WHNFData] -> [WHNFData]
forall a. a -> [a] -> [a]
: ((Index EgisonValue, Tensor ObjectRef) -> WHNFData)
-> [(Index EgisonValue, Tensor ObjectRef)] -> [WHNFData]
forall a b. (a -> b) -> [a] -> [b]
map (Tensor ObjectRef -> WHNFData
ITensor (Tensor ObjectRef -> WHNFData)
-> ((Index EgisonValue, Tensor ObjectRef) -> Tensor ObjectRef)
-> (Index EgisonValue, Tensor ObjectRef)
-> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index EgisonValue, Tensor ObjectRef) -> Tensor ObjectRef
forall a. (Index EgisonValue, Tensor a) -> Tensor a
addscript) ([Index EgisonValue]
-> [Tensor ObjectRef] -> [(Index EgisonValue, Tensor ObjectRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Index EgisonValue]
subjs [Tensor ObjectRef]
tds')
      Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
dot ((WHNFData -> Object) -> [WHNFData] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map WHNFData -> Object
WHNF [WHNFData]
args')
    else EgisonError -> EvalM WHNFData
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM WHNFData) -> EgisonError -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"applyObj"
applyRef Env
env (ITensor (Tensor [Integer]
s1 Vector ObjectRef
t1 [Index EgisonValue]
i1)) [ObjectRef]
refs = do
  [WHNFData]
tds <- (ObjectRef -> EvalM WHNFData)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 ObjectRef -> EvalM WHNFData
evalRef [ObjectRef]
refs
  if [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Index EgisonValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index EgisonValue]
i1 Bool -> Bool -> Bool
&& (WHNFData -> Bool) -> [WHNFData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(ITensor (Tensor [Integer]
s Vector ObjectRef
_ [Index EgisonValue]
i)) -> [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Index EgisonValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index EgisonValue]
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) [WHNFData]
tds
    then do
      String
symId <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      let argnum :: Int
argnum = [WHNFData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WHNFData]
tds
          subjs :: [Index EgisonValue]
subjs = (Int -> Index EgisonValue) -> [Int] -> [Index EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map (EgisonValue -> Index EgisonValue
forall a. a -> Index a
Sub (EgisonValue -> Index EgisonValue)
-> (Int -> EgisonValue) -> Int -> Index EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> EgisonValue
symbolScalarData String
symId (String -> EgisonValue) -> (Int -> String) -> Int -> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
1 .. Int
argnum]
          supjs :: [Index EgisonValue]
supjs = (Int -> Index EgisonValue) -> [Int] -> [Index EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map (EgisonValue -> Index EgisonValue
forall a. a -> Index a
Sup (EgisonValue -> Index EgisonValue)
-> (Int -> EgisonValue) -> Int -> Index EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> EgisonValue
symbolScalarData String
symId (String -> EgisonValue) -> (Int -> String) -> Int -> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
1 .. Int
argnum]
      WHNFData
dot <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env (String -> IExpr
IVarExpr String
".")
      [Tensor ObjectRef]
tds' <- (WHNFData
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef))
-> [WHNFData]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [Tensor ObjectRef]
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 WHNFData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
forall a b. TensorComponent a b => a -> EvalM (Tensor b)
toTensor [WHNFData]
tds
      let args' :: [WHNFData]
args' = Tensor ObjectRef -> WHNFData
ITensor ([Integer]
-> Vector ObjectRef -> [Index EgisonValue] -> Tensor ObjectRef
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
s1 Vector ObjectRef
t1 ([Index EgisonValue]
i1 [Index EgisonValue] -> [Index EgisonValue] -> [Index EgisonValue]
forall a. [a] -> [a] -> [a]
++ [Index EgisonValue]
supjs)) WHNFData -> [WHNFData] -> [WHNFData]
forall a. a -> [a] -> [a]
: ((Index EgisonValue, Tensor ObjectRef) -> WHNFData)
-> [(Index EgisonValue, Tensor ObjectRef)] -> [WHNFData]
forall a b. (a -> b) -> [a] -> [b]
map (Tensor ObjectRef -> WHNFData
ITensor (Tensor ObjectRef -> WHNFData)
-> ((Index EgisonValue, Tensor ObjectRef) -> Tensor ObjectRef)
-> (Index EgisonValue, Tensor ObjectRef)
-> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index EgisonValue, Tensor ObjectRef) -> Tensor ObjectRef
forall a. (Index EgisonValue, Tensor a) -> Tensor a
addscript) ([Index EgisonValue]
-> [Tensor ObjectRef] -> [(Index EgisonValue, Tensor ObjectRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Index EgisonValue]
subjs [Tensor ObjectRef]
tds')
      Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
dot ((WHNFData -> Object) -> [WHNFData] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map WHNFData -> Object
WHNF [WHNFData]
args')
    else EgisonError -> EvalM WHNFData
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM WHNFData) -> EgisonError -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"applyfunc"
applyRef Env
env' (Value (Func Maybe Var
mFuncName Env
env CallStack
names IExpr
body)) [ObjectRef]
refs =
  Maybe Var -> EvalM WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. MonadEval m => Maybe Var -> m a -> m a
mLabelFuncName Maybe Var
mFuncName (EvalM WHNFData -> EvalM WHNFData)
-> EvalM WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$
    if | CallStack -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CallStack
names Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [ObjectRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ObjectRef]
refs -> do
         [Binding]
frame <- CallStack -> [ObjectRef] -> EvalM [Binding]
makeBindings CallStack
names [ObjectRef]
refs
         Env -> IExpr -> EvalM WHNFData
evalExprShallow (Env -> [Binding] -> Env
extendEnv Env
env [Binding]
frame) IExpr
body
       | CallStack -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CallStack
names Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [ObjectRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ObjectRef]
refs -> do -- Currying
         let (CallStack
bound, CallStack
rest) = Int -> CallStack -> (CallStack, CallStack)
forall a. Int -> [a] -> ([a], [a])
splitAt ([ObjectRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ObjectRef]
refs) CallStack
names
         [Binding]
frame <- CallStack -> [ObjectRef] -> EvalM [Binding]
makeBindings CallStack
bound [ObjectRef]
refs
         WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Maybe Var -> Env -> CallStack -> IExpr -> EgisonValue
Func Maybe Var
mFuncName (Env -> [Binding] -> Env
extendEnv Env
env [Binding]
frame) CallStack
rest IExpr
body
       | Bool
otherwise -> do
         let ([ObjectRef]
used, [ObjectRef]
rest) = Int -> [ObjectRef] -> ([ObjectRef], [ObjectRef])
forall a. Int -> [a] -> ([a], [a])
splitAt (CallStack -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CallStack
names) [ObjectRef]
refs
         [Binding]
frame <- CallStack -> [ObjectRef] -> EvalM [Binding]
makeBindings CallStack
names [ObjectRef]
used
         WHNFData
func <- Env -> IExpr -> EvalM WHNFData
evalExprShallow (Env -> [Binding] -> Env
extendEnv Env
env [Binding]
frame) IExpr
body
         Env -> WHNFData -> [ObjectRef] -> EvalM WHNFData
applyRef Env
env' WHNFData
func [ObjectRef]
rest
applyRef Env
_ (Value (CFunc Env
env String
name IExpr
body)) [ObjectRef]
refs = do
  IORef (Seq Inner)
seqRef <- IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Seq Inner))
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner)))
-> (Seq Inner -> IO (IORef (Seq Inner)))
-> Seq Inner
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Inner -> IO (IORef (Seq Inner))
forall a. a -> IO (IORef a)
newIORef (Seq Inner
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner)))
-> Seq Inner
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a b. (a -> b) -> a -> b
$ [Inner] -> Seq Inner
forall a. [a] -> Seq a
Sq.fromList ((ObjectRef -> Inner) -> [ObjectRef] -> [Inner]
forall a b. (a -> b) -> [a] -> [b]
map ObjectRef -> Inner
IElement [ObjectRef]
refs)
  ObjectRef
col <- IO ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> (Object -> IO ObjectRef)
-> Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> IO ObjectRef
forall a. a -> IO (IORef a)
newIORef (Object
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b. (a -> b) -> a -> b
$ WHNFData -> Object
WHNF (WHNFData -> Object) -> WHNFData -> Object
forall a b. (a -> b) -> a -> b
$ IORef (Seq Inner) -> WHNFData
ICollection IORef (Seq Inner)
seqRef
  Env -> IExpr -> EvalM WHNFData
evalExprShallow (Env -> [Binding] -> Env
extendEnv Env
env ([Binding] -> Env) -> [Binding] -> Env
forall a b. (a -> b) -> a -> b
$ [String] -> [ObjectRef] -> [Binding]
makeBindings' [String
name] [ObjectRef
col]) IExpr
body
applyRef Env
_ (Value (PrimitiveFunc PrimitiveFunc
func)) [ObjectRef]
refs = do
  [EgisonValue]
vals <- (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 (\ObjectRef
ref -> ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF) [ObjectRef]
refs
  EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimitiveFunc
func [EgisonValue]
vals
applyRef Env
_ (Value (LazyPrimitiveFunc [WHNFData] -> EvalM WHNFData
func)) [ObjectRef]
refs = do
  [WHNFData]
whnfs <- (ObjectRef -> EvalM WHNFData)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 ObjectRef -> EvalM WHNFData
evalRef [ObjectRef]
refs
  [WHNFData] -> EvalM WHNFData
func [WHNFData]
whnfs
applyRef Env
_ (Value (IOFunc EvalM WHNFData
m)) [ObjectRef]
refs = do
  [WHNFData]
args <- (ObjectRef -> EvalM WHNFData)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 ObjectRef -> EvalM WHNFData
evalRef [ObjectRef]
refs
  case [WHNFData]
args of
    [Value EgisonValue
World] -> EvalM WHNFData
m
    WHNFData
arg : [WHNFData]
_       -> (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"world" WHNFData
arg)
applyRef Env
_ (Value (ScalarData fn :: ScalarData
fn@(SingleTerm Integer
1 [(Symbol{}, Integer
1)]))) [ObjectRef]
refs = do
  [EgisonValue]
args <- (ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 (\ObjectRef
ref -> ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF) [ObjectRef]
refs
  [ScalarData]
mExprs <- (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ScalarData]
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 (\EgisonValue
arg -> case EgisonValue
arg of
                            ScalarData ScalarData
_ -> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
extractScalar EgisonValue
arg
                            EgisonValue
_            -> (CallStack -> EgisonError)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
EgisonBug String
"to use undefined functions, you have to use ScalarData args")) [EgisonValue]
args
  WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> WHNFData
Value (ScalarData -> EgisonValue
ScalarData (Integer -> Monomial -> ScalarData
SingleTerm Integer
1 [(ScalarData -> [ScalarData] -> SymbolExpr
Apply ScalarData
fn [ScalarData]
mExprs, Integer
1)])))
applyRef Env
_ WHNFData
whnf [ObjectRef]
_ = (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"function" WHNFData
whnf)

applyObj :: Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj :: Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
fn [Object]
args = do
  [ObjectRef]
refs <- IO [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ObjectRef]
 -> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef])
-> IO [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall a b. (a -> b) -> a -> b
$ (Object -> IO ObjectRef) -> [Object] -> IO [ObjectRef]
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 Object -> IO ObjectRef
forall a. a -> IO (IORef a)
newIORef [Object]
args
  Env -> WHNFData -> [ObjectRef] -> EvalM WHNFData
applyRef Env
env WHNFData
fn [ObjectRef]
refs

refHash :: WHNFData -> [EgisonValue] -> EvalM WHNFData
refHash :: WHNFData -> [EgisonValue] -> EvalM WHNFData
refHash WHNFData
val [] = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
val
refHash WHNFData
val (EgisonValue
index:[EgisonValue]
indices) =
  case WHNFData
val of
    Value (IntHash HashMap Integer EgisonValue
hash)  -> HashMap Integer EgisonValue -> EvalM WHNFData
forall {k}.
(EgisonData k, Hashable k) =>
HashMap k EgisonValue -> EvalM WHNFData
refHash' HashMap Integer EgisonValue
hash
    Value (CharHash HashMap Char EgisonValue
hash) -> HashMap Char EgisonValue -> EvalM WHNFData
forall {k}.
(EgisonData k, Hashable k) =>
HashMap k EgisonValue -> EvalM WHNFData
refHash' HashMap Char EgisonValue
hash
    Value (StrHash HashMap Text EgisonValue
hash)  -> HashMap Text EgisonValue -> EvalM WHNFData
forall {k}.
(EgisonData k, Hashable k) =>
HashMap k EgisonValue -> EvalM WHNFData
refHash' HashMap Text EgisonValue
hash
    IIntHash HashMap Integer ObjectRef
hash         -> HashMap Integer ObjectRef -> EvalM WHNFData
forall {k}.
(EgisonData k, Hashable k) =>
HashMap k ObjectRef -> EvalM WHNFData
irefHash HashMap Integer ObjectRef
hash
    ICharHash HashMap Char ObjectRef
hash        -> HashMap Char ObjectRef -> EvalM WHNFData
forall {k}.
(EgisonData k, Hashable k) =>
HashMap k ObjectRef -> EvalM WHNFData
irefHash HashMap Char ObjectRef
hash
    IStrHash HashMap Text ObjectRef
hash         -> HashMap Text ObjectRef -> EvalM WHNFData
forall {k}.
(EgisonData k, Hashable k) =>
HashMap k ObjectRef -> EvalM WHNFData
irefHash HashMap Text ObjectRef
hash
    WHNFData
_                     -> (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"hash" WHNFData
val)
 where
  refHash' :: HashMap k EgisonValue -> EvalM WHNFData
refHash' HashMap k EgisonValue
hash = do
    k
key <- EgisonValue -> EvalM k
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
index
    case k -> HashMap k EgisonValue -> Maybe EgisonValue
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HL.lookup k
key HashMap k EgisonValue
hash of
      Just EgisonValue
val -> WHNFData -> [EgisonValue] -> EvalM WHNFData
refHash (EgisonValue -> WHNFData
Value EgisonValue
val) [EgisonValue]
indices
      Maybe EgisonValue
Nothing  -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value EgisonValue
Undefined

  irefHash :: HashMap k ObjectRef -> EvalM WHNFData
irefHash HashMap k ObjectRef
hash = do
    k
key <- EgisonValue -> EvalM k
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
index
    case k -> HashMap k ObjectRef -> Maybe ObjectRef
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HL.lookup k
key HashMap k ObjectRef
hash of
      Just ObjectRef
ref -> ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref EvalM WHNFData -> (WHNFData -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WHNFData -> [EgisonValue] -> EvalM WHNFData)
-> [EgisonValue] -> WHNFData -> EvalM WHNFData
forall a b c. (a -> b -> c) -> b -> a -> c
flip WHNFData -> [EgisonValue] -> EvalM WHNFData
refHash [EgisonValue]
indices
      Maybe ObjectRef
Nothing  -> WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value EgisonValue
Undefined

subst :: (Eq a) => a -> b -> [(a, b)] -> [(a, b)]
subst :: forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
subst a
k b
nv ((a
k', b
v'):[(a, b)]
xs) | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k'   = (a
k', b
nv)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:a -> b -> [(a, b)] -> [(a, b)]
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
subst a
k b
nv [(a, b)]
xs
                         | Bool
otherwise = (a
k', b
v')(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:a -> b -> [(a, b)] -> [(a, b)]
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
subst a
k b
nv [(a, b)]
xs
subst a
_ b
_ [] = []

newThunk :: Env -> IExpr -> Object
newThunk :: Env -> IExpr -> Object
newThunk Env
env IExpr
expr = EvalM WHNFData -> Object
Thunk (EvalM WHNFData -> Object) -> EvalM WHNFData -> Object
forall a b. (a -> b) -> a -> b
$ Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr

newThunkRef :: Env -> IExpr -> EvalM ObjectRef
newThunkRef :: Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env IExpr
expr = IO ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> (Object -> IO ObjectRef)
-> Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> IO ObjectRef
forall a. a -> IO (IORef a)
newIORef (Object
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b. (a -> b) -> a -> b
$ Env -> IExpr -> Object
newThunk Env
env IExpr
expr

recursiveBind :: Env -> [(Var, IExpr)] -> EvalM Env
recursiveBind :: Env -> [(Var, IExpr)] -> EvalM Env
recursiveBind Env
env [(Var, IExpr)]
bindings = do
  -- Create dummy bindings first. Since this is a reference,
  -- it can be overwritten later.
  [Binding]
binds <- ((Var, IExpr)
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Binding)
-> [(Var, IExpr)] -> EvalM [Binding]
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 (\(Var
var, IExpr
_) -> (Var
var,) (ObjectRef -> Binding)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
nullEnv (ConstantExpr -> IExpr
IConstantExpr ConstantExpr
UndefinedExpr)) [(Var, IExpr)]
bindings
  let env' :: Env
env' = Env -> [Binding] -> Env
extendEnv Env
env [Binding]
binds
  [(Var, IExpr)] -> ((Var, IExpr) -> EvalM ()) -> EvalM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Var, IExpr)]
bindings (((Var, IExpr) -> EvalM ()) -> EvalM ())
-> ((Var, IExpr) -> EvalM ()) -> EvalM ()
forall a b. (a -> b) -> a -> b
$ \(Var
var, IExpr
expr) -> do
    let env'' :: Env
env'' = Env -> Var -> Env
memorizeVarInEnv Env
env' Var
var
    let ref :: ObjectRef
ref = Maybe ObjectRef -> ObjectRef
forall a. HasCallStack => Maybe a -> a
fromJust (Env -> Var -> Maybe ObjectRef
refVar Env
env' Var
var)
    IO () -> EvalM ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ ObjectRef -> Object -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef ObjectRef
ref (Env -> IExpr -> Object
newThunk Env
env'' IExpr
expr)
  Env -> EvalM Env
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env'

recursiveMatchBind :: Env -> [IBindingExpr] -> EvalM Env
recursiveMatchBind :: Env -> [IBindingExpr] -> EvalM Env
recursiveMatchBind Env
env [IBindingExpr]
bindings = do
  -- List of variables defined in |bindings|
  let names :: CallStack
names = (IBindingExpr -> CallStack) -> [IBindingExpr] -> CallStack
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(PDPatternBase Var
pd, IExpr
_) -> PDPatternBase Var -> CallStack
forall a. PDPatternBase a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList PDPatternBase Var
pd) [IBindingExpr]
bindings
  -- Create dummy bindings for |names| first. Since this is a reference,
  -- it can be overwritten later.
  [Binding]
binds <- (Var -> StateT EvalState (ExceptT EgisonError RuntimeM) Binding)
-> CallStack -> EvalM [Binding]
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 (\Var
name -> (Var
name,) (ObjectRef -> Binding)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
nullEnv (ConstantExpr -> IExpr
IConstantExpr ConstantExpr
UndefinedExpr)) CallStack
names
  let env' :: Env
env' = Env -> [Binding] -> Env
extendEnv Env
env [Binding]
binds
  [IBindingExpr] -> (IBindingExpr -> EvalM ()) -> EvalM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [IBindingExpr]
bindings ((IBindingExpr -> EvalM ()) -> EvalM ())
-> (IBindingExpr -> EvalM ()) -> EvalM ()
forall a b. (a -> b) -> a -> b
$ \(PDPatternBase Var
pd, IExpr
expr) -> do
    -- Modify |env'| for some cases
    let env'' :: Env
env'' = case PDPatternBase Var
pd of
                  PDPatVar Var
var -> Env -> Var -> Env
memorizeVarInEnv Env
env' Var
var
                  PDPatternBase Var
_            -> Env
env'
    ObjectRef
thunk <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env'' IExpr
expr
    [Binding]
binds <- PDPatternBase Var -> ObjectRef -> EvalM [Binding]
bindPrimitiveDataPattern PDPatternBase Var
pd ObjectRef
thunk
    [Binding] -> (Binding -> EvalM ()) -> EvalM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Binding]
binds ((Binding -> EvalM ()) -> EvalM ())
-> (Binding -> EvalM ()) -> EvalM ()
forall a b. (a -> b) -> a -> b
$ \(Var
var, ObjectRef
objref) -> do
      -- Get an Object |obj| being bound to |var|.
      Object
obj <- IO Object -> StateT EvalState (ExceptT EgisonError RuntimeM) Object
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Object)
-> IO Object
-> StateT EvalState (ExceptT EgisonError RuntimeM) Object
forall a b. (a -> b) -> a -> b
$ ObjectRef -> IO Object
forall a. IORef a -> IO a
readIORef ObjectRef
objref
      let ref :: ObjectRef
ref = Maybe ObjectRef -> ObjectRef
forall a. HasCallStack => Maybe a -> a
fromJust (Env -> Var -> Maybe ObjectRef
refVar Env
env' Var
var)
      IO () -> EvalM ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ ObjectRef -> Object -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef ObjectRef
ref Object
obj
  Env -> EvalM Env
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env'

memorizeVarInEnv :: Env -> Var -> Env
memorizeVarInEnv :: Env -> Var -> Env
memorizeVarInEnv (Env [HashMap Var ObjectRef]
frame Maybe (String, [Index (Maybe ScalarData)])
_) (Var String
var [Index (Maybe Var)]
is) =
  [HashMap Var ObjectRef]
-> Maybe (String, [Index (Maybe ScalarData)]) -> Env
Env [HashMap Var ObjectRef]
frame ((String, [Index (Maybe ScalarData)])
-> Maybe (String, [Index (Maybe ScalarData)])
forall a. a -> Maybe a
Just (String
var, (Index (Maybe Var) -> Index (Maybe ScalarData))
-> [Index (Maybe Var)] -> [Index (Maybe ScalarData)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Var -> Maybe ScalarData)
-> Index (Maybe Var) -> Index (Maybe ScalarData)
forall a b. (a -> b) -> Index a -> Index b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Var
_ -> Maybe ScalarData
forall a. Maybe a
Nothing)) [Index (Maybe Var)]
is))

--
-- Pattern Match
--

patternMatch :: PMMode -> Env -> IPattern -> WHNFData -> Matcher -> EvalM (MList EvalM Match)
patternMatch :: PMMode
-> Env
-> IPattern
-> WHNFData
-> EgisonValue
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
patternMatch PMMode
pmmode Env
env IPattern
pattern WHNFData
target EgisonValue
matcher =
  case PMMode
pmmode of
    PMMode
DFSMode -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
processMStatesAllDFS (MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton MatchingState
initMState)
    PMMode
BFSMode -> [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
processMStatesAll [MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton MatchingState
initMState]
  where
    initMState :: MatchingState
initMState = MState { mStateEnv :: Env
mStateEnv      = Env
env
                        , loopPatCtx :: [LoopPatContext]
loopPatCtx     = []
                        , seqPatCtx :: [SeqPatContext]
seqPatCtx      = []
                        , mStateBindings :: [Binding]
mStateBindings = []
                        , mTrees :: [MatchingTree]
mTrees         = [IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
matcher]
                        }

processMStatesAllDFS :: MList EvalM MatchingState -> EvalM (MList EvalM Match)
processMStatesAllDFS :: MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
processMStatesAllDFS MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
MNil                                   = MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall (m :: * -> *) a. MList m a
MNil
processMStatesAllDFS (MCons (MState Env
_ [LoopPatContext]
_ [] [Binding]
bindings []) EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
ms) = [Binding]
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall (m :: * -> *) a. a -> m (MList m a) -> MList m a
MCons [Binding]
bindings (EvalM
   (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
 -> MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
    -> EvalM
         (MList
            (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]))
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
processMStatesAllDFS (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
ms
processMStatesAllDFS (MCons MatchingState
mstate EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
ms)                      = MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState MatchingState
mstate EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
    -> EvalM
         (MList
            (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall (m :: * -> *) a.
Monad m =>
MList m a -> m (MList m a) -> m (MList m a)
`mappend` EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
ms) EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
    -> EvalM
         (MList
            (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]))
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
processMStatesAllDFS

processMStatesAllDFSForall :: MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
processMStatesAllDFSForall :: MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMStatesAllDFSForall MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
MNil                                                           = MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. MList m a
MNil
processMStatesAllDFSForall (MCons mstate :: MatchingState
mstate@(MState Env
_ [LoopPatContext]
_ (ForallPatContext [EgisonValue]
_ [WHNFData]
_ : [SeqPatContext]
_) [Binding]
_ []) EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
ms) = MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. a -> m (MList m a) -> MList m a
MCons MatchingState
mstate (EvalM
   (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
 -> MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
    -> EvalM
         (MList
            (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMStatesAllDFSForall (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
ms
processMStatesAllDFSForall (MCons MatchingState
mstate EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
ms)                                              = MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState MatchingState
mstate EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
    -> EvalM
         (MList
            (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall (m :: * -> *) a.
Monad m =>
MList m a -> m (MList m a) -> m (MList m a)
`mappend` EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
ms) EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
    -> EvalM
         (MList
            (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMStatesAllDFSForall

processMStatesAll :: [MList EvalM MatchingState] -> EvalM (MList EvalM Match)
processMStatesAll :: [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
processMStatesAll [] = MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall (m :: * -> *) a. MList m a
MNil
processMStatesAll [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
streams = do
  ([[Binding]]
matches, [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
streams') <- (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [[MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]]
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 MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
processMStates [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
streams StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  [[MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]]
-> ([[MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]]
    -> StateT
         EvalState
         (ExceptT EgisonError RuntimeM)
         ([[Binding]],
          [MList
             (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]],
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]],
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
extractMatches ([MList
    (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      ([[Binding]],
       [MList
          (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]))
-> ([[MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]]
    -> [MList
          (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
-> [[MList
       (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]],
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[MList
    (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]]
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
forall (m :: * -> *) a.
Monad m =>
MList m a -> m (MList m a) -> m (MList m a)
mappend ([[Binding]]
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [[Binding]]
matches) (EvalM
   (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]))
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
forall a b. (a -> b) -> a -> b
$ [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
processMStatesAll [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
streams'

processMStates :: MList EvalM MatchingState -> EvalM [MList EvalM MatchingState]
processMStates :: MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
processMStates MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
MNil                 = [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
processMStates (MCons MatchingState
state EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
stream) = (\MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
x MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
y -> [MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
x, MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
y]) (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> [MList
       (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
      -> [MList
            (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState MatchingState
state StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
   -> [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) (a -> b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) a
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
stream

extractMatches :: [MList EvalM MatchingState] -> EvalM ([Match], [MList EvalM MatchingState])
extractMatches :: [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]],
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
extractMatches = ([[Binding]],
 [MList
    (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]],
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
extractMatches' ([], [])
 where
  extractMatches' :: ([Match], [MList EvalM MatchingState]) -> [MList EvalM MatchingState] -> EvalM ([Match], [MList EvalM MatchingState])
  extractMatches' :: ([[Binding]],
 [MList
    (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]],
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
extractMatches' ([[Binding]]
xs, [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
ys) [] = ([[Binding]],
 [MList
    (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]],
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Binding]]
xs, [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
ys)
  extractMatches' ([[Binding]]
xs, [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
ys) (MCons (MatchingState -> Maybe [Binding]
gatherBindings -> Just [Binding]
bindings) EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
states : [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
rest) = do
    MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
states' <- EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
states
    ([[Binding]],
 [MList
    (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]],
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
extractMatches' ([[Binding]]
xs [[Binding]] -> [[Binding]] -> [[Binding]]
forall a. [a] -> [a] -> [a]
++ [[Binding]
bindings], [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
ys [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
forall a. [a] -> [a] -> [a]
++ [MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
states']) [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
rest
  extractMatches' ([[Binding]]
xs, [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
ys) (MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
stream:[MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
rest) = ([[Binding]],
 [MList
    (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]],
      [MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState])
extractMatches' ([[Binding]]
xs, [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
ys [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
-> [MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
forall a. [a] -> [a] -> [a]
++ [MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
stream]) [MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState]
rest

gatherBindings :: MatchingState -> Maybe [Binding]
gatherBindings :: MatchingState -> Maybe [Binding]
gatherBindings MState{ seqPatCtx :: MatchingState -> [SeqPatContext]
seqPatCtx = [], mStateBindings :: MatchingState -> [Binding]
mStateBindings = [Binding]
b, mTrees :: MatchingState -> [MatchingTree]
mTrees = [] } = [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Binding]
b
gatherBindings MatchingState
_                                                         = Maybe [Binding]
forall a. Maybe a
Nothing

processMState :: MatchingState -> EvalM (MList EvalM MatchingState)
processMState :: MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState MatchingState
state | MatchingState -> Bool
nullMState MatchingState
state = MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState' MatchingState
state
processMState MatchingState
state =
  case MatchingState -> (Integer, MatchingState, MatchingState)
splitMState MatchingState
state of
    (Integer
1, MatchingState
state1, MatchingState
state2) -> do
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
result <- MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
processMStatesAllDFS (MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton MatchingState
state1)
      case MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
result of
        MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
MNil -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton MatchingState
state2
        MList (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
_    -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. MList m a
MNil
    (Integer
0, MState Env
e [LoopPatContext]
l [SeqPatContext]
s [Binding]
b [MAtom (IForallPat IPattern
p1 IPattern
p2) WHNFData
m EgisonValue
t], MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = [MatchingTree]
trees }) -> do
      MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
states <- MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMStatesAllDFSForall (MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (Env
-> [LoopPatContext]
-> [SeqPatContext]
-> [Binding]
-> [MatchingTree]
-> MatchingState
MState Env
e [LoopPatContext]
l ([EgisonValue] -> [WHNFData] -> SeqPatContext
ForallPatContext [] []SeqPatContext -> [SeqPatContext] -> [SeqPatContext]
forall a. a -> [a] -> [a]
:[SeqPatContext]
s) [Binding]
b [IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
p1 WHNFData
m EgisonValue
t]))
      MList
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
statess' <- (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM))
        (MList
           (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MList m a -> m (MList m b)
mmap (\(MState Env
e' [LoopPatContext]
l' (ForallPatContext [EgisonValue]
ms [WHNFData]
ts:[SeqPatContext]
s') [Binding]
b' []) -> do
                            let mat' :: EgisonValue
mat' = [EgisonValue] -> EgisonValue
makeTuple [EgisonValue]
ms
                            WHNFData
tgt' <- [WHNFData] -> EvalM WHNFData
makeITuple [WHNFData]
ts
                            MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMStatesAllDFSForall (MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (Env
-> [LoopPatContext]
-> [SeqPatContext]
-> [Binding]
-> [MatchingTree]
-> MatchingState
MState Env
e' [LoopPatContext]
l' ([EgisonValue] -> [WHNFData] -> SeqPatContext
ForallPatContext [] []SeqPatContext -> [SeqPatContext] -> [SeqPatContext]
forall a. a -> [a] -> [a]
:[SeqPatContext]
s') [Binding]
b' [IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
p2 WHNFData
tgt' EgisonValue
mat']))) MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
states
      Bool
b <- (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool)
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> MList m a -> m Bool
mAny (\case
                   MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
MNil -> Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                   MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
_    -> Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) MList
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
statess'
      if Bool
b
        then MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. MList m a
MNil
--        else return MNil
        else do MList
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
nstatess <- (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM))
        (MList
           (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MList m a -> m (MList m b)
mmap ((MatchingState
 -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MList m a -> m (MList m b)
mmap (\(MState Env
e' [LoopPatContext]
l' (ForallPatContext [] []:[SeqPatContext]
s') [Binding]
b' []) -> MatchingState
-> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MatchingState
 -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> MatchingState
-> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState
forall a b. (a -> b) -> a -> b
$ Env
-> [LoopPatContext]
-> [SeqPatContext]
-> [Binding]
-> [MatchingTree]
-> MatchingState
MState Env
e' [LoopPatContext]
l' [SeqPatContext]
s' [Binding]
b' [MatchingTree]
trees)) MList
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
statess'
                MList
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall (m :: * -> *) a.
Monad m =>
MList m (MList m a) -> m (MList m a)
mconcat MList
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
nstatess
    (Integer, MatchingState, MatchingState)
_ -> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState' MatchingState
state
 where
  splitMState :: MatchingState -> (Integer, MatchingState, MatchingState)
  splitMState :: MatchingState -> (Integer, MatchingState, MatchingState)
splitMState mstate :: MatchingState
mstate@MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MAtom (INotPat IPattern
pattern) WHNFData
target EgisonValue
matcher : [MatchingTree]
trees } =
    (Integer
1, MatchingState
mstate { seqPatCtx = [],  mTrees = [MAtom pattern target matcher] }, MatchingState
mstate { mTrees = trees })
  splitMState mstate :: MatchingState
mstate@MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MAtom IPattern
pattern WHNFData
target EgisonValue
matcher : [MatchingTree]
trees } =
    (Integer
0, MatchingState
mstate { mTrees = [MAtom pattern target matcher] }, MatchingState
mstate { mTrees = trees })
  splitMState mstate :: MatchingState
mstate@MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MNode [PatternBinding]
penv MatchingState
state' : [MatchingTree]
trees } =
    (Integer
f, MatchingState
mstate { mTrees = [MNode penv state1] }, MatchingState
mstate { mTrees = MNode penv state2 : trees })
      where (Integer
f, MatchingState
state1, MatchingState
state2) = MatchingState -> (Integer, MatchingState, MatchingState)
splitMState MatchingState
state'

processMState' :: MatchingState -> EvalM (MList EvalM MatchingState)
--processMState' MState{ seqPatCtx = [], mTrees = [] } = throwErrorWithTrace (EgisonBug "should not reach here (empty matching-state)")
processMState' :: MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState' mstate :: MatchingState
mstate@MState{ seqPatCtx :: MatchingState -> [SeqPatContext]
seqPatCtx = [], mTrees :: MatchingState -> [MatchingTree]
mTrees = [] } = MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate -- for forall pattern used in matchAll (not matchAllDFS)

-- Sequential patterns and forall pattern
processMState' mstate :: MatchingState
mstate@MState{ seqPatCtx :: MatchingState -> [SeqPatContext]
seqPatCtx = SeqPatContext [MatchingTree]
stack IPattern
ISeqNilPat [] []:[SeqPatContext]
seqs, mTrees :: MatchingState -> [MatchingTree]
mTrees = [] } =
  MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { seqPatCtx = seqs, mTrees = stack }
processMState' mstate :: MatchingState
mstate@MState{ seqPatCtx :: MatchingState -> [SeqPatContext]
seqPatCtx = SeqPatContext [MatchingTree]
stack IPattern
seqPat [EgisonValue]
mats [WHNFData]
tgts:[SeqPatContext]
seqs, mTrees :: MatchingState -> [MatchingTree]
mTrees = [] } = do
  let mat' :: EgisonValue
mat' = [EgisonValue] -> EgisonValue
makeTuple [EgisonValue]
mats
  WHNFData
tgt' <- [WHNFData] -> EvalM WHNFData
makeITuple [WHNFData]
tgts
  MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { seqPatCtx = seqs, mTrees = MAtom seqPat tgt' mat' : stack }
processMState' mstate :: MatchingState
mstate@MState{ seqPatCtx :: MatchingState -> [SeqPatContext]
seqPatCtx = ForallPatContext [EgisonValue]
_ [WHNFData]
_:[SeqPatContext]
_, mTrees :: MatchingState -> [MatchingTree]
mTrees = [] } =
  MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate

-- Matching Nodes
--processMState' MState{ mTrees = MNode _ MState{ mStateBindings = [], mTrees = [] }:_ } = throwErrorWithTrace (EgisonBug "should not reach here (empty matching-node)")
processMState' mstate :: MatchingState
mstate@MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MNode [PatternBinding]
_ MState{ seqPatCtx :: MatchingState -> [SeqPatContext]
seqPatCtx = [], mTrees :: MatchingState -> [MatchingTree]
mTrees = [] }:[MatchingTree]
trees } = MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = trees }

processMState' ms1 :: MatchingState
ms1@MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MNode [PatternBinding]
penv ms2 :: MatchingState
ms2@MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MAtom (IVarPat String
name) WHNFData
target EgisonValue
matcher:[MatchingTree]
trees' }:[MatchingTree]
trees } =
  case String -> [PatternBinding] -> Maybe IPattern
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [PatternBinding]
penv of
    Just IPattern
pattern ->
      case [MatchingTree]
trees' of
        [] -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
ms1 { mTrees = MAtom pattern target matcher:trees }
        [MatchingTree]
_  -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
ms1 { mTrees = MAtom pattern target matcher:MNode penv (ms2 { mTrees = trees' }):trees }
    Maybe IPattern
Nothing -> (CallStack -> EgisonError)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
UnboundVariable String
name)

processMState' ms1 :: MatchingState
ms1@(MState Env
_ [LoopPatContext]
_ [SeqPatContext]
_ [Binding]
bindings (MNode [PatternBinding]
penv ms2 :: MatchingState
ms2@(MState Env
env' [LoopPatContext]
loops' [SeqPatContext]
_ [Binding]
_ (MAtom (IIndexedPat (IVarPat String
name) [IExpr]
indices) WHNFData
target EgisonValue
matcher:[MatchingTree]
trees')):[MatchingTree]
trees)) =
  case String -> [PatternBinding] -> Maybe IPattern
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [PatternBinding]
penv of
    Just IPattern
pattern -> do
      let env'' :: Env
env'' = Env -> [Binding] -> [LoopPatContext] -> Env
extendEnvForNonLinearPatterns Env
env' [Binding]
bindings [LoopPatContext]
loops'
      [Integer]
indices <- (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Integer]
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 (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env'' (IExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Integer -> Integer)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a b.
(a -> b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) a
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Integer
forall a. Num a => Integer -> a
fromInteger (StateT EvalState (ExceptT EgisonError RuntimeM) Integer
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison) [IExpr]
indices
      let pattern' :: IPattern
pattern' = IPattern -> [IExpr] -> IPattern
IIndexedPat IPattern
pattern ([IExpr] -> IPattern) -> [IExpr] -> IPattern
forall a b. (a -> b) -> a -> b
$ (Integer -> IExpr) -> [Integer] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map (ConstantExpr -> IExpr
IConstantExpr (ConstantExpr -> IExpr)
-> (Integer -> ConstantExpr) -> Integer -> IExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstantExpr
IntegerExpr) [Integer]
indices
      case [MatchingTree]
trees' of
        [] -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
ms1 { mTrees = MAtom pattern' target matcher:trees }
        [MatchingTree]
_  -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
ms1 { mTrees = MAtom pattern' target matcher:MNode penv (ms2 { mTrees = trees' }):trees }
    Maybe IPattern
Nothing -> (CallStack -> EgisonError)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
UnboundVariable String
name)

processMState' mstate :: MatchingState
mstate@MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MNode [PatternBinding]
penv MatchingState
state:[MatchingTree]
trees } =
  MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState' MatchingState
state EvalM
  (MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> (MList
      (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
    -> EvalM
         (MList
            (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MatchingState
 -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MList m a -> m (MList m b)
mmap (\MatchingState
state' -> case MatchingState
state' of
--egi                                              MState { mTrees = [] } -> return $ mstate { mTrees = trees }
                                              MatchingState
_ -> MatchingState
-> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MatchingState
 -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> MatchingState
-> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = MNode penv state':trees })

-- Matching Atoms
processMState' mstate :: MatchingState
mstate@(MState Env
env [LoopPatContext]
loops [SeqPatContext]
seqs [Binding]
bindings (MAtom IPattern
pattern WHNFData
target EgisonValue
matcher:[MatchingTree]
trees)) =
  let env' :: Env
env' = Env -> [Binding] -> [LoopPatContext] -> Env
extendEnvForNonLinearPatterns Env
env [Binding]
bindings [LoopPatContext]
loops in
  case IPattern
pattern of
    IInductiveOrPApplyPat String
name [IPattern]
args ->
      case Env -> Var -> Maybe ObjectRef
refVar Env
env (String -> Var
stringToVar String
name) of
        Maybe ObjectRef
Nothing -> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState' (MatchingState
mstate { mTrees = MAtom (IInductivePat name args) target matcher:trees })
        Just ObjectRef
ref -> do
          WHNFData
whnf <- ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
          case WHNFData
whnf of
            Value PatternFunc{} ->
              MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState' (MatchingState
mstate { mTrees = MAtom (IPApplyPat (IVarExpr name) args) target matcher:trees })
            WHNFData
_                   ->
              MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
processMState' (MatchingState
mstate { mTrees = MAtom (IInductivePat name args) target matcher:trees })

    INotPat IPattern
_ -> (CallStack -> EgisonError)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
EgisonBug String
"should not reach here (not-pattern)")
    IVarPat String
_ -> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default (String -> EgisonError) -> String -> EgisonError
forall a b. (a -> b) -> a -> b
$ String
"cannot use variable except in pattern function:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IPattern -> String
forall a. Show a => a -> String
show IPattern
pattern

    ILetPat [IBindingExpr]
bindings' IPattern
pattern' -> do
      [Binding]
b <- [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Binding]] -> [Binding])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [[Binding]]
-> EvalM [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IBindingExpr -> EvalM [Binding])
-> [IBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [[Binding]]
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 IBindingExpr -> EvalM [Binding]
extractBindings [IBindingExpr]
bindings'
      MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mStateBindings = b ++ bindings, mTrees = MAtom pattern' target matcher:trees }
        where
          extractBindings :: IBindingExpr -> EvalM [Binding]
extractBindings (PDPatternBase Var
pdp, IExpr
expr) = do
            ObjectRef
thunk <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef (Env -> [Binding] -> Env
extendEnv Env
env [Binding]
bindings) IExpr
expr
            PDPatternBase Var -> ObjectRef -> EvalM [Binding]
bindPrimitiveDataPattern PDPatternBase Var
pdp ObjectRef
thunk

    IPredPat IExpr
predicate -> do
      WHNFData
func <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env' IExpr
predicate
      Bool
result <- Env -> WHNFData -> [Object] -> EvalM WHNFData
applyObj Env
env WHNFData
func [WHNFData -> Object
WHNF WHNFData
target] EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison
      if Bool
result then MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = trees }
                else MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. MList m a
MNil

    IPApplyPat IExpr
func [IPattern]
args -> do
      WHNFData
func' <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env' IExpr
func
      case WHNFData
func' of
        Value (PatternFunc Env
env'' [String]
names IPattern
expr) ->
          MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = MNode penv (MState env'' [] [] [] [MAtom expr target matcher]) : trees }
            where penv :: [PatternBinding]
penv = [String] -> [IPattern] -> [PatternBinding]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names [IPattern]
args
        WHNFData
_ -> (CallStack -> EgisonError)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"pattern constructor" WHNFData
func')

    IDApplyPat IPattern
func [IPattern]
args ->
      MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = MAtom (IInductivePat "apply" [func, toListPat args]) target matcher:trees }

    ILoopPat String
name (ILoopRange IExpr
start IExpr
ends IPattern
endPat) IPattern
pat IPattern
pat' -> do
      Integer
startNum    <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env' IExpr
start StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison :: (EvalM Integer)
      ObjectRef
startNumRef <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData) -> EgisonValue -> WHNFData
forall a b. (a -> b) -> a -> b
$ Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Integer
startNum Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
      WHNFData
ends'       <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env' IExpr
ends
      case WHNFData
ends' of
        Value (ScalarData ScalarData
_) -> do -- the case when the end numbers are an integer
          ObjectRef
endsRef  <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
ends'
          IORef (Seq Inner)
inners   <- IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Seq Inner))
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner)))
-> (Seq Inner -> IO (IORef (Seq Inner)))
-> Seq Inner
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Inner -> IO (IORef (Seq Inner))
forall a. a -> IO (IORef a)
newIORef (Seq Inner
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner)))
-> Seq Inner
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
forall a b. (a -> b) -> a -> b
$ [Inner] -> Seq Inner
forall a. [a] -> Seq a
Sq.fromList [ObjectRef -> Inner
IElement ObjectRef
endsRef]
          ObjectRef
endsRef' <- IO ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObjectRef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> IO ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b. (a -> b) -> a -> b
$ Object -> IO ObjectRef
forall a. a -> IO (IORef a)
newIORef (WHNFData -> Object
WHNF (IORef (Seq Inner) -> WHNFData
ICollection IORef (Seq Inner)
inners))
          MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { loopPatCtx = LoopPatContext (name, startNumRef) endsRef' endPat pat pat':loops
                                       , mTrees = MAtom IContPat target matcher:trees }
        WHNFData
_ -> do -- the case when the end numbers are a collection
          ObjectRef
endsRef <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
ends'
          MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { loopPatCtx = LoopPatContext (name, startNumRef) endsRef endPat pat pat':loops
                                       , mTrees = MAtom IContPat target matcher:trees }
    IPattern
IContPat ->
      case [LoopPatContext]
loops of
        [] -> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"cannot use cont pattern except in loop pattern"
        LoopPatContext (String
name, ObjectRef
startNumRef) ObjectRef
endsRef IPattern
endPat IPattern
pat IPattern
pat' : [LoopPatContext]
loops' -> do
          EgisonValue
startNumVal <- ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep ObjectRef
startNumRef
          Integer
startNum <- EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
startNumVal :: (EvalM Integer)
          ObjectRef
nextNumRef <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData) -> EgisonValue -> WHNFData
forall a b. (a -> b) -> a -> b
$ Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Integer
startNum Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
          WHNFData
ends <- ObjectRef -> EvalM WHNFData
evalRef ObjectRef
endsRef
          Bool
b <- WHNFData -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
isEmptyCollection WHNFData
ends
          if Bool
b
            then MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. MList m a
MNil
            else do
              (ObjectRef
carEndsRef, ObjectRef
cdrEndsRef) <- Maybe (ObjectRef, ObjectRef) -> (ObjectRef, ObjectRef)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (ObjectRef, ObjectRef) -> (ObjectRef, ObjectRef))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (Maybe (ObjectRef, ObjectRef))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (ObjectRef, ObjectRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  (ObjectRef, ObjectRef)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (Maybe (ObjectRef, ObjectRef))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     (ObjectRef, ObjectRef)
unconsCollection WHNFData
ends)
              Bool
b2 <- ObjectRef -> EvalM WHNFData
evalRef ObjectRef
cdrEndsRef EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
isEmptyCollection
              Integer
carEndsNum <- ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep ObjectRef
carEndsRef StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison
              MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ if
                | Integer
startNum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>  Integer
carEndsNum -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. MList m a
MNil
                | Integer
startNum Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
carEndsNum Bool -> Bool -> Bool
&& Bool
b2 ->
                  [MatchingState]
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [MatchingState
mstate { loopPatCtx = loops', mTrees = MAtom endPat (Value startNumVal) Something:MAtom pat' target matcher:trees }]
                | Integer
startNum Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
carEndsNum ->
                  [MatchingState]
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [MatchingState
mstate { loopPatCtx = loops', mTrees = MAtom endPat (Value startNumVal) Something:MAtom pat' target matcher:trees },
                            MatchingState
mstate { loopPatCtx = LoopPatContext (name, nextNumRef) cdrEndsRef endPat pat pat':loops', mTrees = MAtom pat target matcher:trees }]
                | Bool
otherwise ->
                  [MatchingState]
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [MatchingState
mstate { loopPatCtx = LoopPatContext (name, nextNumRef) endsRef endPat pat pat':loops', mTrees = MAtom pat target matcher:trees }]
    IPattern
ISeqNilPat -> (CallStack -> EgisonError)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
EgisonBug String
"should not reach here (seq nil pattern)")
    ISeqConsPat IPattern
pattern IPattern
pattern' -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ Env
-> [LoopPatContext]
-> [SeqPatContext]
-> [Binding]
-> [MatchingTree]
-> MatchingState
MState Env
env [LoopPatContext]
loops ([MatchingTree]
-> IPattern -> [EgisonValue] -> [WHNFData] -> SeqPatContext
SeqPatContext [MatchingTree]
trees IPattern
pattern' [] []SeqPatContext -> [SeqPatContext] -> [SeqPatContext]
forall a. a -> [a] -> [a]
:[SeqPatContext]
seqs) [Binding]
bindings [IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
matcher]
    IPattern
ILaterPatVar ->
      case [SeqPatContext]
seqs of
        [] -> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"cannot use # out of seq patterns"
        SeqPatContext [MatchingTree]
stack IPattern
pat [EgisonValue]
mats [WHNFData]
tgts:[SeqPatContext]
seqs ->
          MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ Env
-> [LoopPatContext]
-> [SeqPatContext]
-> [Binding]
-> [MatchingTree]
-> MatchingState
MState Env
env [LoopPatContext]
loops ([MatchingTree]
-> IPattern -> [EgisonValue] -> [WHNFData] -> SeqPatContext
SeqPatContext [MatchingTree]
stack IPattern
pat ([EgisonValue]
mats [EgisonValue] -> [EgisonValue] -> [EgisonValue]
forall a. [a] -> [a] -> [a]
++ [EgisonValue
matcher]) ([WHNFData]
tgts [WHNFData] -> [WHNFData] -> [WHNFData]
forall a. [a] -> [a] -> [a]
++ [WHNFData
target])SeqPatContext -> [SeqPatContext] -> [SeqPatContext]
forall a. a -> [a] -> [a]
:[SeqPatContext]
seqs) [Binding]
bindings [MatchingTree]
trees
        ForallPatContext [EgisonValue]
mats [WHNFData]
tgts:[SeqPatContext]
seqs ->
          MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ Env
-> [LoopPatContext]
-> [SeqPatContext]
-> [Binding]
-> [MatchingTree]
-> MatchingState
MState Env
env [LoopPatContext]
loops ([EgisonValue] -> [WHNFData] -> SeqPatContext
ForallPatContext ([EgisonValue]
mats [EgisonValue] -> [EgisonValue] -> [EgisonValue]
forall a. [a] -> [a] -> [a]
++ [EgisonValue
matcher]) ([WHNFData]
tgts [WHNFData] -> [WHNFData] -> [WHNFData]
forall a. [a] -> [a] -> [a]
++ [WHNFData
target])SeqPatContext -> [SeqPatContext] -> [SeqPatContext]
forall a. a -> [a] -> [a]
:[SeqPatContext]
seqs) [Binding]
bindings [MatchingTree]
trees
    IAndPat IPattern
pat1 IPattern
pat2 ->
      let trees' :: [MatchingTree]
trees' = [IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pat1 WHNFData
target EgisonValue
matcher, IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pat2 WHNFData
target EgisonValue
matcher] [MatchingTree] -> [MatchingTree] -> [MatchingTree]
forall a. [a] -> [a] -> [a]
++ [MatchingTree]
trees
       in MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = trees' }
    IOrPat IPattern
pat1 IPattern
pat2 ->
      MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ [MatchingState]
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [MatchingState
mstate { mTrees = MAtom pat1 target matcher : trees }, MatchingState
mstate { mTrees = MAtom pat2 target matcher : trees }]

    IPattern
_ ->
      case EgisonValue
matcher of
        UserMatcher{} -> do
          ([IPattern]
patterns, MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
targetss, [EgisonValue]
matchers) <- Env
-> IPattern
-> WHNFData
-> EgisonValue
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
inductiveMatch Env
env' IPattern
pattern WHNFData
target EgisonValue
matcher
          case [IPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns of
            Int
1 ->
              MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
-> (ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall (m :: * -> *) a b.
Monad m =>
MList m a -> (a -> m b) -> m (MList m b)
mfor MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
targetss ((ObjectRef
  -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ \ObjectRef
ref -> do
                [WHNFData]
targets <- ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\WHNFData
x -> [WHNFData]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return [WHNFData
x])
                let trees' :: [MatchingTree]
trees' = (IPattern -> WHNFData -> EgisonValue -> MatchingTree)
-> [IPattern] -> [WHNFData] -> [EgisonValue] -> [MatchingTree]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom [IPattern]
patterns [WHNFData]
targets [EgisonValue]
matchers [MatchingTree] -> [MatchingTree] -> [MatchingTree]
forall a. [a] -> [a] -> [a]
++ [MatchingTree]
trees
                MatchingState
-> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MatchingState
 -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> MatchingState
-> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = trees' }
            Int
_ ->
              MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
-> (ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall (m :: * -> *) a b.
Monad m =>
MList m a -> (a -> m b) -> m (MList m b)
mfor MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
targetss ((ObjectRef
  -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ \ObjectRef
ref -> do
                [WHNFData]
targets <- ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
tupleToListWHNF
                let trees' :: [MatchingTree]
trees' = (IPattern -> WHNFData -> EgisonValue -> MatchingTree)
-> [IPattern] -> [WHNFData] -> [EgisonValue] -> [MatchingTree]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom [IPattern]
patterns [WHNFData]
targets [EgisonValue]
matchers [MatchingTree] -> [MatchingTree] -> [MatchingTree]
forall a. [a] -> [a] -> [a]
++ [MatchingTree]
trees
                MatchingState
-> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MatchingState
 -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> MatchingState
-> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = trees' }

        Tuple [EgisonValue]
matchers ->
          case IPattern
pattern of
            IValuePat IExpr
_ -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = MAtom pattern target Something:trees }
            IPattern
IWildCard   -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = MAtom pattern target Something:trees }
            IPatVar String
_   -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = MAtom pattern target Something:trees }
            IIndexedPat IPattern
_ [IExpr]
_ -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = MAtom pattern target Something:trees }
            ITuplePat [IPattern]
patterns -> do
              [WHNFData]
targets <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
tupleToListWHNF WHNFData
target
              Bool -> EvalM () -> EvalM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([IPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [WHNFData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WHNFData]
targets) (EvalM () -> EvalM ()) -> EvalM () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ (CallStack -> EgisonError) -> EvalM ()
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (Int -> Int -> CallStack -> EgisonError
TupleLength ([IPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns) ([WHNFData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WHNFData]
targets))
              Bool -> EvalM () -> EvalM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([IPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [EgisonValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EgisonValue]
matchers) (EvalM () -> EvalM ()) -> EvalM () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ (CallStack -> EgisonError) -> EvalM ()
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (Int -> Int -> CallStack -> EgisonError
TupleLength ([IPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns) ([EgisonValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EgisonValue]
matchers))
              let trees' :: [MatchingTree]
trees' = (IPattern -> WHNFData -> EgisonValue -> MatchingTree)
-> [IPattern] -> [WHNFData] -> [EgisonValue] -> [MatchingTree]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom [IPattern]
patterns [WHNFData]
targets [EgisonValue]
matchers [MatchingTree] -> [MatchingTree] -> [MatchingTree]
forall a. [a] -> [a] -> [a]
++ [MatchingTree]
trees
              MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = trees' }
            IPattern
_ ->  EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default (String -> EgisonError) -> String -> EgisonError
forall a b. (a -> b) -> a -> b
$ String
"should not reach here. matcher: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
matcher String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", pattern:  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IPattern -> String
forall a. Show a => a -> String
show IPattern
pattern

        EgisonValue
Something ->
          case IPattern
pattern of
            IValuePat IExpr
valExpr -> do
              EgisonValue
val <- Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env' IExpr
valExpr
              EgisonValue
tgtVal <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF WHNFData
target
              if EgisonValue
val EgisonValue -> EgisonValue -> Bool
forall a. Eq a => a -> a -> Bool
== EgisonValue
tgtVal
                then MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = trees }
                else MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. MList m a
MNil
            IPattern
IWildCard -> MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = trees }
            IPatVar String
name -> do
              ObjectRef
targetRef <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
target
              MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mStateBindings = (stringToVar name, targetRef):bindings, mTrees = trees }
            IIndexedPat (IPatVar String
name') [IExpr]
indices -> do
              let name :: Var
name = String -> Var
stringToVar String
name'
              [Integer]
indices <- (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Integer]
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 (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env' (IExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Integer -> Integer)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a b.
(a -> b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) a
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Integer
forall a. Num a => Integer -> a
fromInteger (StateT EvalState (ExceptT EgisonError RuntimeM) Integer
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> (EgisonValue
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison) [IExpr]
indices
              case Var -> [Binding] -> Maybe ObjectRef
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Var
name [Binding]
bindings of
                Just ObjectRef
ref -> do
                  ObjectRef
obj <- ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref EvalM WHNFData -> (WHNFData -> EvalM WHNFData) -> EvalM WHNFData
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Integer] -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash [Integer]
indices WHNFData
target EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef
                  MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mStateBindings = subst name obj bindings, mTrees = trees }
                Maybe ObjectRef
Nothing  -> do
                  ObjectRef
obj <- [Integer] -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash [Integer]
indices WHNFData
target (HashMap Integer ObjectRef -> WHNFData
IIntHash HashMap Integer ObjectRef
forall k v. HashMap k v
HL.empty) EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef
                  MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mStateBindings = (name,obj):bindings, mTrees = trees }
            IIndexedPat IPattern
pattern [IExpr]
_ -> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default (String
"invalid indexed-pattern: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IPattern -> String
forall a. Show a => a -> String
show IPattern
pattern)
            ITuplePat [IPattern]
patterns -> do
              [WHNFData]
targets <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
tupleToListWHNF WHNFData
target
              Bool -> EvalM () -> EvalM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([IPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [WHNFData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WHNFData]
targets) (EvalM () -> EvalM ()) -> EvalM () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ (CallStack -> EgisonError) -> EvalM ()
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (Int -> Int -> CallStack -> EgisonError
TupleLength ([IPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns) ([WHNFData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WHNFData]
targets))
              let trees' :: [MatchingTree]
trees' = (IPattern -> WHNFData -> EgisonValue -> MatchingTree)
-> [IPattern] -> [WHNFData] -> [EgisonValue] -> [MatchingTree]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom [IPattern]
patterns [WHNFData]
targets ((IPattern -> EgisonValue) -> [IPattern] -> [EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map (EgisonValue -> IPattern -> EgisonValue
forall a b. a -> b -> a
const EgisonValue
Something) [IPattern]
patterns) [MatchingTree] -> [MatchingTree] -> [MatchingTree]
forall a. [a] -> [a] -> [a]
++ [MatchingTree]
trees
              MList
  (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MList
   (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> (MatchingState
    -> MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState
-> MList
     (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> MatchingState
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees = trees' }
            IPattern
_ -> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState))
-> EgisonError
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default (String -> EgisonError) -> String -> EgisonError
forall a b. (a -> b) -> a -> b
$ String
"something can only match with a pattern variable. not: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IPattern -> String
forall a. Show a => a -> String
show IPattern
pattern
        EgisonValue
_ ->  (CallStack -> EgisonError)
-> EvalM
     (MList
        (StateT EvalState (ExceptT EgisonError RuntimeM)) MatchingState)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
EgisonBug (String
"should not reach here. matcher: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
matcher String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", pattern:  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IPattern -> String
forall a. Show a => a -> String
show IPattern
pattern))

inductiveMatch :: Env -> IPattern -> WHNFData -> Matcher ->
                  EvalM ([IPattern], MList EvalM ObjectRef, [Matcher])
inductiveMatch :: Env
-> IPattern
-> WHNFData
-> EgisonValue
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
inductiveMatch Env
env IPattern
pattern WHNFData
target (UserMatcher Env
matcherEnv [IPatternDef]
clauses) =
  (IPatternDef
 -> EvalM
      ([IPattern],
       MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
       [EgisonValue])
 -> EvalM
      ([IPattern],
       MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
       [EgisonValue]))
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
-> [IPatternDef]
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IPatternDef
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
forall {t :: * -> *}.
Foldable t =>
(PrimitivePatPattern, IExpr, t IBindingExpr)
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
tryPPMatchClause EvalM
  ([IPattern],
   MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
   [EgisonValue])
forall {a}. StateT EvalState (ExceptT EgisonError RuntimeM) a
failPPPatternMatch [IPatternDef]
clauses
 where
  tryPPMatchClause :: (PrimitivePatPattern, IExpr, t IBindingExpr)
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
tryPPMatchClause (PrimitivePatPattern
pat, IExpr
matchers, t IBindingExpr
clauses) EvalM
  ([IPattern],
   MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
   [EgisonValue])
cont = do
    Maybe ([IPattern], [Binding])
result <- MaybeT
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  ([IPattern], [Binding])
-> EvalM (Maybe ([IPattern], [Binding]))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   (StateT EvalState (ExceptT EgisonError RuntimeM))
   ([IPattern], [Binding])
 -> EvalM (Maybe ([IPattern], [Binding])))
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
-> EvalM (Maybe ([IPattern], [Binding]))
forall a b. (a -> b) -> a -> b
$ Env
-> PrimitivePatPattern
-> IPattern
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
primitivePatPatternMatch Env
env PrimitivePatPattern
pat IPattern
pattern
    case Maybe ([IPattern], [Binding])
result of
      Just ([IPattern
pattern], [Binding]
bindings) -> do
        MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
targetss <- (IBindingExpr
 -> EvalM
      (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef))
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
-> t IBindingExpr
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Binding]
-> IBindingExpr
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
tryPDMatchClause [Binding]
bindings) EvalM
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
forall {a}. StateT EvalState (ExceptT EgisonError RuntimeM) a
failPDPatternMatch t IBindingExpr
clauses
        EgisonValue
matcher <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
matcherEnv IExpr
matchers EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF
        ([IPattern],
 MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
 [EgisonValue])
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPattern
pattern], MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
targetss, [EgisonValue
matcher])
      Just ([IPattern]
patterns, [Binding]
bindings) -> do
        MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
targetss <- (IBindingExpr
 -> EvalM
      (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
 -> EvalM
      (MList
         (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef))
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
-> t IBindingExpr
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Binding]
-> IBindingExpr
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
tryPDMatchClause [Binding]
bindings) EvalM
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
forall {a}. StateT EvalState (ExceptT EgisonError RuntimeM) a
failPDPatternMatch t IBindingExpr
clauses
        [EgisonValue]
matchers <- EgisonValue -> [EgisonValue]
tupleToList (EgisonValue -> [EgisonValue])
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
matcherEnv IExpr
matchers EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF)
        ([IPattern],
 MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
 [EgisonValue])
-> EvalM
     ([IPattern],
      MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
      [EgisonValue])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPattern]
patterns, MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
targetss, [EgisonValue]
matchers)
      Maybe ([IPattern], [Binding])
_ -> EvalM
  ([IPattern],
   MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef,
   [EgisonValue])
cont
  tryPDMatchClause :: [Binding]
-> IBindingExpr
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
tryPDMatchClause [Binding]
bindings (PDPatternBase Var
pat, IExpr
expr) EvalM
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
cont = do
    ObjectRef
ref <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
target
    Maybe [Binding]
result <- MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> EvalM (Maybe [Binding])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
 -> EvalM (Maybe [Binding]))
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> EvalM (Maybe [Binding])
forall a b. (a -> b) -> a -> b
$ PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch PDPatternBase Var
pat ObjectRef
ref
    case Maybe [Binding]
result of
      Just [Binding]
bindings' -> do
        let env :: Env
env = Env -> [Binding] -> Env
extendEnv Env
matcherEnv ([Binding] -> Env) -> [Binding] -> Env
forall a b. (a -> b) -> a -> b
$ [Binding]
bindings [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
++ [Binding]
bindings'
        Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr EvalM WHNFData
-> (WHNFData
    -> EvalM
         (MList
            (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef))
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> EvalM
     (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
collectionToRefs
      Maybe [Binding]
_ -> EvalM
  (MList (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
cont
  failPPPatternMatch :: StateT EvalState (ExceptT EgisonError RuntimeM) a
failPPPatternMatch = EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> EgisonError
Default String
"failed primitive pattern pattern match")
  failPDPatternMatch :: EvalM a
failPDPatternMatch = (CallStack -> EgisonError) -> EvalM a
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace CallStack -> EgisonError
PrimitiveMatchFailure

primitivePatPatternMatch :: Env -> PrimitivePatPattern -> IPattern ->
                            MatchM ([IPattern], [Binding])
primitivePatPatternMatch :: Env
-> PrimitivePatPattern
-> IPattern
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
primitivePatPatternMatch Env
_ PrimitivePatPattern
PPWildCard IPattern
IWildCard = ([IPattern], [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
forall a.
a -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
primitivePatPatternMatch Env
_ PrimitivePatPattern
PPPatVar IPattern
pattern = ([IPattern], [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
forall a.
a -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPattern
pattern], [])
primitivePatPatternMatch Env
env (PPValuePat String
name) (IValuePat IExpr
expr) = do
  ObjectRef
ref <- StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) ObjectRef
forall a b. (a -> b) -> a -> b
$ Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env IExpr
expr
  ([IPattern], [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
forall a.
a -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [(String -> Var
stringToVar String
name, ObjectRef
ref)])
primitivePatPatternMatch Env
env (PPInductivePat String
name [PrimitivePatPattern]
patterns) (IInductivePat String
name' [IPattern]
exprs)
  | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name' Bool -> Bool -> Bool
&& [PrimitivePatPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PrimitivePatPattern]
patterns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [IPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
exprs =
    ([[IPattern]] -> [IPattern]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IPattern]] -> [IPattern])
-> ([[Binding]] -> [Binding])
-> ([[IPattern]], [[Binding]])
-> ([IPattern], [Binding])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (([[IPattern]], [[Binding]]) -> ([IPattern], [Binding]))
-> ([([IPattern], [Binding])] -> ([[IPattern]], [[Binding]]))
-> [([IPattern], [Binding])]
-> ([IPattern], [Binding])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([IPattern], [Binding])] -> ([[IPattern]], [[Binding]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([IPattern], [Binding])] -> ([IPattern], [Binding]))
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     [([IPattern], [Binding])]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimitivePatPattern
 -> IPattern
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM))
      ([IPattern], [Binding]))
-> [PrimitivePatPattern]
-> [IPattern]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     [([IPattern], [Binding])]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Env
-> PrimitivePatPattern
-> IPattern
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
primitivePatPatternMatch Env
env) [PrimitivePatPattern]
patterns [IPattern]
exprs
  | Bool
otherwise = MaybeT
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  ([IPattern], [Binding])
forall a. MatchM a
matchFail
primitivePatPatternMatch Env
env (PPTuplePat [PrimitivePatPattern]
patterns) (ITuplePat [IPattern]
exprs)
  | [PrimitivePatPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PrimitivePatPattern]
patterns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [IPattern] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
exprs =
    ([[IPattern]] -> [IPattern]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IPattern]] -> [IPattern])
-> ([[Binding]] -> [Binding])
-> ([[IPattern]], [[Binding]])
-> ([IPattern], [Binding])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (([[IPattern]], [[Binding]]) -> ([IPattern], [Binding]))
-> ([([IPattern], [Binding])] -> ([[IPattern]], [[Binding]]))
-> [([IPattern], [Binding])]
-> ([IPattern], [Binding])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([IPattern], [Binding])] -> ([[IPattern]], [[Binding]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([IPattern], [Binding])] -> ([IPattern], [Binding]))
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     [([IPattern], [Binding])]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimitivePatPattern
 -> IPattern
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM))
      ([IPattern], [Binding]))
-> [PrimitivePatPattern]
-> [IPattern]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     [([IPattern], [Binding])]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Env
-> PrimitivePatPattern
-> IPattern
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([IPattern], [Binding])
primitivePatPatternMatch Env
env) [PrimitivePatPattern]
patterns [IPattern]
exprs
  | Bool
otherwise = MaybeT
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  ([IPattern], [Binding])
forall a. MatchM a
matchFail
primitivePatPatternMatch Env
_ PrimitivePatPattern
_ IPattern
_ = MaybeT
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  ([IPattern], [Binding])
forall a. MatchM a
matchFail

bindPrimitiveDataPattern :: IPrimitiveDataPattern -> ObjectRef -> EvalM [Binding]
bindPrimitiveDataPattern :: PDPatternBase Var -> ObjectRef -> EvalM [Binding]
bindPrimitiveDataPattern PDPatternBase Var
pdp ObjectRef
ref = do
  Maybe [Binding]
r <- MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> EvalM (Maybe [Binding])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
 -> EvalM (Maybe [Binding]))
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> EvalM (Maybe [Binding])
forall a b. (a -> b) -> a -> b
$ PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch PDPatternBase Var
pdp ObjectRef
ref
  case Maybe [Binding]
r of
    Maybe [Binding]
Nothing      -> (CallStack -> EgisonError) -> EvalM [Binding]
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace CallStack -> EgisonError
PrimitiveMatchFailure
    Just [Binding]
binding -> [Binding] -> EvalM [Binding]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Binding]
binding

primitiveDataPatternMatch :: IPrimitiveDataPattern -> ObjectRef -> MatchM [Binding]
primitiveDataPatternMatch :: PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch PDPatternBase Var
PDWildCard ObjectRef
_        = [Binding]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a.
a -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
primitiveDataPatternMatch (PDPatVar Var
name) ObjectRef
ref = [Binding]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a.
a -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Var
name, ObjectRef
ref)]
primitiveDataPatternMatch (PDInductivePat String
name [PDPatternBase Var]
patterns) ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall a b. (a -> b) -> a -> b
$ ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
  case WHNFData
whnf of
    IInductiveData String
name' [ObjectRef]
refs | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name' ->
      [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Binding]] -> [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [[Binding]]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDPatternBase Var
 -> ObjectRef
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
-> [PDPatternBase Var]
-> [ObjectRef]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [[Binding]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch [PDPatternBase Var]
patterns [ObjectRef]
refs
    Value (InductiveData String
name' [EgisonValue]
vals) | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name' -> do
      [ObjectRef]
whnfs <- StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [ObjectRef]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [ObjectRef]
forall a b. (a -> b) -> a -> b
$ (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
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 (WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> (EgisonValue -> WHNFData)
-> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value) [EgisonValue]
vals
      [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Binding]] -> [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [[Binding]]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDPatternBase Var
 -> ObjectRef
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
-> [PDPatternBase Var]
-> [ObjectRef]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [[Binding]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch [PDPatternBase Var]
patterns [ObjectRef]
whnfs
    WHNFData
_ -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a. MatchM a
matchFail
primitiveDataPatternMatch (PDTuplePat [PDPatternBase Var]
patterns) ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall a b. (a -> b) -> a -> b
$ ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
  case WHNFData
whnf of
    ITuple [ObjectRef]
refs -> do
      [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Binding]] -> [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [[Binding]]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDPatternBase Var
 -> ObjectRef
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
-> [PDPatternBase Var]
-> [ObjectRef]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [[Binding]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch [PDPatternBase Var]
patterns [ObjectRef]
refs
    Value (Tuple [EgisonValue]
vals) -> do
      [ObjectRef]
whnfs <- StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [ObjectRef]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [ObjectRef]
forall a b. (a -> b) -> a -> b
$ (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
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 (WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> (EgisonValue -> WHNFData)
-> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value) [EgisonValue]
vals
      [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Binding]] -> [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [[Binding]]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDPatternBase Var
 -> ObjectRef
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding])
-> [PDPatternBase Var]
-> [ObjectRef]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [[Binding]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch [PDPatternBase Var]
patterns [ObjectRef]
whnfs
    WHNFData
_ -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a. MatchM a
matchFail
primitiveDataPatternMatch PDPatternBase Var
PDEmptyPat ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall a b. (a -> b) -> a -> b
$ ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
  Bool
isEmpty <- StateT EvalState (ExceptT EgisonError RuntimeM) Bool
-> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) Bool
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT EvalState (ExceptT EgisonError RuntimeM) Bool
 -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) Bool)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
-> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) Bool
forall a b. (a -> b) -> a -> b
$ WHNFData -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
isEmptyCollection WHNFData
whnf
  if Bool
isEmpty then [Binding]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a.
a -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [] else MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a. MatchM a
matchFail
primitiveDataPatternMatch (PDConsPat PDPatternBase Var
pattern PDPatternBase Var
pattern') ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall a b. (a -> b) -> a -> b
$ ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
  (ObjectRef
head, ObjectRef
tail) <- WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     (ObjectRef, ObjectRef)
unconsCollection WHNFData
whnf
  [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
(++) ([Binding] -> [Binding] -> [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([Binding] -> [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch PDPatternBase Var
pattern ObjectRef
head
       MaybeT
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  ([Binding] -> [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a b.
MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) (a -> b)
-> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) a
-> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch PDPatternBase Var
pattern' ObjectRef
tail
primitiveDataPatternMatch (PDSnocPat PDPatternBase Var
pattern PDPatternBase Var
pattern') ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall a b. (a -> b) -> a -> b
$ ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
  (ObjectRef
init, ObjectRef
last) <- WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     (ObjectRef, ObjectRef)
unsnocCollection WHNFData
whnf
  [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
(++) ([Binding] -> [Binding] -> [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM))
     ([Binding] -> [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch PDPatternBase Var
pattern ObjectRef
init
       MaybeT
  (StateT EvalState (ExceptT EgisonError RuntimeM))
  ([Binding] -> [Binding])
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a b.
MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) (a -> b)
-> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) a
-> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PDPatternBase Var
-> ObjectRef
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
primitiveDataPatternMatch PDPatternBase Var
pattern' ObjectRef
last
primitiveDataPatternMatch (PDConstantPat ConstantExpr
expr) ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData
 -> MaybeT
      (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData)
-> EvalM WHNFData
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) WHNFData
forall a b. (a -> b) -> a -> b
$ ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
  case WHNFData
whnf of
    Value EgisonValue
val | EgisonValue
val EgisonValue -> EgisonValue -> Bool
forall a. Eq a => a -> a -> Bool
== ConstantExpr -> EgisonValue
evalConstant ConstantExpr
expr -> [Binding]
-> MaybeT
     (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a.
a -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    WHNFData
_                                    -> MaybeT (StateT EvalState (ExceptT EgisonError RuntimeM)) [Binding]
forall a. MatchM a
matchFail

extendEnvForNonLinearPatterns :: Env -> [Binding] -> [LoopPatContext] -> Env
extendEnvForNonLinearPatterns :: Env -> [Binding] -> [LoopPatContext] -> Env
extendEnvForNonLinearPatterns Env
env [Binding]
bindings [LoopPatContext]
loops = Env -> [Binding] -> Env
extendEnv Env
env ([Binding] -> Env) -> [Binding] -> Env
forall a b. (a -> b) -> a -> b
$ [Binding]
bindings [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
++ (LoopPatContext -> Binding) -> [LoopPatContext] -> [Binding]
forall a b. (a -> b) -> [a] -> [b]
map (\(LoopPatContext (String
name, ObjectRef
ref) ObjectRef
_ IPattern
_ IPattern
_ IPattern
_) -> (String -> Var
stringToVar String
name, ObjectRef
ref)) [LoopPatContext]
loops

evalMatcherWHNF :: WHNFData -> EvalM Matcher
evalMatcherWHNF :: WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF (Value matcher :: EgisonValue
matcher@EgisonValue
Something) = EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return EgisonValue
matcher
evalMatcherWHNF (Value matcher :: EgisonValue
matcher@UserMatcher{}) = EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return EgisonValue
matcher
evalMatcherWHNF (Value (Tuple [EgisonValue]
ms)) = [EgisonValue] -> EgisonValue
Tuple ([EgisonValue] -> EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 (WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> (EgisonValue -> WHNFData)
-> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value) [EgisonValue]
ms
evalMatcherWHNF (ITuple [ObjectRef]
refs) = do
  [WHNFData]
whnfs <- (ObjectRef -> EvalM WHNFData)
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 ObjectRef -> EvalM WHNFData
evalRef [ObjectRef]
refs
  [EgisonValue]
ms <- (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> [WHNFData]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
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 WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF [WHNFData]
whnfs
  EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue)
-> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b. (a -> b) -> a -> b
$ [EgisonValue] -> EgisonValue
Tuple [EgisonValue]
ms
evalMatcherWHNF WHNFData
whnf = (CallStack -> EgisonError)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"matcher" WHNFData
whnf)

--
-- Util
--
toListPat :: [IPattern] -> IPattern
toListPat :: [IPattern] -> IPattern
toListPat []         = String -> [IPattern] -> IPattern
IInductivePat String
"nil" []
toListPat (IPattern
pat:[IPattern]
pats) = String -> [IPattern] -> IPattern
IInductivePat String
"::" [IPattern
pat, [IPattern] -> IPattern
toListPat [IPattern]
pats]

makeITensorFromWHNF :: Shape -> [WHNFData] -> EvalM WHNFData
makeITensorFromWHNF :: [Integer] -> [WHNFData] -> EvalM WHNFData
makeITensorFromWHNF [Integer]
s [WHNFData]
xs = do
  [ObjectRef]
xs' <- (WHNFData
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> [WHNFData]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
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 WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef [WHNFData]
xs
  WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Tensor ObjectRef -> WHNFData
ITensor ([Integer]
-> Vector ObjectRef -> [Index EgisonValue] -> Tensor ObjectRef
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
s ([ObjectRef] -> Vector ObjectRef
forall a. [a] -> Vector a
V.fromList [ObjectRef]
xs') [])

newITensor :: Shape -> [ObjectRef] -> WHNFData
newITensor :: [Integer] -> [ObjectRef] -> WHNFData
newITensor [Integer]
s [ObjectRef]
refs = Tensor ObjectRef -> WHNFData
ITensor ([Integer]
-> Vector ObjectRef -> [Index EgisonValue] -> Tensor ObjectRef
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
s ([ObjectRef] -> Vector ObjectRef
forall a. [a] -> Vector a
V.fromList [ObjectRef]
refs) [])

-- Refer the specified tensor index with potential overriding of the index.
refTensorWithOverride :: TensorComponent a b => Bool -> [Index EgisonValue] -> Tensor b -> EvalM a
refTensorWithOverride :: forall a b.
TensorComponent a b =>
Bool -> [Index EgisonValue] -> Tensor b -> EvalM a
refTensorWithOverride Bool
override [Index EgisonValue]
js (Tensor [Integer]
ns Vector b
xs [Index EgisonValue]
is) =
  [Index EgisonValue] -> Tensor b -> EvalM (Tensor b)
forall a. [Index EgisonValue] -> Tensor a -> EvalM (Tensor a)
tref [Index EgisonValue]
js' ([Integer] -> Vector b -> [Index EgisonValue] -> Tensor b
forall a. [Integer] -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor [Integer]
ns Vector b
xs [Index EgisonValue]
js') EvalM (Tensor b)
-> (Tensor b -> EvalM (Tensor b)) -> EvalM (Tensor b)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor b -> EvalM (Tensor b)
forall a. Tensor a -> EvalM (Tensor a)
tContract' EvalM (Tensor b)
-> (Tensor b -> StateT EvalState (ExceptT EgisonError RuntimeM) a)
-> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor b -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
    where
      js' :: [Index EgisonValue]
js' = if Bool
override then [Index EgisonValue]
js else [Index EgisonValue]
is [Index EgisonValue] -> [Index EgisonValue] -> [Index EgisonValue]
forall a. [a] -> [a] -> [a]
++ [Index EgisonValue]
js

makeBindings :: [Var] -> [ObjectRef] -> EvalM [Binding]
makeBindings :: CallStack -> [ObjectRef] -> EvalM [Binding]
makeBindings CallStack
vs [ObjectRef]
refs = (Var -> ObjectRef -> EvalM [Binding])
-> CallStack
-> [ObjectRef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [[Binding]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Var -> ObjectRef -> EvalM [Binding]
makeBinding CallStack
vs [ObjectRef]
refs StateT EvalState (ExceptT EgisonError RuntimeM) [[Binding]]
-> ([[Binding]] -> EvalM [Binding]) -> EvalM [Binding]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Binding] -> EvalM [Binding]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Binding] -> EvalM [Binding])
-> ([[Binding]] -> [Binding]) -> [[Binding]] -> EvalM [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  where
    makeBinding :: Var -> ObjectRef -> EvalM [Binding]
    makeBinding :: Var -> ObjectRef -> EvalM [Binding]
makeBinding v :: Var
v@(Var String
_ [])    ObjectRef
ref = [Binding] -> EvalM [Binding]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Var
v, ObjectRef
ref)]
    makeBinding v :: Var
v@(Var String
name [Index (Maybe Var)]
is) ObjectRef
ref = do
      EgisonValue
val <- ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep ObjectRef
ref
      case EgisonValue
val of
        TensorData (Tensor [Integer]
_ Vector EgisonValue
_ [Index EgisonValue]
js) -> do
          [Binding]
frame <- [Index (Maybe Var)] -> [Index EgisonValue] -> EvalM [Binding]
pmIndices [Index (Maybe Var)]
is [Index EgisonValue]
js
          [Binding] -> EvalM [Binding]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Var
v, ObjectRef
ref) Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
: [Binding]
frame)
        EgisonValue
_ -> (CallStack -> EgisonError) -> EvalM [Binding]
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"tensor" (EgisonValue -> WHNFData
Value EgisonValue
val))

makeBindings' :: [String] -> [ObjectRef] -> [Binding]
makeBindings' :: [String] -> [ObjectRef] -> [Binding]
makeBindings' [String]
xs = CallStack -> [ObjectRef] -> [Binding]
forall a b. [a] -> [b] -> [(a, b)]
zip ((String -> Var) -> [String] -> CallStack
forall a b. (a -> b) -> [a] -> [b]
map String -> Var
stringToVar [String]
xs)