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

module Interpreter.Runtime where

import qualified Analyzer.AnalyzedAst as Ast
import Control.Applicative ((<|>))
import Control.Lens (Ixed (ix), (%~), (?~))
import Control.Monad ((>=>))
import Control.Monad.Except (MonadError (throwError))
import Control.Monad.State (get, modify)
import Data.Map ((!?))
import qualified Data.Map.Strict as Map
import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef)
import Interpreter.Result

-- * Variables manipulation

-- ** Get a variable value

getVarValue :: Ast.Identifier -> Result s (RuntimeValue s)
getVarValue :: forall s. Identifier -> Result s (RuntimeValue s)
getVarValue Identifier
name = forall s. Identifier -> Result s (STRef s (RuntimeValue s))
getVar Identifier
name forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a. ST s a -> Result s a
lift2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. STRef s a -> ST s a
readSTRef

-- ** Add a new variable

addNewVar :: Ast.Identifier -> RuntimeValue s -> Result s ()
addNewVar :: forall s. Identifier -> RuntimeValue s -> Result s ()
addNewVar Identifier
name RuntimeValue s
value = do
  STRef s (RuntimeValue s)
ref <- forall s a. ST s a -> Result s a
lift2 forall a b. (a -> b) -> a -> b
$ forall a s. a -> ST s (STRef s a)
newSTRef RuntimeValue s
value
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) s.
Applicative f =>
Int
-> Int
-> Identifier
-> LensLike' f (Env s) (Maybe (STRef s (RuntimeValue s)))
var Int
0 Int
0 Identifier
name forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ STRef s (RuntimeValue s)
ref

-- ** Add or update a variable

addOrUpdateVar :: Ast.Identifier -> RuntimeValue s -> Result s ()
addOrUpdateVar :: forall s. Identifier -> RuntimeValue s -> Result s ()
addOrUpdateVar Identifier
name RuntimeValue s
value =
  forall s.
Identifier
-> Result s (Maybe (STRef s (RuntimeValue s), ScopeLocation))
searchVar Identifier
name forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (STRef s (RuntimeValue s)
_, ScopeLocation
Curr) -> forall s. Identifier -> RuntimeValue s -> Result s ()
updateVar Identifier
name RuntimeValue s
value
    Maybe (STRef s (RuntimeValue s), ScopeLocation)
_ -> forall s. Identifier -> RuntimeValue s -> Result s ()
addNewVar Identifier
name RuntimeValue s
value

-- ** Update a variable

updateVar :: Ast.Identifier -> RuntimeValue s -> Result s ()
updateVar :: forall s. Identifier -> RuntimeValue s -> Result s ()
updateVar Identifier
name RuntimeValue s
value = do
  STRef s (RuntimeValue s)
ref <- forall s. Identifier -> Result s (STRef s (RuntimeValue s))
getVar Identifier
name
  forall s a. ST s a -> Result s a
lift2 (forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (RuntimeValue s)
ref RuntimeValue s
value)

-- ** Search for a variable

getVar :: Ast.Identifier -> Result s (STRef s (RuntimeValue s))
getVar :: forall s. Identifier -> Result s (STRef s (RuntimeValue s))
getVar Identifier
name = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s.
Identifier
-> Result s (Maybe (STRef s (RuntimeValue s), ScopeLocation))
searchVar Identifier
name forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
UnexpectedError) forall (m :: * -> *) a. Monad m => a -> m a
return)

searchVar :: Ast.Identifier -> Result s (Maybe (STRef s (RuntimeValue s), ScopeLocation))
searchVar :: forall s.
Identifier
-> Result s (Maybe (STRef s (RuntimeValue s), ScopeLocation))
searchVar Identifier
name = do
  Env Map Identifier (STRef s Function, Scope s)
fs [FuncScope s]
fScs AccOut
_ <- forall s (m :: * -> *). MonadState s m => m s
get
  Scope s
