{- |
Module      : Language.Egison.Data.Utils
Licence     : MIT

This module provides some helper functions for handling Egison data.
-}

module Language.Egison.Data.Utils
  ( evalRef
  , evalObj
  , writeObjectRef
  , newEvaluatedObjectRef
  , tupleToRefs
  , tupleToListWHNF
  , tupleToList
  , makeTuple
  , makeITuple
  , pmIndices
  , updateHash
  ) where

import           Control.Monad
import           Control.Monad.State   (liftIO)
import           Control.Monad.Except            (throwError)

import           Data.IORef
import qualified Data.HashMap.Lazy               as HL

import           Language.Egison.Data
import           Language.Egison.IExpr


evalRef :: ObjectRef -> EvalM WHNFData
evalRef :: ObjectRef -> EvalM WHNFData
evalRef 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 WHNFData
val -> WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
val
    Thunk EvalM WHNFData
thunk -> do
      WHNFData
val <- EvalM WHNFData
thunk
      ObjectRef -> WHNFData -> EvalM ()
writeObjectRef ObjectRef
ref WHNFData
val
      WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
val

evalObj :: Object -> EvalM WHNFData
evalObj :: Object -> EvalM WHNFData
evalObj (WHNF WHNFData
val)    = WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
val
evalObj (Thunk EvalM WHNFData
thunk) = EvalM WHNFData
thunk

writeObjectRef :: ObjectRef -> WHNFData -> EvalM ()
writeObjectRef :: ObjectRef -> WHNFData -> EvalM ()
writeObjectRef ObjectRef
ref WHNFData
val = IO () -> EvalM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> (Object -> IO ()) -> Object -> EvalM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectRef -> Object -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef ObjectRef
ref (Object -> EvalM ()) -> Object -> EvalM ()
forall a b. (a -> b) -> a -> b
$ WHNFData -> Object
WHNF WHNFData
val

newEvaluatedObjectRef :: WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef :: WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef = IO ObjectRef -> EvalM ObjectRef
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObjectRef -> EvalM ObjectRef)
-> (WHNFData -> IO ObjectRef) -> WHNFData -> EvalM ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> IO ObjectRef
forall a. a -> IO (IORef a)
newIORef (Object -> IO ObjectRef)
-> (WHNFData -> Object) -> WHNFData -> IO ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WHNFData -> Object
WHNF

tupleToRefs :: WHNFData -> EvalM [ObjectRef]
tupleToRefs :: WHNFData -> EvalM [ObjectRef]
tupleToRefs (ITuple [ObjectRef]
refs)        = [ObjectRef] -> EvalM [ObjectRef]
forall (m :: * -> *) a. Monad m => a -> m a
return [ObjectRef]
refs
tupleToRefs (Value (Tuple [EgisonValue]
vals)) = (EgisonValue -> EvalM ObjectRef)
-> [EgisonValue] -> EvalM [ObjectRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef (WHNFData -> EvalM ObjectRef)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value) [EgisonValue]
vals
tupleToRefs WHNFData
whnf                 = ObjectRef -> [ObjectRef]
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjectRef -> [ObjectRef]) -> EvalM ObjectRef -> EvalM [ObjectRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef WHNFData
whnf

tupleToListWHNF :: WHNFData -> EvalM [WHNFData]
tupleToListWHNF :: WHNFData -> EvalM [WHNFData]
tupleToListWHNF (ITuple [ObjectRef]
refs)        = (ObjectRef -> EvalM WHNFData) -> [ObjectRef] -> EvalM [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
tupleToListWHNF (Value (Tuple [EgisonValue]
vals)) = [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) -> [EgisonValue] -> [WHNFData]
forall a b. (a -> b) -> [a] -> [b]
map EgisonValue -> WHNFData
Value [EgisonValue]
vals
tupleToListWHNF WHNFData
whnf                 = [WHNFData] -> EvalM [WHNFData]
forall (m :: * -> *) a. Monad m => a -> m a
return [WHNFData
whnf]

tupleToList :: EgisonValue -> [EgisonValue]
tupleToList :: EgisonValue -> [EgisonValue]
tupleToList (Tuple [EgisonValue]
vals) = [EgisonValue]
vals
tupleToList EgisonValue
val          = [EgisonValue
val]

makeTuple :: [EgisonValue] -> EgisonValue
makeTuple :: [EgisonValue] -> EgisonValue
makeTuple []  = [EgisonValue] -> EgisonValue
Tuple []
makeTuple [EgisonValue
x] = EgisonValue
x
makeTuple [EgisonValue]
xs  = [EgisonValue] -> EgisonValue
Tuple [EgisonValue]
xs

makeITuple :: [WHNFData] -> EvalM WHNFData
makeITuple :: [WHNFData] -> EvalM WHNFData
makeITuple []  = WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return ([ObjectRef] -> WHNFData
ITuple [])
makeITuple [WHNFData
x] = WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return WHNFData
x
makeITuple [WHNFData]
xs  = [ObjectRef] -> WHNFData
ITuple ([ObjectRef] -> WHNFData) -> EvalM [ObjectRef] -> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WHNFData -> EvalM ObjectRef) -> [WHNFData] -> EvalM [ObjectRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef [WHNFData]
xs

pmIndices :: [Index (Maybe Var)] -> [Index EgisonValue] -> EvalM [Binding]
pmIndices :: [Index (Maybe Var)] -> [Index EgisonValue] -> EvalM [Binding]
pmIndices [] [] = [Binding] -> EvalM [Binding]
forall (m :: * -> *) a. Monad m => a -> m a
return []
pmIndices (MultiSub (Just Var
a) Integer
s (Just Var
e):[Index (Maybe Var)]
xs) [Index EgisonValue]
vs = do
  let ([Index EgisonValue]
vs1, [Index EgisonValue]
vs2) = (Index EgisonValue -> Bool)
-> [Index EgisonValue]
-> ([Index EgisonValue], [Index EgisonValue])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Index EgisonValue -> Bool
forall a. Index a -> Bool
isSub [Index EgisonValue]
vs
  let l :: Integer
l = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Index EgisonValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index EgisonValue]
vs1)
  ObjectRef
