{-|
Module      : Htcc.Parser.ConstructionData.Scope.Function
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.Function (
    Function (..),
    Functions,
    add
) where

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

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 Function a = Function -- ^ The contypedefor of a typedef tag
    {
        Function a -> StorageClass a
fntype    :: CT.StorageClass a, -- ^ The type of this typedef
        Function a -> Bool
fnDefined :: Bool -- ^ If the function is defined, it will be `True`, otherwise will be `False`.
    } deriving (Function a -> Function a -> Bool
(Function a -> Function a -> Bool)
-> (Function a -> Function a -> Bool) -> Eq (Function a)
forall a. Eq a => Function a -> Function a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Function a -> Function a -> Bool
$c/= :: forall a. Eq a => Function a -> Function a -> Bool
== :: Function a -> Function a -> Bool
$c== :: forall a. Eq a => Function a -> Function a -> Bool
Eq, Eq (Function a)
Eq (Function a) =>
(Function a -> Function a -> Ordering)
-> (Function a -> Function a -> Bool)
-> (Function a -> Function a -> Bool)
-> (Function a -> Function a -> Bool)
-> (Function a -> Function a -> Bool)
-> (Function a -> Function a -> Function a)
-> (Function a -> Function a -> Function a)
-> Ord (Function a)
Function a -> Function a -> Bool
Function a -> Function a -> Ordering
Function a -> Function a -> Function 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 (Function a)
forall a. Ord a => Function a -> Function a -> Bool
forall a. Ord a => Function a -> Function a -> Ordering
forall a. Ord a => Function a -> Function a -> Function a
min :: Function a -> Function a -> Function a
$cmin :: forall a. Ord a => Function a -> Function a -> Function a
max :: Function a -> Function a -> Function a
$cmax :: forall a. Ord a => Function a -> Function a -> Function a
>= :: Function a -> Function a -> Bool
$c>= :: forall a. Ord a => Function a -> Function a -> Bool
> :: Function a -> Function a -> Bool
$c> :: forall a. Ord a => Function a -> Function a -> Bool
<= :: Function a -> Function a -> Bool
$c<= :: forall a. Ord a => Function a -> Function a -> Bool
< :: Function a -> Function a -> Bool
$c< :: forall a. Ord a => Function a -> Function a -> Bool
compare :: Function a -> Function a -> Ordering
$ccompare :: forall a. Ord a => Function a -> Function a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Function a)
Ord, Int -> Function a -> ShowS
[Function a] -> ShowS
Function a -> String
(Int -> Function a -> ShowS)
-> (Function a -> String)
-> ([Function a] -> ShowS)
-> Show (Function a)
forall a. Show a => Int -> Function a -> ShowS
forall a. Show a => [Function a] -> ShowS
forall a. Show a => Function a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Function a] -> ShowS
$cshowList :: forall a. Show a => [Function a] -> ShowS
show :: Function a -> String
$cshow :: forall a. Show a => Function a -> String
showsPrec :: Int -> Function a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Function a -> ShowS
Show, (forall x. Function a -> Rep (Function a) x)
-> (forall x. Rep (Function a) x -> Function a)
-> Generic (Function a)
forall x. Rep (Function a) x -> Function a
forall x. Function a -> Rep (Function a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Function a) x -> Function a
forall a x. Function a -> Rep (Function a) x
$cto :: forall a x. Rep (Function a) x -> Function a
$cfrom :: forall a x. Function a -> Rep (Function a) x
Generic)

instance NFData a => NFData (Function a)

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

-- | The typedefs data typedefs
type Functions i = M.Map T.Text (Function i)

-- | Given the flag (when that is added function, it is `True`. otherwise `False`), type, identifier token, and `Functions`,
-- 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 `Functions` and return it.
-- If the token does not indicate an identifier, an error indicating internal compiler error is returned.
add :: Num i => Bool -> CT.StorageClass i -> HT.TokenLC i -> Functions i -> Either (ASTError i) (Functions i)
add :: Bool
-> StorageClass i
-> TokenLC i
-> Functions i
-> Either (ASTError i) (Functions i)
add df :: Bool
df t :: StorageClass i
t cur :: TokenLC i
cur@(_, HT.TKIdent ident :: Text
ident) sts :: Functions i
sts = case Text -> Functions i -> Maybe (Function i)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
ident Functions i
sts of
    Just foundFunc :: Function i
foundFunc
        | Bool -> Bool
not (Function i -> Bool
forall a. Function a -> Bool
fnDefined Function i
foundFunc) -> Functions i -> Either (ASTError i) (Functions i)
forall a b. b -> Either a b
Right (Functions i -> Either (ASTError i) (Functions i))
-> Functions i -> Either (ASTError i) (Functions i)
forall a b. (a -> b) -> a -> b
$ Text -> Function i -> Functions i -> Functions i
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident (StorageClass i -> Bool -> Function i
forall a. StorageClass a -> Bool -> Function a
Function StorageClass i
t Bool
True) Functions i
sts
        | Bool
otherwise -> ASTError i -> Either (ASTError i) (Functions 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 -> Functions i -> Either (ASTError i) (Functions i)
forall a b. b -> Either a b
Right (Functions i -> Either (ASTError i) (Functions i))
-> Functions i -> Either (ASTError i) (Functions i)
forall a b. (a -> b) -> a -> b
$ Text -> Function i -> Functions i -> Functions i
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident (StorageClass i -> Bool -> Function i
forall a. StorageClass a -> Bool -> Function a
Function StorageClass i
t Bool
df) Functions i
sts
add _ _ _ _ = ASTError i -> Either (ASTError i) (Functions 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))