{-# LANGUAGE FlexibleContexts #-}

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

This module provides primitive functions in Egison.
-}

module Language.Egison.Primitives
  ( primitiveEnv
  , primitiveEnvNoIO
  ) where

import           Control.Monad.Except

import           Data.IORef

import qualified Data.Sequence                     as Sq
import qualified Data.Vector                       as V

 {--  -- for 'egison-sqlite'
import qualified Database.SQLite3 as SQLite
 --}  -- for 'egison-sqlite'

import           Language.Egison.Data
import           Language.Egison.Data.Collection   (makeICollection)
import           Language.Egison.IExpr             (Index (..), stringToVar)
import           Language.Egison.Math
import           Language.Egison.Primitives.Arith
import           Language.Egison.Primitives.IO
import           Language.Egison.Primitives.String
import           Language.Egison.Primitives.Types
import           Language.Egison.Primitives.Utils

primitiveEnv :: IO Env
primitiveEnv :: IO Env
primitiveEnv = do
  [(Var, IORef Object)]
bindings <- [(String, EgisonValue)]
-> ((String, EgisonValue) -> IO (Var, IORef Object))
-> IO [(Var, IORef Object)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([(String, EgisonValue)]
constants [(String, EgisonValue)]
-> [(String, EgisonValue)] -> [(String, EgisonValue)]
forall a. [a] -> [a] -> [a]
++ [(String, EgisonValue)]
primitives [(String, EgisonValue)]
-> [(String, EgisonValue)] -> [(String, EgisonValue)]
forall a. [a] -> [a] -> [a]
++ [(String, EgisonValue)]
ioPrimitives) (((String, EgisonValue) -> IO (Var, IORef Object))
 -> IO [(Var, IORef Object)])
-> ((String, EgisonValue) -> IO (Var, IORef Object))
-> IO [(Var, IORef Object)]
forall a b. (a -> b) -> a -> b
$ \(String
name, EgisonValue
op) -> do
    IORef Object
ref <- Object -> IO (IORef Object)
forall a. a -> IO (IORef a)
newIORef (Object -> IO (IORef Object))
-> (WHNFData -> Object) -> WHNFData -> IO (IORef Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WHNFData -> Object
WHNF (WHNFData -> IO (IORef Object)) -> WHNFData -> IO (IORef Object)
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value EgisonValue
op
    (Var, IORef Object) -> IO (Var, IORef Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Var
stringToVar String
name, IORef Object
ref)
  Env -> IO Env
forall (m :: * -> *) a. Monad m => a -> m a
return (Env -> IO Env) -> Env -> IO Env
forall a b. (a -> b) -> a -> b
$ Env -> [(Var, IORef Object)] -> Env
extendEnv Env
nullEnv [(Var, IORef Object)]
bindings

primitiveEnvNoIO :: IO Env
primitiveEnvNoIO :: IO Env
primitiveEnvNoIO = do
  [(Var, IORef Object)]
bindings <- [(String, EgisonValue)]
-> ((String, EgisonValue) -> IO (Var, IORef Object))
-> IO [(Var, IORef Object)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([(String, EgisonValue)]
constants [(String, EgisonValue)]
-> [(String, EgisonValue)] -> [(String, EgisonValue)]
forall a. [a] -> [a] -> [a]
++ [(String, EgisonValue)]
primitives) (((String, EgisonValue) -> IO (Var, IORef Object))
 -> IO [(Var, IORef Object)])
-> ((String, EgisonValue) -> IO (Var, IORef Object))
-> IO [(Var, IORef Object)]
forall a b. (a -> b) -> a -> b
$ \(String
name, EgisonValue
op) -> do
    IORef Object
ref <- Object -> IO (IORef Object)
forall a. a -> IO (IORef a)
newIORef (Object -> IO (IORef Object))
-> (WHNFData -> Object) -> WHNFData -> IO (IORef Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WHNFData -> Object
WHNF (WHNFData -> IO (IORef Object)) -> WHNFData -> IO (IORef Object)
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value EgisonValue
op
    (Var, IORef Object) -> IO (Var, IORef Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Var
stringToVar String
name, IORef Object
ref)
  Env -> IO Env
forall (m :: * -> *) a. Monad m => a -> m a
return (Env -> IO Env) -> Env -> IO Env
forall a b. (a -> b) -> a -> b
$ Env -> [(Var, IORef Object)] -> Env
extendEnv Env
nullEnv [(Var, IORef Object)]
bindings

--
-- Constants
--

constants :: [(String, EgisonValue)]
constants :: [(String, EgisonValue)]
constants = [ (String
"f.pi", Double -> EgisonValue
Float Double
3.141592653589793)
            , (String
"f.e" , Double -> EgisonValue
Float Double
2.718281828459045)
            ]

--
-- Primitives
--

primitives :: [(String, EgisonValue)]
primitives :: [(String, EgisonValue)]
primitives =
  ((String, String -> PrimitiveFunc) -> (String, EgisonValue))
-> [(String, String -> PrimitiveFunc)] -> [(String, EgisonValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, String -> PrimitiveFunc
fn) -> (String
name, PrimitiveFunc -> EgisonValue
PrimitiveFunc (String -> PrimitiveFunc
fn String
name))) [(String, String -> PrimitiveFunc)]
strictPrimitives
  [(String, EgisonValue)]
-> [(String, EgisonValue)] -> [(String, EgisonValue)]
forall a. [a] -> [a] -> [a]
++ ((String, String -> LazyPrimitiveFunc) -> (String, EgisonValue))
-> [(String, String -> LazyPrimitiveFunc)]
-> [(String, EgisonValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, String -> LazyPrimitiveFunc
fn) -> (String
name, LazyPrimitiveFunc -> EgisonValue
LazyPrimitiveFunc (String -> LazyPrimitiveFunc
fn String
name))) [(String, String -> LazyPrimitiveFunc)]
lazyPrimitives
  [(String, EgisonValue)]
-> [(String, EgisonValue)] -> [(String, EgisonValue)]
forall a. [a] -> [a] -> [a]
++ [(String, EgisonValue)]
primitiveArithFunctions
  [(String, EgisonValue)]
-> [(String, EgisonValue)] -> [(String, EgisonValue)]
forall a. [a] -> [a] -> [a]
++ [(String, EgisonValue)]
primitiveStringFunctions
  [(String, EgisonValue)]
-> [(String, EgisonValue)] -> [(String, EgisonValue)]
forall a. [a] -> [a] -> [a]
++ [(String, EgisonValue)]
primitiveTypeFunctions
    where
      strictPrimitives :: [(String, String -> PrimitiveFunc)]
strictPrimitives =
        [ (String
"addSubscript", String -> PrimitiveFunc
addSubscript)
        , (String
"addSuperscript", String -> PrimitiveFunc
addSuperscript)

        , (String
"assert",      String -> PrimitiveFunc
assert)
        , (String
"assertEqual", String -> PrimitiveFunc
assertEqual)
        ]
      lazyPrimitives :: [(String, String -> LazyPrimitiveFunc)]
lazyPrimitives =
        [ (String
"tensorShape", String -> LazyPrimitiveFunc
tensorShape')
        , (String
"tensorToList", String -> LazyPrimitiveFunc
tensorToList')
        , (String
"dfOrder", String -> LazyPrimitiveFunc
dfOrder')
        ]

--
-- Miscellaneous primitive functions
--

tensorShape' :: String -> LazyPrimitiveFunc
tensorShape' :: String -> LazyPrimitiveFunc
tensorShape' = (WHNFData -> EvalM WHNFData) -> String -> LazyPrimitiveFunc
lazyOneArg WHNFData -> EvalM WHNFData
forall (m :: * -> *). Monad m => WHNFData -> m WHNFData
tensorShape''
 where
  tensorShape'' :: WHNFData -> m WHNFData
tensorShape'' (Value (TensorData (Tensor Shape
ns Vector EgisonValue
_ [Index EgisonValue]
_))) =
    WHNFData -> m WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> m WHNFData)
-> ([EgisonValue] -> WHNFData) -> [EgisonValue] -> m WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> ([EgisonValue] -> EgisonValue) -> [EgisonValue] -> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue)
-> ([EgisonValue] -> Seq EgisonValue)
-> [EgisonValue]
-> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList ([EgisonValue] -> m WHNFData) -> [EgisonValue] -> m WHNFData
forall a b. (a -> b) -> a -> b
$ (Integer -> EgisonValue) -> Shape -> [EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison Shape
ns
  tensorShape'' (ITensor (Tensor Shape
ns Vector (IORef Object)
_ [Index EgisonValue]
_)) =
    WHNFData -> m WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> m WHNFData)
-> ([EgisonValue] -> WHNFData) -> [EgisonValue] -> m WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> ([EgisonValue] -> EgisonValue) -> [EgisonValue] -> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue)
-> ([EgisonValue] -> Seq EgisonValue)
-> [EgisonValue]
-> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList ([EgisonValue] -> m WHNFData) -> [EgisonValue] -> m WHNFData
forall a b. (a -> b) -> a -> b
$ (Integer -> EgisonValue) -> Shape -> [EgisonValue]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison Shape
ns
  tensorShape'' WHNFData
_ = WHNFData -> m WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> m WHNFData)
-> (Seq EgisonValue -> WHNFData) -> Seq EgisonValue -> m WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> (Seq EgisonValue -> EgisonValue) -> Seq EgisonValue -> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> m WHNFData) -> Seq EgisonValue -> m WHNFData
forall a b. (a -> b) -> a -> b
$ [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList []

tensorToList' :: String -> LazyPrimitiveFunc
tensorToList' :: String -> LazyPrimitiveFunc
tensorToList' = (WHNFData -> EvalM WHNFData) -> String -> LazyPrimitiveFunc
lazyOneArg WHNFData -> EvalM WHNFData
tensorToList''
 where
  tensorToList'' :: WHNFData -> EvalM WHNFData
tensorToList'' (Value (TensorData (Tensor Shape
_ Vector EgisonValue
xs [Index EgisonValue]
_))) =
    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 -> WHNFData)
-> ([EgisonValue] -> EgisonValue) -> [EgisonValue] -> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EgisonValue -> EgisonValue
Collection (Seq EgisonValue -> EgisonValue)
-> ([EgisonValue] -> Seq EgisonValue)
-> [EgisonValue]
-> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EgisonValue] -> Seq EgisonValue
forall a. [a] -> Seq a
Sq.fromList ([EgisonValue] -> EvalM WHNFData)
-> [EgisonValue] -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Vector EgisonValue -> [EgisonValue]
forall a. Vector a -> [a]
V.toList Vector EgisonValue
xs
  tensorToList'' (ITensor (Tensor Shape
_ Vector (IORef Object)
xs [Index EgisonValue]
_)) = do
    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 ((IORef Object -> Inner) -> [IORef Object] -> [Inner]
forall a b. (a -> b) -> [a] -> [b]
map IORef Object -> Inner
IElement (Vector (IORef Object) -> [IORef Object]
forall a. Vector a -> [a]
V.toList Vector (IORef Object)
xs))
    WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef (Seq Inner) -> WHNFData
ICollection IORef (Seq Inner)
inners)
  tensorToList'' WHNFData
