{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module Interpreter.Interpreter where

import qualified Analyzer.AnalyzedAst as Ast
import Control.Lens (Ixed (ix), (%~), (&), (.~), (^.), (^?!))
import Control.Monad (foldM, void, (>=>))
import Control.Monad.Except (MonadError (throwError), liftEither, runExceptT)
import Control.Monad.Extra (fromMaybeM)
import Control.Monad.ST (runST)
import Control.Monad.State (MonadState (get), StateT (runStateT), modify)
import Data.Either.Combinators (leftToMaybe, mapBoth)
import Data.Functor (($>))
import Data.List.Extra ((!?))
import qualified Data.Map as Map
import Data.STRef (newSTRef, readSTRef)
import Data.Text (Text, pack)
import qualified Data.Text as T
import Interpreter.Result
import Interpreter.Runtime
import MaybeVoid (MaybeVoid (..), maybeVoid)
import qualified PrimitiveValue as PV
import StdLib (stdLibFunctionsMap)

------------------------------------------------------Interpreter-------------------------------------------------------

-- * Interpreter

-- | Interpreter entry point. Assumes that program is analyzed successfully.
interpret :: Ast.Program -> (ResultValue (), Env')
interpret :: Program -> (ResultValue (), Env')
interpret Program
ast = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  (ResultValue ()
res, Env s
env) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall s. Program -> Result s ()
interpretProgram Program
ast)) forall s. Env s
emptyEnv
  Env'
env' <- forall s. Env s -> ST s Env'
evalEnv (Env s
env forall a b. a -> (a -> b) -> b
& forall s. Lens' (Env s) [Text]
accumulatedOutput forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. [a] -> [a]
reverse)
  forall (m :: * -> *) a. Monad m => a -> m a
return (ResultValue ()
res, Env'
env')

getInterpretationOut :: (ResultValue (), Env') -> (Text, Maybe Text)
getInterpretationOut :: (ResultValue (), Env') -> (Text, Maybe Text)
getInterpretationOut (ResultValue ()
result, Env'
env) = ([Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Env'
env forall s a. s -> Getting a s a -> a
^. Lens' Env' [Text]
accumulatedOutput', String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Either a b -> Maybe a
leftToMaybe ResultValue ()
result)

-------------------------------------------------Program and functions--------------------------------------------------

interpretProgram :: Ast.Program -> Result s ()
interpretProgram :: forall s. Program -> Result s ()
interpretProgram (Ast.Program [VarDecl]
tlVarDecls [FunctionDef]
tlFuncDefs) = do
  Map Text (STRef s Function, Scope s)
fs' <- forall {s}.
ExceptT
  Err (StateT (Env s) (ST s)) (Map Text (STRef s Function, Scope s))
fs
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall s. Lens' (Env s) (Map Text (STRef s Function, Scope s))
funcs forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Text (STRef s Function, Scope s)
fs'
  let (STRef s Function
main, Scope s
mainFs) = Map Text (STRef s Function, Scope s)
fs' forall k a. Ord k => Map k a -> k -> a
Map.! Text
"main"
  Function
main' <- forall s a. ST s a -> Result s a
lift2 forall a b. (a -> b) -> a -> b
$ forall s a. STRef s a -> ST s a
readSTRef STRef s Function
main
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s.
Function
-> Scope s
-> [RuntimeValue s]
-> Result s (MaybeVoid (RuntimeValue s))
interpretFunc Function
main' Scope s
mainFs []
  where
    globalScope :: ExceptT Err (StateT (Env s) (ST s)) (Scope s)
globalScope = do
      [STRef s (RuntimeValue s)]
vsRefs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall s a. ST s a -> Result s a
lift2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. a -> ST s (STRef s a)
newSTRef) (VarDecl -> Expression
Ast.varValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarDecl]
tlVarDecls)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. Map Text (STRef s (RuntimeValue s)) -> Scope s
Scope forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ (VarDecl -> Text
Ast.varName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarDecl]
tlVarDecls) forall a b. [a] -> [b] -> [(a, b)]
`zip` [STRef s (RuntimeValue s)]
vsRefs

    fs :: ExceptT
  Err (StateT (Env s) (ST s)) (Map Text (STRef s Function, Scope s))
fs = do
      Scope s
globalScope' <- forall {s}. ExceptT Err (StateT (Env s) (ST s)) (Scope s)
globalScope
      [STRef s Function]
fsRefs <- forall s a. ST s a -> Result s a
lift2 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a s. a -> ST s (STRef s a)
newSTRef (FunctionDef -> Function
Ast.func forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FunctionDef]
tlFuncDefs)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ (FunctionDef -> Text
Ast.funcName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FunctionDef]
tlFuncDefs) forall a b. [a] -> [b] -> [(a, b)]
`zip` ((,Scope s
globalScope') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [STRef s Function]
fsRefs)

interpretFunc :: Ast.Function -> Scope s -> [RuntimeValue s] -> Result s (MaybeVoid (RuntimeValue s))
interpretFunc :: forall s.
Function
-> Scope s
-> [RuntimeValue s]
-> Result s (MaybeVoid (RuntimeValue s))
interpretFunc (Ast.FuncOrdinary (Ast.OrdinaryFunction [Text]
params Block
body VoidMark
voidMark)) (Scope Map Text (STRef s (RuntimeValue s))
ns) [RuntimeValue s]
args = do
  Map Text (STRef s (RuntimeValue s))
args' <- forall s a. ST s a -> Result s a
lift2 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a s. a -> ST s (STRef s a)
newSTRef (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ [Text]
params forall a b. [a] -> [b] -> [(a, b)]
`zip` [RuntimeValue s]
args)
  StmtResult s
res <- forall s. FuncScope s -> Block -> Result s (StmtResult s)
interpretFuncBlock (forall s. [Scope s] -> FuncScope s
FuncScope [forall s. Map Text (STRef s (RuntimeValue s)) -> Scope s
Scope Map Text (STRef s (RuntimeValue s))
args', forall s. Map Text (STRef s (RuntimeValue s)) -> Scope s
Scope Map Text (STRef s (RuntimeValue s))
ns]) Block
body
  case (StmtResult s
res, VoidMark
voidMark) of
    (Ret MaybeVoid (RuntimeValue s)
val, VoidMark
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return MaybeVoid (RuntimeValue s)
val
    (StmtResult s
Unit, VoidMark
Ast.VoidFunc) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. MaybeVoid a
Void
    (StmtResult s
Unit, VoidMark
Ast.NonVoidFunc) -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
NoReturn
    (StmtResult s, VoidMark)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
UnexpectedError
interpretFunc (Ast.FuncStdLib Text
name) Scope s
_ [RuntimeValue s]
args = do
  let func :: StdLibFuncImpl
func = Map Text StdLibFuncImpl
stdLibFunctionsMap forall k a. Ord k => Map k a -> k -> a
Map.! Text
name
  (MaybeVoid RuntimeValue'
res, Text
out) <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall a b. (a -> b) -> a -> b
$ StdLibFuncImpl
func forall a b. (a -> b) -> a -> b
$ forall s. RuntimeValue s -> RuntimeValue'
evalRuntimeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RuntimeValue s]
args
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall s. Lens' (Env s) [Text]
accumulatedOutput forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
out forall a. a -> [a] -> [a]
:)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. RuntimeValue' -> RuntimeValue s
unevalRuntimeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeVoid RuntimeValue'
res

