{-|
Module      : Htcc.Parser.ConstructionData.Scope
Description : The Data type of scope and its utilities used in parsing
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

The Data type of variables and its utilities used in parsing
-}
{-# LANGUAGE DeriveGeneric #-}
module Htcc.Parser.ConstructionData.Scope (
    -- * The types
    Scoped (..),
    LookupVarResult (..),
    -- * Operations for scope
    addLVar,
    addGVar,
    addGVarWith,
    addLiteral,
    addTag,
    addTypedef,
    addFunction,
    addEnumerator,
    succNest,
    fallBack,
    lookupLVar,
    lookupGVar,
    lookupVar,
    lookupTag,
    lookupTypedef,
    lookupFunction,
    lookupEnumerator,
    initScope,
    resetLocal
) where

import           Control.DeepSeq                                 (NFData (..))
import           Data.Bits                                       (Bits (..))
import qualified Data.Text                                       as T
import           Data.Tuple.Extra                                (second)
import           GHC.Generics                                    (Generic (..),
                                                                  Generic1 (..))
import           Numeric.Natural

import qualified Htcc.CRules.Types                               as CT
import           Htcc.Parser.AST.Core                            (ATree (..))
import qualified Htcc.Parser.ConstructionData.Scope.Enumerator   as SE
import qualified Htcc.Parser.ConstructionData.Scope.Function     as PF
import qualified Htcc.Parser.ConstructionData.Scope.ManagedScope as SM
import qualified Htcc.Parser.ConstructionData.Scope.Tag          as PS
import qualified Htcc.Parser.ConstructionData.Scope.Typedef      as PT
import qualified Htcc.Parser.ConstructionData.Scope.Var          as PV
import qualified Htcc.Tokenizer.Token                            as HT

-- | The data type of a struct tag
data Scoped i = Scoped -- ^ The constructor of a struct tag
    {
        Scoped i -> Natural
curNestDepth :: !Natural, -- ^ The nest depth of the parsing process
        Scoped i -> Vars i
vars         :: PV.Vars i, -- ^ scoped all identifiers of variables (local variables, global variables and literals) visible during processing
        Scoped i -> Tags i
structs      :: PS.Tags i, -- ^ scoped all struct tags
        Scoped i -> Typedefs i
typedefs     :: PT.Typedefs i, -- ^ scoped all typedefs
        Scoped i -> Functions i
functions    :: PF.Functions i, -- ^ scoped all identifires of functions
        Scoped i -> Enumerators i
enumerators  :: SE.Enumerators i -- ^ scoped all identifiers of enumerators
    } deriving (Int -> Scoped i -> ShowS
[Scoped i] -> ShowS
Scoped i -> String
(Int -> Scoped i -> ShowS)
-> (Scoped i -> String) -> ([Scoped i] -> ShowS) -> Show (Scoped i)
forall i. Show i => Int -> Scoped i -> ShowS
forall i. Show i => [Scoped i] -> ShowS
forall i. Show i => Scoped i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scoped i] -> ShowS
$cshowList :: forall i. Show i => [Scoped i] -> ShowS
show :: Scoped i -> String
$cshow :: forall i. Show i => Scoped i -> String
showsPrec :: Int -> Scoped i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> Scoped i -> ShowS
Show, (forall x. Scoped i -> Rep (Scoped i) x)
-> (forall x. Rep (Scoped i) x -> Scoped i) -> Generic (Scoped i)
forall x. Rep (Scoped i) x -> Scoped i
forall x. Scoped i -> Rep (Scoped i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (Scoped i) x -> Scoped i
forall i x. Scoped i -> Rep (Scoped i) x
$cto :: forall i x. Rep (Scoped i) x -> Scoped i
$cfrom :: forall i x. Scoped i -> Rep (Scoped i) x
Generic, (forall a. Scoped a -> Rep1 Scoped a)
-> (forall a. Rep1 Scoped a -> Scoped a) -> Generic1 Scoped
forall a. Rep1 Scoped a -> Scoped a
forall a. Scoped a -> Rep1 Scoped a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Scoped a -> Scoped a
$cfrom1 :: forall a. Scoped a -> Rep1 Scoped a
Generic1)

instance NFData i => NFData (Scoped i)

-- | A type that represents the result of a variable search
data LookupVarResult i = FoundGVar (PV.GVar i)  -- ^ A type constructor indicating that a global variable has been found
    | FoundLVar (PV.LVar i) -- ^ A type constructor indicating that a local variable has been found
    | FoundEnum (SE.Enumerator i) -- ^ A type constructor indicating that a enumerator has been found
    | NotFound -- ^ A type constructor indicating that it was not found
    deriving (Int -> LookupVarResult i -> ShowS
[LookupVarResult i] -> ShowS
LookupVarResult i -> String
(Int -> LookupVarResult i -> ShowS)
-> (LookupVarResult i -> String)
-> ([LookupVarResult i] -> ShowS)
-> Show (LookupVarResult i)
forall i. Show i => Int -> LookupVarResult i -> ShowS
forall i. Show i => [LookupVarResult i] -> ShowS
forall i. Show i => LookupVarResult i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LookupVarResult i] -> ShowS
$cshowList :: forall i. Show i => [LookupVarResult i] -> ShowS
show :: LookupVarResult i -> String
$cshow :: forall i. Show i => LookupVarResult i -> String
showsPrec :: Int -> LookupVarResult i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> LookupVarResult i -> ShowS
Show, LookupVarResult i -> LookupVarResult i -> Bool
(LookupVarResult i -> LookupVarResult i -> Bool)
-> (LookupVarResult i -> LookupVarResult i -> Bool)
-> Eq (LookupVarResult i)
forall i. Eq i => LookupVarResult i -> LookupVarResult i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LookupVarResult i -> LookupVarResult i -> Bool
$c/= :: forall i. Eq i => LookupVarResult i -> LookupVarResult i -> Bool
== :: LookupVarResult i -> LookupVarResult i -> Bool
$c== :: forall i. Eq i => LookupVarResult i -> LookupVarResult i -> Bool
Eq)