eRef <- WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef (EgisonValue -> WHNFData
Value (Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison Integer
l))
  let hash :: WHNFData
hash = (HashMap Integer ObjectRef -> WHNFData
IIntHash HashMap Integer ObjectRef
forall k v. HashMap k v
HL.empty)
  WHNFData
hash <- (WHNFData -> (Integer, WHNFData) -> EvalM WHNFData)
-> WHNFData -> [(Integer, WHNFData)] -> EvalM WHNFData
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\WHNFData
hash (Integer
i, WHNFData
v) -> [Integer] -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash [Integer
i] WHNFData
v WHNFData
hash) WHNFData
hash ([Integer] -> [WHNFData] -> [(Integer, WHNFData)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
s..(Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)] ((Index EgisonValue -> WHNFData)
-> [Index EgisonValue] -> [WHNFData]
forall a b. (a -> b) -> [a] -> [b]
map (\(Sub EgisonValue
v) -> EgisonValue -> WHNFData
Value EgisonValue
v) [Index EgisonValue]
vs1)) 
  ObjectRef
aRef <- WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef WHNFData
hash
  [Binding]
bs <- [Index (Maybe Var)] -> [Index EgisonValue] -> EvalM [Binding]
pmIndices [Index (Maybe Var)]
xs [Index EgisonValue]
vs2
  [Binding] -> EvalM [Binding]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Var
a, ObjectRef
aRef) Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
: (Var
e, ObjectRef
eRef) Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
: [Binding]
bs)
 where
  isSub :: Index a -> Bool
isSub (Sub a
_) = Bool
True
  isSub Index a
_       = Bool
False
pmIndices (MultiSup (Just Var
a) Integer
s (Just Var
e):[Index (Maybe Var)]
xs) [Index EgisonValue]
vs = do
  let ([Index EgisonValue]
vs1, [Index EgisonValue]
vs2) = (Index EgisonValue -> Bool)
-> [Index EgisonValue]
-> ([Index EgisonValue], [Index EgisonValue])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Index EgisonValue -> Bool
forall a. Index a -> Bool
isSup [Index EgisonValue]
vs
  let l :: Integer
l = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Index EgisonValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index EgisonValue]
vs1)
  ObjectRef
eRef <- WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef (EgisonValue -> WHNFData
Value (Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison Integer
l))
  let hash :: WHNFData
hash = (HashMap Integer ObjectRef -> WHNFData
IIntHash HashMap Integer ObjectRef
forall k v. HashMap k v
HL.empty)
  WHNFData
hash <- (WHNFData -> (Integer, WHNFData) -> EvalM WHNFData)
-> WHNFData -> [(Integer, WHNFData)] -> EvalM WHNFData
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\WHNFData
hash (Integer
i, WHNFData
v) -> [Integer] -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash [Integer
i] WHNFData
v WHNFData
hash) WHNFData
hash ([Integer] -> [WHNFData] -> [(Integer, WHNFData)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
s..(Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)] ((Index EgisonValue -> WHNFData)
-> [Index EgisonValue] -> [WHNFData]
forall a b. (a -> b) -> [a] -> [b]
map (\(Sup EgisonValue
v) -> EgisonValue -> WHNFData
Value EgisonValue
v) [Index EgisonValue]
vs1)) 
  ObjectRef
aRef <- WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef WHNFData
hash
  [Binding]
bs <- [Index (Maybe Var)] -> [Index EgisonValue] -> EvalM [Binding]
pmIndices [Index (Maybe Var)]
xs [Index EgisonValue]
vs2
  [Binding] -> EvalM [Binding]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Var
a, ObjectRef
aRef) Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
: (Var
e, ObjectRef
eRef) Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
: [Binding]
bs)
 where
  isSup :: Index a -> Bool
isSup (Sup a
_) = Bool
True
  isSup Index a
