{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables,
             TupleSections #-}
{-|
Module      : Htcc.Parser.Parsing.Typedef
Description : The C languge parser and AST constructor
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

Perspective on @typedef@ declaration
-}
module Htcc.Parser.Parsing.Typedef (
    typedef
) where

import           Data.Bits                                       (Bits)

import           Htcc.Parser.AST
import           Htcc.Parser.ConstructionData
import           Htcc.Parser.ConstructionData.Scope.ManagedScope (ASTError)
import           Htcc.Parser.ConstructionData.Scope.Utils        (internalCE)
import           Htcc.Parser.Parsing.Type
import qualified Htcc.Tokenizer                                  as HT
import           Htcc.Utils                                      (maybeToRight,
                                                                  tshow)

-- | Perform type definition from token string starting from @typedef@ token.
-- \[\text{typedef-name}=\text{ident}\]
typedef :: (Integral i, Show i, Read i, Bits i) => [(HT.TokenLCNums i, HT.Token i)] -> ConstructionData i -> Either (ASTError i) ([HT.TokenLC i], ATree a, ConstructionData i)
typedef :: [(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either
     (ASTError i)
     ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
typedef ((_, HT.TKTypedef):cur :: (TokenLCNums i, Token i)
cur@(_, HT.TKReserved _):_) _ = ASTError i
-> Either
     (ASTError i)
     ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
forall a b. a -> Either a b
Left ("storage-class specifier is not allowed in this context", (TokenLCNums i, Token i)
cur)
typedef (cur :: (TokenLCNums i, Token i)
cur@(_, HT.TKTypedef):xs :: [(TokenLCNums i, Token i)]
xs) !ConstructionData i
scp = case [(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLCNums i, Token i),
      [(TokenLCNums i, Token i)], ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)
takeType [(TokenLCNums i, Token i)]
xs ConstructionData i
scp of
    Left er :: ASTError i
er -> ASTError i
-> Either
     (ASTError i)
     ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
forall a b. a -> Either a b
Left ASTError i
er
    Right (ty :: StorageClass i
ty, Just ident :: (TokenLCNums i, Token i)
ident, ds :: [(TokenLCNums i, Token i)]
ds, scp' :: ConstructionData i
scp') -> case [(TokenLCNums i, Token i)]
ds of
        (_, HT.TKReserved ";"):ds' :: [(TokenLCNums i, Token i)]
ds' -> do
            StorageClass i
ty' <- ASTError i
-> Maybe (StorageClass i) -> Either (ASTError i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("incomplete type typedef", (TokenLCNums i, Token i)
ident) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
ty ConstructionData i
scp')
            ([(TokenLCNums i, Token i)]
ds', ATree a
forall a. ATree a
ATEmpty,) (ConstructionData i
 -> ([(TokenLCNums i, Token i)], ATree a, ConstructionData i))
-> Either (ASTError i) (ConstructionData i)
-> Either
     (ASTError i)
     ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> (TokenLCNums i, Token i)
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
forall i.
(Eq i, Num i) =>
StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addTypedef StorageClass i
ty' (TokenLCNums i, Token i)
ident ConstructionData i
scp'
        _ -> ASTError i
-> Either
     (ASTError i)
     ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
forall a b. a -> Either a b
Left ("expected ';' token after '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Token i -> Text
forall a. Show a => a -> Text
tshow ((TokenLCNums i, Token i) -> Token i
forall a b. (a, b) -> b
snd (TokenLCNums i, Token i)
ident) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", (TokenLCNums i, Token i)
ident)
    Right (_, Nothing, ds :: [(TokenLCNums i, Token i)]
ds, scp' :: ConstructionData i
scp') -> case [(TokenLCNums i, Token i)]
ds of
        (_, HT.TKReserved ";"):ds' :: [(TokenLCNums i, Token i)]
ds' -> ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
-> Either
     (ASTError i)
     ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
forall a b. b -> Either a b
Right ([(TokenLCNums i, Token i)]
ds', ATree a
forall a. ATree a
ATEmpty, Text
-> (TokenLCNums i, Token i)
-> ConstructionData i
-> ConstructionData i
forall i.
Text -> TokenLC i -> ConstructionData i -> ConstructionData i
pushWarn "useless type name in empty declaration" (TokenLCNums i, Token i)
cur ConstructionData i
scp')
        _ -> ASTError i
-> Either
     (ASTError i)
     ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
forall a b. a -> Either a b
Left (ASTError i
 -> Either
      (ASTError i)
      ([(TokenLCNums i, Token i)], ATree a, ConstructionData i))
-> ASTError i
-> Either
     (ASTError i)
     ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not ([(TokenLCNums i, Token i)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TokenLCNums i, Token i)]
ds) then ("expected ';' token after '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Token i -> Text
forall a. Show a => a -> Text
tshow ((TokenLCNums i, Token i) -> Token i
forall a b. (a, b) -> b
snd ((TokenLCNums i, Token i) -> Token i)
-> (TokenLCNums i, Token i) -> Token i
forall a b. (a -> b) -> a -> b
$ [(TokenLCNums i, Token i)] -> (TokenLCNums i, Token i)
forall a. [a] -> a
head [(TokenLCNums i, Token i)]
ds) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", [(TokenLCNums i, Token i)] -> (TokenLCNums i, Token i)
forall a. [a] -> a
head [(TokenLCNums i, Token i)]
ds) else ("expected ';' token", (TokenLCNums i, Token i)
forall i. Num i => TokenLC i
HT.emptyToken)
typedef _ _ = ASTError i
-> Either
     (ASTError i)
     ([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
forall a b. a -> Either a b
Left (Text
internalCE, (TokenLCNums i, Token i)
forall i. Num i => TokenLC i
HT.emptyToken)