{-# INLINE applyVars #-}
applyVars :: Scoped i -> (a, PV.Vars i) -> (a, Scoped i)
applyVars :: Scoped i -> (a, Vars i) -> (a, Scoped i)
applyVars sc :: Scoped i
sc = (Vars i -> Scoped i) -> (a, Vars i) -> (a, Scoped i)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (\x :: Vars i
x -> Scoped i
sc { vars :: Vars i
vars = Vars i
x })

{-# INLINE addVar #-}
addVar :: (Integral i, Bits i) => (CT.StorageClass i -> HT.TokenLC i -> PV.Vars i -> Either (T.Text, HT.TokenLC i) (ATree i, PV.Vars i)) -> CT.StorageClass i -> HT.TokenLC i -> Scoped i -> Either (SM.ASTError i) (ATree i, Scoped i)
addVar :: (StorageClass i
 -> TokenLC i
 -> Vars i
 -> Either (Text, TokenLC i) (ATree i, Vars i))
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (Text, TokenLC i) (ATree i, Scoped i)
addVar f :: StorageClass i
-> TokenLC i
-> Vars i
-> Either (Text, TokenLC i) (ATree i, Vars i)
f ty :: StorageClass i
ty tkn :: TokenLC i
tkn sc :: Scoped i
sc = Scoped i -> (ATree i, Vars i) -> (ATree i, Scoped i)
forall i a. Scoped i -> (a, Vars i) -> (a, Scoped i)
applyVars Scoped i
sc ((ATree i, Vars i) -> (ATree i, Scoped i))
-> Either (Text, TokenLC i) (ATree i, Vars i)
-> Either (Text, TokenLC i) (ATree i, Scoped i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i
-> Vars i
-> Either (Text, TokenLC i) (ATree i, Vars i)
f StorageClass i
ty TokenLC i
tkn (Scoped i -> Vars i
forall i. Scoped i -> Vars i
vars Scoped i
sc)

-- | `addLVar` has a scoped type argument and is the same function as `PV.addLVar` internally.
{-# INLINE addLVar #-}
addLVar :: (Integral i, Bits i) => CT.StorageClass i -> HT.TokenLC i -> Scoped i -> Either (SM.ASTError i) (ATree i, Scoped i)
addLVar :: StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
addLVar ty :: StorageClass i
ty tkn :: TokenLC i
tkn scp :: Scoped i
scp = (StorageClass i
 -> TokenLC i -> Vars i -> Either (ASTError i) (ATree i, Vars i))
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i)
forall i.
(Integral i, Bits i) =>
(StorageClass i
 -> TokenLC i
 -> Vars i
 -> Either (Text, TokenLC i) (ATree i, Vars i))
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (Text, TokenLC i) (ATree i, Scoped i)
addVar (Natural
-> StorageClass i
-> TokenLC i
-> Vars i
-> Either (ASTError i) (ATree i, Vars i)
forall i.
(Integral i, Bits i) =>
Natural
-> StorageClass i
-> TokenLC i
-> Vars i
-> Either (ASTError i) (ATree i, Vars i)
PV.addLVar (Natural
 -> StorageClass i
 -> TokenLC i
 -> Vars i
 -> Either (ASTError i) (ATree i, Vars i))
-> Natural
-> StorageClass i
-> TokenLC i
-> Vars i
-> Either (ASTError i) (ATree i, Vars i)
forall a b. (a -> b) -> a -> b
$ Scoped i -> Natural
forall i. Scoped i -> Natural
curNestDepth Scoped i
scp) StorageClass i
ty TokenLC i
tkn Scoped i
scp

-- | `addGVar` has a scoped type argument and is the same function as `PV.addGVar` internally.
{-# INLINE addGVar #-}
addGVar :: (Integral i, Bits i) => CT.StorageClass i -> HT.TokenLC i -> Scoped i -> Either (SM.ASTError i) (ATree i, Scoped i)
addGVar :: StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
addGVar = (StorageClass i
 -> TokenLC i -> Vars i -> Either (ASTError i) (ATree i, Vars i))
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i)
forall i.
(Integral i, Bits i) =>
(StorageClass i
 -> TokenLC i
 -> Vars i
 -> Either (Text, TokenLC i) (ATree i, Vars i))
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (Text, TokenLC i) (ATree i, Scoped i)
addVar StorageClass i
-> TokenLC i -> Vars i -> Either (ASTError i) (ATree i, Vars i)
forall i.
Num i =>
StorageClass i
-> TokenLC i -> Vars i -> Either (ASTError i) (ATree i, Vars i)
PV.addGVar

-- | `addGVarWith` has a scoped type argument and is the same function as `PV.addLiteral` internally.
{-# INLINE addGVarWith #-}
addGVarWith :: (Integral i, Bits i) => CT.StorageClass i -> HT.TokenLC i -> PV.GVarInitWith i -> Scoped i -> Either (SM.ASTError i) (ATree i, Scoped i)
addGVarWith :: StorageClass i
-> TokenLC i
-> GVarInitWith i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i)
addGVarWith ty :: StorageClass i
ty tkn :: TokenLC i
tkn iw :: GVarInitWith i
iw sc :: Scoped i
sc = Scoped i -> (ATree i, Vars i) -> (ATree i, Scoped i)
forall i a. Scoped i -> (a, Vars i) -> (a, Scoped i)
applyVars Scoped i
sc ((ATree i, Vars i) -> (ATree i, Scoped i))
-> Either (ASTError i) (ATree i, Vars i)
-> Either (ASTError i) (ATree i, Scoped i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i
-> GVarInitWith i
-> Vars i
-> Either (ASTError i) (ATree i, Vars i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> GVarInitWith i
-> Vars i
-> Either (ASTError i) (ATree i, Vars i)
PV.addGVarWith StorageClass i
ty TokenLC i
tkn GVarInitWith i
iw (Scoped i -> Vars i
forall i. Scoped i -> Vars i
vars Scoped i
sc)

-- | `addLiteral` has a scoped type argument and is the same function as `PV.addLiteral` internally.
{-# INLINE addLiteral #-}
addLiteral :: (Integral i, Bits i) => CT.StorageClass i -> HT.TokenLC i -> Scoped i -> Either (SM.ASTError i) (ATree i, Scoped i)
addLiteral :: StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
addLiteral = (StorageClass i
 -> TokenLC i -> Vars i -> Either (ASTError i) (ATree i, Vars i))
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i)
forall i.
(Integral i, Bits i) =>
(StorageClass i
 -> TokenLC i
 -> Vars i
 -> Either (Text, TokenLC i) (ATree i, Vars i))
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (Text, TokenLC i) (ATree i, Scoped i)
addVar StorageClass i
-> TokenLC i -> Vars i -> Either (ASTError i) (ATree i, Vars i)
forall i.
(Ord i, Num i) =>
StorageClass i
-> TokenLC i -> Vars i -> Either (ASTError i) (ATree i, Vars i)
PV.addLiteral

-- | `succNest` has a scoped type argument and is the same function as `PV.succNest` internally.
{-# INLINE succNest #-}
succNest :: Scoped i -> Scoped i
succNest :: Scoped i -> Scoped i
succNest sc :: Scoped i
sc = Scoped i
sc { curNestDepth :: Natural
curNestDepth = Natural -> Natural
forall a. Enum a => a -> a
succ (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$ Scoped i -> Natural
forall i. Scoped i -> Natural
curNestDepth Scoped i
sc }

-- | `fallBack` has a scoped type argument and is the same function as `PV.fallBack` internally.
{-# INLINE fallBack #-}
fallBack :: Scoped i -> Scoped i -> Scoped i
fallBack :: Scoped i -> Scoped i -> Scoped i
fallBack pre :: Scoped i
pre post :: Scoped i
post = Scoped i
pre
    {
        vars :: Vars i
vars = Vars i -> Vars i -> Vars i
forall a. Vars a -> Vars a -> Vars a
PV.fallBack (Scoped i -> Vars i
forall i. Scoped i -> Vars i
vars Scoped i
pre) (Scoped i -> Vars i
forall i. Scoped i -> Vars i
vars Scoped i
post),
        structs :: Tags i
structs = Tags i -> Tags i -> Tags i
forall a. ManagedScope a => Map Text a -> Map Text a -> Map Text a
SM.fallBack (Scoped i -> Tags i
forall i. Scoped i -> Tags i
structs Scoped i
pre) (Scoped i -> Tags i
forall i. Scoped i -> Tags i
structs Scoped i
post),
        typedefs :: Typedefs i
typedefs = Typedefs i -> Typedefs i -> Typedefs i
forall a. ManagedScope a => Map Text a -> Map Text a -> Map Text a
SM.fallBack (Scoped i -> Typedefs i
forall i. Scoped i -> Typedefs i
typedefs Scoped i
pre) (Scoped i -> Typedefs i
forall i. Scoped i -> Typedefs i
typedefs Scoped i
post),
        functions :: Functions i
functions = Functions i -> Functions i -> Functions i
forall a. ManagedScope a => Map Text a -> Map Text a -> Map Text a
SM.fallBack (Scoped i -> Functions i
forall i. Scoped i -> Functions i
functions Scoped i
pre) (Scoped i -> Functions i
forall i. Scoped i -> Functions i
functions Scoped i
post),
        enumerators :: Enumerators i
enumerators = Enumerators i -> Enumerators i -> Enumerators i
forall a. ManagedScope a => Map Text a -> Map Text a -> Map Text a
SM.fallBack (Scoped i -> Enumerators i
forall i. Scoped i -> Enumerators i
enumerators Scoped i
pre) (Scoped i -> Enumerators i
forall i. Scoped i -> Enumerators i
enumerators Scoped i
post)
    }

{-# INLINE lookupVar' #-}
lookupVar' :: (T.Text -> PV.Vars a -> b) -> T.Text -> Scoped a -> b
lookupVar' :: (Text -> Vars a -> b) -> Text -> Scoped a -> b
lookupVar' f :: Text -> Vars a -> b
f s :: Text
s sc :: Scoped a
sc = Text -> Vars a -> b
f Text
s (Vars a -> b) -> Vars a -> b
forall a b. (a -> b) -> a -> b
$ Scoped a -> Vars a
forall i. Scoped i -> Vars i
vars Scoped a
sc

-- | `lookupLVar` has a scoped type argument and is the same function as `PV.lookupLVar` internally.
{-# INLINE lookupLVar #-}
lookupLVar :: T.Text -> Scoped i -> Maybe (PV.LVar i)
lookupLVar :: Text -> Scoped i -> Maybe (LVar i)
lookupLVar = (Text -> Vars i -> Maybe (LVar i))
-> Text -> Scoped i -> Maybe (LVar i)
forall a b. (Text -> Vars a -> b) -> Text -> Scoped a -> b
lookupVar' Text -> Vars i -> Maybe (LVar i)
forall a. Text -> Vars a -> Maybe (LVar a)
PV.lookupLVar

-- | `lookupGVar` has a scoped type argument and is the same function as `PV.lookupGVar` internally.
{-# INLINE lookupGVar #-}
lookupGVar :: T.Text -> Scoped i -> Maybe (PV.GVar i)
lookupGVar :: Text -> Scoped i -> Maybe (GVar i)
lookupGVar = (Text -> Vars i -> Maybe (GVar i))
-> Text -> Scoped i -> Maybe (GVar i)
forall a b. (Text -> Vars a -> b) -> Text -> Scoped a -> b
lookupVar' Text -> Vars i -> Maybe (GVar i)
forall a. Text -> Vars a -> Maybe (GVar a)
PV.lookupGVar

-- | `lookupVar` has a scoped type argument and is the same function as `PV.lookupVar` internally.
{-# INLINE lookupVar #-}
lookupVar :: T.Text -> Scoped i -> LookupVarResult i
lookupVar :: Text -> Scoped i -> LookupVarResult i
lookupVar ident :: Text
ident scp :: Scoped i
scp = case Text -> Scoped i -> Maybe (LVar i)
forall i. Text -> Scoped i -> Maybe (LVar i)
lookupLVar Text
ident Scoped i
scp of
    Just local :: LVar i
local -> LVar i -> LookupVarResult i
forall i. LVar i -> LookupVarResult i
FoundLVar LVar i
local
    _ -> case Text -> Scoped i -> Maybe (Enumerator i)
forall i. Text -> Scoped i -> Maybe (Enumerator i)
lookupEnumerator Text
ident Scoped i
scp of
        Just enum :: Enumerator i
enum -> Enumerator i -> LookupVarResult i
forall i. Enumerator i -> LookupVarResult i
FoundEnum Enumerator i
enum
        _         -> LookupVarResult i
-> (GVar i -> LookupVarResult i)
-> Maybe (GVar i)
-> LookupVarResult i
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LookupVarResult i
forall i. LookupVarResult i
NotFound GVar i -> LookupVarResult i
forall i. GVar i -> LookupVarResult i
FoundGVar (Maybe (GVar i) -> LookupVarResult i)
-> Maybe (GVar i) -> LookupVarResult i
forall a b. (a -> b) -> a -> b
$ Text -> Scoped i -> Maybe (GVar i)
forall i. Text -> Scoped i -> Maybe (GVar i)
lookupGVar Text
ident Scoped i
scp

-- | `lookupTag` has a scoped type argument and is the same function as `PS.lookupTag` internally.
{-# INLINE lookupTag #-}
lookupTag :: T.Text -> Scoped i -> Maybe (PS.Tag i)
lookupTag :: Text -> Scoped i -> Maybe (Tag i)
lookupTag t :: Text
t sc :: Scoped i
sc = Text -> Map Text (Tag i) -> Maybe (Tag i)
forall a. ManagedScope a => Text -> Map Text a -> Maybe a
SM.lookup Text
t (Map Text (Tag i) -> Maybe (Tag i))
-> Map Text (Tag i) -> Maybe (Tag i)
forall a b. (a -> b) -> a -> b
$ Scoped i -> Map Text (Tag i)
forall i. Scoped i -> Tags i
structs Scoped i
sc

-- | `lookupTypedef` has a scoped type argument and is the same function as `PT.lookupTypedef` internally.
{-# INLINE lookupTypedef #-}
lookupTypedef :: T.Text -> Scoped i -> Maybe (PT.Typedef i)
lookupTypedef :: Text -> Scoped i -> Maybe (Typedef i)
lookupTypedef t :: Text
t sc :: Scoped i
sc = Text -> Map Text (Typedef i) -> Maybe (Typedef i)
forall a. ManagedScope a => Text -> Map Text a -> Maybe a
SM.lookup Text
t (Map Text (Typedef i) -> Maybe (Typedef i))
-> Map Text (Typedef i) -> Maybe (Typedef i)
forall a b. (a -> b) -> a -> b
$ Scoped i -> Map Text (Typedef i)
forall i. Scoped i -> Typedefs i
typedefs Scoped i
sc

-- | `lookupFunction` has a scoped type argument and is the same function as `PF.lookupFunction` internally.
{-# INLINE lookupFunction #-}
lookupFunction :: T.Text -> Scoped i -> Maybe (PF.Function i)
lookupFunction :: Text -> Scoped i -> Maybe (Function i)
lookupFunction t :: Text
t sc :: Scoped i
sc = Text -> Map Text (Function i) -> Maybe (Function i)
forall a. ManagedScope a => Text -> Map Text a -> Maybe a
SM.lookup Text
t (Map Text (Function i) -> Maybe (Function i))
-> Map Text (Function i) -> Maybe (Function i)
forall a b. (a -> b) -> a -> b
$ Scoped i -> Map Text (Function i)
forall i. Scoped i -> Functions i
functions Scoped i
sc

{-# INLINE lookupEnumerator #-}
-- | `lookupEnumerator` has a scoped type argument and is the same function as `PF.lookupFunction` internally.
lookupEnumerator :: T.Text -> Scoped i -> Maybe (SE.Enumerator i)
lookupEnumerator :: Text -> Scoped i -> Maybe (Enumerator i)
lookupEnumerator t :: Text
t sc :: Scoped i
sc = Text -> Map Text (Enumerator i) -> Maybe (Enumerator i)
forall a. ManagedScope a => Text -> Map Text a -> Maybe a
SM.lookup Text
t (Map Text (Enumerator i) -> Maybe (Enumerator i))
-> Map Text (Enumerator i) -> Maybe (Enumerator i)
forall a b. (a -> b) -> a -> b
$ Scoped i -> Map Text (Enumerator i)
forall i. Scoped i -> Enumerators i
enumerators Scoped i
sc

-- | `addTag` has a scoped type argument and is the same function as `PS.add` internally.
{-# INLINE addTag #-}
addTag :: Num i => CT.StorageClass i -> HT.TokenLC i -> Scoped i -> Either (SM.ASTError i) (Scoped i)
addTag :: StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (Scoped i)
addTag ty :: StorageClass i
ty tkn :: TokenLC i
tkn sc :: Scoped i
sc = (\x :: Tags i
x -> Scoped i
sc { structs :: Tags i
structs = Tags i
x }) (Tags i -> Scoped i)
-> Either (ASTError i) (Tags i) -> Either (ASTError i) (Scoped i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural
-> StorageClass i
-> TokenLC i
-> Tags i
-> Either (ASTError i) (Tags i)
forall i.
Num i =>
Natural
-> StorageClass i
-> TokenLC i
-> Tags i
-> Either (ASTError i) (Tags i)
PS.add (Scoped i -> Natural
forall i. Scoped i -> Natural
curNestDepth Scoped i
sc) StorageClass i
ty TokenLC i
tkn (Scoped i -> Tags i
forall i. Scoped i -> Tags i
structs Scoped i
sc)

-- | `addTypedef` has a scoped type argument and is the same function as `PT.add` internally.
{-# INLINE addTypedef #-}
addTypedef :: (Eq i, Num i) => CT.StorageClass i -> HT.TokenLC i -> Scoped i -> Either (SM.ASTError i) (Scoped i)
addTypedef :: StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (Scoped i)
addTypedef ty :: StorageClass i
ty tkn :: TokenLC i
tkn sc :: Scoped i
sc = (\x :: Typedefs i
x -> Scoped i
sc { typedefs :: Typedefs i
typedefs = Typedefs i
x }) (Typedefs i -> Scoped i)
-> Either (ASTError i) (Typedefs i)
-> Either (ASTError i) (Scoped i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural
-> StorageClass i
-> TokenLC i
-> Typedefs i
-> Either (ASTError i) (Typedefs i)
forall i.
(Num i, Eq i) =>
Natural
-> StorageClass i
-> TokenLC i
-> Typedefs i
-> Either (ASTError i) (Typedefs i)
PT.add (Scoped i -> Natural
forall i. Scoped i -> Natural
curNestDepth Scoped i
sc) StorageClass i
ty TokenLC i
tkn (Scoped i -> Typedefs i
forall i. Scoped i -> Typedefs i
typedefs Scoped i
sc)

-- | `addFunction` has a scoped type argument and is the same function as `PT.add` internally.
{-# INLINE addFunction #-}
addFunction :: Num i => Bool -> CT.StorageClass i -> HT.TokenLC i -> Scoped i -> Either (SM.ASTError i) (Scoped i)
addFunction :: Bool
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (Scoped i)
addFunction fd :: Bool
fd ty :: StorageClass i
ty tkn :: TokenLC i
tkn sc :: Scoped i
sc = (\x :: Functions i
x -> Scoped i
sc { functions :: Functions i
functions = Functions i
x }) (Functions i -> Scoped i)
-> Either (ASTError i) (Functions i)
-> Either (ASTError i) (Scoped i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> StorageClass i
-> TokenLC i
-> Functions i
-> Either (ASTError i) (Functions i)
forall i.
Num i =>
Bool
-> StorageClass i
-> TokenLC i
-> Functions i
-> Either (ASTError i) (Functions i)
PF.add Bool
fd StorageClass i
ty TokenLC i
tkn (Scoped i -> Functions i
forall i. Scoped i -> Functions i
functions Scoped i
sc)

-- | `addEnumerator` has a scoped type argument and is the same function as `SE.add` internally.
{-# INLINE addEnumerator #-}
addEnumerator :: Num i => CT.StorageClass i -> HT.TokenLC i -> i -> Scoped i -> Either (SM.ASTError i) (Scoped i)
addEnumerator :: StorageClass i
-> TokenLC i -> i -> Scoped i -> Either (ASTError i) (Scoped i)
addEnumerator ty :: StorageClass i
ty tkn :: TokenLC i
tkn val :: i
val sc :: Scoped i
sc = (\x :: Enumerators i
x -> Scoped i
sc { enumerators :: Enumerators i
enumerators = Enumerators i
x }) (Enumerators i -> Scoped i)
-> Either (ASTError i) (Enumerators i)
-> Either (ASTError i) (Scoped i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i
-> i
-> Enumerators i
-> Either (ASTError i) (Enumerators i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> i
-> Enumerators i
-> Either (ASTError i) (Enumerators i)
SE.add StorageClass i
ty TokenLC i
tkn i
val (Scoped i -> Enumerators i
forall i. Scoped i -> Enumerators i
enumerators Scoped i
sc)

{-# INLINE initScope #-}
-- | Helper function representing an empty scoped data
initScope :: Scoped i
initScope :: Scoped i
initScope = Natural
-> Vars i
-> Tags i
-> Typedefs i
-> Functions i
-> Enumerators i
-> Scoped i
forall i.
Natural
-> Vars i
-> Tags i
-> Typedefs i
-> Functions i
-> Enumerators i
-> Scoped i
Scoped 0 Vars i
forall a. Vars a
PV.initVars Tags i
forall a. ManagedScope a => Map Text a
SM.initial Typedefs i
forall a. ManagedScope a => Map Text a
SM.initial Functions i
forall a. ManagedScope a => Map Text a
SM.initial Enumerators i
forall a. ManagedScope a => Map Text a
SM.initial

{-# INLINE resetLocal #-}
-- | `resetLocal` has a scoped type argument and is the same function as `PV.resetLocal` internally.
resetLocal :: Scoped i -> Scoped i
resetLocal :: Scoped i -> Scoped i
resetLocal sc :: Scoped i
sc = Scoped i
sc { vars :: Vars i
vars = Vars i -> Vars i
forall a. Vars a -> Vars a
PV.resetLocal (Scoped i -> Vars i
forall i. Scoped i -> Vars i
vars Scoped i
sc) }