interpretFuncBlock :: FuncScope s -> Ast.Block -> Result s (StmtResult s)
interpretFuncBlock :: forall s. FuncScope s -> Block -> Result s (StmtResult s)
interpretFuncBlock FuncScope s
initScope = forall scope s.
scope
-> (scope -> Env s -> Env s)
-> (Env s -> Env s)
-> Block
-> Result s (StmtResult s)
interpretBlock' FuncScope s
initScope forall s. FuncScope s -> Env s -> Env s
pushFuncScope forall s. Env s -> Env s
popFuncScope

interpretBlock :: Scope s -> Ast.Block -> Result s (StmtResult s)
interpretBlock :: forall s. Scope s -> Block -> Result s (StmtResult s)
interpretBlock Scope s
initScope = forall scope s.
scope
-> (scope -> Env s -> Env s)
-> (Env s -> Env s)
-> Block
-> Result s (StmtResult s)
interpretBlock' Scope s
initScope forall s. Scope s -> Env s -> Env s
pushBlockScope forall s. Env s -> Env s
popBlockScope

interpretBlock' :: scope -> (scope -> Env s -> Env s) -> (Env s -> Env s) -> Ast.Block -> Result s (StmtResult s)
interpretBlock' :: forall scope s.
scope
-> (scope -> Env s -> Env s)
-> (Env s -> Env s)
-> Block
-> Result s (StmtResult s)
interpretBlock' scope
initScope scope -> Env s -> Env s
pushScope Env s -> Env s
popScope Block
block = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ scope -> Env s -> Env s
pushScope scope
initScope
  StmtResult s