x = LazyPrimitiveFunc
makeICollection [WHNFData
x]

dfOrder' :: String -> LazyPrimitiveFunc
dfOrder' :: String -> LazyPrimitiveFunc
dfOrder' = (WHNFData -> EvalM WHNFData) -> String -> LazyPrimitiveFunc
lazyOneArg WHNFData -> EvalM WHNFData
forall (m :: * -> *). Monad m => WHNFData -> m WHNFData
dfOrder''
 where
  dfOrder'' :: WHNFData -> m WHNFData
dfOrder'' (Value (TensorData (Tensor Shape
ns Vector EgisonValue
_ [Index EgisonValue]
is))) =
    WHNFData -> m WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> m WHNFData) -> WHNFData -> m WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Shape -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Shape
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Index EgisonValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index EgisonValue]
is) :: Integer))
  dfOrder'' (ITensor (Tensor Shape
ns Vector (IORef Object)
_ [Index EgisonValue]
is)) =
    WHNFData -> m WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> m WHNFData) -> WHNFData -> m WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Shape -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Shape
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Index EgisonValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index EgisonValue]
is) :: Integer))
  dfOrder'' WHNFData
_ = WHNFData -> m WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> m WHNFData) -> WHNFData -> m WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value (Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Integer
0 :: Integer))

