{-# 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.Except            (throwError)
import           Control.Monad.State             hiding (join, mapM)
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 (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 (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 (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 (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. [a] -> a
head String
name) ->
      WHNFData -> EvalM WHNFData
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 (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 (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)
mapM (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env) [IExpr]
exprs

evalExprShallow Env
_ (ICollectionExpr []) = WHNFData -> EvalM WHNFData
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)
mapM ((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
<$>) (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 (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 (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 (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 (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 (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 (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 (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)
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)
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 (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 (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]
_ -> Shape -> [WHNFData] -> EvalM WHNFData
makeITensorFromWHNF [Integer
n] [WHNFData]
whnfs
  where
    f :: WHNFData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
f (ITensor (Tensor Shape
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)
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)
mapM WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef Vector WHNFData
xs'
      Tensor ObjectRef
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Tensor ObjectRef)
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
$ Shape
-> Vector ObjectRef -> [Index EgisonValue] -> Tensor ObjectRef
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
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
  Shape
ns <- (WHNFData -> EvalM (MList EvalM ObjectRef)
collectionToRefs WHNFData
nsWhnf EvalM (MList EvalM ObjectRef)
-> (MList EvalM ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList EvalM 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 (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)
mapM ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
-> ([EgisonValue]
    -> StateT EvalState (ExceptT EgisonError RuntimeM) Shape)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Shape
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) Shape
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 EvalM ObjectRef)
collectionToRefs WHNFData
xsWhnf EvalM (MList EvalM ObjectRef)
-> (MList EvalM ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList EvalM 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 (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)
mapM ObjectRef -> EvalM WHNFData
evalRef
  if Shape -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product Shape
ns Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([WHNFData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WHNFData]
xs)
    then Shape -> [WHNFData] -> EvalM WHNFData
makeITensorFromWHNF Shape
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)
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)
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)
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 (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. (Eq k, 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 (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. (Eq k, 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' :: Shape
keys' = (EgisonHashKey -> Integer) -> [EgisonHashKey] -> Shape
forall a b. (a -> b) -> [a] -> [b]
map (\case IntKey Integer
i -> Integer
i) [EgisonHashKey]
keys
      WHNFData -> EvalM WHNFData
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. (Eq k, 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
$ Shape -> [ObjectRef] -> [(Integer, ObjectRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip Shape
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 (m :: * -> *) a. Monad m => a -> m a
return (Char -> EgisonHashKey
CharKey Char
c)
      String Text
str   -> EgisonHashKey
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonHashKey
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 (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)
mapM Index IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
evalIndexToScalar [Index IExpr]
indices
      WHNFData -> EvalM WHNFData
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)
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 (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)
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)
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)
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)
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)
traverse ((EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
extractScalar (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData)
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (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 (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 (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 (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 (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 (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 (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)
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 (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 (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 (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 Shape WHNFData)
hashRef <- IO (IORef (HashMap Shape WHNFData))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (IORef (HashMap Shape WHNFData))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HashMap Shape WHNFData))
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      (IORef (HashMap Shape WHNFData)))
-> IO (IORef (HashMap Shape WHNFData))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (IORef (HashMap Shape WHNFData))
forall a b. (a -> b) -> a -> b
$ HashMap Shape WHNFData -> IO (IORef (HashMap Shape WHNFData))
forall a. a -> IO (IORef a)
newIORef HashMap Shape WHNFData
forall k v. HashMap k v
HL.empty
  WHNFData -> EvalM WHNFData
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 Shape WHNFData)
-> Env -> [String] -> IExpr -> EgisonValue
MemoizedFunc IORef (HashMap Shape WHNFData)
hashRef Env
env [String]
names IExpr
body

evalExprShallow Env
env (ICambdaExpr String
name IExpr
expr) = WHNFData -> EvalM WHNFData
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 (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 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)
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 (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)
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)
mapM Index (Maybe ScalarData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Index ScalarData)
unwrapMaybeFromIndex [Index (Maybe ScalarData)]
is
  WHNFData -> EvalM WHNFData
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 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 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 (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 (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 (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)
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 (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 (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 (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 (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)
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 (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 :: String -> Tensor a -> EvalM (Tensor a)
removeTmpScripts String
symId (Tensor Shape
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 Shape
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) (Shape -> Vector a -> [Index EgisonValue] -> Tensor a
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
s Vector a
xs [Index EgisonValue]
is)
    Tensor a -> EvalM (Tensor a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> Vector a -> [Index EgisonValue] -> Tensor a
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
s Vector a
ys [Index EgisonValue]
js)


evalExprShallow Env
env (IDoExpr [IBindingExpr]
bindings IExpr
expr) = WHNFData -> EvalM WHNFData
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 (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 (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 EvalM WHNFData)
f EgisonValue
matcher WHNFData
target StateT
  EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
-> (MList EvalM WHNFData -> EvalM WHNFData) -> EvalM WHNFData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList EvalM WHNFData -> EvalM WHNFData
fromMList
 where
  fromMList :: MList EvalM WHNFData -> EvalM WHNFData
  fromMList :: MList EvalM WHNFData -> EvalM WHNFData
fromMList MList EvalM WHNFData
MNil = WHNFData -> EvalM WHNFData
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 EvalM 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 (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 EvalM WHNFData)
m StateT
  EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
-> (MList EvalM WHNFData -> EvalM WHNFData) -> EvalM WHNFData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList EvalM WHNFData -> EvalM WHNFData
fromMList)
    IORef (Seq Inner)
seqRef <- IO (IORef (Seq Inner))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef (Seq Inner))
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 (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 EvalM WHNFData)
f EgisonValue
matcher WHNFData
target = do
      let tryMatchClause :: IMatchClause
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
tryMatchClause (IPattern
pattern, IExpr
expr) StateT
  EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
results = do
            MList EvalM [Binding]
result <- PMMode
-> Env
-> IPattern
-> WHNFData
-> EgisonValue
-> EvalM (MList EvalM [Binding])
patternMatch PMMode
pmmode Env
env IPattern
pattern WHNFData
target EgisonValue
matcher
            ([Binding] -> EvalM WHNFData)
-> MList EvalM [Binding]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM 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 EvalM [Binding]
result StateT
  EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
-> (MList EvalM WHNFData
    -> StateT
         EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MList EvalM WHNFData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
forall (m :: * -> *) a.
Monad m =>
MList m a -> m (MList m a) -> m (MList m a)
`mappend` StateT
  EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
results)
      (IMatchClause
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData))
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
-> MList EvalM IMatchClause
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM 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 EvalM WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
tryMatchClause (MList EvalM WHNFData
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (MList EvalM WHNFData)
forall (m :: * -> *) a. Monad m => a -> m a
return MList EvalM WHNFData
forall (m :: * -> *) a. MList m a
MNil) ([IMatchClause] -> MList EvalM 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 (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 EvalM [Binding]
result <- PMMode
-> Env
-> IPattern
-> WHNFData
-> EgisonValue
-> EvalM (MList EvalM [Binding])
patternMatch PMMode
pmmode Env
env IPattern
pattern WHNFData
target EgisonValue
matcher
            case MList EvalM [Binding]
result of
              MCons [Binding]
bindings EvalM (MList EvalM [Binding])
_ -> Env -> IExpr -> EvalM WHNFData
evalExprShallow (Env -> [Binding] -> Env
extendEnv Env
env [Binding]
bindings) IExpr
expr
              MList EvalM [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 (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IMatchClause -> EvalM WHNFData -> EvalM WHNFData
tryMatchClause (EgisonError -> EvalM WHNFData
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 (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 Shape WHNFData)
hashRef Env
env [String]
names IExpr
body) ->
      IORef (HashMap Shape WHNFData)
-> Env -> [String] -> IExpr -> [EgisonValue] -> EvalM WHNFData
evalMemoizedFunc IORef (HashMap Shape 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)
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 (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 (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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData -> EvalM WHNFData
removeDF
    Value (MemoizedFunc IORef (HashMap Shape 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)
mapM (Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalExprDeep Env
env) [IExpr]
args
      IORef (HashMap Shape WHNFData)
-> Env -> [String] -> IExpr -> [EgisonValue] -> EvalM WHNFData
evalMemoizedFunc IORef (HashMap Shape 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 (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)
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)
-> Shape -> [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 (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 (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 Shape 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)
mapM WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalWHNF [WHNFData]
args
      IORef (HashMap Shape WHNFData)
-> Env -> [String] -> IExpr -> [EgisonValue] -> EvalM WHNFData
evalMemoizedFunc IORef (HashMap Shape 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 (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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) [EgisonValue]
collectionToList
  Shape
ns    <- (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) Shape
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison [EgisonValue]
shape :: EvalM Shape
  [ObjectRef]
xs    <- (Shape
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> [Shape]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Env
-> [ScalarData]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
evalWithIndex Env
env ([ScalarData]
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> (Shape -> [ScalarData])
-> Shape
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> ScalarData) -> Shape -> [ScalarData]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
n -> Integer -> Monomial -> ScalarData
SingleTerm Integer
n [])) (Shape -> [Shape]
enumTensorIndices Shape
ns)
  WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Shape -> [ObjectRef] -> WHNFData
newITensor Shape
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 :: 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 (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)
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 (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)
mapM Tensor EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
forall a b. TensorComponent a b => Tensor b -> EvalM a
fromTensor
      WHNFData -> EvalM WHNFData
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 Shape WHNFData)
-> Env -> [String] -> IExpr -> [EgisonValue] -> EvalM WHNFData
evalMemoizedFunc IORef (HashMap Shape WHNFData)
hashRef Env
env [String]
names IExpr
body [EgisonValue]
args = do
  Shape
indices <- (EgisonValue
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> [EgisonValue]
-> StateT EvalState (ExceptT EgisonError RuntimeM) Shape
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison [EgisonValue]
args
  HashMap Shape WHNFData
hash <- IO (HashMap Shape WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (HashMap Shape WHNFData)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap Shape WHNFData)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (HashMap Shape WHNFData))
-> IO (HashMap Shape WHNFData)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (HashMap Shape WHNFData)
forall a b. (a -> b) -> a -> b
$ IORef (HashMap Shape WHNFData) -> IO (HashMap Shape WHNFData)
forall a. IORef a -> IO a
readIORef IORef (HashMap Shape WHNFData)
hashRef
  case Shape -> HashMap Shape WHNFData -> Maybe WHNFData
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HL.lookup Shape
indices HashMap Shape WHNFData
hash of
    Just WHNFData
whnf -> WHNFData -> EvalM WHNFData
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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ IORef (HashMap Shape WHNFData)
-> (HashMap Shape WHNFData -> HashMap Shape WHNFData) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (HashMap Shape WHNFData)
hashRef (Shape
-> WHNFData -> HashMap Shape WHNFData -> HashMap Shape WHNFData
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HL.insert Shape
indices WHNFData
whnf)
      WHNFData -> EvalM WHNFData
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 (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)
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)
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)
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)
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)
mapM ObjectRef
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalRefDeep [ObjectRef]
refs
evalWHNF (ITensor (Tensor Shape
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 (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
$ Shape
-> Vector EgisonValue -> [Index EgisonValue] -> Tensor EgisonValue
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
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 EvalM ObjectRef)
collectionToRefs WHNFData
coll EvalM (MList EvalM ObjectRef)
-> (MList EvalM ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList EvalM 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 (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)
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 :: (Index EgisonValue, Tensor a) -> Tensor a
addscript (Index EgisonValue
subj, Tensor Shape
s Vector a
t [Index EgisonValue]
i) = Shape -> Vector a -> [Index EgisonValue] -> Tensor a
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
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 (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 (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 Shape
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)
mapM ObjectRef -> EvalM WHNFData
evalRef [ObjectRef]
refs
  if Shape -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Shape
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Index EgisonValue] -> 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 Shape
s Vector ObjectRef
_ [Index EgisonValue]
i)) -> Shape -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Shape
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Index EgisonValue] -> 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 (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)
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 (Shape
-> Vector EgisonValue -> [Index EgisonValue] -> Tensor EgisonValue
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
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 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 Shape
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)
mapM ObjectRef -> EvalM WHNFData
evalRef [ObjectRef]
refs
  if Shape -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Shape
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Index EgisonValue] -> 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 Shape
s Vector ObjectRef
_ [Index EgisonValue]
i)) -> Shape -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Shape
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Index EgisonValue] -> 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 (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)
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 (Shape
-> Vector ObjectRef -> [Index EgisonValue] -> Tensor ObjectRef
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
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 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 (t :: * -> *) a. Foldable t => t a -> Int
length CallStack
names Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [ObjectRef] -> 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 (t :: * -> *) a. Foldable t => t a -> Int
length CallStack
names Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [ObjectRef] -> 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 (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 (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 (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 (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 (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)
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 (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)
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)
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)
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 (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)
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 (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 (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)
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 (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. (Eq k, 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 (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. (Eq k, 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 (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 (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 :: 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 (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)
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 (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 (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 (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)
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 (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 (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 (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 (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 EvalM [Binding])
patternMatch PMMode
pmmode Env
env IPattern
pattern WHNFData
target EgisonValue
matcher =
  case PMMode
pmmode of
    PMMode
DFSMode -> MList EvalM MatchingState -> EvalM (MList EvalM [Binding])
processMStatesAllDFS (MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton MatchingState
initMState)
    PMMode
BFSMode -> [MList EvalM MatchingState] -> EvalM (MList EvalM [Binding])
processMStatesAll [MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton MatchingState
initMState]
  where
    initMState :: MatchingState
initMState = MState :: Env
-> [LoopPatContext]
-> [SeqPatContext]
-> [Binding]
-> [MatchingTree]
-> MatchingState
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 EvalM MatchingState -> EvalM (MList EvalM [Binding])
processMStatesAllDFS MList EvalM MatchingState
MNil                                   = MList EvalM [Binding] -> EvalM (MList EvalM [Binding])
forall (m :: * -> *) a. Monad m => a -> m a
return MList EvalM [Binding]
forall (m :: * -> *) a. MList m a
MNil
processMStatesAllDFS (MCons (MState Env
_ [LoopPatContext]
_ [] [Binding]
bindings []) EvalM (MList EvalM MatchingState)
ms) = [Binding] -> EvalM (MList EvalM [Binding]) -> MList EvalM [Binding]
forall (m :: * -> *) a. a -> m (MList m a) -> MList m a
MCons [Binding]
bindings (EvalM (MList EvalM [Binding]) -> MList EvalM [Binding])
-> (MList EvalM MatchingState -> EvalM (MList EvalM [Binding]))
-> MList EvalM MatchingState
-> MList EvalM [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MList EvalM MatchingState -> EvalM (MList EvalM [Binding])
processMStatesAllDFS (MList EvalM MatchingState -> MList EvalM [Binding])
-> EvalM (MList EvalM MatchingState)
-> EvalM (MList EvalM [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalM (MList EvalM MatchingState)
ms
processMStatesAllDFS (MCons MatchingState
mstate EvalM (MList EvalM MatchingState)
ms)                      = MatchingState -> EvalM (MList EvalM MatchingState)
processMState MatchingState
mstate EvalM (MList EvalM MatchingState)
-> (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MList EvalM MatchingState
-> EvalM (MList EvalM MatchingState)
-> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a.
Monad m =>
MList m a -> m (MList m a) -> m (MList m a)
`mappend` EvalM (MList EvalM MatchingState)
ms) EvalM (MList EvalM MatchingState)
-> (MList EvalM MatchingState -> EvalM (MList EvalM [Binding]))
-> EvalM (MList EvalM [Binding])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MList EvalM MatchingState -> EvalM (MList EvalM [Binding])
processMStatesAllDFS

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

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

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

extractMatches :: [MList EvalM MatchingState] -> EvalM ([Match], [MList EvalM MatchingState])
extractMatches :: [MList EvalM MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]], [MList EvalM MatchingState])
extractMatches = ([[Binding]], [MList EvalM MatchingState])
-> [MList EvalM MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]], [MList EvalM MatchingState])
extractMatches' ([], [])
 where
  extractMatches' :: ([Match], [MList EvalM MatchingState]) -> [MList EvalM MatchingState] -> EvalM ([Match], [MList EvalM MatchingState])
  extractMatches' :: ([[Binding]], [MList EvalM MatchingState])
-> [MList EvalM MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]], [MList EvalM MatchingState])
extractMatches' ([[Binding]]
xs, [MList EvalM MatchingState]
ys) [] = ([[Binding]], [MList EvalM MatchingState])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]], [MList EvalM MatchingState])
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Binding]]
xs, [MList EvalM MatchingState]
ys)
  extractMatches' ([[Binding]]
xs, [MList EvalM MatchingState]
ys) (MCons (MatchingState -> Maybe [Binding]
gatherBindings -> Just [Binding]
bindings) EvalM (MList EvalM MatchingState)
states : [MList EvalM MatchingState]
rest) = do
    MList EvalM MatchingState
states' <- EvalM (MList EvalM MatchingState)
states
    ([[Binding]], [MList EvalM MatchingState])
-> [MList EvalM MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]], [MList EvalM MatchingState])
extractMatches' ([[Binding]]
xs [[Binding]] -> [[Binding]] -> [[Binding]]
forall a. [a] -> [a] -> [a]
++ [[Binding]
bindings], [MList EvalM MatchingState]
ys [MList EvalM MatchingState]
-> [MList EvalM MatchingState] -> [MList EvalM MatchingState]
forall a. [a] -> [a] -> [a]
++ [MList EvalM MatchingState
states']) [MList EvalM MatchingState]
rest
  extractMatches' ([[Binding]]
xs, [MList EvalM MatchingState]
ys) (MList EvalM MatchingState
stream:[MList EvalM MatchingState]
rest) = ([[Binding]], [MList EvalM MatchingState])
-> [MList EvalM MatchingState]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([[Binding]], [MList EvalM MatchingState])
extractMatches' ([[Binding]]
xs, [MList EvalM MatchingState]
ys [MList EvalM MatchingState]
-> [MList EvalM MatchingState] -> [MList EvalM MatchingState]
forall a. [a] -> [a] -> [a]
++ [MList EvalM MatchingState
stream]) [MList EvalM 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 (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 EvalM MatchingState)
processMState MatchingState
state | MatchingState -> Bool
nullMState MatchingState
state = MatchingState -> EvalM (MList EvalM MatchingState)
processMState' MatchingState
state
processMState MatchingState
state =
  case MatchingState -> (Integer, MatchingState, MatchingState)
splitMState MatchingState
state of
    (Integer
1, MatchingState
state1, MatchingState
state2) -> do
      MList EvalM [Binding]
result <- MList EvalM MatchingState -> EvalM (MList EvalM [Binding])
processMStatesAllDFS (MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton MatchingState
state1)
      case MList EvalM [Binding]
result of
        MList EvalM [Binding]
MNil -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton MatchingState
state2
        MList EvalM [Binding]
_    -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return MList EvalM 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 EvalM MatchingState
states <- MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
processMStatesAllDFSForall (MatchingState -> MList EvalM 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 EvalM (MList EvalM MatchingState)
statess' <- (MatchingState -> EvalM (MList EvalM MatchingState))
-> MList EvalM MatchingState
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
processMStatesAllDFSForall (MatchingState -> MList EvalM 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 EvalM MatchingState
states
      Bool
b <- (MList EvalM MatchingState
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool)
-> MList EvalM (MList EvalM MatchingState)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> MList m a -> m Bool
mAny (\case
                   MList EvalM MatchingState
MNil -> Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                   MList EvalM MatchingState
_    -> Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) MList EvalM (MList EvalM MatchingState)
statess'
      if Bool
b
        then MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return MList EvalM MatchingState
forall (m :: * -> *) a. MList m a
MNil
--        else return MNil
        else do MList EvalM (MList EvalM MatchingState)
nstatess <- (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> MList EvalM (MList EvalM MatchingState)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (MList EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM 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 (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 EvalM (MList EvalM MatchingState)
statess'
                MList EvalM (MList EvalM MatchingState)
-> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a.
Monad m =>
MList m (MList m a) -> m (MList m a)
mconcat MList EvalM (MList EvalM MatchingState)
nstatess
    (Integer, MatchingState, MatchingState)
_ -> MatchingState -> EvalM (MList EvalM 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 :: [SeqPatContext]
seqPatCtx = [],  mTrees :: [MatchingTree]
mTrees = [IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
matcher] }, MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees })
  splitMState mstate :: MatchingState
mstate@MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MAtom IPattern
pattern WHNFData
target EgisonValue
matcher : [MatchingTree]
trees } =
    (Integer
0, MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
matcher] }, MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees })
  splitMState mstate :: MatchingState
mstate@MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MNode [PatternBinding]
penv MatchingState
state' : [MatchingTree]
trees } =
    (Integer
f, MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [[PatternBinding] -> MatchingState -> MatchingTree
MNode [PatternBinding]
penv MatchingState
state1] }, MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [PatternBinding] -> MatchingState -> MatchingTree
MNode [PatternBinding]
penv MatchingState
state2 MatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
: [MatchingTree]
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 EvalM MatchingState)
processMState' mstate :: MatchingState
mstate@MState{ seqPatCtx :: MatchingState -> [SeqPatContext]
seqPatCtx = [], mTrees :: MatchingState -> [MatchingTree]
mTrees = [] } = MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { seqPatCtx :: [SeqPatContext]
seqPatCtx = [SeqPatContext]
seqs, mTrees :: [MatchingTree]
mTrees = [MatchingTree]
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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { seqPatCtx :: [SeqPatContext]
seqPatCtx = [SeqPatContext]
seqs, mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
seqPat WHNFData
tgt' EgisonValue
mat' MatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
: [MatchingTree]
stack }
processMState' mstate :: MatchingState
mstate@MState{ seqPatCtx :: MatchingState -> [SeqPatContext]
seqPatCtx = ForallPatContext [EgisonValue]
_ [WHNFData]
_:[SeqPatContext]
_, mTrees :: MatchingState -> [MatchingTree]
mTrees = [] } =
  MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
ms1 { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }
        [MatchingTree]
_  -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
ms1 { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[PatternBinding] -> MatchingState -> MatchingTree
MNode [PatternBinding]
penv (MatchingState
ms2 { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees' })MatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }
    Maybe IPattern
Nothing -> (CallStack -> EgisonError) -> EvalM (MList EvalM 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'
      Shape
indices <- (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> [IExpr] -> StateT EvalState (ExceptT EgisonError RuntimeM) Shape
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 (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) -> Shape -> [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) Shape
indices
      case [MatchingTree]
trees' of
        [] -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
ms1 { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern' WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }
        [MatchingTree]
_  -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
ms1 { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern' WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[PatternBinding] -> MatchingState -> MatchingTree
MNode [PatternBinding]
penv (MatchingState
ms2 { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees' })MatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }
    Maybe IPattern
Nothing -> (CallStack -> EgisonError) -> EvalM (MList EvalM 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 EvalM MatchingState)
processMState' MatchingState
state EvalM (MList EvalM MatchingState)
-> (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MatchingState
 -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> MList EvalM MatchingState -> EvalM (MList EvalM 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 (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 :: [MatchingTree]
mTrees = [PatternBinding] -> MatchingState -> MatchingTree
MNode [PatternBinding]
penv MatchingState
state'MatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
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 EvalM MatchingState)
processMState' (MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom (String -> [IPattern] -> IPattern
IInductivePat String
name [IPattern]
args) WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees })
        Just ObjectRef
ref -> do
          WHNFData
whnf <- ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
          case WHNFData
whnf of
            Value PatternFunc{} ->
              MatchingState -> EvalM (MList EvalM MatchingState)
processMState' (MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom (IExpr -> [IPattern] -> IPattern
IPApplyPat (String -> IExpr
IVarExpr String
name) [IPattern]
args) WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees })
            WHNFData
_                   ->
              MatchingState -> EvalM (MList EvalM MatchingState)
processMState' (MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom (String -> [IPattern] -> IPattern
IInductivePat String
name [IPattern]
args) WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees })

    INotPat IPattern
_ -> (CallStack -> EgisonError) -> EvalM (MList EvalM MatchingState)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
EgisonBug String
"should not reach here (not-pattern)")
    IVarPat String
_ -> EgisonError -> EvalM (MList EvalM MatchingState)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM (MList EvalM MatchingState))
-> EgisonError -> EvalM (MList EvalM 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)
mapM IBindingExpr -> EvalM [Binding]
extractBindings [IBindingExpr]
bindings'
      MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mStateBindings :: [Binding]
mStateBindings = [Binding]
b [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
++ [Binding]
bindings, mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern' WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
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 (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 (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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees }
                else MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [PatternBinding] -> MatchingState -> MatchingTree
MNode [PatternBinding]
penv (Env
-> [LoopPatContext]
-> [SeqPatContext]
-> [Binding]
-> [MatchingTree]
-> MatchingState
MState Env
env'' [] [] [] [IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
expr WHNFData
target EgisonValue
matcher]) MatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
: [MatchingTree]
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 EvalM MatchingState)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"pattern constructor" WHNFData
func')

    IDApplyPat IPattern
func [IPattern]
args ->
      MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom (String -> [IPattern] -> IPattern
IInductivePat String
"apply" [IPattern
func, [IPattern] -> IPattern
toListPat [IPattern]
args]) WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
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 (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 (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 (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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { loopPatCtx :: [LoopPatContext]
loopPatCtx = (String, ObjectRef)
-> ObjectRef -> IPattern -> IPattern -> IPattern -> LoopPatContext
LoopPatContext (String
name, ObjectRef
startNumRef) ObjectRef
endsRef' IPattern
endPat IPattern
pat IPattern
pat'LoopPatContext -> [LoopPatContext] -> [LoopPatContext]
forall a. a -> [a] -> [a]
:[LoopPatContext]
loops
                                       , mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
IContPat WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { loopPatCtx :: [LoopPatContext]
loopPatCtx = (String, ObjectRef)
-> ObjectRef -> IPattern -> IPattern -> IPattern -> LoopPatContext
LoopPatContext (String
name, ObjectRef
startNumRef) ObjectRef
endsRef IPattern
endPat IPattern
pat IPattern
pat'LoopPatContext -> [LoopPatContext] -> [LoopPatContext]
forall a. a -> [a] -> [a]
:[LoopPatContext]
loops
                                       , mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
IContPat WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }
    IPattern
IContPat ->
      case [LoopPatContext]
loops of
        [] -> EgisonError -> EvalM (MList EvalM MatchingState)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM (MList EvalM MatchingState))
-> EgisonError -> EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return MList EvalM 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))
-> EvalM (Maybe (ObjectRef, ObjectRef))
-> EvalM (ObjectRef, ObjectRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT EvalM (ObjectRef, ObjectRef)
-> EvalM (Maybe (ObjectRef, ObjectRef))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (WHNFData -> MaybeT EvalM (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 (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 (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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ if
                | Integer
startNum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>  Integer
carEndsNum -> MList EvalM 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 EvalM MatchingState
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [MatchingState
mstate { loopPatCtx :: [LoopPatContext]
loopPatCtx = [LoopPatContext]
loops', mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
endPat (EgisonValue -> WHNFData
Value EgisonValue
startNumVal) EgisonValue
SomethingMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pat' WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }]
                | Integer
startNum Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
carEndsNum ->
                  [MatchingState] -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [MatchingState
mstate { loopPatCtx :: [LoopPatContext]
loopPatCtx = [LoopPatContext]
loops', mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
endPat (EgisonValue -> WHNFData
Value EgisonValue
startNumVal) EgisonValue
SomethingMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pat' WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees },
                            MatchingState
mstate { loopPatCtx :: [LoopPatContext]
loopPatCtx = (String, ObjectRef)
-> ObjectRef -> IPattern -> IPattern -> IPattern -> LoopPatContext
LoopPatContext (String
name, ObjectRef
nextNumRef) ObjectRef
cdrEndsRef IPattern
endPat IPattern
pat IPattern
pat'LoopPatContext -> [LoopPatContext] -> [LoopPatContext]
forall a. a -> [a] -> [a]
:[LoopPatContext]
loops', mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pat WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }]
                | Bool
otherwise ->
                  [MatchingState] -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [MatchingState
mstate { loopPatCtx :: [LoopPatContext]
loopPatCtx = (String, ObjectRef)
-> ObjectRef -> IPattern -> IPattern -> IPattern -> LoopPatContext
LoopPatContext (String
name, ObjectRef
nextNumRef) ObjectRef
endsRef IPattern
endPat IPattern
pat IPattern
pat'LoopPatContext -> [LoopPatContext] -> [LoopPatContext]
forall a. a -> [a] -> [a]
:[LoopPatContext]
loops', mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pat WHNFData
target EgisonValue
matcherMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }]
    IPattern
ISeqNilPat -> (CallStack -> EgisonError) -> EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM 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 EvalM MatchingState)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM (MList EvalM MatchingState))
-> EgisonError -> EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees' }
    IOrPat IPattern
pat1 IPattern
pat2 ->
      MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ [MatchingState] -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => [a] -> MList m a
fromList [MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pat1 WHNFData
target EgisonValue
matcher MatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
: [MatchingTree]
trees }, MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pat2 WHNFData
target EgisonValue
matcher MatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
: [MatchingTree]
trees }]

    IPattern
_ ->
      case EgisonValue
matcher of
        UserMatcher{} -> do
          ([IPattern]
patterns, MList EvalM ObjectRef
targetss, [EgisonValue]
matchers) <- Env
-> IPattern
-> WHNFData
-> EgisonValue
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
inductiveMatch Env
env' IPattern
pattern WHNFData
target EgisonValue
matcher
          case [IPattern] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns of
            Int
1 ->
              MList EvalM ObjectRef
-> (ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a b.
Monad m =>
MList m a -> (a -> m b) -> m (MList m b)
mfor MList EvalM ObjectRef
targetss ((ObjectRef
  -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
 -> EvalM (MList EvalM MatchingState))
-> (ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> EvalM (MList EvalM 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\WHNFData
x -> [WHNFData]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [WHNFData]
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 (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 :: [MatchingTree]
mTrees = [MatchingTree]
trees' }
            Int
_ ->
              MList EvalM ObjectRef
-> (ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a b.
Monad m =>
MList m a -> (a -> m b) -> m (MList m b)
mfor MList EvalM ObjectRef
targetss ((ObjectRef
  -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
 -> EvalM (MList EvalM MatchingState))
-> (ObjectRef
    -> StateT EvalState (ExceptT EgisonError RuntimeM) MatchingState)
-> EvalM (MList EvalM 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 (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 (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 :: [MatchingTree]
mTrees = [MatchingTree]
trees' }

        Tuple [EgisonValue]
matchers ->
          case IPattern
pattern of
            IValuePat IExpr
_ -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
SomethingMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }
            IPattern
IWildCard   -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
SomethingMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }
            IPatVar String
_   -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
SomethingMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
trees }
            IIndexedPat IPattern
_ [IExpr]
_ -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = IPattern -> WHNFData -> EgisonValue -> MatchingTree
MAtom IPattern
pattern WHNFData
target EgisonValue
SomethingMatchingTree -> [MatchingTree] -> [MatchingTree]
forall a. a -> [a] -> [a]
:[MatchingTree]
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 (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [WHNFData] -> 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 (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns) ([WHNFData] -> 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 (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [EgisonValue] -> 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 (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns) ([EgisonValue] -> 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees' }
            IPattern
_ ->  EgisonError -> EvalM (MList EvalM MatchingState)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM (MList EvalM MatchingState))
-> EgisonError -> EvalM (MList EvalM 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees }
                else MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return MList EvalM MatchingState
forall (m :: * -> *) a. MList m a
MNil
            IPattern
IWildCard -> MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees }
            IPatVar String
name -> do
              ObjectRef
targetRef <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
target
              MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mStateBindings :: [Binding]
mStateBindings = (String -> Var
stringToVar String
name, ObjectRef
targetRef)Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
:[Binding]
bindings, mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees }
            IIndexedPat (IPatVar String
name') [IExpr]
indices -> do
              let name :: Var
name = String -> Var
stringToVar String
name'
              Shape
indices <- (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) Integer)
-> [IExpr] -> StateT EvalState (ExceptT EgisonError RuntimeM) Shape
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Shape -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash Shape
indices WHNFData
target EvalM WHNFData
-> (WHNFData
    -> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef
                  MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mStateBindings :: [Binding]
mStateBindings = Var -> ObjectRef -> [Binding] -> [Binding]
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
subst Var
name ObjectRef
obj [Binding]
bindings, mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees }
                Maybe ObjectRef
Nothing  -> do
                  ObjectRef
obj <- Shape -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash Shape
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef
                  MList EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mStateBindings :: [Binding]
mStateBindings = (Var
name,ObjectRef
obj)Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
:[Binding]
bindings, mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees }
            IIndexedPat IPattern
pattern [IExpr]
_ -> EgisonError -> EvalM (MList EvalM MatchingState)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM (MList EvalM MatchingState))
-> EgisonError -> EvalM (MList EvalM 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 (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [WHNFData] -> 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 (t :: * -> *) a. Foldable t => t a -> Int
length [IPattern]
patterns) ([WHNFData] -> 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 EvalM MatchingState -> EvalM (MList EvalM MatchingState)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList EvalM MatchingState -> EvalM (MList EvalM MatchingState))
-> (MatchingState -> MList EvalM MatchingState)
-> MatchingState
-> EvalM (MList EvalM MatchingState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingState -> MList EvalM MatchingState
forall (m :: * -> *) a. Monad m => a -> MList m a
msingleton (MatchingState -> EvalM (MList EvalM MatchingState))
-> MatchingState -> EvalM (MList EvalM MatchingState)
forall a b. (a -> b) -> a -> b
$ MatchingState
mstate { mTrees :: [MatchingTree]
mTrees = [MatchingTree]
trees' }
            IPattern
_ -> EgisonError -> EvalM (MList EvalM MatchingState)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM (MList EvalM MatchingState))
-> EgisonError -> EvalM (MList EvalM 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 EvalM 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 EvalM ObjectRef, [EgisonValue])
inductiveMatch Env
env IPattern
pattern WHNFData
target (UserMatcher Env
matcherEnv [IPatternDef]
clauses) =
  (IPatternDef
 -> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
 -> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue]))
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
-> [IPatternDef]
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IPatternDef
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
forall (t :: * -> *).
Foldable t =>
(PrimitivePatPattern, IExpr, t IBindingExpr)
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
tryPPMatchClause EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
forall a. StateT EvalState (ExceptT EgisonError RuntimeM) a
failPPPatternMatch [IPatternDef]
clauses
 where
  tryPPMatchClause :: (PrimitivePatPattern, IExpr, t IBindingExpr)
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
tryPPMatchClause (PrimitivePatPattern
pat, IExpr
matchers, t IBindingExpr
clauses) EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
cont = do
    Maybe ([IPattern], [Binding])
result <- MaybeT EvalM ([IPattern], [Binding])
-> EvalM (Maybe ([IPattern], [Binding]))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT EvalM ([IPattern], [Binding])
 -> EvalM (Maybe ([IPattern], [Binding])))
-> MaybeT EvalM ([IPattern], [Binding])
-> EvalM (Maybe ([IPattern], [Binding]))
forall a b. (a -> b) -> a -> b
$ Env
-> PrimitivePatPattern
-> IPattern
-> MaybeT EvalM ([IPattern], [Binding])
primitivePatPatternMatch Env
env PrimitivePatPattern
pat IPattern
pattern
    case Maybe ([IPattern], [Binding])
result of
      Just ([IPattern
pattern], [Binding]
bindings) -> do
        MList EvalM ObjectRef
targetss <- (IBindingExpr
 -> EvalM (MList EvalM ObjectRef) -> EvalM (MList EvalM ObjectRef))
-> EvalM (MList EvalM ObjectRef)
-> t IBindingExpr
-> EvalM (MList EvalM ObjectRef)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Binding]
-> IBindingExpr
-> EvalM (MList EvalM ObjectRef)
-> EvalM (MList EvalM ObjectRef)
tryPDMatchClause [Binding]
bindings) EvalM (MList EvalM 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF
        ([IPattern], MList EvalM ObjectRef, [EgisonValue])
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPattern
pattern], MList EvalM ObjectRef
targetss, [EgisonValue
matcher])
      Just ([IPattern]
patterns, [Binding]
bindings) -> do
        MList EvalM ObjectRef
targetss <- (IBindingExpr
 -> EvalM (MList EvalM ObjectRef) -> EvalM (MList EvalM ObjectRef))
-> EvalM (MList EvalM ObjectRef)
-> t IBindingExpr
-> EvalM (MList EvalM ObjectRef)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Binding]
-> IBindingExpr
-> EvalM (MList EvalM ObjectRef)
-> EvalM (MList EvalM ObjectRef)
tryPDMatchClause [Binding]
bindings) EvalM (MList EvalM 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF)
        ([IPattern], MList EvalM ObjectRef, [EgisonValue])
-> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPattern]
patterns, MList EvalM ObjectRef
targetss, [EgisonValue]
matchers)
      Maybe ([IPattern], [Binding])
_ -> EvalM ([IPattern], MList EvalM ObjectRef, [EgisonValue])
cont
  tryPDMatchClause :: [Binding]
-> IBindingExpr
-> EvalM (MList EvalM ObjectRef)
-> EvalM (MList EvalM ObjectRef)
tryPDMatchClause [Binding]
bindings (PDPatternBase Var
pat, IExpr
expr) EvalM (MList EvalM ObjectRef)
cont = do
    ObjectRef
ref <- WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef WHNFData
target
    Maybe [Binding]
result <- MaybeT EvalM [Binding] -> EvalM (Maybe [Binding])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT EvalM [Binding] -> EvalM (Maybe [Binding]))
-> MaybeT EvalM [Binding] -> EvalM (Maybe [Binding])
forall a b. (a -> b) -> a -> b
$ PDPatternBase Var -> ObjectRef -> MaybeT EvalM [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 EvalM ObjectRef))
-> EvalM (MList EvalM ObjectRef)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData -> EvalM (MList EvalM ObjectRef)
collectionToRefs
      Maybe [Binding]
_ -> EvalM (MList EvalM ObjectRef)
cont
  failPPPatternMatch :: StateT EvalState (ExceptT EgisonError RuntimeM) a
failPPPatternMatch = 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 EvalM ([IPattern], [Binding])
primitivePatPatternMatch Env
_ PrimitivePatPattern
PPWildCard IPattern
IWildCard = ([IPattern], [Binding]) -> MaybeT EvalM ([IPattern], [Binding])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
primitivePatPatternMatch Env
_ PrimitivePatPattern
PPPatVar IPattern
pattern = ([IPattern], [Binding]) -> MaybeT EvalM ([IPattern], [Binding])
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 EvalM ObjectRef
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
 -> MaybeT EvalM ObjectRef)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
-> MaybeT EvalM ObjectRef
forall a b. (a -> b) -> a -> b
$ Env
-> IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newThunkRef Env
env IExpr
expr
  ([IPattern], [Binding]) -> MaybeT EvalM ([IPattern], [Binding])
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 (t :: * -> *) a. Foldable t => t a -> Int
length [PrimitivePatPattern]
patterns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [IPattern] -> 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 (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 EvalM [([IPattern], [Binding])]
-> MaybeT EvalM ([IPattern], [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimitivePatPattern
 -> IPattern -> MaybeT EvalM ([IPattern], [Binding]))
-> [PrimitivePatPattern]
-> [IPattern]
-> MaybeT EvalM [([IPattern], [Binding])]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Env
-> PrimitivePatPattern
-> IPattern
-> MaybeT EvalM ([IPattern], [Binding])
primitivePatPatternMatch Env
env) [PrimitivePatPattern]
patterns [IPattern]
exprs
  | Bool
otherwise = MaybeT EvalM ([IPattern], [Binding])
forall a. MatchM a
matchFail
primitivePatPatternMatch Env
env (PPTuplePat [PrimitivePatPattern]
patterns) (ITuplePat [IPattern]
exprs)
  | [PrimitivePatPattern] -> 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 (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 (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 EvalM [([IPattern], [Binding])]
-> MaybeT EvalM ([IPattern], [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimitivePatPattern
 -> IPattern -> MaybeT EvalM ([IPattern], [Binding]))
-> [PrimitivePatPattern]
-> [IPattern]
-> MaybeT EvalM [([IPattern], [Binding])]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Env
-> PrimitivePatPattern
-> IPattern
-> MaybeT EvalM ([IPattern], [Binding])
primitivePatPatternMatch Env
env) [PrimitivePatPattern]
patterns [IPattern]
exprs
  | Bool
otherwise = MaybeT EvalM ([IPattern], [Binding])
forall a. MatchM a
matchFail
primitivePatPatternMatch Env
_ PrimitivePatPattern
_ IPattern
_ = MaybeT EvalM ([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 EvalM [Binding] -> EvalM (Maybe [Binding])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT EvalM [Binding] -> EvalM (Maybe [Binding]))
-> MaybeT EvalM [Binding] -> EvalM (Maybe [Binding])
forall a b. (a -> b) -> a -> b
$ PDPatternBase Var -> ObjectRef -> MaybeT EvalM [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 (m :: * -> *) a. Monad m => a -> m a
return [Binding]
binding

primitiveDataPatternMatch :: IPrimitiveDataPattern -> ObjectRef -> MatchM [Binding]
primitiveDataPatternMatch :: PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding]
primitiveDataPatternMatch PDPatternBase Var
PDWildCard ObjectRef
_        = [Binding] -> MaybeT EvalM [Binding]
forall (m :: * -> *) a. Monad m => a -> m a
return []
primitiveDataPatternMatch (PDPatVar Var
name) ObjectRef
ref = [Binding] -> MaybeT EvalM [Binding]
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 EvalM WHNFData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData -> MaybeT EvalM WHNFData)
-> EvalM WHNFData -> MaybeT EvalM 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 EvalM [[Binding]] -> MaybeT EvalM [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding])
-> [PDPatternBase Var] -> [ObjectRef] -> MaybeT EvalM [[Binding]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PDPatternBase Var -> ObjectRef -> MaybeT EvalM [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 EvalM [ObjectRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
 -> MaybeT EvalM [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> MaybeT EvalM [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)
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 EvalM [[Binding]] -> MaybeT EvalM [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding])
-> [PDPatternBase Var] -> [ObjectRef] -> MaybeT EvalM [[Binding]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding]
primitiveDataPatternMatch [PDPatternBase Var]
patterns [ObjectRef]
whnfs
    WHNFData
_ -> MaybeT EvalM [Binding]
forall a. MatchM a
matchFail
primitiveDataPatternMatch (PDTuplePat [PDPatternBase Var]
patterns) ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData -> MaybeT EvalM WHNFData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData -> MaybeT EvalM WHNFData)
-> EvalM WHNFData -> MaybeT EvalM 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 EvalM [[Binding]] -> MaybeT EvalM [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding])
-> [PDPatternBase Var] -> [ObjectRef] -> MaybeT EvalM [[Binding]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding]
primitiveDataPatternMatch [PDPatternBase Var]
patterns [ObjectRef]
refs
    Value (Tuple [EgisonValue]
vals) -> do
      [ObjectRef]
whnfs <- StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> MaybeT EvalM [ObjectRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
 -> MaybeT EvalM [ObjectRef])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [ObjectRef]
-> MaybeT EvalM [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)
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 EvalM [[Binding]] -> MaybeT EvalM [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding])
-> [PDPatternBase Var] -> [ObjectRef] -> MaybeT EvalM [[Binding]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding]
primitiveDataPatternMatch [PDPatternBase Var]
patterns [ObjectRef]
whnfs
    WHNFData
_ -> MaybeT EvalM [Binding]
forall a. MatchM a
matchFail
primitiveDataPatternMatch PDPatternBase Var
PDEmptyPat ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData -> MaybeT EvalM WHNFData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData -> MaybeT EvalM WHNFData)
-> EvalM WHNFData -> MaybeT EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
  Bool
isEmpty <- StateT EvalState (ExceptT EgisonError RuntimeM) Bool
-> MaybeT EvalM Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT EvalState (ExceptT EgisonError RuntimeM) Bool
 -> MaybeT EvalM Bool)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
-> MaybeT EvalM Bool
forall a b. (a -> b) -> a -> b
$ WHNFData -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
isEmptyCollection WHNFData
whnf
  if Bool
isEmpty then [Binding] -> MaybeT EvalM [Binding]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else MaybeT EvalM [Binding]
forall a. MatchM a
matchFail
primitiveDataPatternMatch (PDConsPat PDPatternBase Var
pattern PDPatternBase Var
pattern') ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData -> MaybeT EvalM WHNFData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData -> MaybeT EvalM WHNFData)
-> EvalM WHNFData -> MaybeT EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
  (ObjectRef
head, ObjectRef
tail) <- WHNFData -> MaybeT EvalM (ObjectRef, ObjectRef)
unconsCollection WHNFData
whnf
  [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
(++) ([Binding] -> [Binding] -> [Binding])
-> MaybeT EvalM [Binding] -> MaybeT EvalM ([Binding] -> [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding]
primitiveDataPatternMatch PDPatternBase Var
pattern ObjectRef
head
       MaybeT EvalM ([Binding] -> [Binding])
-> MaybeT EvalM [Binding] -> MaybeT EvalM [Binding]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding]
primitiveDataPatternMatch PDPatternBase Var
pattern' ObjectRef
tail
primitiveDataPatternMatch (PDSnocPat PDPatternBase Var
pattern PDPatternBase Var
pattern') ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData -> MaybeT EvalM WHNFData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData -> MaybeT EvalM WHNFData)
-> EvalM WHNFData -> MaybeT EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ ObjectRef -> EvalM WHNFData
evalRef ObjectRef
ref
  (ObjectRef
init, ObjectRef
last) <- WHNFData -> MaybeT EvalM (ObjectRef, ObjectRef)
unsnocCollection WHNFData
whnf
  [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
(++) ([Binding] -> [Binding] -> [Binding])
-> MaybeT EvalM [Binding] -> MaybeT EvalM ([Binding] -> [Binding])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding]
primitiveDataPatternMatch PDPatternBase Var
pattern ObjectRef
init
       MaybeT EvalM ([Binding] -> [Binding])
-> MaybeT EvalM [Binding] -> MaybeT EvalM [Binding]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PDPatternBase Var -> ObjectRef -> MaybeT EvalM [Binding]
primitiveDataPatternMatch PDPatternBase Var
pattern' ObjectRef
last
primitiveDataPatternMatch (PDConstantPat ConstantExpr
expr) ObjectRef
ref = do
  WHNFData
whnf <- EvalM WHNFData -> MaybeT EvalM WHNFData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EvalM WHNFData -> MaybeT EvalM WHNFData)
-> EvalM WHNFData -> MaybeT EvalM 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 EvalM [Binding]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    WHNFData
_                                    -> MaybeT EvalM [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 (m :: * -> *) a. Monad m => a -> m a
return EgisonValue
matcher
evalMatcherWHNF (Value matcher :: EgisonValue
matcher@UserMatcher{}) = EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
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)
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)
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)
mapM WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
evalMatcherWHNF [WHNFData]
whnfs
  EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) EgisonValue
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 :: Shape -> [WHNFData] -> EvalM WHNFData
makeITensorFromWHNF Shape
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)
mapM WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ObjectRef
newEvaluatedObjectRef [WHNFData]
xs
  WHNFData -> EvalM WHNFData
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 (Shape
-> Vector ObjectRef -> [Index EgisonValue] -> Tensor ObjectRef
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
s ([ObjectRef] -> Vector ObjectRef
forall a. [a] -> Vector a
V.fromList [ObjectRef]
xs') [])

newITensor :: Shape -> [ObjectRef] -> WHNFData
newITensor :: Shape -> [ObjectRef] -> WHNFData
newITensor Shape
s [ObjectRef]
refs = Tensor ObjectRef -> WHNFData
ITensor (Shape
-> Vector ObjectRef -> [Index EgisonValue] -> Tensor ObjectRef
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
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 :: Bool -> [Index EgisonValue] -> Tensor b -> EvalM a
refTensorWithOverride Bool
override [Index EgisonValue]
js (Tensor Shape
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' (Shape -> Vector b -> [Index EgisonValue] -> Tensor b
forall a. Shape -> Vector a -> [Index EgisonValue] -> Tensor a
Tensor Shape
ns Vector b
xs [Index EgisonValue]
js') EvalM (Tensor b)
-> (Tensor b -> EvalM (Tensor b)) -> EvalM (Tensor 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 -> EvalM a) -> EvalM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tensor b -> EvalM 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Binding] -> EvalM [Binding]
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 (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 Shape
_ 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 (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)