res <- forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {s}.
ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
-> Statement -> ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
f (forall (m :: * -> *) a. Monad m => a -> m a
return forall s. StmtResult s
Unit) Block
block
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Env s -> Env s
popScope
  forall (m :: * -> *) a. Monad m => a -> m a
return StmtResult s
res
  where
    f :: ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
-> Statement -> ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
f ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
res Statement
stmt = ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
res forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \StmtResult s
r -> if StmtResult s
r forall a. Eq a => a -> a -> Bool
== forall s. StmtResult s
Unit then forall s. Statement -> Result s (StmtResult s)
interpretStmt Statement
stmt else forall (m :: * -> *) a. Monad m => a -> m a
return StmtResult s
r

-------------------------------------------------------Statements-------------------------------------------------------

interpretStmt :: Ast.Statement -> Result s (StmtResult s)
interpretStmt :: forall s. Statement -> Result s (StmtResult s)
interpretStmt = \case
  Ast.StmtReturn MaybeVoid Expression
expr -> forall s. MaybeVoid Expression -> Result s (StmtResult s)
interpretStmtReturn MaybeVoid Expression
expr
  Ast.StmtForGoTo ForGoTo
goto -> forall s. ForGoTo -> Result s (StmtResult s)
interpretStmtForGoTo ForGoTo
goto
  Ast.StmtFor For
for -> forall s. For -> Result s (StmtResult s)
interpretStmtFor For
for
  Ast.StmtVarDecl VarDecl
varDecl -> forall s. VarDecl -> Result s (StmtResult s)
interpretStmtVarDecl VarDecl
varDecl
  Ast.StmtIfElse IfElse
ifElse -> forall s. IfElse -> Result s (StmtResult s)
interpretStmtIfElse IfElse
ifElse
  Ast.StmtBlock Block
block -> forall s. Scope s -> Block -> Result s (StmtResult s)
interpretBlock forall s. Scope s
emptyScope Block
block
  Ast.StmtSimple SimpleStmt
simpleStmt -> forall s. SimpleStmt -> Result s (StmtResult s)
interpretStmtSimple SimpleStmt
simpleStmt

interpretStmtReturn :: MaybeVoid Ast.Expression -> Result s (StmtResult s)
interpretStmtReturn :: forall s. MaybeVoid Expression -> Result s (StmtResult s)
interpretStmtReturn = forall b a. b -> (a -> b) -> MaybeVoid a -> b
maybeVoid (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. MaybeVoid (RuntimeValue s) -> StmtResult s
Ret forall a. MaybeVoid a
Void) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s. MaybeVoid (RuntimeValue s) -> StmtResult s
Ret forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExpr)

interpretStmtForGoTo :: Ast.ForGoTo -> Result s (StmtResult s)
interpretStmtForGoTo :: forall s. ForGoTo -> Result s (StmtResult s)
interpretStmtForGoTo = \case
  ForGoTo
Ast.Break -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s. StmtResult s
Break
  ForGoTo
Ast.Continue -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s. StmtResult s
Continue

interpretStmtFor :: Ast.For -> Result s (StmtResult s)
interpretStmtFor :: forall s. For -> Result s (StmtResult s)
interpretStmtFor (Ast.For (Ast.ForHead Maybe SimpleStmt
pre Maybe Expression
cond Maybe SimpleStmt
post) Block
block) = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall s. Scope s -> Env s -> Env s
pushBlockScope forall s. Scope s
emptyScope
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall s. SimpleStmt -> Result s (StmtResult s)
interpretStmtSimple Maybe SimpleStmt
pre
  StmtResult s
res <- forall {s}. ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
for
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall s. Env s -> Env s
popBlockScope
  forall (m :: * -> *) a. Monad m => a -> m a
return StmtResult s
res
  where
    for :: ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
for = do
      Bool
