{-|
Module      : Htcc.Parser.ConstructionData.Scope.Typedef
Description : The Data type of typedef 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, OverloadedStrings #-}
module Htcc.Parser.ConstructionData.Scope.Typedef (
    Typedef (..),
    Typedefs,
    add
) where

import           Control.DeepSeq                                 (NFData (..))
import qualified Data.Map                                        as M
import qualified Data.Text                                       as T
import           GHC.Generics                                    (Generic (..))
import           Numeric.Natural

import qualified Htcc.CRules.Types                               as CT
import           Htcc.Parser.ConstructionData.Scope.ManagedScope
import           Htcc.Parser.ConstructionData.Scope.Utils        (internalCE)
import qualified Htcc.Tokenizer.Token                            as HT

-- | The data type of a typedef tag
data Typedef a = Typedef -- ^ The contypedefor of a typedef tag
    {
        Typedef a -> StorageClass a
tdtype      :: CT.StorageClass a, -- ^ The type of this typedef
        Typedef a -> Natural
tdNestDepth :: !Natural -- ^ The nest depth of this typedef
    } deriving (Typedef a -> Typedef a -> Bool
(Typedef a -> Typedef a -> Bool)
-> (Typedef a -> Typedef a -> Bool) -> Eq (Typedef a)
forall a. Eq a => Typedef a -> Typedef a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Typedef a -> Typedef a -> Bool
$c/= :: forall a. Eq a => Typedef a -> Typedef a -> Bool
== :: Typedef a -> Typedef a -> Bool
$c== :: forall a. Eq a => Typedef a -> Typedef a -> Bool
Eq, Eq (Typedef a)
Eq (Typedef a) =>
(Typedef a -> Typedef a -> Ordering)
-> (Typedef a -> Typedef a -> Bool)
-> (Typedef a -> Typedef a -> Bool)
-> (Typedef a -> Typedef a -> Bool)
-> (Typedef a -> Typedef a -> Bool)
-> (Typedef a -> Typedef a -> Typedef a)
-> (Typedef a -> Typedef a -> Typedef a)
-> Ord (Typedef a)
Typedef a -> Typedef a -> Bool
Typedef a -> Typedef a -> Ordering
Typedef a -> Typedef a -> Typedef a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Typedef a)
forall a. Ord a => Typedef a -> Typedef a -> Bool
forall a. Ord a => Typedef a -> Typedef a -> Ordering
forall a. Ord a => Typedef a -> Typedef a -> Typedef a
min :: Typedef a -> Typedef a -> Typedef a
$cmin :: forall a. Ord a => Typedef a -> Typedef a -> Typedef a
max :: Typedef a -> Typedef a -> Typedef a
$cmax :: forall a. Ord a => Typedef a -> Typedef a -> Typedef a
>= :: Typedef a -> Typedef a -> Bool
$c>= :: forall a. Ord a => Typedef a -> Typedef a -> Bool
> :: Typedef a -> Typedef a -> Bool
$c> :: forall a. Ord a => Typedef a -> Typedef a -> Bool
<= :: Typedef a -> Typedef a -> Bool
$c<= :: forall a. Ord a => Typedef a -> Typedef a -> Bool
< :: Typedef a -> Typedef a -> Bool
$c< :: forall a. Ord a => Typedef a -> Typedef a -> Bool
compare :: Typedef a -> Typedef a -> Ordering
$ccompare :: forall a. Ord a => Typedef a -> Typedef a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Typedef a)
Ord, Int -> Typedef a -> ShowS
[Typedef a] -> ShowS
Typedef a -> String
(Int -> Typedef a -> ShowS)
-> (Typedef a -> String)
-> ([Typedef a] -> ShowS)
-> Show (Typedef a)
forall a. Show a => Int -> Typedef a -> ShowS
forall a. Show a => [Typedef a] -> ShowS
forall a. Show a => Typedef a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Typedef a] -> ShowS
$cshowList :: forall a. Show a => [Typedef a] -> ShowS
show :: Typedef a -> String
$cshow :: forall a. Show a => Typedef a -> String
showsPrec :: Int -> Typedef a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Typedef a -> ShowS
Show, (forall x. Typedef a -> Rep (Typedef a) x)
-> (forall x. Rep (Typedef a) x -> Typedef a)
-> Generic (Typedef a)
forall x. Rep (Typedef a) x -> Typedef a
forall x. Typedef a -> Rep (Typedef a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Typedef a) x -> Typedef a
forall a x. Typedef a -> Rep (Typedef a) x
$cto :: forall a x. Rep (Typedef a) x -> Typedef a
$cfrom :: forall a x. Typedef a -> Rep (Typedef a) x
Generic)