addSubscript :: String -> PrimitiveFunc
addSubscript :: String -> PrimitiveFunc
addSubscript = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
fn EgisonValue
sub ->
  case (EgisonValue
fn, EgisonValue
sub) of
    (ScalarData (SingleSymbol (Symbol String
id String
name [Index ScalarData]
is)), ScalarData s :: ScalarData
s@(SingleSymbol (Symbol String
_ String
_ []))) ->
      EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ScalarData -> EgisonValue
ScalarData (SymbolExpr -> ScalarData
SingleSymbol (String -> String -> [Index ScalarData] -> SymbolExpr
Symbol String
id String
name ([Index ScalarData]
is [Index ScalarData] -> [Index ScalarData] -> [Index ScalarData]
forall a. [a] -> [a] -> [a]
++ [ScalarData -> Index ScalarData
forall a. a -> Index a
Sub ScalarData
s]))))
    (ScalarData (SingleSymbol (Symbol String
id String
name [Index ScalarData]
is)), ScalarData s :: ScalarData
s@(SingleTerm Integer
_ [])) ->
      EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ScalarData -> EgisonValue
ScalarData (SymbolExpr -> ScalarData
SingleSymbol (String -> String -> [Index ScalarData] -> SymbolExpr
Symbol String
id String
name ([Index ScalarData]
is [Index ScalarData] -> [Index ScalarData] -> [Index ScalarData]
forall a. [a] -> [a] -> [a]
++ [ScalarData -> Index ScalarData
forall a. a -> Index a
Sub ScalarData
s]))))
    (EgisonValue, EgisonValue)