sc <- forall s a. ST s a -> Result s a
lift2 forall a b. (a -> b) -> a -> b
$ forall s. Map Identifier (STRef s (RuntimeValue s)) -> Scope s
Scope forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((\(STRef s Function
f, Scope s
sc) -> (,Scope s
sc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. STRef s a -> ST s a
readSTRef STRef s Function
f) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \(Function
f, Scope s
sc) -> forall a s. a -> ST s (STRef s a)
newSTRef forall a b. (a -> b) -> a -> b
$ forall s. FunctionValue -> Scope s -> RuntimeValue s
ValFunction (Function -> FunctionValue
Ast.Function Function
f) Scope s
sc) Map Identifier (STRef s Function, Scope s)
fs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [FuncScope s]
fScs of
    FuncScope [Scope s]
scs : [FuncScope s]
_ -> forall {s}.
Identifier
-> ScopeLocation
-> [Scope s]
-> Maybe (STRef s (RuntimeValue s), ScopeLocation)
searchVar' Identifier
name ScopeLocation
Curr ([Scope s]
scs forall a. [a] -> [a] -> [a]
++ [Scope s
sc])
    [FuncScope s]
_ -> forall {s}.
Identifier
-> ScopeLocation
-> [Scope s]
-> Maybe (STRef s (RuntimeValue s), ScopeLocation)
searchVar' Identifier
name ScopeLocation
Outer [Scope s
sc]
  where
    searchVar' :: Identifier
-> ScopeLocation
-> [Scope s]
-> Maybe (STRef s (RuntimeValue s), ScopeLocation)
searchVar' Identifier
n ScopeLocation
loc (Scope Map Identifier (STRef s (RuntimeValue s))
ns : [Scope s]
scs) = ((,ScopeLocation
loc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Identifier (STRef s (RuntimeValue s))
ns forall k a. Ord k => Map k a -> k -> Maybe a
!? Identifier
n)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Identifier
-> ScopeLocation
-> [Scope s]
-> Maybe (STRef s (RuntimeValue s), ScopeLocation)
searchVar' Identifier
n ScopeLocation
Outer [Scope s]
scs
    searchVar' Identifier
_ ScopeLocation
_ [Scope s]
_ = forall a. Maybe a
Nothing

data ScopeLocation = Curr | Outer

-- * Scopes manipulation

pushFuncScope :: FuncScope s -> Env s -> Env s
pushFuncScope :: forall s. FuncScope s -> Env s -> Env s
pushFuncScope FuncScope s
initScope = forall s. Lens' (Env s) [FuncScope s]
funcScopes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (FuncScope s
initScope forall a. a -> [a] -> [a]
:)

popFuncScope :: Env s -> Env s
popFuncScope :: forall s. Env s -> Env s
popFuncScope = forall s. Lens' (Env s) [FuncScope s]
funcScopes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. [a] -> [a]
tail

pushBlockScope :: Scope s -> Env s -> Env s
pushBlockScope :: forall s. Scope s -> Env s -> Env s
pushBlockScope Scope s
initScope = (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s1 s2.
Iso (FuncScope s1) (FuncScope s2) [Scope s1] [Scope s2]
scopes) forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Scope s
initScope forall a. a -> [a] -> [a]
:)

popBlockScope :: Env s -> Env s
popBlockScope :: forall s. Env s -> Env s
popBlockScope = (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s1 s2.
Iso (FuncScope s1) (FuncScope s2) [Scope s1] [Scope s2]
scopes) forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. [a] -> [a]
tail

flattenFuncScope :: FuncScope s -> Scope s
flattenFuncScope :: forall s. FuncScope s -> Scope s
flattenFuncScope (FuncScope [Scope s]
scs) = forall {s}. [Scope s] -> Scope s
flattenFuncScope' [Scope s]
scs
  where
    flattenFuncScope' :: [Scope s] -> Scope s
flattenFuncScope' (Scope Map Identifier (STRef s (RuntimeValue s))
ns : Scope Map Identifier (STRef s (RuntimeValue s))
ns' : [Scope s]
scs') = [Scope s] -> Scope s
flattenFuncScope' (forall s. Map Identifier (STRef s (RuntimeValue s)) -> Scope s
Scope (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Identifier (STRef s (RuntimeValue s))
ns Map Identifier (STRef s (RuntimeValue s))
ns') forall a. a -> [a] -> [a]
: [Scope s]
scs')
    flattenFuncScope' [Scope s
sc] = Scope s
sc
    flattenFuncScope' [] = forall s. Scope s
emptyScope