instance NFData i => NFData (Typedef i)

instance ManagedScope (Typedef i) where
    lookup :: Text -> Map Text (Typedef i) -> Maybe (Typedef i)
lookup = Text -> Map Text (Typedef i) -> Maybe (Typedef i)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
    fallBack :: Map Text (Typedef i)
-> Map Text (Typedef i) -> Map Text (Typedef i)
fallBack = Map Text (Typedef i)
-> Map Text (Typedef i) -> Map Text (Typedef i)
forall a b. a -> b -> a
const
    initial :: Map Text (Typedef i)
initial = Map Text (Typedef i)
forall k a. Map k a
M.empty

-- | The typedefs data type
type Typedefs a = M.Map T.Text (Typedef a)

-- | Given the current nesting number, type, identifier token, and `Typedefs`, if the specified identifier already exists in the same scope,
-- return an error message and its location as a pair.
-- Otherwise, add a new tag to `Typedefs` and return it.
-- If the token does not indicate an identifier, an error indicating internal compiler error is returned.
add :: (Num i, Eq i) => Natural -> CT.StorageClass i -> HT.TokenLC i -> Typedefs i -> Either (ASTError i) (Typedefs i)
add :: Natural
-> StorageClass i
-> TokenLC i
-> Typedefs i
-> Either (ASTError i) (Typedefs i)
add cnd :: Natural
cnd t :: StorageClass i
t cur :: TokenLC i
cur@(_, HT.TKIdent ident :: Text
ident) sts :: Typedefs i
sts = case Text -> Typedefs i -> Maybe (Typedef i)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
ident Typedefs i
sts of
    Just foundedTag :: Typedef i
foundedTag
        | Typedef i -> Natural
forall a. Typedef a -> Natural
tdNestDepth Typedef i
foundedTag Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Natural
cnd -> Either (ASTError i) (Typedefs i)
forall a. Either a (Typedefs i)
tdnat
        | Typedef i -> StorageClass i
forall a. Typedef a -> StorageClass a
tdtype Typedef i
foundedTag StorageClass i -> StorageClass i -> Bool
forall a. Eq a => a -> a -> Bool
== StorageClass i
t -> Either (ASTError i) (Typedefs i)
forall a. Either a (Typedefs i)
tdnat
        | Bool
otherwise -> ASTError i -> Either (ASTError i) (Typedefs i)
forall a b. a -> Either a b
Left ("conflicting types for '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", TokenLC i
cur) -- ODR
    Nothing -> Either (ASTError i) (Typedefs i)
forall a. Either a (Typedefs i)
tdnat
    where
        tdnat :: Either a (Typedefs i)
tdnat = Typedefs i -> Either a (Typedefs i)
forall a b. b -> Either a b
Right (Typedefs i -> Either a (Typedefs i))
-> Typedefs i -> Either a (Typedefs i)
forall a b. (a -> b) -> a -> b
$ Text -> Typedef i -> Typedefs i -> Typedefs i
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident (StorageClass i -> Natural -> Typedef i
forall a. StorageClass a -> Natural -> Typedef a
Typedef StorageClass i
t Natural
cnd) Typedefs i
sts
add _ _ _ _ = ASTError i -> Either (ASTError i) (Typedefs i)
forall a b. a -> Either a b
Left (Text
internalCE, (i -> i -> TokenLCNums i
forall i. i -> i -> TokenLCNums i
HT.TokenLCNums 0 0, Token i
forall i. Token i
HT.TKEmpty))