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

module Analyzer.Runtime where

import qualified Analyzer.AnalyzedAst as AAst
import qualified Analyzer.AnalyzedType as AType
import Analyzer.Result
import Control.Applicative ((<|>))
import Control.Lens (ix, (%~), (?~), (^?!))
import Control.Monad.Except (MonadError (throwError))
import Control.Monad.State (get, gets, modify)
import Data.Map ((!?))
import Data.Maybe (isJust)

-- ** Get a variable type

getVarType :: AAst.Identifier -> Result AType.Type
getVarType :: Text -> Result Type
getVarType Text
name = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Text -> Env -> Maybe (Type, ScopeLocation)
searchVar Text
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 forall a b. (a -> b) -> a -> b
$ Text -> Err
IdentifierNotFound Text
name) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- ** Add a new variable

addNewVar :: AAst.Identifier -> AType.Type -> Result ()
addNewVar :: Text -> Type -> Result ()
addNewVar Text
name Type
t = do
  Env
env <- forall s (m :: * -> *). MonadState s m => m s
get
  if forall a. Maybe a -> Bool
isJust (Env
env forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall (f :: * -> *).
Applicative f =>
Int -> Text -> LensLike' f Env (Maybe Type)
var Int
0 Text
name)
    then forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Err
IdentifierRedeclaration Text
name
    else forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Applicative f =>
Int -> Text -> LensLike' f Env (Maybe Type)
var Int
0 Text
name forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Type
t

-- ** Add or update a variable

addOrUpdateVar :: AAst.Identifier -> AType.Type -> Result ()
addOrUpdateVar :: Text -> Type -> Result ()
addOrUpdateVar Text
name Type
t = do
  Env
env <- forall s (m :: * -> *). MonadState s m => m s
get
  case Text -> Env -> Maybe (Type, ScopeLocation)
searchVar Text
name Env
env of
    Just (Type
_, ScopeLocation
Curr) -> Text -> Type -> Result ()
updateVar Text
name Type
t
    Maybe (Type, ScopeLocation)
_ -> Text -> Type -> Result ()
addNewVar Text
name Type
t

-- ** Update a variable

updateVar :: AAst.Identifier -> AType.Type -> Result ()
updateVar :: Text -> Type -> Result ()
updateVar Text
name Type
t = do
  Env
env <- forall s (m :: * -> *). MonadState s m => m s
get
  case Text -> Env -> Maybe (Type, ScopeLocation)
searchVar Text
name Env
env of
    Just (Type
t', ScopeLocation
_) | Type
t forall a. Eq a => a -> a -> Bool
== Type
t' -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Type, ScopeLocation)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Err
MismatchedTypes
    Maybe (Type, ScopeLocation)
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Err
IdentifierNotFound Text
name

-- ** Search for a variable

searchVar :: AAst.Identifier -> Env -> Maybe (AType.Type, ScopeLocation)
searchVar :: Text -> Env -> Maybe (Type, ScopeLocation)
searchVar Text
name (Env [Scope]
scs) = Text -> [Scope] -> ScopeLocation -> Maybe (Type, ScopeLocation)
searchVar' Text
name [Scope]
scs ScopeLocation
Curr
  where
    searchVar' :: Text -> [Scope] -> ScopeLocation -> Maybe (Type, ScopeLocation)
searchVar' Text
n (Scope ScopeType
_ Map Text Type
ns : [Scope]
outerScs) ScopeLocation
loc = ((,ScopeLocation
loc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Text Type
ns forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
n)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [Scope] -> ScopeLocation -> Maybe (Type, ScopeLocation)
searchVar' Text
n [Scope]
outerScs ScopeLocation
Outer
    searchVar' Text
_ [Scope]
_ ScopeLocation
_ = forall a. Maybe a
Nothing

data ScopeLocation = Curr | Outer

getTypeDefault :: AType.Type -> AAst.Expression
getTypeDefault :: Type -> Expression
getTypeDefault Type
t = Value -> Expression
AAst.ExprValue forall a b. (a -> b) -> a -> b
$ case Type
t of
  Type
AType.TInt -> Int -> Value
AAst.ValInt Int
0
  Type
AType.TBool -> Bool -> Value
AAst.ValBool Bool
False
  Type
AType.TString -> Text -> Value
AAst.ValString Text
""
  AType.TArray Type
elT Int
len -> [Expression] -> Value
AAst.ValArray forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
len (Type -> Expression
getTypeDefault Type
elT)
  AType.TFunction FunctionType
_ -> FunctionValue -> Value
AAst.ValFunction FunctionValue
AAst.Nil
  Type
AType.TNil -> FunctionValue -> Value
AAst.ValFunction FunctionValue
AAst.Nil

-- ** Scopes manipulation

pushScope :: Scope -> Env -> Env
pushScope :: Scope -> Env -> Env
pushScope Scope
initScope = Iso' Env [Scope]
scopes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Scope
initScope forall a. a -> [a] -> [a]
:)

popScope :: Env -> Env
popScope :: Env -> Env
popScope = Iso' Env [Scope]
scopes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. [a] -> [a]
tail

getCurrScopeType :: Env -> ScopeType
getCurrScopeType :: Env -> ScopeType
getCurrScopeType Env
env = Env
env forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Iso' Env [Scope]
scopes 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
. Lens' Scope ScopeType
scopeType)