module Htcc.Parser.ConstructionData.Core (
ConstructionData (..),
Warnings,
addLVar,
addGVar,
addGVarWith,
addLiteral,
addTag,
addTypedef,
addFunction,
addEnumerator,
lookupLVar,
lookupGVar,
lookupVar,
lookupTag,
lookupTypedef,
lookupFunction,
lookupEnumerator,
succNest,
fallBack,
initConstructionData,
resetLocal,
pushWarn,
incomplete
) where
import Data.Bits (Bits (..))
import Data.Maybe (fromJust)
import qualified Data.Sequence as S
import qualified Data.Text as T
import Data.Tuple.Extra (second)
import qualified Htcc.CRules.Types as CT
import Htcc.Parser.AST.Core (ATree (..))
import Htcc.Parser.ConstructionData.Scope (LookupVarResult (..))
import qualified Htcc.Parser.ConstructionData.Scope as AS
import qualified Htcc.Parser.ConstructionData.Scope.Enumerator as SE
import qualified Htcc.Parser.ConstructionData.Scope.Function as PF
import Htcc.Parser.ConstructionData.Scope.ManagedScope (ASTError)
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 Htcc.Tokenizer.Token (TokenLC)
import qualified Htcc.Tokenizer.Token as HT
type Warnings i = S.Seq (T.Text, TokenLC i)
data ConstructionData i = ConstructionData
{
ConstructionData i -> Warnings i
warns :: Warnings i,
ConstructionData i -> Scoped i
scope :: AS.Scoped i,
ConstructionData i -> Bool
isSwitchStmt :: Bool
} deriving Int -> ConstructionData i -> ShowS
[ConstructionData i] -> ShowS
ConstructionData i -> String
(Int -> ConstructionData i -> ShowS)
-> (ConstructionData i -> String)
-> ([ConstructionData i] -> ShowS)
-> Show (ConstructionData i)
forall i. Show i => Int -> ConstructionData i -> ShowS
forall i. Show i => [ConstructionData i] -> ShowS
forall i. Show i => ConstructionData i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstructionData i] -> ShowS
$cshowList :: forall i. Show i => [ConstructionData i] -> ShowS
show :: ConstructionData i -> String
$cshow :: forall i. Show i => ConstructionData i -> String
showsPrec :: Int -> ConstructionData i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> ConstructionData i -> ShowS
Show
{-# INLINE applyScope #-}
applyScope :: ConstructionData i -> (a, AS.Scoped i) -> (a, ConstructionData i)
applyScope :: ConstructionData i -> (a, Scoped i) -> (a, ConstructionData i)
applyScope cd :: ConstructionData i
cd = (Scoped i -> ConstructionData i)
-> (a, Scoped i) -> (a, ConstructionData i)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (\x :: Scoped i
x -> ConstructionData i
cd { scope :: Scoped i
scope = Scoped i
x })
{-# INLINE addVar #-}
addVar :: (Integral i, Bits i) => (CT.StorageClass i -> HT.TokenLC i -> AS.Scoped i -> Either (ASTError i) (ATree i, AS.Scoped i)) -> CT.StorageClass i -> HT.TokenLC i -> ConstructionData i -> Either (ASTError i) (ATree i, ConstructionData i)
addVar :: (StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i))
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addVar f :: StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
f ty :: StorageClass i
ty tkn :: TokenLC i
tkn cd :: ConstructionData i
cd = ConstructionData i
-> (ATree i, Scoped i) -> (ATree i, ConstructionData i)
forall i a.
ConstructionData i -> (a, Scoped i) -> (a, ConstructionData i)
applyScope ConstructionData i
cd ((ATree i, Scoped i) -> (ATree i, ConstructionData i))
-> Either (ASTError i) (ATree i, Scoped i)
-> Either (ASTError i) (ATree i, ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
f StorageClass i
ty TokenLC i
tkn (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
cd)
addLVar :: (Integral i, Bits i) => CT.StorageClass i -> HT.TokenLC i -> ConstructionData i -> Either (ASTError i) (ATree i, ConstructionData i)
addLVar :: StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addLVar = (StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i))
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
forall i.
(Integral i, Bits i) =>
(StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i))
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addVar StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
AS.addLVar
addGVar :: (Integral i, Bits i) => CT.StorageClass i -> HT.TokenLC i -> ConstructionData i -> Either (ASTError i) (ATree i, ConstructionData i)
addGVar :: StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addGVar = (StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i))
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
forall i.
(Integral i, Bits i) =>
(StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i))
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addVar StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
AS.addGVar
addGVarWith :: (Integral i, Bits i) => CT.StorageClass i -> HT.TokenLC i -> PV.GVarInitWith i -> ConstructionData i -> Either (ASTError i) (ATree i, ConstructionData i)
addGVarWith :: StorageClass i
-> TokenLC i
-> GVarInitWith i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addGVarWith ty :: StorageClass i
ty tkn :: TokenLC i
tkn iw :: GVarInitWith i
iw cd :: ConstructionData i
cd = ConstructionData i
-> (ATree i, Scoped i) -> (ATree i, ConstructionData i)
forall i a.
ConstructionData i -> (a, Scoped i) -> (a, ConstructionData i)
applyScope ConstructionData i
cd ((ATree i, Scoped i) -> (ATree i, ConstructionData i))
-> Either (ASTError i) (ATree i, Scoped i)
-> Either (ASTError i) (ATree i, ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i
-> GVarInitWith i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i
-> GVarInitWith i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i)
AS.addGVarWith StorageClass i
ty TokenLC i
tkn GVarInitWith i
iw (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
cd)
addLiteral :: (Integral i, Bits i) => CT.StorageClass i -> HT.TokenLC i -> ConstructionData i -> Either (ASTError i) (ATree i, ConstructionData i)
addLiteral :: StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addLiteral = (StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i))
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
forall i.
(Integral i, Bits i) =>
(StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (ATree i, Scoped i))
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addVar StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (ATree i, Scoped i)
AS.addLiteral
succNest :: ConstructionData i -> ConstructionData i
succNest :: ConstructionData i -> ConstructionData i
succNest cd :: ConstructionData i
cd = ConstructionData i
cd { scope :: Scoped i
scope = Scoped i -> Scoped i
forall i. Scoped i -> Scoped i
AS.succNest (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
cd) }
fallBack :: ConstructionData i -> ConstructionData i -> ConstructionData i
fallBack :: ConstructionData i -> ConstructionData i -> ConstructionData i
fallBack pre :: ConstructionData i
pre post :: ConstructionData i
post = ConstructionData i
post { scope :: Scoped i
scope = Scoped i -> Scoped i -> Scoped i
forall i. Scoped i -> Scoped i -> Scoped i
AS.fallBack (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
pre) (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
post) }
{-# INLINE lookupFromScope #-}
lookupFromScope :: (T.Text -> AS.Scoped i -> a) -> T.Text -> ConstructionData i -> a
lookupFromScope :: (Text -> Scoped i -> a) -> Text -> ConstructionData i -> a
lookupFromScope f :: Text -> Scoped i -> a
f s :: Text
s cd :: ConstructionData i
cd = Text -> Scoped i -> a
f Text
s (Scoped i -> a) -> Scoped i -> a
forall a b. (a -> b) -> a -> b
$ ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
cd
lookupLVar :: T.Text -> ConstructionData i -> Maybe (PV.LVar i)
lookupLVar :: Text -> ConstructionData i -> Maybe (LVar i)
lookupLVar = (Text -> Scoped i -> Maybe (LVar i))
-> Text -> ConstructionData i -> Maybe (LVar i)
forall i a.
(Text -> Scoped i -> a) -> Text -> ConstructionData i -> a
lookupFromScope Text -> Scoped i -> Maybe (LVar i)
forall i. Text -> Scoped i -> Maybe (LVar i)
AS.lookupLVar
lookupGVar :: T.Text -> ConstructionData i -> Maybe (PV.GVar i)
lookupGVar :: Text -> ConstructionData i -> Maybe (GVar i)
lookupGVar = (Text -> Scoped i -> Maybe (GVar i))
-> Text -> ConstructionData i -> Maybe (GVar i)
forall i a.
(Text -> Scoped i -> a) -> Text -> ConstructionData i -> a
lookupFromScope Text -> Scoped i -> Maybe (GVar i)
forall i. Text -> Scoped i -> Maybe (GVar i)
AS.lookupGVar
lookupVar :: T.Text -> ConstructionData i -> LookupVarResult i
lookupVar :: Text -> ConstructionData i -> LookupVarResult i
lookupVar = (Text -> Scoped i -> LookupVarResult i)
-> Text -> ConstructionData i -> LookupVarResult i
forall i a.
(Text -> Scoped i -> a) -> Text -> ConstructionData i -> a
lookupFromScope Text -> Scoped i -> LookupVarResult i
forall i. Text -> Scoped i -> LookupVarResult i
AS.lookupVar
lookupTag :: T.Text -> ConstructionData i -> Maybe (PS.Tag i)
lookupTag :: Text -> ConstructionData i -> Maybe (Tag i)
lookupTag = (Text -> Scoped i -> Maybe (Tag i))
-> Text -> ConstructionData i -> Maybe (Tag i)
forall i a.
(Text -> Scoped i -> a) -> Text -> ConstructionData i -> a
lookupFromScope Text -> Scoped i -> Maybe (Tag i)
forall i. Text -> Scoped i -> Maybe (Tag i)
AS.lookupTag
lookupTypedef :: T.Text -> ConstructionData i -> Maybe (PT.Typedef i)
lookupTypedef :: Text -> ConstructionData i -> Maybe (Typedef i)
lookupTypedef = (Text -> Scoped i -> Maybe (Typedef i))
-> Text -> ConstructionData i -> Maybe (Typedef i)
forall i a.
(Text -> Scoped i -> a) -> Text -> ConstructionData i -> a
lookupFromScope Text -> Scoped i -> Maybe (Typedef i)
forall i. Text -> Scoped i -> Maybe (Typedef i)
AS.lookupTypedef
lookupFunction :: T.Text -> ConstructionData i -> Maybe (PF.Function i)
lookupFunction :: Text -> ConstructionData i -> Maybe (Function i)
lookupFunction = (Text -> Scoped i -> Maybe (Function i))
-> Text -> ConstructionData i -> Maybe (Function i)
forall i a.
(Text -> Scoped i -> a) -> Text -> ConstructionData i -> a
lookupFromScope Text -> Scoped i -> Maybe (Function i)
forall i. Text -> Scoped i -> Maybe (Function i)
AS.lookupFunction
lookupEnumerator :: T.Text -> ConstructionData i -> Maybe (SE.Enumerator i)
lookupEnumerator :: Text -> ConstructionData i -> Maybe (Enumerator i)
lookupEnumerator = (Text -> Scoped i -> Maybe (Enumerator i))
-> Text -> ConstructionData i -> Maybe (Enumerator i)
forall i a.
(Text -> Scoped i -> a) -> Text -> ConstructionData i -> a
lookupFromScope Text -> Scoped i -> Maybe (Enumerator i)
forall i. Text -> Scoped i -> Maybe (Enumerator i)
AS.lookupEnumerator
addTag :: Num i => CT.StorageClass i -> HT.TokenLC i -> ConstructionData i -> Either (ASTError i) (ConstructionData i)
addTag :: StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addTag ty :: StorageClass i
ty tkn :: TokenLC i
tkn cd :: ConstructionData i
cd = (\x :: Scoped i
x -> ConstructionData i
cd { scope :: Scoped i
scope = Scoped i
x }) (Scoped i -> ConstructionData i)
-> Either (ASTError i) (Scoped i)
-> Either (ASTError i) (ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (Scoped i)
forall i.
Num i =>
StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (Scoped i)
AS.addTag StorageClass i
ty TokenLC i
tkn (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
cd)
addTypedef :: (Eq i, Num i) => CT.StorageClass i -> HT.TokenLC i -> ConstructionData i -> Either (ASTError i) (ConstructionData i)
addTypedef :: StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addTypedef ty :: StorageClass i
ty tkn :: TokenLC i
tkn cd :: ConstructionData i
cd = (\x :: Scoped i
x -> ConstructionData i
cd { scope :: Scoped i
scope = Scoped i
x }) (Scoped i -> ConstructionData i)
-> Either (ASTError i) (Scoped i)
-> Either (ASTError i) (ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (Scoped i)
forall i.
(Eq i, Num i) =>
StorageClass i
-> TokenLC i -> Scoped i -> Either (ASTError i) (Scoped i)
AS.addTypedef StorageClass i
ty TokenLC i
tkn (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
cd)
addFunction :: Num i => Bool -> CT.StorageClass i -> HT.TokenLC i -> ConstructionData i -> Either (ASTError i) (ConstructionData i)
addFunction :: Bool
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addFunction fd :: Bool
fd ty :: StorageClass i
ty tkn :: TokenLC i
tkn cd :: ConstructionData i
cd = (\x :: Scoped i
x -> ConstructionData i
cd { scope :: Scoped i
scope = Scoped i
x }) (Scoped i -> ConstructionData i)
-> Either (ASTError i) (Scoped i)
-> Either (ASTError i) (ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (Scoped i)
forall i.
Num i =>
Bool
-> StorageClass i
-> TokenLC i
-> Scoped i
-> Either (ASTError i) (Scoped i)
AS.addFunction Bool
fd StorageClass i
ty TokenLC i
tkn (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
cd)
addEnumerator :: Num i => CT.StorageClass i -> HT.TokenLC i -> i -> ConstructionData i -> Either (ASTError i) (ConstructionData i)
addEnumerator :: StorageClass i
-> TokenLC i
-> i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addEnumerator ty :: StorageClass i
ty tkn :: TokenLC i
tkn n :: i
n cd :: ConstructionData i
cd = (\x :: Scoped i
x -> ConstructionData i
cd { scope :: Scoped i
scope = Scoped i
x }) (Scoped i -> ConstructionData i)
-> Either (ASTError i) (Scoped i)
-> Either (ASTError i) (ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i -> i -> Scoped i -> Either (ASTError i) (Scoped i)
forall i.
Num i =>
StorageClass i
-> TokenLC i -> i -> Scoped i -> Either (ASTError i) (Scoped i)
AS.addEnumerator StorageClass i
ty TokenLC i
tkn i
n (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
cd)
{-# INLINE initConstructionData #-}
initConstructionData :: ConstructionData i
initConstructionData :: ConstructionData i
initConstructionData = Warnings i -> Scoped i -> Bool -> ConstructionData i
forall i. Warnings i -> Scoped i -> Bool -> ConstructionData i
ConstructionData Warnings i
forall a. Seq a
S.empty Scoped i
forall i. Scoped i
AS.initScope Bool
False
resetLocal :: ConstructionData i -> ConstructionData i
resetLocal :: ConstructionData i -> ConstructionData i
resetLocal cd :: ConstructionData i
cd = ConstructionData i
cd { scope :: Scoped i
scope = Scoped i -> Scoped i
forall i. Scoped i -> Scoped i
AS.resetLocal (ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
cd) }
pushWarn :: T.Text -> TokenLC i -> ConstructionData i -> ConstructionData i
pushWarn :: Text -> TokenLC i -> ConstructionData i -> ConstructionData i
pushWarn t :: Text
t tkn :: TokenLC i
tkn cd :: ConstructionData i
cd = ConstructionData i
cd { warns :: Warnings i
warns = ConstructionData i -> Warnings i
forall i. ConstructionData i -> Warnings i
warns ConstructionData i
cd Warnings i -> (Text, TokenLC i) -> Warnings i
forall a. Seq a -> a -> Seq a
S.|> (Text
t, TokenLC i
tkn) }
{-# INLINE incomplete #-}
incomplete :: CT.StorageClass i -> ConstructionData i -> Maybe (CT.StorageClass i)
incomplete :: StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete ty :: StorageClass i
ty scp :: ConstructionData i
scp
| Bool -> Bool
not (StorageClass i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
CT.isCTIncomplete StorageClass i
ty) = StorageClass i -> Maybe (StorageClass i)
forall a. a -> Maybe a
Just StorageClass i
ty
| StorageClass i -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
CT.isIncompleteStruct StorageClass i
ty = Maybe (Tag i)
-> (Tag i -> Maybe (StorageClass i)) -> Maybe (StorageClass i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (Text -> ConstructionData i -> Maybe (Tag i)
forall i. Text -> ConstructionData i -> Maybe (Tag i)
lookupTag (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ StorageClass i -> Maybe Text
forall (a :: * -> *) i. IncompleteBase a => a i -> Maybe Text
CT.fromIncompleteStruct StorageClass i
ty) ConstructionData i
scp) ((Tag i -> Maybe (StorageClass i)) -> Maybe (StorageClass i))
-> (Tag i -> Maybe (StorageClass i)) -> Maybe (StorageClass i)
forall a b. (a -> b) -> a -> b
$ \tag :: Tag i
tag ->
if StorageClass i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
CT.isCTIncomplete (Tag i -> StorageClass i
forall i. Tag i -> StorageClass i
PS.sttype Tag i
tag) then Maybe (StorageClass i)
forall a. Maybe a
Nothing else StorageClass i -> Maybe (StorageClass i)
forall a. a -> Maybe a
Just (Tag i -> StorageClass i
forall i. Tag i -> StorageClass i
PS.sttype Tag i
tag)
| Bool
otherwise = Maybe (StorageClass i)
forall a. Maybe a
Nothing