module Language.Egison.Eval
(
evalExpr
, evalTopExpr
, evalTopExprStr
, evalTopExprs
, evalTopExprsNoPrint
, runExpr
, runTopExpr
, runTopExprStr
, runTopExprs
, loadEgisonLibrary
, loadEgisonFile
) where
import Control.Monad.Except (throwError)
import Control.Monad.Reader (ask, asks)
import Control.Monad.State
import Language.Egison.AST
import Language.Egison.CmdOptions
import Language.Egison.Core
import Language.Egison.Data
import Language.Egison.Desugar
import Language.Egison.EvalState (MonadEval (..))
import Language.Egison.IExpr
import Language.Egison.MathOutput (prettyMath)
import Language.Egison.Parser
evalExpr :: Env -> Expr -> EvalM EgisonValue
evalExpr :: Env -> Expr -> EvalM EgisonValue
evalExpr Env
env Expr
expr = Expr -> EvalM IExpr
desugarExpr Expr
expr EvalM IExpr -> (IExpr -> EvalM EgisonValue) -> EvalM EgisonValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> IExpr -> EvalM EgisonValue
evalExprDeep Env
env
evalTopExpr :: Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr :: Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env TopExpr
topExpr = do
Maybe ITopExpr
topExpr <- TopExpr -> EvalM (Maybe ITopExpr)
desugarTopExpr TopExpr
topExpr
case Maybe ITopExpr
topExpr of
Maybe ITopExpr
Nothing -> (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env)
Just ITopExpr
topExpr -> Env -> ITopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr' Env
env ITopExpr
topExpr
evalTopExprStr :: Env -> TopExpr -> EvalM (Maybe String, Env)
evalTopExprStr :: Env -> TopExpr -> EvalM (Maybe String, Env)
evalTopExprStr Env
env TopExpr
topExpr = do
(Maybe EgisonValue
val, Env
env') <- Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env TopExpr
topExpr
case Maybe EgisonValue
val of
Maybe EgisonValue
Nothing -> (Maybe String, Env) -> EvalM (Maybe String, Env)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
forall a. Maybe a
Nothing, Env
env')
Just EgisonValue
val -> do String
str <- EgisonValue -> EvalM String
valueToStr EgisonValue
val
(Maybe String, Env) -> EvalM (Maybe String, Env)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
str, Env
env')
valueToStr :: EgisonValue -> EvalM String
valueToStr :: EgisonValue -> EvalM String
valueToStr EgisonValue
val = do
Maybe String
mathExpr <- (EgisonOpts -> Maybe String)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EgisonOpts -> Maybe String
optMathExpr
case Maybe String
mathExpr of
Maybe String
Nothing -> String -> EvalM String
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
val)
Just String
lang -> String -> EvalM String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EgisonValue -> String
prettyMath String
lang EgisonValue
val)
evalTopExprs :: Env -> [TopExpr] -> EvalM Env
evalTopExprs :: Env -> [TopExpr] -> EvalM Env
evalTopExprs Env
env [TopExpr]
exprs = do
[ITopExpr]
exprs <- [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs [TopExpr]
exprs
EgisonOpts
opts <- StateT EvalState (ExceptT EgisonError RuntimeM) EgisonOpts
forall r (m :: * -> *). MonadReader r m => m r
ask
([(Var, IExpr)]
bindings, [ITopExpr]
rest) <- EgisonOpts -> [ITopExpr] -> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs EgisonOpts
opts [ITopExpr]
exprs
Env
env <- Env -> [(Var, IExpr)] -> EvalM Env
recursiveBind Env
env [(Var, IExpr)]
bindings
[ITopExpr]
-> (ITopExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ITopExpr]
rest ((ITopExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> (ITopExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ \ITopExpr
expr -> do
(Maybe EgisonValue
val, Env
_) <- Env -> ITopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr' Env
env ITopExpr
expr
case Maybe EgisonValue
val of
Maybe EgisonValue
Nothing -> () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just EgisonValue
val -> EgisonValue -> EvalM String
valueToStr EgisonValue
val EvalM String
-> (String -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> (String -> IO ())
-> String
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn
Env -> EvalM Env
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env
evalTopExprsNoPrint :: Env -> [TopExpr] -> EvalM Env
evalTopExprsNoPrint :: Env -> [TopExpr] -> EvalM Env
evalTopExprsNoPrint Env
env [TopExpr]
exprs = do
[ITopExpr]
exprs <- [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs [TopExpr]
exprs
EgisonOpts
opts <- StateT EvalState (ExceptT EgisonError RuntimeM) EgisonOpts
forall r (m :: * -> *). MonadReader r m => m r
ask
([(Var, IExpr)]
bindings, [ITopExpr]
rest) <- EgisonOpts -> [ITopExpr] -> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs EgisonOpts
opts [ITopExpr]
exprs
Env
env <- Env -> [(Var, IExpr)] -> EvalM Env
recursiveBind Env
env [(Var, IExpr)]
bindings
[ITopExpr]
-> (ITopExpr -> EvalM (Maybe EgisonValue, Env))
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ITopExpr]
rest ((ITopExpr -> EvalM (Maybe EgisonValue, Env))
-> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> (ITopExpr -> EvalM (Maybe EgisonValue, Env))
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ Env -> ITopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr' Env
env
Env -> EvalM Env
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env
runExpr :: Env -> String -> EvalM EgisonValue
runExpr :: Env -> String -> EvalM EgisonValue
runExpr Env
env String
input =
String -> EvalM Expr
readExpr String
input EvalM Expr -> (Expr -> EvalM EgisonValue) -> EvalM EgisonValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> Expr -> EvalM EgisonValue
evalExpr Env
env
runTopExpr :: Env -> String -> EvalM (Maybe EgisonValue, Env)
runTopExpr :: Env -> String -> EvalM (Maybe EgisonValue, Env)
runTopExpr Env
env String
input =
String -> EvalM TopExpr
readTopExpr String
input EvalM TopExpr
-> (TopExpr -> EvalM (Maybe EgisonValue, Env))
-> EvalM (Maybe EgisonValue, Env)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env
runTopExprStr :: Env -> String -> EvalM (Maybe String, Env)
runTopExprStr :: Env -> String -> EvalM (Maybe String, Env)
runTopExprStr Env
env String
input =
String -> EvalM TopExpr
readTopExpr String
input EvalM TopExpr
-> (TopExpr -> EvalM (Maybe String, Env))
-> EvalM (Maybe String, Env)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> TopExpr -> EvalM (Maybe String, Env)
evalTopExprStr Env
env
runTopExprs :: Env -> String -> EvalM Env
runTopExprs :: Env -> String -> EvalM Env
runTopExprs Env
env String
input =
String -> EvalM [TopExpr]
readTopExprs String
input EvalM [TopExpr] -> ([TopExpr] -> EvalM Env) -> EvalM Env
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> [TopExpr] -> EvalM Env
evalTopExprs Env
env
loadEgisonFile :: Env -> FilePath -> EvalM Env
loadEgisonFile :: Env -> String -> EvalM Env
loadEgisonFile Env
env String
path = do
(Maybe EgisonValue
_, Env
env') <- Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env (String -> TopExpr
LoadFile String
path)
Env -> EvalM Env
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env'
loadEgisonLibrary :: Env -> FilePath -> EvalM Env
loadEgisonLibrary :: Env -> String -> EvalM Env
loadEgisonLibrary Env
env String
path = do
(Maybe EgisonValue
_, Env
env') <- Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env (String -> TopExpr
Load String
path)
Env -> EvalM Env
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env'
collectDefs :: EgisonOpts -> [ITopExpr] -> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs :: EgisonOpts -> [ITopExpr] -> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs EgisonOpts
opts [ITopExpr]
exprs = EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs [] []
where
collectDefs' :: EgisonOpts -> [ITopExpr] -> [(Var, IExpr)] -> [ITopExpr] -> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs' :: EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts (ITopExpr
expr:[ITopExpr]
exprs) [(Var, IExpr)]
bindings [ITopExpr]
rest =
case ITopExpr
expr of
IDefine Var
name IExpr
expr -> EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs ((Var
name, IExpr
expr) (Var, IExpr) -> [(Var, IExpr)] -> [(Var, IExpr)]
forall a. a -> [a] -> [a]
: [(Var, IExpr)]
bindings) [ITopExpr]
rest
ITest{} -> EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs [(Var, IExpr)]
bindings (ITopExpr
expr ITopExpr -> [ITopExpr] -> [ITopExpr]
forall a. a -> [a] -> [a]
: [ITopExpr]
rest)
IExecute{} -> EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs [(Var, IExpr)]
bindings (ITopExpr
expr ITopExpr -> [ITopExpr] -> [ITopExpr]
forall a. a -> [a] -> [a]
: [ITopExpr]
rest)
ILoadFile String
_ | EgisonOpts -> Bool
optNoIO EgisonOpts
opts -> EgisonError -> EvalM ([(Var, IExpr)], [ITopExpr])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> EgisonError
Default String
"No IO support")
ILoadFile String
file -> do
[ITopExpr]
exprs' <- String -> EvalM [TopExpr]
loadFile String
file EvalM [TopExpr]
-> ([TopExpr] -> EvalM [ITopExpr]) -> EvalM [ITopExpr]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs
EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts ([ITopExpr]
exprs' [ITopExpr] -> [ITopExpr] -> [ITopExpr]
forall a. [a] -> [a] -> [a]
++ [ITopExpr]
exprs) [(Var, IExpr)]
bindings [ITopExpr]
rest
ILoad String
_ | EgisonOpts -> Bool
optNoIO EgisonOpts
opts -> EgisonError -> EvalM ([(Var, IExpr)], [ITopExpr])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> EgisonError
Default String
"No IO support")
ILoad String
file -> do
[ITopExpr]
exprs' <- String -> EvalM [TopExpr]
loadLibraryFile String
file EvalM [TopExpr]
-> ([TopExpr] -> EvalM [ITopExpr]) -> EvalM [ITopExpr]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs
EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts ([ITopExpr]
exprs' [ITopExpr] -> [ITopExpr] -> [ITopExpr]
forall a. [a] -> [a] -> [a]
++ [ITopExpr]
exprs) [(Var, IExpr)]
bindings [ITopExpr]
rest
collectDefs' EgisonOpts
_ [] [(Var, IExpr)]
bindings [ITopExpr]
rest = ([(Var, IExpr)], [ITopExpr]) -> EvalM ([(Var, IExpr)], [ITopExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Var, IExpr)]
bindings, [ITopExpr] -> [ITopExpr]
forall a. [a] -> [a]
reverse [ITopExpr]
rest)
evalTopExpr' :: Env -> ITopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr' :: Env -> ITopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr' Env
env (IDefine Var
name IExpr
expr) = do
Env
env' <- Env -> [(Var, IExpr)] -> EvalM Env
recursiveBind Env
env [(Var
name, IExpr
expr)]
(Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env')
evalTopExpr' Env
env (ITest IExpr
expr) = do
Var -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => Var -> m ()
pushFuncName (String -> Var
stringToVar String
"<stdin>")
EgisonValue
val <- Env -> IExpr -> EvalM EgisonValue
evalExprDeep Env
env IExpr
expr
StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => m ()
popFuncName
(Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> Maybe EgisonValue
forall a. a -> Maybe a
Just EgisonValue
val, Env
env)
evalTopExpr' Env
env (IExecute IExpr
expr) = do
Var -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => Var -> m ()
pushFuncName (String -> Var
stringToVar String
"<stdin>")
WHNFData
io <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
case WHNFData
io of
Value (IOFunc EvalM WHNFData
m) -> EvalM WHNFData
m EvalM WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => m ()
popFuncName StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> EvalM (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env)
WHNFData
_ -> (CallStack -> EgisonError) -> EvalM (Maybe EgisonValue, Env)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"io" WHNFData
io)
evalTopExpr' Env
env (ILoad String
file) = do
EgisonOpts
opts <- StateT EvalState (ExceptT EgisonError RuntimeM) EgisonOpts
forall r (m :: * -> *). MonadReader r m => m r
ask
Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EgisonOpts -> Bool
optNoIO EgisonOpts
opts) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> EgisonError
Default String
"No IO support")
[ITopExpr]
exprs <- String -> EvalM [TopExpr]
loadLibraryFile String
file EvalM [TopExpr]
-> ([TopExpr] -> EvalM [ITopExpr]) -> EvalM [ITopExpr]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs
([(Var, IExpr)]
bindings, [ITopExpr]
_) <- EgisonOpts -> [ITopExpr] -> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs EgisonOpts
opts [ITopExpr]
exprs
Env
env' <- Env -> [(Var, IExpr)] -> EvalM Env
recursiveBind Env
env [(Var, IExpr)]
bindings
(Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env')
evalTopExpr' Env
env (ILoadFile String
file) = do
EgisonOpts
opts <- StateT EvalState (ExceptT EgisonError RuntimeM) EgisonOpts
forall r (m :: * -> *). MonadReader r m => m r
ask
Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EgisonOpts -> Bool
optNoIO EgisonOpts
opts) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> EgisonError
Default String
"No IO support")
[ITopExpr]
exprs <- String -> EvalM [TopExpr]
loadFile String
file EvalM [TopExpr]
-> ([TopExpr] -> EvalM [ITopExpr]) -> EvalM [ITopExpr]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs
([(Var, IExpr)]
bindings, [ITopExpr]
_) <- EgisonOpts -> [ITopExpr] -> EvalM ([(Var, IExpr)], [ITopExpr])
collectDefs EgisonOpts
opts [ITopExpr]
exprs
Env
env' <- Env -> [(Var, IExpr)] -> EvalM Env
recursiveBind Env
env [(Var, IExpr)]
bindings
(Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env')