cond' <- forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
fromMaybeM (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall s. Expression -> Result s Bool
interpretBoolExpr Maybe Expression
cond
      if Bool
cond'
        then do
          StmtResult s
res <- forall s. Scope s -> Block -> Result s (StmtResult s)
interpretBlock forall s. Scope s
emptyScope Block
block
          case StmtResult s
res of
            StmtResult s
Unit -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall s. SimpleStmt -> Result s (StmtResult s)
interpretStmtSimple Maybe SimpleStmt
post forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
for
            StmtResult s
Break -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall s. SimpleStmt -> Result s (StmtResult s)
interpretStmtSimple Maybe SimpleStmt
post forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall s. StmtResult s
Unit
            StmtResult s
Continue -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall s. SimpleStmt -> Result s (StmtResult s)
interpretStmtSimple Maybe SimpleStmt
post forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExceptT Err (StateT (Env s) (ST s)) (StmtResult s)
for
            Ret MaybeVoid (RuntimeValue s)
_ -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall s. SimpleStmt -> Result s (StmtResult s)
interpretStmtSimple Maybe SimpleStmt
post forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StmtResult s
res
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall s. StmtResult s
Unit

interpretStmtVarDecl :: Ast.VarDecl -> Result s (StmtResult s)
interpretStmtVarDecl :: forall s. VarDecl -> Result s (StmtResult s)
interpretStmtVarDecl (Ast.VarDecl Text
name Expression
expr) = (forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' Expression
expr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. Text -> RuntimeValue s -> Result s ()
addNewVar Text
name) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall s. StmtResult s
Unit

interpretStmtIfElse :: Ast.IfElse -> Result s (StmtResult s)
interpretStmtIfElse :: forall s. IfElse -> Result s (StmtResult s)
interpretStmtIfElse (Ast.IfElse Maybe SimpleStmt
preStmt Expression
condition Block
block Else
elseStmt) = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall s. Scope s -> Env s -> Env s
pushBlockScope forall s. Scope s
emptyScope
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall s. SimpleStmt -> Result s (StmtResult s)
interpretStmtSimple Maybe SimpleStmt
preStmt
  Bool
cond <- forall s. Expression -> Result s Bool
interpretBoolExpr Expression
condition
  StmtResult s
res <-
    if Bool
cond
      then forall s. Scope s -> Block -> Result s (StmtResult s)
interpretBlock forall s. Scope s
emptyScope Block
block
      else case Else
elseStmt of
        Else
Ast.NoElse -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s. StmtResult s
Unit
        Ast.Else Block
block' -> forall s. Scope s -> Block -> Result s (StmtResult s)
interpretBlock forall s. Scope s
emptyScope Block
block'
        Ast.Elif IfElse
ifElse -> forall s. IfElse -> Result s (StmtResult s)
interpretStmtIfElse IfElse
ifElse
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall s. Env s -> Env s
popBlockScope
  forall (m :: * -> *) a. Monad m => a -> m a
return StmtResult s
res

interpretStmtSimple :: Ast.SimpleStmt -> Result s (StmtResult s)
interpretStmtSimple :: forall s. SimpleStmt -> Result s (StmtResult s)
interpretStmtSimple = \case
  Ast.StmtAssignment Lvalue
lval Expression
expr -> do
    RuntimeValue s
e <- forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' Expression
expr
    (Text
n, RuntimeValue s
_, RuntimeValue s -> RuntimeValue s
f) <- forall s.
Lvalue
-> Result
     s (Text, RuntimeValue s, RuntimeValue s -> RuntimeValue s)
getLvalueUpdater Lvalue
lval
    forall s. Text -> RuntimeValue s -> Result s ()
updateVar Text
n (RuntimeValue s -> RuntimeValue s
f RuntimeValue s
e)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall s. StmtResult s
Unit
  Ast.StmtIncDec Lvalue
lval IncDec
incDec -> do
    let upd :: Int -> Int
upd = case IncDec
incDec of
          IncDec
Ast.Inc -> (forall a. Num a => a -> a -> a
+ Int
1)
          IncDec
Ast.Dec -> \Int
x -> Int
x forall a. Num a => a -> a -> a
- Int
1
    (Text
n, RuntimeValue s
v, RuntimeValue s -> RuntimeValue s
f) <- forall s.
Lvalue
-> Result
     s (Text, RuntimeValue s, RuntimeValue s -> RuntimeValue s)
getLvalueUpdater Lvalue
lval
    Int
v' <- forall s. RuntimeValue s -> Result s Int
castToInt RuntimeValue s
v
    forall s. Text -> RuntimeValue s -> Result s ()
updateVar Text
n (RuntimeValue s -> RuntimeValue s
f (forall s. Int -> RuntimeValue s
ValInt (Int -> Int
upd Int
v')))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall s. StmtResult s
Unit
  Ast.StmtShortVarDecl Text
name Expression
expr -> (forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' Expression
expr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. Text -> RuntimeValue s -> Result s ()
addOrUpdateVar Text
name) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall s. StmtResult s
Unit
  Ast.StmtExpression Expression
expr -> forall s. Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExpr Expression
expr forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall s. StmtResult s
Unit

getLvalueUpdater :: Ast.Lvalue -> Result s (Ast.Identifier, RuntimeValue s, RuntimeValue s -> RuntimeValue s)
getLvalueUpdater :: forall s.
Lvalue
-> Result
     s (Text, RuntimeValue s, RuntimeValue s -> RuntimeValue s)
getLvalueUpdater (Ast.LvalVar Text
name) = (Text
name,,forall a. a -> a
id) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Text -> Result s (RuntimeValue s)
getVarValue Text
name
getLvalueUpdater (Ast.LvalArrEl Text
name [Expression]
indices) = do
  RuntimeValue s
arr <- forall s. Text -> Result s (RuntimeValue s)
getVarValue Text
name
  [Int]
indices' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall s. Expression -> Result s Int
interpretIntExpr [Expression]
indices
  (RuntimeValue s
value, RuntimeValue s -> RuntimeValue s -> RuntimeValue s
accessor) <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall s.
(RuntimeValue s,
 RuntimeValue s -> RuntimeValue s -> RuntimeValue s)
-> Int
-> Result
     s
     (RuntimeValue s,
      RuntimeValue s -> RuntimeValue s -> RuntimeValue s)
helper (RuntimeValue s
arr, \RuntimeValue s
_ RuntimeValue s
v -> RuntimeValue s
v) [Int]
indices'
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, RuntimeValue s
value, RuntimeValue s -> RuntimeValue s -> RuntimeValue s
accessor RuntimeValue s
arr)
  where
    helper ::
      (RuntimeValue s, RuntimeValue s -> RuntimeValue s -> RuntimeValue s) ->
      Int ->
      Result s (RuntimeValue s, RuntimeValue s -> RuntimeValue s -> RuntimeValue s)
    helper :: forall s.
(RuntimeValue s,
 RuntimeValue s -> RuntimeValue s -> RuntimeValue s)
-> Int
-> Result
     s
     (RuntimeValue s,
      RuntimeValue s -> RuntimeValue s -> RuntimeValue s)
helper (RuntimeValue s
arr, RuntimeValue s -> RuntimeValue s -> RuntimeValue s
replacer) Int
i = do
      [RuntimeValue s]
arr' <- forall s. RuntimeValue s -> Result s [RuntimeValue s]
castToArr RuntimeValue s
arr
      let arrEl :: RuntimeValue s
arrEl = [RuntimeValue s]
arr' forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i
      forall (m :: * -> *) a. Monad m => a -> m a
return (RuntimeValue s
arrEl, \RuntimeValue s
oldArr RuntimeValue s
v -> RuntimeValue s -> RuntimeValue s -> RuntimeValue s
replacer RuntimeValue s
oldArr (forall s. [RuntimeValue s] -> RuntimeValue s
ValArray ([RuntimeValue s]
arr' forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i forall s t a b. ASetter s t a b -> b -> s -> t
.~ RuntimeValue s
v)))

-- | Statement interpretation result.
data StmtResult s
  = -- | Result of ordinary statement.
    Unit
  | -- | Result of the @break@ statement.
    Break
  | -- | Result of the @continue@ statement.
    Continue
  | -- | Result of the @return@ statement.
    Ret (MaybeVoid (RuntimeValue s))
  deriving (StmtResult s -> StmtResult s -> Bool
forall s. StmtResult s -> StmtResult s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StmtResult s -> StmtResult s -> Bool
$c/= :: forall s. StmtResult s -> StmtResult s -> Bool
== :: StmtResult s -> StmtResult s -> Bool
$c== :: forall s. StmtResult s -> StmtResult s -> Bool
Eq)

------------------------------------------------------Expressions-------------------------------------------------------

interpretExpr :: Ast.Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExpr :: forall s. Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExpr = \case
  Ast.ExprValue Value
value -> forall s. Value -> Result s (MaybeVoid (RuntimeValue s))
interpretExprValue Value
value
  Ast.ExprIdentifier Text
name -> forall s. Text -> Result s (MaybeVoid (RuntimeValue s))
interpretExprIdentifier Text
name
  Ast.ExprUnaryOp UnaryOp
unOp Expression
expr -> forall s.
UnaryOp -> Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExprUnaryOp UnaryOp
unOp Expression
expr
  Ast.ExprBinaryOp BinaryOp
binOp Expression
lhs Expression
rhs -> forall s.
BinaryOp
-> Expression
-> Expression
-> Result s (MaybeVoid (RuntimeValue s))
interpretExprBinaryOp BinaryOp
binOp Expression
lhs Expression
rhs
  Ast.ExprArrayAccessByIndex Expression
arr Expression
i -> forall s.
Expression -> Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExprArrayAccessByIndex Expression
arr Expression
i
  Ast.ExprFuncCall Expression
func [Expression]
args -> forall s.
Expression -> [Expression] -> Result s (MaybeVoid (RuntimeValue s))
interpretExprFuncCall Expression
func [Expression]
args

interpretExprValue :: Ast.Value -> Result s (MaybeVoid (RuntimeValue s))
interpretExprValue :: forall s. Value -> Result s (MaybeVoid (RuntimeValue s))
interpretExprValue = \case
  Ast.ValInt Int
v -> forall {m :: * -> *} {a}. Monad m => a -> m (MaybeVoid a)
return' forall a b. (a -> b) -> a -> b
$ forall s. Int -> RuntimeValue s
ValInt Int
v
  Ast.ValBool Bool
v -> forall {m :: * -> *} {a}. Monad m => a -> m (MaybeVoid a)
return' forall a b. (a -> b) -> a -> b
$ forall s. Bool -> RuntimeValue s
ValBool Bool
v
  Ast.ValString Text
v -> forall {m :: * -> *} {a}. Monad m => a -> m (MaybeVoid a)
return' forall a b. (a -> b) -> a -> b
$ forall s. Text -> RuntimeValue s
ValString Text
v
  Ast.ValArray [Expression]
es -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' [Expression]
es forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a}. Monad m => a -> m (MaybeVoid a)
return' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. [RuntimeValue s] -> RuntimeValue s
ValArray
  Ast.ValFunction FunctionValue
v -> do
    Env s
env <- forall s (m :: * -> *). MonadState s m => m s
get
    forall {m :: * -> *} {a}. Monad m => a -> m (MaybeVoid a)
return' forall a b. (a -> b) -> a -> b
$ forall s. FunctionValue -> Scope s -> RuntimeValue s
ValFunction FunctionValue
v forall a b. (a -> b) -> a -> b
$ forall s. FuncScope s -> Scope s
flattenFuncScope (Env s
env forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (forall s. Lens' (Env s) [FuncScope s]
funcScopes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0))
  where
    return' :: a -> m (MaybeVoid a)
return' a
v = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> MaybeVoid a
NonVoid a
v

interpretExprIdentifier :: Ast.Identifier -> Result s (MaybeVoid (RuntimeValue s))
interpretExprIdentifier :: forall s. Text -> Result s (MaybeVoid (RuntimeValue s))
interpretExprIdentifier Text
name = forall a. a -> MaybeVoid a
NonVoid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Text -> Result s (RuntimeValue s)
getVarValue Text
name

interpretExprUnaryOp :: Ast.UnaryOp -> Ast.Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExprUnaryOp :: forall s.
UnaryOp -> Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExprUnaryOp UnaryOp
unOp Expression
expr =
  forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' Expression
expr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. RuntimeValue s -> Result s (PrimitiveValue Int)
valueToPrimitive forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s.
Either Err (PrimitiveValue Int)
-> Result s (MaybeVoid (RuntimeValue s))
liftPV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall num.
Integral num =>
UnaryOp -> PrimitiveValue num -> Either Err (PrimitiveValue num)
PV.primitiveUnOpApplication UnaryOp
unOp

interpretExprBinaryOp :: Ast.BinaryOp -> Ast.Expression -> Ast.Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExprBinaryOp :: forall s.
BinaryOp
-> Expression
-> Expression
-> Result s (MaybeVoid (RuntimeValue s))
interpretExprBinaryOp BinaryOp
Ast.OrOp Expression
lhs Expression
rhs = do
  Bool
lhs' <- forall s. Expression -> Result s Bool
interpretBoolExpr Expression
lhs
  if Bool
lhs'
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> MaybeVoid a
NonVoid forall a b. (a -> b) -> a -> b
$ forall s. Bool -> RuntimeValue s
ValBool Bool
True
    else forall a. a -> MaybeVoid a
NonVoid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Bool -> RuntimeValue s
ValBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Expression -> Result s Bool
interpretBoolExpr Expression
rhs
interpretExprBinaryOp BinaryOp
Ast.AndOp Expression
lhs Expression
rhs = do
  Bool
lhs' <- forall s. Expression -> Result s Bool
interpretBoolExpr Expression
lhs
  if Bool -> Bool
not Bool
lhs'
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> MaybeVoid a
NonVoid forall a b. (a -> b) -> a -> b
$ forall s. Bool -> RuntimeValue s
ValBool Bool
False
    else forall a. a -> MaybeVoid a
NonVoid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Bool -> RuntimeValue s
ValBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Expression -> Result s Bool
interpretBoolExpr Expression
rhs
interpretExprBinaryOp BinaryOp
binOp Expression
lhs Expression
rhs = do
  RuntimeValue s
lhsVal <- forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' Expression
lhs
  RuntimeValue s
rhsVal <- forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' Expression
rhs
  case BinaryOp
binOp of
    BinaryOp
Ast.EqOp -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> MaybeVoid a
NonVoid forall a b. (a -> b) -> a -> b
$ forall s. Bool -> RuntimeValue s
ValBool forall a b. (a -> b) -> a -> b
$ RuntimeValue s
lhsVal forall a. Eq a => a -> a -> Bool
== RuntimeValue s
rhsVal
    BinaryOp
Ast.NeOp -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> MaybeVoid a
NonVoid forall a b. (a -> b) -> a -> b
$ forall s. Bool -> RuntimeValue s
ValBool forall a b. (a -> b) -> a -> b
$ RuntimeValue s
lhsVal forall a. Eq a => a -> a -> Bool
/= RuntimeValue s
rhsVal
    BinaryOp
_ -> do
      PrimitiveValue Int
lhsPV <- forall s. RuntimeValue s -> Result s (PrimitiveValue Int)
valueToPrimitive RuntimeValue s
lhsVal
      PrimitiveValue Int
rhsPV <- forall s. RuntimeValue s -> Result s (PrimitiveValue Int)
valueToPrimitive RuntimeValue s
rhsVal
      forall s.
Either Err (PrimitiveValue Int)
-> Result s (MaybeVoid (RuntimeValue s))
liftPV forall a b. (a -> b) -> a -> b
$ forall num.
Integral num =>
BinaryOp
-> PrimitiveValue num
-> PrimitiveValue num
-> Either Err (PrimitiveValue num)
PV.primitiveBinOpApplication BinaryOp
binOp PrimitiveValue Int
lhsPV PrimitiveValue Int
rhsPV

interpretExprArrayAccessByIndex :: Ast.Expression -> Ast.Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExprArrayAccessByIndex :: forall s.
Expression -> Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExprArrayAccessByIndex Expression
arr Expression
i = do
  [RuntimeValue s]
arr' <- forall s. Expression -> Result s [RuntimeValue s]
interpretArrExpr Expression
arr
  Int
i' <- forall s. Expression -> Result s Int
interpretIntExpr Expression
i
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Int -> Int -> Err
IndexOutOfRange Int
i' (forall (t :: * -> *) a. Foldable t => t a -> Int
length [RuntimeValue s]
arr')) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> MaybeVoid a
NonVoid) ([RuntimeValue s]
arr' forall a. [a] -> Int -> Maybe a
!? Int
i')

interpretExprFuncCall :: Ast.Expression -> [Ast.Expression] -> Result s (MaybeVoid (RuntimeValue s))
interpretExprFuncCall :: forall s.
Expression -> [Expression] -> Result s (MaybeVoid (RuntimeValue s))
interpretExprFuncCall Expression
func [Expression]
args = do
  (Function
func', Scope s
sc) <- forall s. Expression -> Result s (Function, Scope s)
interpretFuncExpr Expression
func
  [RuntimeValue s]
args' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' [Expression]
args
  forall s.
Function
-> Scope s
-> [RuntimeValue s]
-> Result s (MaybeVoid (RuntimeValue s))
interpretFunc Function
func' Scope s
sc [RuntimeValue s]
args'

---------------------------------------------------------Utils----------------------------------------------------------

-- * Utils

-- ** Interpret non-void Expression

interpretIntExpr :: Ast.Expression -> Result s Int
interpretIntExpr :: forall s. Expression -> Result s Int
interpretIntExpr = forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall s. RuntimeValue s -> Result s Int
castToInt

interpretBoolExpr :: Ast.Expression -> Result s Bool
interpretBoolExpr :: forall s. Expression -> Result s Bool
interpretBoolExpr = forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall s. RuntimeValue s -> Result s Bool
castToBool

interpretArrExpr :: Ast.Expression -> Result s [RuntimeValue s]
interpretArrExpr :: forall s. Expression -> Result s [RuntimeValue s]
interpretArrExpr = forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall s. RuntimeValue s -> Result s [RuntimeValue s]
castToArr

interpretFuncExpr :: Ast.Expression -> Result s (Ast.Function, Scope s)
interpretFuncExpr :: forall s. Expression -> Result s (Function, Scope s)
interpretFuncExpr = forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall s. RuntimeValue s -> Result s (Function, Scope s)
castToFunc

interpretExpr' :: Ast.Expression -> Result s (RuntimeValue s)
interpretExpr' :: forall s. Expression -> Result s (RuntimeValue s)
interpretExpr' = forall s. Expression -> Result s (MaybeVoid (RuntimeValue s))
interpretExpr forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a s. MaybeVoid a -> Result s a
unwrapJust

unwrapJust :: MaybeVoid a -> Result s a
unwrapJust :: forall a s. MaybeVoid a -> Result s a
unwrapJust = forall b a. b -> (a -> b) -> MaybeVoid a -> b
maybeVoid (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
UnexpectedError) forall (m :: * -> *) a. Monad m => a -> m a
return

-- ** Primitive values

valueToPrimitive :: RuntimeValue s -> Result s (PV.PrimitiveValue Int)
valueToPrimitive :: forall s. RuntimeValue s -> Result s (PrimitiveValue Int)
valueToPrimitive = \case
  ValInt Int
v -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall num. num -> PrimitiveValue num
PV.PrimNum Int
v
  ValBool Bool
v -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall num. Bool -> PrimitiveValue num
PV.PrimBool Bool
v
  ValString Text
v -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall num. Text -> PrimitiveValue num
PV.PrimString Text
v
  RuntimeValue s
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
UnexpectedError

liftPV :: Either PV.Err (PV.PrimitiveValue Int) -> Result s (MaybeVoid (RuntimeValue s))
liftPV :: forall s.
Either Err (PrimitiveValue Int)
-> Result s (MaybeVoid (RuntimeValue s))
liftPV Either Err (PrimitiveValue Int)
pvRes = forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall a b. (a -> b) -> a -> b
$ forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapBoth Err -> Err
mapErr (forall a. a -> MaybeVoid a
NonVoid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {s}. PrimitiveValue Int -> RuntimeValue s
primitiveToValue) Either Err (PrimitiveValue Int)
pvRes
  where
    mapErr :: Err -> Err
mapErr = \case
      Err
PV.MismatchedTypes -> Err
UnexpectedError
      Err
PV.DivisionByZero -> Err
DivisionByZero

    primitiveToValue :: PrimitiveValue Int -> RuntimeValue s
primitiveToValue = \case
      PV.PrimNum Int
v -> forall s. Int -> RuntimeValue s
ValInt Int
v
      PV.PrimBool Bool
v -> forall s. Bool -> RuntimeValue s
ValBool Bool
v
      PV.PrimString Text
v -> forall s. Text -> RuntimeValue s
ValString Text
v

-- ** Cast runtime values

castToInt :: RuntimeValue s -> Result s Int
castToInt :: forall s. RuntimeValue s -> Result s Int
castToInt = \case
  ValInt Int
int -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
int
  RuntimeValue s
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
UnexpectedError

castToBool :: RuntimeValue s -> Result s Bool
castToBool :: forall s. RuntimeValue s -> Result s Bool
castToBool = \case
  ValBool Bool
bool -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
bool
  RuntimeValue s
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
UnexpectedError

castToArr :: RuntimeValue s -> Result s [RuntimeValue s]
castToArr :: forall s. RuntimeValue s -> Result s [RuntimeValue s]
castToArr = \case
  ValArray [RuntimeValue s]
arr -> forall (m :: * -> *) a. Monad m => a -> m a
return [RuntimeValue s]
arr
  RuntimeValue s
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
UnexpectedError

castToFunc :: RuntimeValue s -> Result s (Ast.Function, Scope s)
castToFunc :: forall s. RuntimeValue s -> Result s (Function, Scope s)
castToFunc = \case
  ValFunction (Ast.Function Function
f) Scope s
sc -> forall (m :: * -> *) a. Monad m => a -> m a
return (Function
f, Scope s
sc)
  ValFunction FunctionValue
Ast.Nil Scope s
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
Npe
  RuntimeValue s
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
UnexpectedError