_       = Bool
False

pmIndices (Index (Maybe Var)
x:[Index (Maybe Var)]
xs) (Index EgisonValue
v:[Index EgisonValue]
vs) = do
  [Binding]
bs <- Index (Maybe Var) -> Index EgisonValue -> EvalM [Binding]
pmIndex Index (Maybe Var)
x Index EgisonValue
v
  [Binding]
bs' <- [Index (Maybe Var)] -> [Index EgisonValue] -> EvalM [Binding]
pmIndices [Index (Maybe Var)]
xs [Index EgisonValue]
vs
  [Binding] -> EvalM [Binding]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Binding]
bs [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
++ [Binding]
bs')
pmIndices [Index (Maybe Var)]
_ [Index EgisonValue]
_ = (CallStack -> EgisonError) -> EvalM [Binding]
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace CallStack -> EgisonError
InconsistentTensorIndex

pmIndex :: Index (Maybe Var) -> Index EgisonValue -> EvalM [Binding]
pmIndex :: Index (Maybe Var) -> Index EgisonValue -> EvalM [Binding]
pmIndex (Sub (Just Var
var)) (Sub EgisonValue
val) = do
  ObjectRef
ref <- WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef (EgisonValue -> WHNFData
Value EgisonValue
val)
  [Binding] -> EvalM [Binding]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Var
var, ObjectRef
ref)]
pmIndex (Sup (Just Var
var)) (Sup EgisonValue
val) = do
  ObjectRef
ref <- WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef (EgisonValue -> WHNFData
Value EgisonValue
val)
  [Binding] -> EvalM [Binding]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Var
var, ObjectRef
ref)]
pmIndex Index (Maybe Var)
_ Index EgisonValue
_ = (CallStack -> EgisonError) -> EvalM [Binding]
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace CallStack -> EgisonError
InconsistentTensorIndex

updateHash :: [Integer] -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash :: [Integer] -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash [Integer
index] WHNFData
tgt (IIntHash HashMap Integer ObjectRef
hash) = do
  ObjectRef
targetRef <- WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef WHNFData
tgt
  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
-> HashMap Integer ObjectRef
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HL.insert Integer
index ObjectRef
targetRef HashMap Integer ObjectRef
hash
updateHash (Integer
index:[Integer]
indices) WHNFData
tgt (IIntHash HashMap Integer ObjectRef
hash) = do
  WHNFData
val <- EvalM WHNFData
-> (ObjectRef -> EvalM WHNFData)
-> Maybe ObjectRef
-> EvalM WHNFData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
$ HashMap Integer ObjectRef -> WHNFData
IIntHash HashMap Integer ObjectRef
forall k v. HashMap k v
HL.empty) ObjectRef -> EvalM WHNFData
evalRef (Maybe ObjectRef -> EvalM WHNFData)
-> Maybe ObjectRef -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Integer -> HashMap Integer ObjectRef -> Maybe ObjectRef
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HL.lookup Integer
index HashMap Integer ObjectRef
hash
  ObjectRef
ref <- [Integer] -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash [Integer]
indices WHNFData
tgt WHNFData
val EvalM WHNFData -> (WHNFData -> EvalM ObjectRef) -> EvalM ObjectRef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef
  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
-> HashMap Integer ObjectRef
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HL.insert Integer
index ObjectRef
ref HashMap Integer ObjectRef
hash
updateHash [Integer]
indices WHNFData
tgt (Value (IntHash HashMap Integer EgisonValue
hash)) = do
  let keys :: [Integer]
keys = HashMap Integer EgisonValue -> [Integer]
forall k v. HashMap k v -> [k]
HL.keys HashMap Integer EgisonValue
hash
  [ObjectRef]
vals <- (EgisonValue -> EvalM ObjectRef)
-> [EgisonValue] -> EvalM [ObjectRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WHNFData -> EvalM ObjectRef
newEvaluatedObjectRef (WHNFData -> EvalM ObjectRef)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM ObjectRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value) ([EgisonValue] -> EvalM [ObjectRef])
-> [EgisonValue] -> EvalM [ObjectRef]
forall a b. (a -> b) -> a -> b
$ HashMap Integer EgisonValue -> [EgisonValue]
forall k v. HashMap k v -> [v]
HL.elems HashMap Integer EgisonValue
hash
  [Integer] -> WHNFData -> WHNFData -> EvalM WHNFData
updateHash [Integer]
indices WHNFData
tgt (HashMap Integer ObjectRef -> WHNFData
IIntHash (HashMap Integer ObjectRef -> WHNFData)
-> HashMap Integer ObjectRef -> 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
$ [Integer] -> [ObjectRef] -> [(Integer, ObjectRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
keys [ObjectRef]
vals)
updateHash [Integer]
_ WHNFData
_ WHNFData
v = 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 -> EgisonError) -> String -> EgisonError
forall a b. (a -> b) -> a -> b
$ String
"expected hash value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WHNFData -> String
forall a. Show a => a -> String
show WHNFData
v