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

The module of the Type parsing
-}
module Htcc.Parser.Parsing.Type (
    -- * Constant
    ConstantResult,
    constantExp,
    -- * Utilities
    isTypeName,
    -- * Structure and Enum
    takeStructFields,
    takeEnumFiels,
    -- * Declarations
    arrayDeclSuffix,
    absDeclaration,
    declaration,
    -- * Type
    takePreType,
    takeType,
    takeTypeName
) where

import           Data.Bits                                       hiding (shift)
import           Data.Bool                                       (bool)
import qualified Data.Map.Strict                                 as M
import           Data.Maybe                                      (fromJust,
                                                                  fromMaybe,
                                                                  isJust)
import qualified Data.Text                                       as T
import           Data.Tuple.Extra                                (dupe, first,
                                                                  uncurry3)
import           Prelude                                         hiding
                                                                  (toInteger)

import qualified Htcc.CRules.Types                               as CT
import           Htcc.Parser.AST
import           Htcc.Parser.ConstructionData
import           Htcc.Parser.ConstructionData.Scope.ManagedScope (ASTError)
import qualified Htcc.Parser.ConstructionData.Scope.Tag          as PST
import qualified Htcc.Parser.ConstructionData.Scope.Typedef      as PSD
import           Htcc.Parser.ConstructionData.Scope.Utils        (internalCE)
import {-# SOURCE #-} Htcc.Parser.Parsing.Core                        (conditional)
import           Htcc.Parser.Utils
import qualified Htcc.Tokenizer                                  as HT
import           Htcc.Utils                                      (dropFst3,
                                                                  dropFst4,
                                                                  dropSnd3,
                                                                  first3,
                                                                  maybe',
                                                                  maybeToRight,
                                                                  spanLen,
                                                                  toInteger,
                                                                  toNatural,
                                                                  tshow)

-- | \[
-- \begin{array}{ccc}
-- \text{struct-decl}&=&\text{"struct"}\ \text{ident?}\ \left(\text{"\{"}\ \text{struct-member}\ \text{"\}"}\right)\text{?}\\
-- \text{struct-member}&=&\text{pre-type}\ \text{declaration}\ \text{array-decl-suffix}\ \text{";"}
-- \end{array}
-- \]
takeStructFields :: (Integral i, Show i, Read i, Bits i) => [HT.TokenLC i] -> ConstructionData i -> Either (ASTError i) (M.Map T.Text (CT.StructMember i), ConstructionData i)
takeStructFields :: [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
takeStructFields tk :: [TokenLC i]
tk sc :: ConstructionData i
sc = [TokenLC i]
-> ConstructionData i
-> Natural
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
takeStructFields' [TokenLC i]
tk ConstructionData i
sc 0
    where
        takeStructFields' :: [TokenLC i]
-> ConstructionData i
-> Natural
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
takeStructFields' [] scp' :: ConstructionData i
scp' _ = (Map Text (StructMember i), ConstructionData i)
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
forall a b. b -> Either a b
Right (Map Text (StructMember i)
forall k a. Map k a
M.empty, ConstructionData i
scp')
        takeStructFields' fs :: [TokenLC i]
fs scp' :: ConstructionData i
scp' !Natural
n = Either
  (ASTError i)
  (StorageClass i, Maybe (TokenLC i), [TokenLC i],
   ConstructionData i)
-> ((StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)
    -> Either
         (ASTError i) (Map Text (StructMember i), ConstructionData i))
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ([TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLC i), [TokenLC 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 [TokenLC i]
fs ConstructionData i
scp' Either
  (ASTError i)
  (StorageClass i, Maybe (TokenLC i), [TokenLC i],
   ConstructionData i)
-> ((StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)
    -> Either
         (ASTError i)
         (StorageClass i, Maybe (TokenLC i), [TokenLC i],
          ConstructionData i))
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TokenLC i
-> (StorageClass i, Maybe (TokenLC i), [TokenLC i],
    ConstructionData i)
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)
forall i a a c.
(Eq i, Show a) =>
(a, a)
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
     (Text, (a, a))
     (StorageClass i, Maybe (a, a), c, ConstructionData i)
validDecl ([TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
tk)) (((StorageClass i, Maybe (TokenLC i), [TokenLC i],
   ConstructionData i)
  -> Either
       (ASTError i) (Map Text (StructMember i), ConstructionData i))
 -> Either
      (ASTError i) (Map Text (StructMember i), ConstructionData i))
-> ((StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)
    -> Either
         (ASTError i) (Map Text (StructMember i), ConstructionData i))
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \case
            (ty :: StorageClass i
ty@(CT.SCAuto _), Just (_, HT.TKIdent ident :: Text
ident), (_, HT.TKReserved ";"):ds :: [TokenLC i]
ds, scp'' :: ConstructionData i
scp'') -> let ofs :: Natural
ofs = Integer -> Natural
forall i. Integral i => i -> Natural
toNatural (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. (Bits a, Num a, Enum a) => a -> a -> a
CT.alignas (Natural -> Integer
toInteger Natural
n) (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ StorageClass i -> Natural
forall a. CType a => a -> Natural
CT.alignof StorageClass i
ty in
                (Map Text (StructMember i) -> Map Text (StructMember i))
-> (Map Text (StructMember i), ConstructionData i)
-> (Map Text (StructMember i), ConstructionData i)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Text
-> StructMember i
-> Map Text (StructMember i)
-> Map Text (StructMember i)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident (TypeKind i -> Natural -> StructMember i
forall i. TypeKind i -> Natural -> StructMember i
CT.StructMember (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
ty) Natural
ofs)) ((Map Text (StructMember i), ConstructionData i)
 -> (Map Text (StructMember i), ConstructionData i))
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenLC i]
-> ConstructionData i
-> Natural
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
takeStructFields' [TokenLC i]
ds ConstructionData i
scp'' (Natural
ofs Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StorageClass i -> Natural
forall a. CType a => a -> Natural
CT.sizeof StorageClass i
ty))
            (_, Just _, _, _) -> ASTError i
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
forall a b. a -> Either a b
Left ("invalid storage-class specifier", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
fs)
            _ -> ASTError i
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
forall a b. a -> Either a b
Left ("expected member name or ';' after declaration specifiers", [TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
fs)
        validDecl :: (a, a)
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
     (Text, (a, a))
     (StorageClass i, Maybe (a, a), c, ConstructionData i)
validDecl _ (t :: StorageClass i
t, Just ident :: (a, a)
ident, tks :: c
tks, scp :: ConstructionData i
scp) = (Text, (a, a))
-> Maybe (StorageClass i) -> Either (Text, (a, a)) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("declaration with incomplete type", (a, a)
ident) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
t ConstructionData i
scp) Either (Text, (a, a)) (StorageClass i)
-> (StorageClass i
    -> Either
         (Text, (a, a))
         (StorageClass i, Maybe (a, a), c, ConstructionData i))
-> Either
     (Text, (a, a))
     (StorageClass i, Maybe (a, a), c, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t' :: StorageClass i
t' -> if StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
t TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i
forall i. TypeKind i
CT.CTVoid then
            (Text, (a, a))
-> Either
     (Text, (a, a))
     (StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. a -> Either a b
Left ("variable or field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow ((a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
ident) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' declarated void", (a, a)
ident) else (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
     (Text, (a, a))
     (StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. b -> Either a b
Right (StorageClass i
t', (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a, a)
ident, c
tks, ConstructionData i
scp)
        validDecl errPlaceholder :: (a, a)
errPlaceholder (t :: StorageClass i
t, noth :: Maybe (a, a)
noth, tks :: c
tks, scp :: ConstructionData i
scp) = (Text, (a, a))
-> Maybe (StorageClass i) -> Either (Text, (a, a)) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("declaration with incomplete type", (a, a)
errPlaceholder) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
t ConstructionData i
scp) Either (Text, (a, a)) (StorageClass i)
-> (StorageClass i
    -> Either
         (Text, (a, a))
         (StorageClass i, Maybe (a, a), c, ConstructionData i))
-> Either
     (Text, (a, a))
     (StorageClass i, Maybe (a, a), c, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t' :: StorageClass i
t' -> if StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
t TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i
forall i. TypeKind i
CT.CTVoid then
            (Text, (a, a))
-> Either
     (Text, (a, a))
     (StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. a -> Either a b
Left ("declarations of type void is invalid in this context", (a, a)
errPlaceholder) else (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
     (Text, (a, a))
     (StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. b -> Either a b
Right (StorageClass i
t', Maybe (a, a)
noth, c
tks, ConstructionData i
scp)

-- | \[
-- \begin{array}{ccc}
-- \text{enum-specifier}&=&\text{"enum"}\ \text{ident}\ \mid\ \text{"enum"}\ \text{ident?}\ \text{"\{"}\ \text{enum-list?}\ \text{"\}"}\\
-- \text{enum-list}&=&\text{enum-elem}\ \left(\text{","}\ \text{enum-elem}\right)\ast\ \text{","?}\\
-- \text{enum-elem}&=&\text{ident}\ \left(\text{"="}\ \text{const-expr}\right)\text{?}
-- \end{array}
-- \]
takeEnumFiels :: (Integral i, Show i, Read i, Bits i) => CT.StorageClass i -> [HT.TokenLC i] -> ConstructionData i -> Either (ASTError i) (M.Map T.Text i, ConstructionData i)
takeEnumFiels :: StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
takeEnumFiels = i
-> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall i.
(Bits i, Integral i, Show i, Read i) =>
i
-> StorageClass i
-> [(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
takeEnumFiels' 0
    where
        takeEnumFiels' :: i
-> StorageClass i
-> [(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
takeEnumFiels' !i
n ty :: StorageClass i
ty [cur :: (TokenLCNums i, Token i)
cur@(_, HT.TKIdent ident :: Text
ident)] scp :: ConstructionData i
scp = (Text -> i -> Map Text i
forall k a. k -> a -> Map k a
M.singleton Text
ident i
n,) (ConstructionData i -> (Map Text i, ConstructionData i))
-> Either (ASTError i) (ConstructionData i)
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> (TokenLCNums i, Token i)
-> i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addEnumerator StorageClass i
ty (TokenLCNums i, Token i)
cur i
n ConstructionData i
scp
        takeEnumFiels' !i
n ty :: StorageClass i
ty (cur :: (TokenLCNums i, Token i)
cur@(_, HT.TKIdent ident :: Text
ident):(_, HT.TKReserved ","):xs :: [(TokenLCNums i, Token i)]
xs) scp :: ConstructionData i
scp = Either (ASTError i) (Map Text i, ConstructionData i)
-> ((Map Text i, ConstructionData i)
    -> Either (ASTError i) (Map Text i, ConstructionData i))
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (i
-> StorageClass i
-> [(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
takeEnumFiels' (i -> i
forall a. Enum a => a -> a
succ i
n) StorageClass i
ty [(TokenLCNums i, Token i)]
xs ConstructionData i
scp) (((Map Text i, ConstructionData i)
  -> Either (ASTError i) (Map Text i, ConstructionData i))
 -> Either (ASTError i) (Map Text i, ConstructionData i))
-> ((Map Text i, ConstructionData i)
    -> Either (ASTError i) (Map Text i, ConstructionData i))
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \(m :: Map Text i
m, scp' :: ConstructionData i
scp') ->
            (Text -> i -> Map Text i -> Map Text i
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident i
n Map Text i
m,) (ConstructionData i -> (Map Text i, ConstructionData i))
-> Either (ASTError i) (ConstructionData i)
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> (TokenLCNums i, Token i)
-> i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addEnumerator StorageClass i
ty (TokenLCNums i, Token i)
cur i
n ConstructionData i
scp'
        takeEnumFiels' _ ty :: StorageClass i
ty (cur :: (TokenLCNums i, Token i)
cur@(_, HT.TKIdent ident :: Text
ident):(_, HT.TKReserved "="):xs :: [(TokenLCNums i, Token i)]
xs) scp :: ConstructionData i
scp = case [(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either (ConstantResult i) ([(TokenLCNums i, Token i)], i)
forall i.
(Bits i, Integral i, Show i, Read i) =>
[TokenLC i]
-> ConstructionData i -> Either (ConstantResult i) ([TokenLC i], i)
constantExp [(TokenLCNums i, Token i)]
xs ConstructionData i
scp of
            Left (Just err :: ASTError i
err) -> ASTError i -> Either (ASTError i) (Map Text i, ConstructionData i)
forall a b. a -> Either a b
Left ASTError i
err
            Left Nothing -> ASTError i -> Either (ASTError i) (Map Text i, ConstructionData i)
forall a b. a -> Either a b
Left ("The enumerator value for '" 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)
cur) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' is not an integer constant", (TokenLCNums i, Token i)
cur)
            Right ((_, HT.TKReserved ","):ds :: [(TokenLCNums i, Token i)]
ds, val :: i
val) -> Either (ASTError i) (Map Text i, ConstructionData i)
-> ((Map Text i, ConstructionData i)
    -> Either (ASTError i) (Map Text i, ConstructionData i))
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (i
-> StorageClass i
-> [(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
takeEnumFiels' (i -> i
forall a. Enum a => a -> a
succ i
val) StorageClass i
ty [(TokenLCNums i, Token i)]
ds ConstructionData i
scp) (((Map Text i, ConstructionData i)
  -> Either (ASTError i) (Map Text i, ConstructionData i))
 -> Either (ASTError i) (Map Text i, ConstructionData i))
-> ((Map Text i, ConstructionData i)
    -> Either (ASTError i) (Map Text i, ConstructionData i))
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \(m :: Map Text i
m, scp' :: ConstructionData i
scp') ->
                (Text -> i -> Map Text i -> Map Text i
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident i
val Map Text i
m,) (ConstructionData i -> (Map Text i, ConstructionData i))
-> Either (ASTError i) (ConstructionData i)
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> (TokenLCNums i, Token i)
-> i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addEnumerator StorageClass i
ty (TokenLCNums i, Token i)
cur i
val ConstructionData i
scp'
            Right (ds :: [(TokenLCNums i, Token i)]
ds, val :: i
val) -> Either (ASTError i) (Map Text i, ConstructionData i)
-> ((Map Text i, ConstructionData i)
    -> Either (ASTError i) (Map Text i, ConstructionData i))
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (i
-> StorageClass i
-> [(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
takeEnumFiels' (i -> i
forall a. Enum a => a -> a
succ i
val) StorageClass i
ty [(TokenLCNums i, Token i)]
ds ConstructionData i
scp) (((Map Text i, ConstructionData i)
  -> Either (ASTError i) (Map Text i, ConstructionData i))
 -> Either (ASTError i) (Map Text i, ConstructionData i))
-> ((Map Text i, ConstructionData i)
    -> Either (ASTError i) (Map Text i, ConstructionData i))
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \(m :: Map Text i
m, scp' :: ConstructionData i
scp') ->
                (Text -> i -> Map Text i -> Map Text i
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident i
val Map Text i
m,) (ConstructionData i -> (Map Text i, ConstructionData i))
-> Either (ASTError i) (ConstructionData i)
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> (TokenLCNums i, Token i)
-> i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addEnumerator StorageClass i
ty (TokenLCNums i, Token i)
cur i
val ConstructionData i
scp'
        takeEnumFiels' _ _ ds :: [(TokenLCNums i, Token i)]
ds _ = let lst :: (TokenLCNums i, Token i)
lst = if [(TokenLCNums i, Token i)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TokenLCNums i, Token i)]
ds then (TokenLCNums i, Token i)
forall i. Num i => TokenLC i
HT.emptyToken else [(TokenLCNums i, Token i)] -> (TokenLCNums i, Token i)
forall a. [a] -> a
last [(TokenLCNums i, Token i)]
ds in
            ASTError i -> Either (ASTError i) (Map Text i, ConstructionData i)
forall a b. a -> Either a b
Left ("expected enum identifier_opt { enumerator-list } or enum identifier_opt { enumerator-list , }", (TokenLCNums i, Token i)
lst)

{-# INLINE takeCtorPtr #-}
takeCtorPtr :: Integral i => [HT.TokenLC i] -> (CT.StorageClass i -> CT.StorageClass i, [HT.TokenLC i])
takeCtorPtr :: [TokenLC i] -> (StorageClass i -> StorageClass i, [TokenLC i])
takeCtorPtr = (Int -> StorageClass i -> StorageClass i)
-> (Int, [TokenLC i])
-> (StorageClass i -> StorageClass i, [TokenLC i])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Natural -> StorageClass i -> StorageClass i
forall a. CType a => Natural -> a -> a
CT.ctorPtr (Natural -> StorageClass i -> StorageClass i)
-> (Int -> Natural) -> Int -> StorageClass i -> StorageClass i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Natural
forall i. Integral i => i -> Natural
toNatural) ((Int, [TokenLC i])
 -> (StorageClass i -> StorageClass i, [TokenLC i]))
-> ([TokenLC i] -> (Int, [TokenLC i]))
-> [TokenLC i]
-> (StorageClass i -> StorageClass i, [TokenLC i])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [TokenLC i], [TokenLC i]) -> (Int, [TokenLC i])
forall a b c. (a, b, c) -> (a, c)
dropSnd3 ((Int, [TokenLC i], [TokenLC i]) -> (Int, [TokenLC i]))
-> ([TokenLC i] -> (Int, [TokenLC i], [TokenLC i]))
-> [TokenLC i]
-> (Int, [TokenLC i])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenLC i -> Bool)
-> [TokenLC i] -> (Int, [TokenLC i], [TokenLC i])
forall a. (a -> Bool) -> [a] -> (Int, [a], [a])
spanLen ((Token i -> Token i -> Bool
forall a. Eq a => a -> a -> Bool
==Text -> Token i
forall i. Text -> Token i
HT.TKReserved "*") (Token i -> Bool) -> (TokenLC i -> Token i) -> TokenLC i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenLC i -> Token i
forall a b. (a, b) -> b
snd)

-- | It is obtained by parsing the front part of the type from the token string.
-- e.g. @int (*)[4]@ applied to this function yields @int@.
--
-- \[\begin{array}{ccc}
-- \text{pre-type}&=&\text{builtin-type}\ \mid\ \text{struct-decl}\ \mid\ \text{typedef-name}\ \mid\ \text{enum-specifier}\\
-- \text{builtin-type}&=&\text{"void"}\ \mid\ \text{"_Bool"}\ \mid\ \text{"char"}\ \mid\ \text{"short"}\ \mid\ \text{"int"}\ \mid\ \text{"long"}\ \mid\ \text{"long "long"}
-- \end{array}
-- \]
takePreType :: (Integral i, Show i, Read i, Bits i) => [HT.TokenLC i] -> ConstructionData i -> Either (ASTError i) (CT.StorageClass i, [HT.TokenLC i], ConstructionData i)
takePreType :: [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
takePreType ((_, HT.TKType ty1 :: StorageClass i
ty1):y :: TokenLC i
y@(iy :: TokenLCNums i
iy, HT.TKType ty2 :: StorageClass i
ty2):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = ASTError i
-> Maybe (StorageClass i) -> Either (ASTError i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight (Char -> Text
T.singleton '\'' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StorageClass i -> Text
forall a. Show a => a -> Text
tshow StorageClass i
ty1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StorageClass i -> Text
forall a. Show a => a -> Text
tshow StorageClass i
ty2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' is invalid.", TokenLC i
y) (StorageClass i -> StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> a -> Maybe a
CT.qualify StorageClass i
ty1 StorageClass i
ty2) Either (ASTError i) (StorageClass i)
-> (StorageClass i
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ty :: StorageClass i
ty -> -- for a complex type
    [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
takePreType ((TokenLCNums i
iy, StorageClass i -> Token i
forall i. StorageClass i -> Token i
HT.TKType StorageClass i
ty)TokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:[TokenLC i]
xs) ConstructionData i
scp
takePreType ((_, HT.TKType ty :: StorageClass i
ty):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = (StorageClass i, [TokenLC i], ConstructionData i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. b -> Either a b
Right (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind (StorageClass i -> TypeKind i) -> StorageClass i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ StorageClass i -> StorageClass i
forall a. CType a => a -> a
CT.implicitInt StorageClass i
ty, [TokenLC i]
xs, ConstructionData i
scp) -- for fundamental type
takePreType ((_, HT.TKStruct):cur :: TokenLC i
cur@(_, HT.TKReserved "{"):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = ASTError i
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Either
     (ASTError i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall e. e -> Maybe ~> Either e
maybeToRight (Text
internalCE, TokenLC i
cur) (Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall i.
(Integral i, Read i, Show i) =>
Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
takeBrace "{" "}" (TokenLC i
curTokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:[TokenLC i]
xs)) Either (ASTError i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> (Either (TokenLC i) ([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= -- for @struct@ definition
    (TokenLC i
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ASTError i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. a -> Either a b
Left (ASTError i
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (TokenLC i -> ASTError i)
-> TokenLC i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("expected '}' token to match this '{'",)) (\(field :: [TokenLC i]
field, ds :: [TokenLC i]
ds) -> (StorageClass i
 -> ConstructionData i
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> (StorageClass i, ConstructionData i)
-> (StorageClass i, [TokenLC i], ConstructionData i)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (,[TokenLC i]
ds,) ((StorageClass i, ConstructionData i)
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> ((Map Text (StructMember i), ConstructionData i)
    -> (StorageClass i, ConstructionData i))
-> (Map Text (StructMember i), ConstructionData i)
-> (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text (StructMember i) -> StorageClass i)
-> (Map Text (StructMember i), ConstructionData i)
-> (StorageClass i, ConstructionData i)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto (TypeKind i -> StorageClass i)
-> (Map Text (StructMember i) -> TypeKind i)
-> Map Text (StructMember i)
-> StorageClass i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (StructMember i) -> TypeKind i
forall i. Map Text (StructMember i) -> TypeKind i
CT.CTStruct) ((Map Text (StructMember i), ConstructionData i)
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
takeStructFields ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail ([TokenLC i] -> [TokenLC i]) -> [TokenLC i] -> [TokenLC i]
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
init [TokenLC i]
field) ConstructionData i
scp)
takePreType ((_, HT.TKStruct):cur1 :: TokenLC i
cur1@(_, HT.TKIdent ident :: Text
ident):cur2 :: TokenLC i
cur2@(_, HT.TKReserved "{"):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = Either (ASTError i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> (Either (TokenLC i) ([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (ASTError i
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Either
     (ASTError i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall e. e -> Maybe ~> Either e
maybeToRight (Text
internalCE, TokenLC i
cur1) (Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall i.
(Integral i, Read i, Show i) =>
Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
takeBrace "{" "}" (TokenLC i
cur2TokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:[TokenLC i]
xs))) ((Either (TokenLC i) ([TokenLC i], [TokenLC i])
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (Either (TokenLC i) ([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ -- for @struct@ definition with tag
    (TokenLC i
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ASTError i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. a -> Either a b
Left (ASTError i
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (TokenLC i -> ASTError i)
-> TokenLC i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("expected '}' token to match this '{'",)) ((([TokenLC i], [TokenLC i])
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either (TokenLC i) ([TokenLC i], [TokenLC i])
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \(field :: [TokenLC i]
field, ds :: [TokenLC i]
ds) -> Either (ASTError i) (ConstructionData i)
-> (ConstructionData i
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addTag (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ Incomplete i -> TypeKind i
forall i. Incomplete i -> TypeKind i
CT.CTIncomplete (Incomplete i -> TypeKind i) -> Incomplete i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ Text -> Incomplete i
forall i. Text -> Incomplete i
CT.IncompleteStruct Text
ident) TokenLC i
cur1 ConstructionData i
scp) ((ConstructionData i
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (ConstructionData i
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \scp' :: ConstructionData i
scp' ->
        Either (ASTError i) (Map Text (StructMember i), ConstructionData i)
-> ((Map Text (StructMember i), ConstructionData i)
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ([TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (Map Text (StructMember i), ConstructionData i)
takeStructFields ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail ([TokenLC i] -> [TokenLC i]) -> [TokenLC i] -> [TokenLC i]
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
init [TokenLC i]
field) ConstructionData i
scp') (((Map Text (StructMember i), ConstructionData i)
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> ((Map Text (StructMember i), ConstructionData i)
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \(mem :: Map Text (StructMember i)
mem, scp'' :: ConstructionData i
scp'') -> let ty :: StorageClass i
ty = TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ Map Text (StructMember i) -> TypeKind i
forall i. Map Text (StructMember i) -> TypeKind i
CT.CTStruct Map Text (StructMember i)
mem in StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addTag StorageClass i
ty TokenLC i
cur1 ConstructionData i
scp'' Either (ASTError i) (ConstructionData i)
-> (ConstructionData i
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StorageClass i, [TokenLC i], ConstructionData i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. b -> Either a b
Right ((StorageClass i, [TokenLC i], ConstructionData i)
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (ConstructionData i
    -> (StorageClass i, [TokenLC i], ConstructionData i))
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageClass i
ty, [TokenLC i]
ds,)
takePreType ((_, HT.TKStruct):cur1 :: TokenLC i
cur1@(_, HT.TKIdent ident :: Text
ident):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = case Text -> ConstructionData i -> Maybe (Tag i)
forall i. Text -> ConstructionData i -> Maybe (Tag i)
lookupTag Text
ident ConstructionData i
scp of -- for variable declaration with @struct@ tag
    Nothing -> let ty :: StorageClass i
ty = TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ Incomplete i -> TypeKind i
forall i. Incomplete i -> TypeKind i
CT.CTIncomplete (Incomplete i -> TypeKind i) -> Incomplete i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ Text -> Incomplete i
forall i. Text -> Incomplete i
CT.IncompleteStruct Text
ident in Either (ASTError i) (ConstructionData i)
-> (ConstructionData i
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addTag StorageClass i
forall i. StorageClass i
ty TokenLC i
cur1 ConstructionData i
scp) ((ConstructionData i
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (ConstructionData i
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \scp' :: ConstructionData i
scp' -> (StorageClass i, [TokenLC i], ConstructionData i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. b -> Either a b
Right (StorageClass i
forall i. StorageClass i
ty, [TokenLC i]
xs, ConstructionData i
scp')
    Just ty :: Tag i
ty -> (StorageClass i, [TokenLC i], ConstructionData i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. b -> Either a b
Right (Tag i -> StorageClass i
forall i. Tag i -> StorageClass i
PST.sttype Tag i
ty, [TokenLC i]
xs, ConstructionData i
scp)
takePreType (cur :: TokenLC i
cur@(_, HT.TKIdent ident :: Text
ident):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = (, [TokenLC i]
xs, ConstructionData i
scp) (StorageClass i
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> (Typedef i -> StorageClass i)
-> Typedef i
-> (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Typedef i -> StorageClass i
forall a. Typedef a -> StorageClass a
PSD.tdtype (Typedef i -> (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (ASTError i) (Typedef i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTError i -> Maybe (Typedef i) -> Either (ASTError i) (Typedef i)
forall e. e -> Maybe ~> Either e
maybeToRight (Char -> Text
T.singleton '\'' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Token i -> Text
forall a. Show a => a -> Text
tshow (TokenLC i -> Token i
forall a b. (a, b) -> b
snd TokenLC i
cur) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' is not a type or also a typedef identifier", TokenLC i
cur) (Text -> ConstructionData i -> Maybe (Typedef i)
forall i. Text -> ConstructionData i -> Maybe (Typedef i)
lookupTypedef Text
ident ConstructionData i
scp) -- for declaration variable with @typedef@
takePreType ((_, HT.TKEnum):cur :: TokenLC i
cur@(_, HT.TKReserved "{"):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = Either (ASTError i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> (Either (TokenLC i) ([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (ASTError i
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Either
     (ASTError i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall e. e -> Maybe ~> Either e
maybeToRight (Text
internalCE, TokenLC i
cur) (Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall i.
(Integral i, Read i, Show i) =>
Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
takeBrace "{" "}" (TokenLC i
curTokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:[TokenLC i]
xs))) ((Either (TokenLC i) ([TokenLC i], [TokenLC i])
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (Either (TokenLC i) ([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ -- for @enum@
    (TokenLC i
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ASTError i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. a -> Either a b
Left (ASTError i
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (TokenLC i -> ASTError i)
-> TokenLC i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("expected '}' token to match this '{'",)) ((([TokenLC i], [TokenLC i])
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either (TokenLC i) ([TokenLC i], [TokenLC i])
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \(field :: [TokenLC i]
field, ds :: [TokenLC i]
ds) -> (StorageClass i
 -> ConstructionData i
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> (StorageClass i, ConstructionData i)
-> (StorageClass i, [TokenLC i], ConstructionData i)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (,[TokenLC i]
ds,) ((StorageClass i, ConstructionData i)
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> ((Map Text i, ConstructionData i)
    -> (StorageClass i, ConstructionData i))
-> (Map Text i, ConstructionData i)
-> (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text i -> StorageClass i)
-> (Map Text i, ConstructionData i)
-> (StorageClass i, ConstructionData i)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto (TypeKind i -> StorageClass i)
-> (Map Text i -> TypeKind i) -> Map Text i -> StorageClass i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> Map Text i -> TypeKind i
forall i. TypeKind i -> Map Text i -> TypeKind i
CT.CTEnum TypeKind i
forall i. TypeKind i
CT.CTInt) ((Map Text i, ConstructionData i)
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (ASTError i) (Map Text i, ConstructionData i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
takeEnumFiels (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto TypeKind i
forall i. TypeKind i
CT.CTInt) ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail ([TokenLC i] -> [TokenLC i]) -> [TokenLC i] -> [TokenLC i]
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
init [TokenLC i]
field) ConstructionData i
scp
takePreType ((_, HT.TKEnum):cur1 :: TokenLC i
cur1@(_, HT.TKIdent _):cur2 :: TokenLC i
cur2@(_, HT.TKReserved "{"):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = Either (ASTError i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> (Either (TokenLC i) ([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (ASTError i
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Either
     (ASTError i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall e. e -> Maybe ~> Either e
maybeToRight (Text
internalCE, TokenLC i
cur1) (Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall i.
(Integral i, Read i, Show i) =>
Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
takeBrace "{" "}" (TokenLC i
cur2TokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:[TokenLC i]
xs))) ((Either (TokenLC i) ([TokenLC i], [TokenLC i])
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (Either (TokenLC i) ([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ -- for @enum@ with tag
    (TokenLC i
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ASTError i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. a -> Either a b
Left (ASTError i
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (TokenLC i -> ASTError i)
-> TokenLC i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("expected '}' token to match this '{'",)) ((([TokenLC i], [TokenLC i])
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either (TokenLC i) ([TokenLC i], [TokenLC i])
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (([TokenLC i], [TokenLC i])
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \(field :: [TokenLC i]
field, ds :: [TokenLC i]
ds) -> Either (ASTError i) (Map Text i, ConstructionData i)
-> ((Map Text i, ConstructionData i)
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (Map Text i, ConstructionData i)
takeEnumFiels (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto TypeKind i
forall i. TypeKind i
CT.CTInt) ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail ([TokenLC i] -> [TokenLC i]) -> [TokenLC i] -> [TokenLC i]
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
init [TokenLC i]
field) ConstructionData i
scp) (((Map Text i, ConstructionData i)
  -> Either
       (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> ((Map Text i, ConstructionData i)
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \(mem :: Map Text i
mem, scp' :: ConstructionData i
scp') -> let ty :: StorageClass i
ty = TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> Map Text i -> TypeKind i
forall i. TypeKind i -> Map Text i -> TypeKind i
CT.CTEnum TypeKind i
forall i. TypeKind i
CT.CTInt Map Text i
mem in
        StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
forall i.
Num i =>
StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addTag StorageClass i
ty TokenLC i
cur1 ConstructionData i
scp' Either (ASTError i) (ConstructionData i)
-> (ConstructionData i
    -> Either
         (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StorageClass i, [TokenLC i], ConstructionData i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. b -> Either a b
Right ((StorageClass i, [TokenLC i], ConstructionData i)
 -> Either
      (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i))
-> (ConstructionData i
    -> (StorageClass i, [TokenLC i], ConstructionData i))
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageClass i
ty, [TokenLC i]
ds,)
takePreType ((_, HT.TKEnum):cur1 :: TokenLC i
cur1@(_, HT.TKIdent ident :: Text
ident):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = (, [TokenLC i]
xs, ConstructionData i
scp) (StorageClass i
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> (Tag i -> StorageClass i)
-> Tag i
-> (StorageClass i, [TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag i -> StorageClass i
forall i. Tag i -> StorageClass i
PST.sttype (Tag i -> (StorageClass i, [TokenLC i], ConstructionData i))
-> Either (ASTError i) (Tag i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTError i -> Maybe (Tag i) -> Either (ASTError i) (Tag i)
forall e. e -> Maybe ~> Either e
maybeToRight ("storage size of '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' isn't known", TokenLC i
cur1) (Text -> ConstructionData i -> Maybe (Tag i)
forall i. Text -> ConstructionData i -> Maybe (Tag i)
lookupTag Text
ident ConstructionData i
scp) -- declaration for @enum@
takePreType ((_, HT.TKReserved _):cur :: TokenLC i
cur@(_, HT.TKReserved _):_) _ = ASTError i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. a -> Either a b
Left ("cannot combine with previous '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Token i -> Text
forall a. Show a => a -> Text
tshow (TokenLC i -> Token i
forall a b. (a, b) -> b
snd TokenLC i
cur) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' declaration specifier", TokenLC i
cur)
takePreType ((_, HT.TKReserved "static"):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = (StorageClass i -> StorageClass i)
-> (StorageClass i, [TokenLC i], ConstructionData i)
-> (StorageClass i, [TokenLC i], ConstructionData i)
forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
first3 (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCStatic (TypeKind i -> StorageClass i)
-> (StorageClass i -> TypeKind i)
-> StorageClass i
-> StorageClass i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind) ((StorageClass i, [TokenLC i], ConstructionData i)
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
takePreType [TokenLC i]
xs ConstructionData i
scp
takePreType ((_, HT.TKReserved "register"):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = (StorageClass i -> StorageClass i)
-> (StorageClass i, [TokenLC i], ConstructionData i)
-> (StorageClass i, [TokenLC i], ConstructionData i)
forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
first3 (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCRegister (TypeKind i -> StorageClass i)
-> (StorageClass i -> TypeKind i)
-> StorageClass i
-> StorageClass i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind) ((StorageClass i, [TokenLC i], ConstructionData i)
 -> (StorageClass i, [TokenLC i], ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
takePreType [TokenLC i]
xs ConstructionData i
scp
takePreType ((_, HT.TKReserved "auto"):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
takePreType [TokenLC i]
xs ConstructionData i
scp
takePreType (x :: TokenLC i
x:_) _ = ASTError i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. a -> Either a b
Left ("ISO C forbids declaration with no type", TokenLC i
x)
takePreType _ _ = ASTError i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall a b. a -> Either a b
Left ("ISO C forbids declaration with no type", TokenLC i
forall i. Num i => TokenLC i
HT.emptyToken)

{-# INLINE declaration #-}
-- | \[
-- \text{declaration} = \text{"*"*}\ \left(\text{"("}\ \text{declaration}\ \text{")"}\ \mid\ \text{ident}\right)\ \text{array-decl-suffix}
-- \]
declaration :: (Integral i, Bits i, Show i, Read i) => CT.StorageClass i -> [HT.TokenLC i] -> ConstructionData i -> Either (ASTError i) (CT.StorageClass i, Maybe (HT.TokenLC i), [HT.TokenLC i])
declaration :: StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, Maybe (TokenLC i), [TokenLC i])
declaration ty :: StorageClass i
ty xs :: [TokenLC i]
xs scp :: ConstructionData i
scp = case [TokenLC i] -> (StorageClass i -> StorageClass i, [TokenLC i])
forall i.
Integral i =>
[TokenLC i] -> (StorageClass i -> StorageClass i, [TokenLC i])
takeCtorPtr [TokenLC i]
xs of
    (fn :: StorageClass i -> StorageClass i
fn, xs' :: [TokenLC i]
xs'@((_, HT.TKReserved "("):_)) -> (StorageClass i -> StorageClass i, StorageClass i,
 Maybe (TokenLC i), [TokenLC i])
-> (StorageClass i, Maybe (TokenLC i), [TokenLC i])
forall a b c d. (a, b, c, d) -> (b, c, d)
dropFst4 ((StorageClass i -> StorageClass i, StorageClass i,
  Maybe (TokenLC i), [TokenLC i])
 -> (StorageClass i, Maybe (TokenLC i), [TokenLC i]))
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, Maybe (TokenLC i), [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StorageClass i -> StorageClass i)
-> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
forall i c.
(Integral i, Bits i, Show i, Read i) =>
(StorageClass i -> c)
-> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
declaration' StorageClass i -> StorageClass i
forall a. a -> a
id (StorageClass i -> StorageClass i
fn StorageClass i
ty) [TokenLC i]
xs' ConstructionData i
scp
    (fn :: StorageClass i -> StorageClass i
fn, ident :: TokenLC i
ident@(_, HT.TKIdent _):ds' :: [TokenLC i]
ds') -> case StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall i.
(Integral i, Bits i, Show i, Read i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
arrayDeclSuffix (StorageClass i -> StorageClass i
fn StorageClass i
ty) [TokenLC i]
ds' ConstructionData i
scp of
        Nothing -> (StorageClass i, Maybe (TokenLC i), [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, Maybe (TokenLC i), [TokenLC i])
forall a b. b -> Either a b
Right (StorageClass i -> StorageClass i
fn StorageClass i
ty, TokenLC i -> Maybe (TokenLC i)
forall a. a -> Maybe a
Just TokenLC i
ident, [TokenLC i]
ds')
        Just rs :: Either (ASTError i) (StorageClass i, [TokenLC i])
rs -> (StorageClass i
 -> [TokenLC i] -> (StorageClass i, Maybe (TokenLC i), [TokenLC i]))
-> (StorageClass i, [TokenLC i])
-> (StorageClass i, Maybe (TokenLC i), [TokenLC i])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (,TokenLC i -> Maybe (TokenLC i)
forall a. a -> Maybe a
Just TokenLC i
ident,) ((StorageClass i, [TokenLC i])
 -> (StorageClass i, Maybe (TokenLC i), [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, Maybe (TokenLC i), [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (ASTError i) (StorageClass i, [TokenLC i])
rs
    (fn :: StorageClass i -> StorageClass i
fn, es :: [TokenLC i]
es) -> (StorageClass i, Maybe (TokenLC i), [TokenLC i])
-> Either
     (ASTError i) (StorageClass i, Maybe (TokenLC i), [TokenLC i])
forall a b. b -> Either a b
Right (StorageClass i -> StorageClass i
fn StorageClass i
ty, Maybe (TokenLC i)
forall a. Maybe a
Nothing, [TokenLC i]
es)
    where
        declaration' :: (StorageClass i -> c)
-> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
declaration' fn :: StorageClass i -> c
fn ty' :: StorageClass i
ty' xs' :: [TokenLC i]
xs' scp' :: ConstructionData i
scp' = case [TokenLC i] -> (StorageClass i -> StorageClass i, [TokenLC i])
forall i.
Integral i =>
[TokenLC i] -> (StorageClass i -> StorageClass i, [TokenLC i])
takeCtorPtr [TokenLC i]
xs' of
            (ptrf :: StorageClass i -> StorageClass i
ptrf, cur :: TokenLC i
cur@(_, HT.TKReserved "("):ds' :: [TokenLC i]
ds') -> Either
  (ASTError i)
  (StorageClass i -> StorageClass i, StorageClass i,
   Maybe (TokenLC i), [TokenLC i])
-> ((StorageClass i -> StorageClass i, StorageClass i,
     Maybe (TokenLC i), [TokenLC i])
    -> Either
         (ASTError i)
         (StorageClass i -> StorageClass i, StorageClass i,
          Maybe (TokenLC i), [TokenLC i]))
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ((StorageClass i -> c)
-> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
declaration' (StorageClass i -> c
fn (StorageClass i -> c)
-> (StorageClass i -> StorageClass i) -> StorageClass i -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> StorageClass i
ptrf) StorageClass i
ty' [TokenLC i]
ds' ConstructionData i
scp') (((StorageClass i -> StorageClass i, StorageClass i,
   Maybe (TokenLC i), [TokenLC i])
  -> Either
       (ASTError i)
       (StorageClass i -> StorageClass i, StorageClass i,
        Maybe (TokenLC i), [TokenLC i]))
 -> Either
      (ASTError i)
      (StorageClass i -> StorageClass i, StorageClass i,
       Maybe (TokenLC i), [TokenLC i]))
-> ((StorageClass i -> StorageClass i, StorageClass i,
     Maybe (TokenLC i), [TokenLC i])
    -> Either
         (ASTError i)
         (StorageClass i -> StorageClass i, StorageClass i,
          Maybe (TokenLC i), [TokenLC i]))
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
forall a b. (a -> b) -> a -> b
$ \case
                (ptrf' :: StorageClass i -> StorageClass i
ptrf', ty'' :: StorageClass i
ty'', ident :: Maybe (TokenLC i)
ident, (_, HT.TKReserved ")"):ds'' :: [TokenLC i]
ds'') -> case StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall i.
(Integral i, Bits i, Show i, Read i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
arrayDeclSuffix StorageClass i
ty'' [TokenLC i]
ds'' ConstructionData i
scp' of
                    Nothing -> (StorageClass i -> StorageClass i, StorageClass i,
 Maybe (TokenLC i), [TokenLC i])
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
forall a b. b -> Either a b
Right (StorageClass i -> StorageClass i
forall a. a -> a
id, StorageClass i -> StorageClass i
ptrf' StorageClass i
ty', Maybe (TokenLC i)
ident, [TokenLC i]
ds'')
                    Just rs :: Either (ASTError i) (StorageClass i, [TokenLC i])
rs -> (StorageClass i
 -> [TokenLC i]
 -> (StorageClass i -> StorageClass i, StorageClass i,
     Maybe (TokenLC i), [TokenLC i]))
-> (StorageClass i, [TokenLC i])
-> (StorageClass i -> StorageClass i, StorageClass i,
    Maybe (TokenLC i), [TokenLC i])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (StorageClass i -> StorageClass i
forall a. a -> a
id,,Maybe (TokenLC i)
ident,) ((StorageClass i, [TokenLC i])
 -> (StorageClass i -> StorageClass i, StorageClass i,
     Maybe (TokenLC i), [TokenLC i]))
-> ((StorageClass i, [TokenLC i]) -> (StorageClass i, [TokenLC i]))
-> (StorageClass i, [TokenLC i])
-> (StorageClass i -> StorageClass i, StorageClass i,
    Maybe (TokenLC i), [TokenLC i])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageClass i -> StorageClass i)
-> (StorageClass i, [TokenLC i]) -> (StorageClass i, [TokenLC i])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first StorageClass i -> StorageClass i
ptrf' ((StorageClass i, [TokenLC i])
 -> (StorageClass i -> StorageClass i, StorageClass i,
     Maybe (TokenLC i), [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (ASTError i) (StorageClass i, [TokenLC i])
rs
                _ -> ASTError i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
forall a b. a -> Either a b
Left ("expected ')' token for this '('", TokenLC i
cur)
            (ptrf :: StorageClass i -> StorageClass i
ptrf, ident :: TokenLC i
ident@(_, HT.TKIdent _):ds' :: [TokenLC i]
ds') -> case StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall i.
(Integral i, Bits i, Show i, Read i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
arrayDeclSuffix StorageClass i
ty' [TokenLC i]
ds' ConstructionData i
scp' of
                Nothing -> (StorageClass i -> StorageClass i, StorageClass i,
 Maybe (TokenLC i), [TokenLC i])
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
forall a b. b -> Either a b
Right (StorageClass i -> StorageClass i
ptrf, StorageClass i
ty', TokenLC i -> Maybe (TokenLC i)
forall a. a -> Maybe a
Just TokenLC i
ident, [TokenLC i]
ds')
                Just rs :: Either (ASTError i) (StorageClass i, [TokenLC i])
rs -> (StorageClass i
 -> [TokenLC i]
 -> (StorageClass i -> StorageClass i, StorageClass i,
     Maybe (TokenLC i), [TokenLC i]))
-> (StorageClass i, [TokenLC i])
-> (StorageClass i -> StorageClass i, StorageClass i,
    Maybe (TokenLC i), [TokenLC i])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (StorageClass i -> StorageClass i
ptrf,,TokenLC i -> Maybe (TokenLC i)
forall a. a -> Maybe a
Just TokenLC i
ident,) ((StorageClass i, [TokenLC i])
 -> (StorageClass i -> StorageClass i, StorageClass i,
     Maybe (TokenLC i), [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (ASTError i) (StorageClass i, [TokenLC i])
rs
            _ -> ASTError i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i,
      Maybe (TokenLC i), [TokenLC i])
forall a b. a -> Either a b
Left ("expected some identifier", TokenLC i
forall i. Num i => TokenLC i
HT.emptyToken)

-- | `takeType` returns a pair of type (including pointer and array type) and the remaining tokens wrapped in
-- `Just` only if the token starts with `HT.TKType`, `HT.TKStruct` or identifier that is declarated by @typedef@.
-- Otherwise `Nothing` is returned.
--
-- \[
-- \text{type}=\text{pre-type}\ \text{declaration}
-- \]
takeType :: (Integral i, Show i, Read i, Bits i) => [HT.TokenLC i] -> ConstructionData i -> Either (ASTError i) (CT.StorageClass i, Maybe (HT.TokenLC i), [HT.TokenLC i], ConstructionData i)
takeType :: [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)
takeType tk :: [TokenLC i]
tk scp :: ConstructionData i
scp = [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
takePreType [TokenLC i]
tk ConstructionData i
scp Either
  (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
-> ((StorageClass i, [TokenLC i], ConstructionData i)
    -> Either
         (ASTError i)
         (StorageClass i, Maybe (TokenLC i), [TokenLC i],
          ConstructionData i))
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(x :: StorageClass i
x, y :: [TokenLC i]
y, z :: ConstructionData i
z) -> (StorageClass i
 -> Maybe (TokenLC i)
 -> [TokenLC i]
 -> (StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i))
-> (StorageClass i, Maybe (TokenLC i), [TokenLC i])
-> (StorageClass i, Maybe (TokenLC i), [TokenLC i],
    ConstructionData i)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 (,,, ConstructionData i
z) ((StorageClass i, Maybe (TokenLC i), [TokenLC i])
 -> (StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i))
-> Either
     (ASTError i) (StorageClass i, Maybe (TokenLC i), [TokenLC i])
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, Maybe (TokenLC i), [TokenLC i])
forall i.
(Integral i, Bits i, Show i, Read i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, Maybe (TokenLC i), [TokenLC i])
declaration StorageClass i
x [TokenLC i]
y ConstructionData i
z)


-- | `absDeclaration` parses abstract type declarations:
--
-- \[
-- \text{abs-declaration} = \text{"*"*}\ \left(\text{"("}\ \text{abs-declaration}\ \text{")"}\right)\text{?}\ \text{array-decl-suffix}
-- \]
absDeclaration :: (Integral i, Bits i, Show i, Read i) => CT.StorageClass i -> [HT.TokenLC i] -> ConstructionData i -> Either (ASTError i) (CT.StorageClass i, [HT.TokenLC i])
absDeclaration :: StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (StorageClass i, [TokenLC i])
absDeclaration ty :: StorageClass i
ty xs :: [TokenLC i]
xs scp :: ConstructionData i
scp = case [TokenLC i] -> (StorageClass i -> StorageClass i, [TokenLC i])
forall i.
Integral i =>
[TokenLC i] -> (StorageClass i -> StorageClass i, [TokenLC i])
takeCtorPtr [TokenLC i]
xs of
    (fn :: StorageClass i -> StorageClass i
fn, xs' :: [TokenLC i]
xs'@((_, HT.TKReserved "("):_)) -> (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
-> (StorageClass i, [TokenLC i])
forall a b c. (a, b, c) -> (b, c)
dropFst3 ((StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
 -> (StorageClass i, [TokenLC i]))
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StorageClass i -> StorageClass i)
-> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall i c.
(Integral i, Bits i, Show i, Read i) =>
(StorageClass i -> c)
-> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
absDeclarator' StorageClass i -> StorageClass i
forall a. a -> a
id (StorageClass i -> StorageClass i
fn StorageClass i
ty) [TokenLC i]
xs' ConstructionData i
scp
    (fn :: StorageClass i -> StorageClass i
fn, ds :: [TokenLC i]
ds) -> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a. a -> Maybe a -> a
fromMaybe ((StorageClass i, [TokenLC i])
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. b -> Either a b
Right (StorageClass i -> StorageClass i
fn StorageClass i
ty, [TokenLC i]
ds)) (Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
 -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. (a -> b) -> a -> b
$ StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall i.
(Integral i, Bits i, Show i, Read i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
arrayDeclSuffix (StorageClass i -> StorageClass i
fn StorageClass i
ty) [TokenLC i]
ds ConstructionData i
scp
    where
        absDeclarator' :: (StorageClass i -> c)
-> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
absDeclarator' fn :: StorageClass i -> c
fn ty' :: StorageClass i
ty' xs' :: [TokenLC i]
xs' scp' :: ConstructionData i
scp' = case [TokenLC i] -> (StorageClass i -> StorageClass i, [TokenLC i])
forall i.
Integral i =>
[TokenLC i] -> (StorageClass i -> StorageClass i, [TokenLC i])
takeCtorPtr [TokenLC i]
xs' of
            (ptrf :: StorageClass i -> StorageClass i
ptrf, cur :: TokenLC i
cur@(_, HT.TKReserved "("):ds' :: [TokenLC i]
ds') -> Either
  (ASTError i)
  (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
-> ((StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
    -> Either
         (ASTError i)
         (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i]))
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ((StorageClass i -> c)
-> StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
absDeclarator' (StorageClass i -> c
fn (StorageClass i -> c)
-> (StorageClass i -> StorageClass i) -> StorageClass i -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> StorageClass i
ptrf) StorageClass i
ty' [TokenLC i]
ds' ConstructionData i
scp') (((StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
  -> Either
       (ASTError i)
       (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i]))
 -> Either
      (ASTError i)
      (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i]))
-> ((StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
    -> Either
         (ASTError i)
         (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i]))
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall a b. (a -> b) -> a -> b
$ \case
                (ptrf' :: StorageClass i -> StorageClass i
ptrf', ty'' :: StorageClass i
ty'', (_, HT.TKReserved ")"):ds'' :: [TokenLC i]
ds'') -> Either
  (ASTError i)
  (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
-> (Either (ASTError i) (StorageClass i, [TokenLC i])
    -> Either
         (ASTError i)
         (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i]))
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall a b. b -> Either a b
Right (StorageClass i -> StorageClass i
forall a. a -> a
id, StorageClass i -> StorageClass i
ptrf' StorageClass i
ty'', [TokenLC i]
ds'')) (((StorageClass i, [TokenLC i])
 -> (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StorageClass i
 -> [TokenLC i]
 -> (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i]))
-> (StorageClass i, [TokenLC i])
-> (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (StorageClass i -> StorageClass i
forall a. a -> a
id,,) ((StorageClass i, [TokenLC i])
 -> (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i]))
-> ((StorageClass i, [TokenLC i]) -> (StorageClass i, [TokenLC i]))
-> (StorageClass i, [TokenLC i])
-> (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageClass i -> StorageClass i)
-> (StorageClass i, [TokenLC i]) -> (StorageClass i, [TokenLC i])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first StorageClass i -> StorageClass i
ptrf')) (Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
 -> Either
      (ASTError i)
      (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i]))
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall a b. (a -> b) -> a -> b
$ StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall i.
(Integral i, Bits i, Show i, Read i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
arrayDeclSuffix StorageClass i
ty'' [TokenLC i]
ds'' ConstructionData i
scp'
                _ -> ASTError i
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall a b. a -> Either a b
Left ("expected ')' token for this '('", TokenLC i
cur)
            (p :: StorageClass i -> StorageClass i
p, ds :: [TokenLC i]
ds) -> (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
-> Either
     (ASTError i)
     (StorageClass i -> StorageClass i, StorageClass i, [TokenLC i])
forall a b. b -> Either a b
Right (StorageClass i -> StorageClass i
p, StorageClass i
ty', [TokenLC i]
ds)

-- | `takeTypeName` is used to parse type names used for sizeof etc. Version without `takeType`s identifier.
takeTypeName :: (Integral i, Show i, Read i, Bits i) => [HT.TokenLC i] -> ConstructionData i -> Either (ASTError i) (CT.StorageClass i, [HT.TokenLC i])
takeTypeName :: [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (StorageClass i, [TokenLC i])
takeTypeName tk :: [TokenLC i]
tk scp :: ConstructionData i
scp = Either
  (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
-> ((StorageClass i, [TokenLC i], ConstructionData i)
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ([TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i) (StorageClass i, [TokenLC i], ConstructionData i)
takePreType [TokenLC i]
tk ConstructionData i
scp) (((StorageClass i, [TokenLC i], ConstructionData i)
  -> Either (ASTError i) (StorageClass i, [TokenLC i]))
 -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> ((StorageClass i, [TokenLC i], ConstructionData i)
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. (a -> b) -> a -> b
$ \(x :: StorageClass i
x, y :: [TokenLC i]
y, z :: ConstructionData i
z) -> if StorageClass i -> Bool
forall (a :: * -> *) i. StorageClassBase a => a i -> Bool
CT.isSCStatic StorageClass i
x then ASTError i -> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. a -> Either a b
Left ("storage-class specifier is not allowed", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
tk) else StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall i.
(Integral i, Bits i, Show i, Read i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (StorageClass i, [TokenLC i])
absDeclaration StorageClass i
x [TokenLC i]
y ConstructionData i
z -- !

-- | @HT.TKReserved "[", n, HT.TKReserved "]"@ from the beginning of the token sequence.
-- `arrayDeclSuffix` constructs an array type of the given type @t@ based on
-- the token sequence if \(k\leq 1\), wraps it in `Right` and `Just` and returns it with the rest of the token sequence.
-- If the token @HT.TKReserved "["@ exists at the beginning of the token sequence,
-- but the subsequent token sequence is invalid as an array declaration in C programming language,
-- an error mesage and the token at the error location are returned wrapped in
-- `Left` and `Just`. When \(k=0\), `Nothing` is returned.
--
-- \[
-- \text{array-decl-suffix}=\left(\text{"["}\ \text{const-expr?}\ \text{"]"}\ \text{array-decl-suffix}\right)\text{?}
-- \]
arrayDeclSuffix :: forall i. (Integral i, Bits i, Show i, Read i) => CT.StorageClass i -> [HT.TokenLC i] -> ConstructionData i -> Maybe (Either (ASTError i) (CT.StorageClass i, [HT.TokenLC i]))
arrayDeclSuffix :: StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
arrayDeclSuffix t :: StorageClass i
t (cur :: TokenLC i
cur@(_, HT.TKReserved "["):(_, HT.TKReserved "]"):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = case StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall i.
(Integral i, Bits i, Show i, Read i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
arrayDeclSuffix StorageClass i
t [TokenLC i]
xs ConstructionData i
scp of
    Nothing -> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a. a -> Maybe a
Just ((,[TokenLC i]
xs) (StorageClass i -> (StorageClass i, [TokenLC i]))
-> (StorageClass i -> StorageClass i)
-> StorageClass i
-> (StorageClass i, [TokenLC i])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
CT.mapTypeKind (Incomplete i -> TypeKind i
forall i. Incomplete i -> TypeKind i
CT.CTIncomplete (Incomplete i -> TypeKind i)
-> (TypeKind i -> Incomplete i) -> TypeKind i -> TypeKind i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> Incomplete i
forall i. TypeKind i -> Incomplete i
CT.IncompleteArray) (StorageClass i -> (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i)
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTError i
-> Maybe (StorageClass i) -> Either (ASTError i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight (StorageClass i -> ASTError i
forall a. Show a => a -> ASTError i
errSt StorageClass i
t) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
t ConstructionData i
scp))
    Just rs :: Either (ASTError i) (StorageClass i, [TokenLC i])
rs -> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a. a -> Maybe a
Just (Either (ASTError i) (StorageClass i, [TokenLC i])
 -> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i])))
-> (((StorageClass i, [TokenLC i])
     -> Either (ASTError i) (StorageClass i, [TokenLC i]))
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> ((StorageClass i, [TokenLC i])
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ASTError i) (StorageClass i, [TokenLC i])
-> ((StorageClass i, [TokenLC i])
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) Either (ASTError i) (StorageClass i, [TokenLC i])
rs (((StorageClass i, [TokenLC i])
  -> Either (ASTError i) (StorageClass i, [TokenLC i]))
 -> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i])))
-> ((StorageClass i, [TokenLC i])
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a b. (a -> b) -> a -> b
$ \(t' :: StorageClass i
t', ds :: [TokenLC i]
ds) -> (,[TokenLC i]
ds) (StorageClass i -> (StorageClass i, [TokenLC i]))
-> (StorageClass i -> StorageClass i)
-> StorageClass i
-> (StorageClass i, [TokenLC i])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
CT.mapTypeKind ((TypeKind i -> TypeKind i -> TypeKind i)
-> (TypeKind i, TypeKind i) -> TypeKind i
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Maybe (TypeKind i) -> TypeKind i)
-> (TypeKind i -> Maybe (TypeKind i)) -> TypeKind i -> TypeKind i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Maybe (TypeKind i) -> TypeKind i
forall a. HasCallStack => Maybe a -> a
fromJust ((TypeKind i -> Maybe (TypeKind i)) -> TypeKind i -> TypeKind i)
-> (TypeKind i -> TypeKind i -> Maybe (TypeKind i))
-> TypeKind i
-> TypeKind i
-> TypeKind i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> TypeKind i -> Maybe (TypeKind i)
forall (a :: * -> *) i.
(TypeKindBase a, Ord i) =>
a i -> a i -> Maybe (a i)
CT.concatCTArray) ((TypeKind i, TypeKind i) -> TypeKind i)
-> (TypeKind i -> (TypeKind i, TypeKind i))
-> TypeKind i
-> TypeKind i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeKind i -> TypeKind i)
-> (TypeKind i, TypeKind i) -> (TypeKind i, TypeKind i)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Incomplete i -> TypeKind i
forall i. Incomplete i -> TypeKind i
CT.CTIncomplete (Incomplete i -> TypeKind i)
-> (TypeKind i -> Incomplete i) -> TypeKind i -> TypeKind i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> Incomplete i
forall i. TypeKind i -> Incomplete i
CT.IncompleteArray (TypeKind i -> Incomplete i)
-> (TypeKind i -> TypeKind i) -> TypeKind i -> Incomplete i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> TypeKind i
forall a. CType a => a -> a
CT.removeAllExtents) ((TypeKind i, TypeKind i) -> (TypeKind i, TypeKind i))
-> (TypeKind i -> (TypeKind i, TypeKind i))
-> TypeKind i
-> (TypeKind i, TypeKind i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> (TypeKind i, TypeKind i)
forall a. a -> (a, a)
dupe) (StorageClass i -> (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i)
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ASTError i
-> Maybe (StorageClass i) -> Either (ASTError i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight (StorageClass i -> ASTError i
forall a. Show a => a -> ASTError i
errSt StorageClass i
t') (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
t' ConstructionData i
scp)
    where
        errSt :: a -> ASTError i
errSt t' :: a
t' = ("array type has incomplete element type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
t' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", TokenLC i
cur)
arrayDeclSuffix t :: StorageClass i
t (cur :: TokenLC i
cur@(_, HT.TKReserved "["):xs :: [TokenLC i]
xs) scp :: ConstructionData i
scp = case [TokenLC i]
-> ConstructionData i -> Either (ConstantResult i) ([TokenLC i], i)
forall i.
(Bits i, Integral i, Show i, Read i) =>
[TokenLC i]
-> ConstructionData i -> Either (ConstantResult i) ([TokenLC i], i)
constantExp [TokenLC i]
xs ConstructionData i
scp of
    Left (Just err :: ASTError i
err) -> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a. a -> Maybe a
Just (Either (ASTError i) (StorageClass i, [TokenLC i])
 -> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i])))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a b. (a -> b) -> a -> b
$ ASTError i -> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. a -> Either a b
Left ASTError i
err
    Left Nothing -> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a. a -> Maybe a
Just (Either (ASTError i) (StorageClass i, [TokenLC i])
 -> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i])))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a b. (a -> b) -> a -> b
$ ASTError i -> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. a -> Either a b
Left (ASTError i -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> ASTError i -> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. (a -> b) -> a -> b
$ if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
xs then ("The expression is not constant-expression", TokenLC i
cur) else ("The expression '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Token i -> Text
forall a. Show a => a -> Text
tshow (TokenLC i -> Token i
forall a b. (a, b) -> b
snd (TokenLC i -> Token i) -> TokenLC i -> Token i
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' is not constant-expression", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs)
    Right ((_, HT.TKReserved "]"):ds :: [TokenLC i]
ds, val :: i
val) -> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a. a -> Maybe a
Just (Either (ASTError i) (StorageClass i, [TokenLC i])
 -> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i])))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a b. (a -> b) -> a -> b
$ Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
-> (Either (ASTError i) (StorageClass i, [TokenLC i])
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' ((StorageClass i, [TokenLC i])
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. b -> Either a b
Right ((TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
CT.mapTypeKind (Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CT.CTArray (i -> Natural
forall i. Integral i => i -> Natural
toNatural i
val)) StorageClass i
t, [TokenLC i]
ds)) (StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall i.
(Integral i, Bits i, Show i, Read i) =>
StorageClass i
-> [TokenLC i]
-> ConstructionData i
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
arrayDeclSuffix StorageClass i
t [TokenLC i]
ds ConstructionData i
scp) ((Either (ASTError i) (StorageClass i, [TokenLC i])
  -> Either (ASTError i) (StorageClass i, [TokenLC i]))
 -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> (Either (ASTError i) (StorageClass i, [TokenLC i])
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. (a -> b) -> a -> b
$
        (ASTError i -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> ((StorageClass i, [TokenLC i])
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ASTError i -> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. a -> Either a b
Left (((StorageClass i, [TokenLC i])
  -> Either (ASTError i) (StorageClass i, [TokenLC i]))
 -> Either (ASTError i) (StorageClass i, [TokenLC i])
 -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> ((StorageClass i, [TokenLC i])
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. (a -> b) -> a -> b
$ \(t' :: StorageClass i
t', ds' :: [TokenLC i]
ds') -> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (StorageClass i)
-> (StorageClass i
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' (StorageClass i -> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. Show a => a -> Either (ASTError i) b
errSt StorageClass i
t') (StorageClass i -> StorageClass i -> Maybe (StorageClass i)
forall (a :: * -> *) i.
(TypeKindBase a, Ord i) =>
a i -> a i -> Maybe (a i)
CT.concatCTArray ((TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
CT.mapTypeKind (Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CT.CTArray (i -> Natural
forall i. Integral i => i -> Natural
toNatural i
val)) StorageClass i
t) StorageClass i
t') ((StorageClass i
  -> Either (ASTError i) (StorageClass i, [TokenLC i]))
 -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> (StorageClass i
    -> Either (ASTError i) (StorageClass i, [TokenLC i]))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. (a -> b) -> a -> b
$ \ty :: StorageClass i
ty -> if StorageClass i -> Bool
forall (a :: * -> *) i. (IncompleteBase a, Ord i) => a i -> Bool
CT.isValidIncomplete StorageClass i
ty then (StorageClass i, [TokenLC i])
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. b -> Either a b
Right (StorageClass i
ty, [TokenLC i]
ds') else StorageClass i -> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. Show a => a -> Either (ASTError i) b
errSt StorageClass i
t'
    _ -> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a. a -> Maybe a
Just (Either (ASTError i) (StorageClass i, [TokenLC i])
 -> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i])))
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a b. (a -> b) -> a -> b
$ ASTError i -> Either (ASTError i) (StorageClass i, [TokenLC i])
forall a b. a -> Either a b
Left ("expected storage size after '[' token", TokenLC i
cur)
    where
        errSt :: a -> Either (ASTError i) b
errSt t' :: a
t' = ASTError i -> Either (ASTError i) b
forall a b. a -> Either a b
Left ("array type has incomplete element type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
t' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", TokenLC i
cur)
arrayDeclSuffix _ _ _ = Maybe (Either (ASTError i) (StorageClass i, [TokenLC i]))
forall a. Maybe a
Nothing

{-# INLINE isTypeName #-}
-- | `isTypeName` returns @True@ if the token is a type name, @False@ otherwise.
isTypeName :: HT.TokenLC i -> ConstructionData i -> Bool
isTypeName :: TokenLC i -> ConstructionData i -> Bool
isTypeName (_, HT.TKType _) _              = Bool
True
isTypeName (_, HT.TKStruct) _              = Bool
True
isTypeName (_, HT.TKEnum) _                = Bool
True
isTypeName (_, HT.TKReserved "static") _   = Bool
True
isTypeName (_, HT.TKReserved "auto") _     = Bool
True
isTypeName (_, HT.TKReserved "register") _ = Bool
True
isTypeName (_, HT.TKIdent ident :: Text
ident) scp :: ConstructionData i
scp       = Maybe (Typedef i) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Typedef i) -> Bool) -> Maybe (Typedef i) -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> ConstructionData i -> Maybe (Typedef i)
forall i. Text -> ConstructionData i -> Maybe (Typedef i)
lookupTypedef Text
ident ConstructionData i
scp
isTypeName _ _                             = Bool
False

-- | The `Just` represents an error during construction of the syntax tree, and the `Nothing` represents no valid constant expression.
type ConstantResult i = Maybe (ASTError i)

-- | `constantExp` evaluates to a constant expression from token list.
constantExp :: forall i. (Bits i, Integral i, Show i, Read i) => [HT.TokenLC i] -> ConstructionData i -> Either (ConstantResult i) ([HT.TokenLC i], i)
constantExp :: [TokenLC i]
-> ConstructionData i -> Either (ConstantResult i) ([TokenLC i], i)
constantExp tk :: [TokenLC i]
tk scp :: ConstructionData i
scp = ((ASTSuccess i -> Either (ConstantResult i) ([TokenLC i], i))
 -> Either (ASTError i) (ASTSuccess i)
 -> Either (ConstantResult i) ([TokenLC i], i))
-> Either (ASTError i) (ASTSuccess i)
-> (ASTSuccess i -> Either (ConstantResult i) ([TokenLC i], i))
-> Either (ConstantResult i) ([TokenLC i], i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ASTError i -> Either (ConstantResult i) ([TokenLC i], i))
-> (ASTSuccess i -> Either (ConstantResult i) ([TokenLC i], i))
-> Either (ASTError i) (ASTSuccess i)
-> Either (ConstantResult i) ([TokenLC i], i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ConstantResult i -> Either (ConstantResult i) ([TokenLC i], i)
forall a b. a -> Either a b
Left (ConstantResult i -> Either (ConstantResult i) ([TokenLC i], i))
-> (ASTError i -> ConstantResult i)
-> ASTError i
-> Either (ConstantResult i) ([TokenLC i], i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASTError i -> ConstantResult i
forall a. a -> Maybe a
Just)) ([TokenLC i]
-> ATree i
-> ConstructionData i
-> Either (ASTError i) (ASTSuccess i)
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
conditional [TokenLC i]
tk ATree i
forall a. ATree a
ATEmpty ConstructionData i
scp) ((ASTSuccess i -> Either (ConstantResult i) ([TokenLC i], i))
 -> Either (ConstantResult i) ([TokenLC i], i))
-> (ASTSuccess i -> Either (ConstantResult i) ([TokenLC i], i))
-> Either (ConstantResult i) ([TokenLC i], i)
forall a b. (a -> b) -> a -> b
$ \(ds :: [TokenLC i]
ds, at :: ATree i
at, _) ->
    Either (ConstantResult i) ([TokenLC i], i)
-> (i -> Either (ConstantResult i) ([TokenLC i], i))
-> Maybe i
-> Either (ConstantResult i) ([TokenLC i], i)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConstantResult i -> Either (ConstantResult i) ([TokenLC i], i)
forall a b. a -> Either a b
Left ConstantResult i
forall a. Maybe a
Nothing) (([TokenLC i], i) -> Either (ConstantResult i) ([TokenLC i], i)
forall a b. b -> Either a b
Right (([TokenLC i], i) -> Either (ConstantResult i) ([TokenLC i], i))
-> (i -> ([TokenLC i], i))
-> i
-> Either (ConstantResult i) ([TokenLC i], i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TokenLC i]
ds, )) (Maybe i -> Either (ConstantResult i) ([TokenLC i], i))
-> Maybe i -> Either (ConstantResult i) ([TokenLC i], i)
forall a b. (a -> b) -> a -> b
$ ATree i -> Maybe i
evalConstantExp ATree i
at
    where
        evalConstantExp :: ATree i -> Maybe i
        evalConstantExp :: ATree i -> Maybe i
evalConstantExp (ATNode k :: ATKind i
k _ lhs :: ATree i
lhs rhs :: ATree i
rhs) = let fromBool :: Bool -> i
fromBool = Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> i) -> (Bool -> Int) -> Bool -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum :: Bool -> i in case ATKind i
k of
            ATAdd -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop i -> i -> i
forall a. Num a => a -> a -> a
(+)
            ATSub -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop (-)
            ATMul -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop i -> i -> i
forall a. Num a => a -> a -> a
(*)
            ATDiv -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop i -> i -> i
forall a. Integral a => a -> a -> a
div
            ATAnd -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop i -> i -> i
forall a. Bits a => a -> a -> a
(.&.)
            ATXor -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop i -> i -> i
forall a. Bits a => a -> a -> a
xor
            ATOr -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop i -> i -> i
forall a. Bits a => a -> a -> a
(.|.)
            ATShl -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop (((Int -> i) -> (i -> Int) -> i -> i)
-> (i -> Int) -> (Int -> i) -> i -> i
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> i) -> (i -> Int) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> i) -> i -> i) -> (i -> Int -> i) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Int -> i
forall a. Bits a => a -> Int -> a
shiftL)
            ATShr -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop (((Int -> i) -> (i -> Int) -> i -> i)
-> (i -> Int) -> (Int -> i) -> i -> i
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> i) -> (i -> Int) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> i) -> i -> i) -> (i -> Int -> i) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Int -> i
forall a. Bits a => a -> Int -> a
shiftR)
            ATEQ -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop ((Bool -> i) -> (i -> Bool) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Bool -> i
fromBool ((i -> Bool) -> i -> i) -> (i -> i -> Bool) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> Bool
forall a. Eq a => a -> a -> Bool
(==))
            ATNEQ -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop ((Bool -> i) -> (i -> Bool) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Bool -> i
fromBool ((i -> Bool) -> i -> i) -> (i -> i -> Bool) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> Bool
forall a. Eq a => a -> a -> Bool
(/=))
            ATLT -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop ((Bool -> i) -> (i -> Bool) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Bool -> i
fromBool ((i -> Bool) -> i -> i) -> (i -> i -> Bool) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> Bool
forall a. Ord a => a -> a -> Bool
(<))
            ATGT -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop ((Bool -> i) -> (i -> Bool) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Bool -> i
fromBool ((i -> Bool) -> i -> i) -> (i -> i -> Bool) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> Bool
forall a. Ord a => a -> a -> Bool
(>))
            ATLEQ -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop ((Bool -> i) -> (i -> Bool) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Bool -> i
fromBool ((i -> Bool) -> i -> i) -> (i -> i -> Bool) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> Bool
forall a. Ord a => a -> a -> Bool
(<=))
            ATGEQ -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop ((Bool -> i) -> (i -> Bool) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Bool -> i
fromBool ((i -> Bool) -> i -> i) -> (i -> i -> Bool) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> Bool
forall a. Ord a => a -> a -> Bool
(>=))
            ATConditional cn :: ATree i
cn th :: ATree i
th el :: ATree i
el -> ATree i -> Maybe i
evalConstantExp ATree i
cn Maybe i -> (i -> Maybe i) -> Maybe i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe i -> Maybe i -> Bool -> Maybe i
forall a. a -> a -> Bool -> a
bool (ATree i -> Maybe i
evalConstantExp ATree i
el) (ATree i -> Maybe i
evalConstantExp ATree i
th) (Bool -> Maybe i) -> (i -> Bool) -> i -> Maybe i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Bool
forall a. (Eq a, Num a) => a -> Bool
castBool
            ATComma -> ATree i -> Maybe i
evalConstantExp ATree i
rhs
            ATNot ->  Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> i) -> (i -> Int) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool -> Int) -> (i -> Bool) -> i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (i -> Bool) -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Bool
forall a. (Eq a, Num a) => a -> Bool
castBool (i -> i) -> Maybe i -> Maybe i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ATree i -> Maybe i
evalConstantExp ATree i
lhs
            ATBitNot -> i -> i
forall a. Bits a => a -> a
complement (i -> i) -> Maybe i -> Maybe i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ATree i -> Maybe i
evalConstantExp ATree i
lhs
            ATLAnd -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop ((Bool -> i) -> (i -> Bool) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Bool -> i
fromBool ((i -> Bool) -> i -> i) -> (i -> i -> Bool) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> Bool) -> (i -> Bool) -> i -> Bool)
-> (i -> Bool) -> (Bool -> Bool) -> i -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> Bool) -> (i -> Bool) -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) i -> Bool
forall a. (Eq a, Num a) => a -> Bool
castBool ((Bool -> Bool) -> i -> Bool)
-> (i -> Bool -> Bool) -> i -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (i -> Bool) -> i -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Bool
forall a. (Eq a, Num a) => a -> Bool
castBool)
            ATLOr -> (i -> i -> i) -> Maybe i
forall a b. (Integral a, Num b) => (i -> i -> a) -> Maybe b
binop ((Bool -> i) -> (i -> Bool) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Bool -> i
fromBool ((i -> Bool) -> i -> i) -> (i -> i -> Bool) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> Bool) -> (i -> Bool) -> i -> Bool)
-> (i -> Bool) -> (Bool -> Bool) -> i -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> Bool) -> (i -> Bool) -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) i -> Bool
forall a. (Eq a, Num a) => a -> Bool
castBool ((Bool -> Bool) -> i -> Bool)
-> (i -> Bool -> Bool) -> i -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> (i -> Bool) -> i -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Bool
forall a. (Eq a, Num a) => a -> Bool
castBool)
            ATNum v :: i
v -> i -> Maybe i
forall a. a -> Maybe a
Just i
v
            _ -> Maybe i
forall a. Maybe a
Nothing
            where
                binop :: (i -> i -> a) -> Maybe b
binop f :: i -> i -> a
f = Maybe i -> (i -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (ATree i -> Maybe i
evalConstantExp ATree i
lhs) ((i -> Maybe b) -> Maybe b) -> (i -> Maybe b) -> Maybe b
forall a b. (a -> b) -> a -> b
$ \lhs' :: i
lhs' -> a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> b) -> (i -> a) -> i -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> a
f i
lhs' (i -> b) -> Maybe i -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ATree i -> Maybe i
evalConstantExp ATree i
rhs
                castBool :: a -> Bool
castBool x :: a
x | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Bool
False | Bool
otherwise = Bool
True
        evalConstantExp ATEmpty = Maybe i
forall a. Maybe a
Nothing