_ -> (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"symbol or integer" (EgisonValue -> WHNFData
Value EgisonValue
fn))

addSuperscript :: String -> PrimitiveFunc
addSuperscript :: String -> PrimitiveFunc
addSuperscript = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
fn EgisonValue
sub ->
  case (EgisonValue
fn, EgisonValue
sub) of
    (ScalarData (SingleSymbol (Symbol String
id String
name [Index ScalarData]
is)), ScalarData s :: ScalarData
s@(SingleSymbol (Symbol String
_ String
_ []))) ->
      EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ScalarData -> EgisonValue
ScalarData (SymbolExpr -> ScalarData
SingleSymbol (String -> String -> [Index ScalarData] -> SymbolExpr
Symbol String
id String
name ([Index ScalarData]
is [Index ScalarData] -> [Index ScalarData] -> [Index ScalarData]
forall a. [a] -> [a] -> [a]
++ [ScalarData -> Index ScalarData
forall a. a -> Index a
Sup ScalarData
s]))))
    (ScalarData (SingleSymbol (Symbol String
id String
name [Index ScalarData]
is)), ScalarData s :: ScalarData
s@(SingleTerm Integer
_ [])) ->
      EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ScalarData -> EgisonValue
ScalarData (SymbolExpr -> ScalarData
SingleSymbol (String -> String -> [Index ScalarData] -> SymbolExpr
Symbol String
id String
name ([Index ScalarData]
is [Index ScalarData] -> [Index ScalarData] -> [Index ScalarData]
forall a. [a] -> [a] -> [a]
++ [ScalarData -> Index ScalarData
forall a. a -> Index a
Sup ScalarData
s]))))
    (EgisonValue, EgisonValue)
_ -> (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"symbol" (EgisonValue -> WHNFData
Value EgisonValue
fn))

assert ::  String -> PrimitiveFunc
assert :: String -> PrimitiveFunc
assert = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs' ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
label EgisonValue
test -> do
  Bool
test <- EgisonValue -> EvalM Bool
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
test
  if Bool
test
    then EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool Bool
True
    else (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
Assertion (EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
label))

assertEqual :: String -> PrimitiveFunc
assertEqual :: String -> PrimitiveFunc
assertEqual = (EgisonValue -> EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
threeArgs' ((EgisonValue -> EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
label EgisonValue
actual EgisonValue
expected ->
  if EgisonValue
actual EgisonValue -> EgisonValue -> Bool
forall a. Eq a => a -> a -> Bool
== EgisonValue
expected
     then EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool Bool
True
     else (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> CallStack -> EgisonError
Assertion
            (EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n expected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n but found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
actual))

 {-- -- for 'egison-sqlite'
sqlite :: PrimitiveFunc
sqlite  = twoArgs' $ \val val' -> do
  dbName <- fromEgison val
  qStr <- fromEgison val'
  ret <- liftIO $ query' (T.pack dbName) $ T.pack qStr
  return $ makeIO $ return $ Collection $ Sq.fromList $ map (\r -> Tuple (map toEgison r)) ret
 where
  query' :: T.Text -> T.Text -> IO [[String]]
  query' dbName q = do
    db <- SQLite.open dbName
    rowsRef <- newIORef []
    SQLite.execWithCallback db q (\_ _ mcs -> do
                                    row <- forM mcs (\mcol -> case mcol of
                                                              Just col ->  return $ T.unpack col
                                                              Nothing -> return "null")
                                    rows <- readIORef rowsRef
                                    writeIORef rowsRef (row:rows))
    SQLite.close db
    ret <- readIORef rowsRef
    return $ reverse ret
 --} -- for 'egison-sqlite'