{-|
Module      : Htcc.CRules.Types.TypeKind
Description : The types of C language
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

The types of C language
-}
{-# LANGUAGE BangPatterns, DeriveGeneric #-}
module Htcc.CRules.Types.TypeKind (
    -- * TypeKind data type
    StructMember (..),
    TypeKind (..),
    Incomplete (..),
    -- * Type classes that can be converted to `TypeKind`
    TypeKindBase (..),
    IncompleteBase (..),
    -- * Lookup functions
    lookupMember,
    -- * Utilities of C type
    alignas,
    Desg (..),
    accessibleIndices,
) where

import           Control.Applicative     ((<|>))
import           Control.DeepSeq         (NFData (..))
import           Data.Bits               (Bits (..), complement, (.&.))
import           Data.Foldable           (Foldable (..))
import           Data.List               (find, intercalate, maximumBy)
import           Data.List.Split         (chunksOf)
import qualified Data.Map                as M
import qualified Data.Text               as T
import           Data.Tree               (Tree (..))
import           Data.Tuple.Extra        (first, second)
import           GHC.Generics            (Generic)
import           Numeric.Natural
import           Prelude                 hiding (toInteger)

import           Htcc.CRules.Char
import           Htcc.CRules.Types.CType
import           Htcc.Utils              (dropFst3, dropSnd3, lor, maybe',
                                          spanLen, toInteger, toNatural)

-- | Class to a type based on `TypeKind`.
class TypeKindBase a where
    -- | `isCTArray` returns `True` when the given argument is `Htcc.CRules.Types.Core.CTArray`.
    -- Otherwise, returns `False`
    isCTArray :: a i -> Bool
    -- | `isArray` return `True` when the given argument is `Htcc.CRules.Types.Core.CTArray` or `IncompleteArray`
    -- Otherwise, returns `False`
    isArray :: a i -> Bool
    -- | `isCTStruct` returns `True` when the given argument is `Htcc.CRules.Types.Core.CTStruct`.
    -- Otherwise, returns `False`
    isCTStruct :: a i -> Bool
    -- | `isCTUndef` returns `True` when the given argument is `Htcc.CRules.Types.Core.CTUndef`.
    -- Otherwise, returns `False`
    isCTUndef :: a i -> Bool
    -- | `isCTIncomplete` returns `True` when the given argument is `Htcc.CRules.Types.CType.CTIncomplete`.
    isCTIncomplete :: a i -> Bool
    -- | `makeCTArray` retunrs a multidimensional array based on the arguments (list of each dimension).
    -- e.g.:
    --
    -- >>> makeCTArray [1, 2] CTInt
    -- int[1][2]
    -- >>> makeCTArray [1, 2] (CTArray 2 CTInt)
    -- int[2][1][2]
    makeCTArray :: [Natural] -> a i -> a i
    -- | Only if both arguments is `Htcc.CRules.Types.Core.CTArray`,
    -- `concatCTArray` returns a new multidimensional array by conbining the types of
    -- multidimensional arrays as follows.
    --
    -- >>> makeCTArray [1, 2] CTInt `concatCTArray` makeCTArray [3, 4] CTInt
    -- Just int[1][2][3][4]
    -- >>> CTInt `concatCTArray` CTArray 2 CTInt
    -- Nothing
    concatCTArray :: Ord i => a i -> a i -> Maybe (a i)
    -- | Convert to `TypeKind`.
    toTypeKind :: a i -> TypeKind i
    -- | Application to `TypeKind`.
    mapTypeKind :: (TypeKind i -> TypeKind j) -> a i -> a j

-- | The type and offset value of a data member.
data StructMember i = StructMember -- ^ `StructMember` constructor
    {
        StructMember i -> TypeKind i
smType   :: TypeKind i, -- ^ The type of a data member
        StructMember i -> Natural
smOffset :: Natural -- ^ The offset of a data member
    } deriving (StructMember i -> StructMember i -> Bool
(StructMember i -> StructMember i -> Bool)
-> (StructMember i -> StructMember i -> Bool)
-> Eq (StructMember i)
forall i. Eq i => StructMember i -> StructMember i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StructMember i -> StructMember i -> Bool
$c/= :: forall i. Eq i => StructMember i -> StructMember i -> Bool
== :: StructMember i -> StructMember i -> Bool
$c== :: forall i. Eq i => StructMember i -> StructMember i -> Bool
Eq, Int -> StructMember i -> ShowS
[StructMember i] -> ShowS
StructMember i -> String
(Int -> StructMember i -> ShowS)
-> (StructMember i -> String)
-> ([StructMember i] -> ShowS)
-> Show (StructMember i)
forall i. Show i => Int -> StructMember i -> ShowS
forall i. Show i => [StructMember i] -> ShowS
forall i. Show i => StructMember i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructMember i] -> ShowS
$cshowList :: forall i. Show i => [StructMember i] -> ShowS
show :: StructMember i -> String
$cshow :: forall i. Show i => StructMember i -> String
showsPrec :: Int -> StructMember i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> StructMember i -> ShowS
Show, ReadPrec [StructMember i]
ReadPrec (StructMember i)
Int -> ReadS (StructMember i)
ReadS [StructMember i]
(Int -> ReadS (StructMember i))
-> ReadS [StructMember i]
-> ReadPrec (StructMember i)
-> ReadPrec [StructMember i]
-> Read (StructMember i)
forall i. (Show i, Read i, Ord i) => ReadPrec [StructMember i]
forall i. (Show i, Read i, Ord i) => ReadPrec (StructMember i)
forall i. (Show i, Read i, Ord i) => Int -> ReadS (StructMember i)
forall i. (Show i, Read i, Ord i) => ReadS [StructMember i]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StructMember i]
$creadListPrec :: forall i. (Show i, Read i, Ord i) => ReadPrec [StructMember i]
readPrec :: ReadPrec (StructMember i)
$creadPrec :: forall i. (Show i, Read i, Ord i) => ReadPrec (StructMember i)
readList :: ReadS [StructMember i]
$creadList :: forall i. (Show i, Read i, Ord i) => ReadS [StructMember i]
readsPrec :: Int -> ReadS (StructMember i)
$creadsPrec :: forall i. (Show i, Read i, Ord i) => Int -> ReadS (StructMember i)
Read, (forall x. StructMember i -> Rep (StructMember i) x)
-> (forall x. Rep (StructMember i) x -> StructMember i)
-> Generic (StructMember i)
forall x. Rep (StructMember i) x -> StructMember i
forall x. StructMember i -> Rep (StructMember i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (StructMember i) x -> StructMember i
forall i x. StructMember i -> Rep (StructMember i) x
$cto :: forall i x. Rep (StructMember i) x -> StructMember i
$cfrom :: forall i x. StructMember i -> Rep (StructMember i) x
Generic)

instance NFData i => NFData (StructMember i)

-- | A class requesting a type that represents an incomplete type.
class IncompleteBase a where
    -- | When the given argument is incomplete array, `isIncompleteArray` returns `True`, otherwise `False`.
    isIncompleteArray :: a i -> Bool
    -- | When the given argument is incmoplete struct, `isIncompleteStruct` returns `True`, otherwise `False`.
    isIncompleteStruct :: a i -> Bool
    -- | Extract the tag name from `IncompleteStruct`. If not `IncompleteStruct`, `Nothing` is retunred.
    fromIncompleteStruct :: a i -> Maybe T.Text
    -- | Extract the type of array from `IncompleteArray`. If not `IncompleteArray`, `Nothing` is retunred.
    fromIncompleteArray :: a i -> Maybe (TypeKind i)
    -- | Returns True if the incomplete type is temporarily valid at the time of declaration. Otherwise returns `False`.
    isValidIncomplete :: Ord i => a i -> Bool

-- | The type representing an incomplete type
data Incomplete i = IncompleteArray (TypeKind i) -- ^ incomplete array, it has a base type.
    | IncompleteStruct T.Text -- ^ incomplete struct, it has a tag name.
    deriving (Incomplete i -> Incomplete i -> Bool
(Incomplete i -> Incomplete i -> Bool)
-> (Incomplete i -> Incomplete i -> Bool) -> Eq (Incomplete i)
forall i. Eq i => Incomplete i -> Incomplete i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Incomplete i -> Incomplete i -> Bool
$c/= :: forall i. Eq i => Incomplete i -> Incomplete i -> Bool
== :: Incomplete i -> Incomplete i -> Bool
$c== :: forall i. Eq i => Incomplete i -> Incomplete i -> Bool
Eq, (forall x. Incomplete i -> Rep (Incomplete i) x)
-> (forall x. Rep (Incomplete i) x -> Incomplete i)
-> Generic (Incomplete i)
forall x. Rep (Incomplete i) x -> Incomplete i
forall x. Incomplete i -> Rep (Incomplete i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (Incomplete i) x -> Incomplete i
forall i x. Incomplete i -> Rep (Incomplete i) x
$cto :: forall i x. Rep (Incomplete i) x -> Incomplete i
$cfrom :: forall i x. Incomplete i -> Rep (Incomplete i) x
Generic)

instance IncompleteBase Incomplete where
    isIncompleteArray :: Incomplete i -> Bool
isIncompleteArray (IncompleteArray _) = Bool
True
    isIncompleteArray _                   = Bool
False
    isIncompleteStruct :: Incomplete i -> Bool
isIncompleteStruct (IncompleteStruct _) = Bool
True
    isIncompleteStruct _                    = Bool
False
    fromIncompleteStruct :: Incomplete i -> Maybe Text
fromIncompleteStruct (IncompleteStruct t :: Text
t) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
    fromIncompleteStruct _                    = Maybe Text
forall a. Maybe a
Nothing
    fromIncompleteArray :: Incomplete i -> Maybe (TypeKind i)
fromIncompleteArray (IncompleteArray t :: TypeKind i
t) = TypeKind i -> Maybe (TypeKind i)
forall a. a -> Maybe a
Just TypeKind i
t
    fromIncompleteArray _                   = Maybe (TypeKind i)
forall a. Maybe a
Nothing
    isValidIncomplete :: Incomplete i -> Bool
isValidIncomplete (IncompleteArray t :: TypeKind i
t) = TypeKind i -> Bool
forall a. CType a => a -> Bool
isFundamental TypeKind i
t
    isValidIncomplete _                   = Bool
True

instance Show i => Show (Incomplete i) where
    show :: Incomplete i -> String
show (IncompleteArray t :: TypeKind i
t)  = TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "[]"
    show (IncompleteStruct t :: Text
t) = Text -> String
T.unpack Text
t

instance NFData i => NFData (Incomplete i)

-- | The kinds of types in C language.
data TypeKind i = CTInt -- ^ The type @int@ as C language
    | CTChar -- ^ The type @char@ as C language
    | CTSigned (TypeKind i) -- ^ The type @signed@ as C language
    | CTShort (TypeKind i) -- ^ The type @short@ as C language
    | CTLong (TypeKind i) -- ^ The type @long@ as C language
    | CTBool -- ^ The type @_Bool@ as C language
    | CTVoid -- ^ The type @void@ as C language
    | CTPtr (TypeKind i) -- ^ The pointer type of `TypeKind`
    | CTArray Natural (TypeKind i) -- ^ The array type
    | CTEnum (TypeKind i) (M.Map T.Text i) -- ^ The enum, has its underlying type and a map
    | CTStruct (M.Map T.Text (StructMember i)) -- ^ The struct, has its members and their names.
    | CTIncomplete (Incomplete i) -- ^ The incomplete type.
    | CTUndef -- ^ Undefined type
    deriving (forall x. TypeKind i -> Rep (TypeKind i) x)
-> (forall x. Rep (TypeKind i) x -> TypeKind i)
-> Generic (TypeKind i)
forall x. Rep (TypeKind i) x -> TypeKind i
forall x. TypeKind i -> Rep (TypeKind i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (TypeKind i) x -> TypeKind i
forall i x. TypeKind i -> Rep (TypeKind i) x
$cto :: forall i x. Rep (TypeKind i) x -> TypeKind i
$cfrom :: forall i x. TypeKind i -> Rep (TypeKind i) x
Generic

{-# INLINE fundamental #-}
fundamental :: [TypeKind i]
fundamental :: [TypeKind i]
fundamental = [TypeKind i
forall i. TypeKind i
CTChar, TypeKind i
forall i. TypeKind i
CTInt, TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTShort TypeKind i
forall i. TypeKind i
CTUndef, TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTLong TypeKind i
forall i. TypeKind i
CTUndef, TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTSigned TypeKind i
forall i. TypeKind i
CTUndef]

{-# INLINE isLongShortable #-}
isLongShortable :: TypeKind i -> Bool
isLongShortable :: TypeKind i -> Bool
isLongShortable CTInt        = Bool
True
isLongShortable CTUndef      = Bool
True
isLongShortable (CTLong x :: TypeKind i
x)   = TypeKind i -> Bool
forall i. TypeKind i -> Bool
isLongShortable TypeKind i
x
isLongShortable (CTShort x :: TypeKind i
x)  = TypeKind i -> Bool
forall i. TypeKind i -> Bool
isLongShortable TypeKind i
x
isLongShortable (CTSigned x :: TypeKind i
x) = TypeKind i -> Bool
forall i. TypeKind i -> Bool
isLongShortable TypeKind i
x
isLongShortable _            = Bool
False

{-# INLINE isShort #-}
isShort :: TypeKind i -> Bool
isShort :: TypeKind i -> Bool
isShort (CTShort _)  = Bool
True
isShort (CTSigned t :: TypeKind i
t) = TypeKind i -> Bool
forall i. TypeKind i -> Bool
isShort TypeKind i
t
isShort _            = Bool
False

{-# INLINE isLong #-}
isLong :: TypeKind i -> Bool
isLong :: TypeKind i -> Bool
isLong (CTLong _)   = Bool
True
isLong (CTSigned t :: TypeKind i
t) = TypeKind i -> Bool
forall i. TypeKind i -> Bool
isLong TypeKind i
t
isLong _            = Bool
False

{-# INLINE isQualifier #-}
isQualifier :: TypeKind i -> Bool
isQualifier :: TypeKind i -> Bool
isQualifier (CTShort _)  = Bool
True
isQualifier (CTLong _)   = Bool
True
isQualifier (CTSigned _) = Bool
True
isQualifier _            = Bool
False

{-# INLINE qual #-}
qual :: TypeKind i -> TypeKind i -> TypeKind i
qual :: TypeKind i -> TypeKind i -> TypeKind i
qual (CTLong x :: TypeKind i
x) t :: TypeKind i
t   = TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTLong (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i -> TypeKind i
qual TypeKind i
x TypeKind i
t
qual (CTShort x :: TypeKind i
x) t :: TypeKind i
t  = TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTShort (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i -> TypeKind i
qual TypeKind i
x TypeKind i
t
qual (CTSigned x :: TypeKind i
x) t :: TypeKind i
t = TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTSigned (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i -> TypeKind i
qual TypeKind i
x TypeKind i
t
qual CTUndef t :: TypeKind i
t      = TypeKind i
t
qual _ _            = String -> TypeKind i
forall a. HasCallStack => String -> a
error "qual: should not reach here"

{-# INLINE removeAllQualified #-}
removeAllQualified :: TypeKind i -> TypeKind i
removeAllQualified :: TypeKind i -> TypeKind i
removeAllQualified (CTLong x :: TypeKind i
x)   = TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
removeAllQualified TypeKind i
x
removeAllQualified (CTShort x :: TypeKind i
x)  = TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
removeAllQualified TypeKind i
x
removeAllQualified (CTSigned x :: TypeKind i
x) = TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
removeAllQualified TypeKind i
x
removeAllQualified x :: TypeKind i
x            = TypeKind i
x

{-# INLINE combTable #-}
combTable :: TypeKind i -> Maybe Int
combTable :: TypeKind i -> Maybe Int
combTable CTChar       = Int -> Maybe Int
forall a. a -> Maybe a
Just 1
combTable CTInt        = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 1 1
combTable CTBool       = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 1 2
combTable CTVoid       = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 1 3
combTable CTUndef      = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 1 4
combTable (CTPtr x :: TypeKind i
x)    = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 1 5 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|.) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeKind i -> Maybe Int
forall i. TypeKind i -> Maybe Int
combTable TypeKind i
x
combTable (CTSigned x :: TypeKind i
x) = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 1 6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|.) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeKind i -> Maybe Int
forall i. TypeKind i -> Maybe Int
combTable TypeKind i
x
combTable (CTLong x :: TypeKind i
x)   = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 1 7 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|.) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeKind i -> Maybe Int
forall i. TypeKind i -> Maybe Int
combTable TypeKind i
x
combTable (CTShort x :: TypeKind i
x)  = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 1 8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|.) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeKind i -> Maybe Int
forall i. TypeKind i -> Maybe Int
combTable TypeKind i
x
combTable _            = Maybe Int
forall a. Maybe a
Nothing

{-# INLINE arSizes #-}
arSizes :: (Num i, Enum i) => TypeKind i -> (i, [[i]])
arSizes :: TypeKind i -> (i, [[i]])
arSizes = i -> TypeKind i -> (i, [[i]])
forall a a i.
(Num a, Enum a, Enum a) =>
a -> TypeKind i -> (a, [[a]])
arSizes' 0
    where
        arSizes' :: a -> TypeKind i -> (a, [[a]])
arSizes' !a
dp (CTArray v :: Natural
v t :: TypeKind i
t) = ([[a]] -> [[a]]) -> (a, [[a]]) -> (a, [[a]])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second ([0..a -> a
forall a. Enum a => a -> a
pred (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Natural -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
v][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:) ((a, [[a]]) -> (a, [[a]])) -> (a, [[a]]) -> (a, [[a]])
forall a b. (a -> b) -> a -> b
$ a -> TypeKind i -> (a, [[a]])
arSizes' (a -> a
forall a. Enum a => a -> a
succ a
dp) TypeKind i
t
        arSizes' !a
dp _ = (a
dp, [])

-- | The type of designator
data Desg i = DesgIdx i -- ^ index type
    | DesgMem (StructMember i) -- ^ struct member type
    deriving Desg i -> Desg i -> Bool
(Desg i -> Desg i -> Bool)
-> (Desg i -> Desg i -> Bool) -> Eq (Desg i)
forall i. Eq i => Desg i -> Desg i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Desg i -> Desg i -> Bool
$c/= :: forall i. Eq i => Desg i -> Desg i -> Bool
== :: Desg i -> Desg i -> Bool
$c== :: forall i. Eq i => Desg i -> Desg i -> Bool
Eq

instance (Eq i, Ord i, Integral i) => Ord (Desg i) where
    compare :: Desg i -> Desg i -> Ordering
compare (DesgIdx x :: i
x) (DesgIdx y :: i
y) = i -> i -> Ordering
forall a. Ord a => a -> a -> Ordering
compare i
x i
y
    compare (DesgMem mem :: StructMember i
mem) y :: Desg i
y = Desg i -> Desg i -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (i -> Desg i
forall i. i -> Desg i
DesgIdx (i -> Desg i) -> i -> Desg i
forall a b. (a -> b) -> a -> b
$ Natural -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> i) -> Natural -> i
forall a b. (a -> b) -> a -> b
$ StructMember i -> Natural
forall i. StructMember i -> Natural
smOffset StructMember i
mem) Desg i
y
    compare x :: Desg i
x (DesgMem mem :: StructMember i
mem) = Desg i -> Desg i -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Desg i
x (i -> Desg i
forall i. i -> Desg i
DesgIdx (i -> Desg i) -> i -> Desg i
forall a b. (a -> b) -> a -> b
$ Natural -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> i) -> Natural -> i
forall a b. (a -> b) -> a -> b
$ StructMember i -> Natural
forall i. StructMember i -> Natural
smOffset StructMember i
mem)

instance (Enum i, Integral i) => Enum (Desg i) where
    toEnum :: Int -> Desg i
toEnum = i -> Desg i
forall i. i -> Desg i
DesgIdx (i -> Desg i) -> (Int -> i) -> Int -> Desg i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromEnum :: Desg i -> Int
fromEnum (DesgIdx x :: i
x)   = i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
x
    fromEnum (DesgMem mem :: StructMember i
mem) = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int) -> Natural -> Int
forall a b. (a -> b) -> a -> b
$ StructMember i -> Natural
forall i. StructMember i -> Natural
smOffset StructMember i
mem

-- | If the given argument is `CTArray`, it returns a list of accessible indexes of the array.
-- Othrewise returns empty list.
accessibleIndices :: Integral i => TypeKind i -> [[Desg i]]
accessibleIndices :: TypeKind i -> [[Desg i]]
accessibleIndices = (Int -> [[Desg i]] -> [[Desg i]])
-> (Int, [[Desg i]]) -> [[Desg i]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([Desg i] -> [[Desg i]]) -> [[Desg i]] -> [[Desg i]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Desg i] -> [[Desg i]]) -> [[Desg i]] -> [[Desg i]])
-> (Int -> [Desg i] -> [[Desg i]])
-> Int
-> [[Desg i]]
-> [[Desg i]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Desg i] -> [[Desg i]]
forall e. Int -> [e] -> [[e]]
chunksOf) ((Int, [[Desg i]]) -> [[Desg i]])
-> (TypeKind i -> (Int, [[Desg i]])) -> TypeKind i -> [[Desg i]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Int) -> (i, [[Desg i]]) -> (Int, [[Desg i]])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((i, [[Desg i]]) -> (Int, [[Desg i]]))
-> (TypeKind i -> (i, [[Desg i]]))
-> TypeKind i
-> (Int, [[Desg i]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[i]] -> [[Desg i]]) -> (i, [[i]]) -> (i, [[Desg i]])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second ((Tree i -> [[Desg i]]) -> [Tree i] -> [[Desg i]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Tree i -> [Desg i]) -> [Tree i] -> [[Desg i]]
forall a b. (a -> b) -> [a] -> [b]
map (([Desg i] -> [Desg i]) -> Tree i -> [Desg i]
forall i. ([Desg i] -> [Desg i]) -> Tree i -> [Desg i]
iNode' [Desg i] -> [Desg i]
forall a. a -> a
id) ([Tree i] -> [[Desg i]])
-> (Tree i -> [Tree i]) -> Tree i -> [[Desg i]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree i -> Tree i) -> Tree i -> [Tree i]
forall a. (Tree a -> Tree a) -> Tree a -> [Tree a]
iNode Tree i -> Tree i
forall a. a -> a
id) ([Tree i] -> [[Desg i]])
-> ([[i]] -> [Tree i]) -> [[i]] -> [[Desg i]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[i]] -> [Tree i]
forall a. [[a]] -> Forest a
arIndices') ((i, [[i]]) -> (i, [[Desg i]]))
-> (TypeKind i -> (i, [[i]])) -> TypeKind i -> (i, [[Desg i]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> (i, [[i]])
forall i. (Num i, Enum i) => TypeKind i -> (i, [[i]])
arSizes
    where
        arIndices' :: [[a]] -> Forest a
arIndices' []     = []
        arIndices' (x :: [a]
x:xs :: [[a]]
xs) = (a -> Tree a) -> [a] -> Forest a
forall a b. (a -> b) -> [a] -> [b]
map (((Forest a -> Tree a) -> Forest a -> Tree a)
-> Forest a -> (Forest a -> Tree a) -> Tree a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Forest a -> Tree a) -> Forest a -> Tree a
forall a b. (a -> b) -> a -> b
($) ([[a]] -> Forest a
arIndices' [[a]]
xs) ((Forest a -> Tree a) -> Tree a)
-> (a -> Forest a -> Tree a) -> a -> Tree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node) [a]
x

        iNode :: (Tree a -> Tree a) -> Tree a -> [Tree a]
iNode f :: Tree a -> Tree a
f x :: Tree a
x@(Node _ []) = [Tree a -> Tree a
f Tree a
x]
        iNode f :: Tree a -> Tree a
f (Node v :: a
v xs :: [Tree a]
xs@(Node _ []:_)) = [a -> [Tree a] -> Tree a
forall a. a -> Forest a -> Tree a
Node a
v ([Tree a] -> Tree a) -> [Tree a] -> Tree a
forall a b. (a -> b) -> a -> b
$ (Tree a -> Tree a) -> [Tree a] -> [Tree a]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Tree a
f [Tree a]
xs]
        iNode f :: Tree a -> Tree a
f (Node v :: a
v (x :: Tree a
x:xs :: [Tree a]
xs)) = (Tree a -> Tree a) -> Tree a -> [Tree a]
iNode (a -> [Tree a] -> Tree a
forall a. a -> Forest a -> Tree a
Node a
v ([Tree a] -> Tree a) -> (Tree a -> [Tree a]) -> Tree a -> Tree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> [Tree a] -> [Tree a]
forall a. a -> [a] -> [a]
:[]) (Tree a -> [Tree a]) -> (Tree a -> Tree a) -> Tree a -> [Tree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Tree a
f) Tree a
x [Tree a] -> [Tree a] -> [Tree a]
forall a. [a] -> [a] -> [a]
++ (Tree a -> [Tree a]) -> [Tree a] -> [Tree a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Tree a -> Tree a) -> Tree a -> [Tree a]
iNode (a -> [Tree a] -> Tree a
forall a. a -> Forest a -> Tree a
Node a
v ([Tree a] -> Tree a) -> (Tree a -> [Tree a]) -> Tree a -> Tree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> [Tree a] -> [Tree a]
forall a. a -> [a] -> [a]
:[]) (Tree a -> [Tree a]) -> (Tree a -> Tree a) -> Tree a -> [Tree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Tree a
f)) [Tree a]
xs

        iNode' :: ([Desg i] -> [Desg i]) -> Tree i -> [Desg i]
iNode' f :: [Desg i] -> [Desg i]
f (Node v :: i
v []) = [Desg i] -> [Desg i]
f [i -> Desg i
forall i. i -> Desg i
DesgIdx i
v]
        iNode' f :: [Desg i] -> [Desg i]
f (Node v :: i
v t :: Forest i
t)  = (Tree i -> [Desg i]) -> Forest i -> [Desg i]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Desg i] -> [Desg i]) -> Tree i -> [Desg i]
iNode' ((i -> Desg i
forall i. i -> Desg i
DesgIdx i
vDesg i -> [Desg i] -> [Desg i]
forall a. a -> [a] -> [a]
:) ([Desg i] -> [Desg i])
-> ([Desg i] -> [Desg i]) -> [Desg i] -> [Desg i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Desg i] -> [Desg i]
f)) Forest i
t

instance Eq i => Eq (TypeKind i) where
    == :: TypeKind i -> TypeKind i -> Bool
(==) CTInt CTInt = Bool
True
    (==) CTChar CTChar = Bool
True
    (==) CTBool CTBool = Bool
True
    (==) CTVoid CTVoid = Bool
True
    (==) (CTEnum ut1 :: TypeKind i
ut1 m1 :: Map Text i
m1) (CTEnum ut2 :: TypeKind i
ut2 m2 :: Map Text i
m2) = TypeKind i
ut1 TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i
ut2 Bool -> Bool -> Bool
&& Map Text i
m1 Map Text i -> Map Text i -> Bool
forall a. Eq a => a -> a -> Bool
== Map Text i
m2
    (==) (CTArray v1 :: Natural
v1 t1 :: TypeKind i
t1) (CTArray v2 :: Natural
v2 t2 :: TypeKind i
t2) = Natural
v1 Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
v2 Bool -> Bool -> Bool
&& TypeKind i
t1 TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i
t2
    (==) (CTStruct m1 :: Map Text (StructMember i)
m1) (CTStruct m2 :: Map Text (StructMember i)
m2) = Map Text (StructMember i)
m1 Map Text (StructMember i) -> Map Text (StructMember i) -> Bool
forall a. Eq a => a -> a -> Bool
== Map Text (StructMember i)
m2
    (==) CTUndef CTUndef = Bool
True
    (==) (CTPtr t1 :: TypeKind i
t1) (CTPtr t2 :: TypeKind i
t2) = TypeKind i
t1 TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i
t2
    (==) (CTIncomplete t1 :: Incomplete i
t1) (CTIncomplete t2 :: Incomplete i
t2) = Incomplete i
t1 Incomplete i -> Incomplete i -> Bool
forall a. Eq a => a -> a -> Bool
== Incomplete i
t2
    (==) l :: TypeKind i
l r :: TypeKind i
r
        | TypeKind i -> Bool
forall i. TypeKind i -> Bool
isQualifier TypeKind i
l Bool -> Bool -> Bool
|| TypeKind i -> Bool
forall i. TypeKind i -> Bool
isQualifier TypeKind i
r = Bool -> Maybe Int -> (Int -> Bool) -> Bool
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' Bool
False (TypeKind i -> Maybe Int
forall i. TypeKind i -> Maybe Int
combTable TypeKind i
l) ((Int -> Bool) -> Bool) -> (Int -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \lh :: Int
lh ->
            Bool -> Maybe Int -> (Int -> Bool) -> Bool
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' Bool
False (TypeKind i -> Maybe Int
forall i. TypeKind i -> Maybe Int
combTable TypeKind i
r) ((Int -> Bool) -> Bool) -> (Int -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \rh :: Int
rh -> Int
lh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rh
        | Bool
otherwise = Bool
False

instance Show i => Show (TypeKind i) where
    show :: TypeKind i -> String
show CTInt = "int"
    show CTChar = "char"
    show (CTSigned CTUndef) = "signed"
    show (CTSigned t :: TypeKind i
t) = "signed " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
t
    show (CTShort CTUndef) = "short"
    show (CTShort t :: TypeKind i
t) = "short " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
t
    show (CTLong CTUndef) = "long"
    show (CTLong t :: TypeKind i
t) = "long " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
t
    show CTBool = "_Bool"
    show CTVoid = "void"
    show (CTPtr x :: TypeKind i
x) = TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "*"
    show (CTArray v :: Natural
v t :: TypeKind i
t) = TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Natural -> String
forall a. Show a => a -> String
show Natural
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]"
    show (CTEnum _ m :: Map Text i
m) = "enum { " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ Map Text i -> [Text]
forall k a. Map k a -> [k]
M.keys Map Text i
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " }"
    show (CTStruct m :: Map Text (StructMember i)
m) = "struct { " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((Text, StructMember i) -> String)
-> [(Text, StructMember i)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(v :: Text
v, inf :: StructMember i
inf) -> TypeKind i -> String
forall a. Show a => a -> String
show (StructMember i -> TypeKind i
forall i. StructMember i -> TypeKind i
smType StructMember i
inf) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ "; ") (Map Text (StructMember i) -> [(Text, StructMember i)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text (StructMember i)
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}"
    show (CTIncomplete t :: Incomplete i
t) = Incomplete i -> String
forall a. Show a => a -> String
show Incomplete i
t
    show CTUndef = "undefined"

instance (Show i, Read i, Ord i) => Read (TypeKind i) where
    readsPrec :: Int -> ReadS (TypeKind i)
readsPrec _ xs :: String
xs = let (ys :: String
ys, ds :: String
ds) = (Int, String, String) -> (String, String)
forall a b c. (a, b, c) -> (b, c)
dropFst3 ((Int, String, String) -> (String, String))
-> (Int, String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (Int, String, String)
forall a. (a -> Bool) -> [a] -> (Int, [a], [a])
spanLen Char -> Bool
isValidChar String
xs in
        [(TypeKind i, String)]
-> Maybe (TypeKind i)
-> (TypeKind i -> [(TypeKind i, String)])
-> [(TypeKind i, String)]
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' (ReadS (TypeKind i)
forall a. HasCallStack => String -> a
error "no parse pattern by TypeKind") ((TypeKind i -> Bool) -> [TypeKind i] -> Maybe (TypeKind i)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String
ysString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (TypeKind i -> String) -> TypeKind i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> String
forall a. Show a => a -> String
show) [TypeKind i]
forall i. [TypeKind i]
fundamental) ((TypeKind i -> [(TypeKind i, String)]) -> [(TypeKind i, String)])
-> (TypeKind i -> [(TypeKind i, String)]) -> [(TypeKind i, String)]
forall a b. (a -> b) -> a -> b
$ \x :: TypeKind i
x ->
            [(Int -> TypeKind i) -> (Int, String) -> (TypeKind i, String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (((TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i)
-> TypeKind i -> (TypeKind i -> TypeKind i) -> TypeKind i
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a. a -> a
id TypeKind i
x ((TypeKind i -> TypeKind i) -> TypeKind i)
-> (Int -> TypeKind i -> TypeKind i) -> Int -> TypeKind i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> TypeKind i -> TypeKind i
forall a. CType a => Natural -> a -> a
ctorPtr (Natural -> TypeKind i -> TypeKind i)
-> (Int -> Natural) -> Int -> TypeKind i -> TypeKind i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Natural
forall i. Integral i => i -> Natural
toNatural) ((Int, String) -> (TypeKind i, String))
-> (Int, String) -> (TypeKind i, String)
forall a b. (a -> b) -> a -> b
$ (Int, String, String) -> (Int, String)
forall a b c. (a, b, c) -> (a, c)
dropSnd3 ((Int, String, String) -> (Int, String))
-> (Int, String, String) -> (Int, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (Int, String, String)
forall a. (a -> Bool) -> [a] -> (Int, [a], [a])
spanLen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='*') String
ds]

instance Ord i => Ord (TypeKind i) where
    compare :: TypeKind i -> TypeKind i -> Ordering
compare x :: TypeKind i
x = Natural -> Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof TypeKind i
x) (Natural -> Ordering)
-> (TypeKind i -> Natural) -> TypeKind i -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof

instance NFData i => NFData (TypeKind i)

instance Ord i => CType (TypeKind i) where
    qualify :: TypeKind i -> TypeKind i -> Maybe (TypeKind i)
qualify = (Maybe (TypeKind i, TypeKind i) -> Maybe (TypeKind i))
-> (TypeKind i -> Maybe (TypeKind i, TypeKind i))
-> TypeKind i
-> Maybe (TypeKind i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((TypeKind i, TypeKind i) -> TypeKind i)
-> Maybe (TypeKind i, TypeKind i) -> Maybe (TypeKind i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TypeKind i -> TypeKind i -> TypeKind i)
-> (TypeKind i, TypeKind i) -> TypeKind i
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TypeKind i -> TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i -> TypeKind i
qual)) ((TypeKind i -> Maybe (TypeKind i, TypeKind i))
 -> TypeKind i -> Maybe (TypeKind i))
-> (TypeKind i -> TypeKind i -> Maybe (TypeKind i, TypeKind i))
-> TypeKind i
-> TypeKind i
-> Maybe (TypeKind i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> TypeKind i -> Maybe (TypeKind i, TypeKind i)
forall i.
Ord i =>
TypeKind i -> TypeKind i -> Maybe (TypeKind i, TypeKind i)
maxQual
        where
            maxQual :: TypeKind i -> TypeKind i -> Maybe (TypeKind i, TypeKind i)
maxQual CTChar (CTSigned CTUndef) = (TypeKind i, TypeKind i) -> Maybe (TypeKind i, TypeKind i)
forall a. a -> Maybe a
Just (TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTSigned TypeKind i
forall i. TypeKind i
CTUndef, TypeKind i
forall i. TypeKind i
CTChar)
            maxQual (CTSigned CTUndef) CTChar = (TypeKind i, TypeKind i) -> Maybe (TypeKind i, TypeKind i)
forall a. a -> Maybe a
Just (TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTSigned TypeKind i
forall i. TypeKind i
CTUndef, TypeKind i
forall i. TypeKind i
CTChar)
            maxQual ty1 :: TypeKind i
ty1 ty2 :: TypeKind i
ty2
                | TypeKind i -> Bool
forall i. TypeKind i -> Bool
isShort TypeKind i
ty1 Bool -> Bool -> Bool
&& TypeKind i -> Bool
forall i. TypeKind i -> Bool
isLong TypeKind i
ty2 Bool -> Bool -> Bool
|| TypeKind i -> Bool
forall i. TypeKind i -> Bool
isShort TypeKind i
ty2 Bool -> Bool -> Bool
&& TypeKind i -> Bool
forall i. TypeKind i -> Bool
isLong TypeKind i
ty1 = Maybe (TypeKind i, TypeKind i)
forall a. Maybe a
Nothing
                | TypeKind i -> Bool
forall i. TypeKind i -> Bool
isQualifier TypeKind i
ty1 Bool -> Bool -> Bool
&& TypeKind i -> Bool
forall i. TypeKind i -> Bool
isQualifier TypeKind i
ty2 Bool -> Bool -> Bool
&& TypeKind i -> Bool
forall i. TypeKind i -> Bool
isLongShortable (TypeKind i -> TypeKind i -> TypeKind i
forall a. Ord a => a -> a -> a
max TypeKind i
ty1 TypeKind i
ty2) = (TypeKind i, TypeKind i) -> Maybe (TypeKind i, TypeKind i)
forall a. a -> Maybe a
Just (TypeKind i -> TypeKind i -> TypeKind i
forall a. Ord a => a -> a -> a
min TypeKind i
ty1 TypeKind i
ty2, TypeKind i -> TypeKind i -> TypeKind i
forall a. Ord a => a -> a -> a
max TypeKind i
ty1 TypeKind i
ty2)
                | Bool
otherwise = TypeKind i -> TypeKind i -> Maybe (TypeKind i, TypeKind i)
forall i i.
TypeKind i -> TypeKind i -> Maybe (TypeKind i, TypeKind i)
f TypeKind i
ty1 TypeKind i
ty2 Maybe (TypeKind i, TypeKind i)
-> Maybe (TypeKind i, TypeKind i) -> Maybe (TypeKind i, TypeKind i)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeKind i -> TypeKind i -> Maybe (TypeKind i, TypeKind i)
forall i i.
TypeKind i -> TypeKind i -> Maybe (TypeKind i, TypeKind i)
f TypeKind i
ty2 TypeKind i
ty1
                where
                    f :: TypeKind i -> TypeKind i -> Maybe (TypeKind i, TypeKind i)
f t :: TypeKind i
t u :: TypeKind i
u
                        | TypeKind i -> Bool
forall i. TypeKind i -> Bool
isQualifier TypeKind i
t Bool -> Bool -> Bool
&& TypeKind i -> Bool
forall i. TypeKind i -> Bool
isLongShortable TypeKind i
u = (TypeKind i, TypeKind i) -> Maybe (TypeKind i, TypeKind i)
forall a. a -> Maybe a
Just (TypeKind i
t, TypeKind i
u)
                        | Bool
otherwise = Maybe (TypeKind i, TypeKind i)
forall a. Maybe a
Nothing

    {-# INLINE isFundamental #-}
    isFundamental :: TypeKind i -> Bool
isFundamental = (TypeKind i -> [TypeKind i] -> Bool)
-> [TypeKind i] -> TypeKind i -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeKind i -> [TypeKind i] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [TypeKind i
forall i. TypeKind i
CTChar, TypeKind i
forall i. TypeKind i
CTInt, TypeKind i
forall i. TypeKind i
CTBool] (TypeKind i -> Bool)
-> (TypeKind i -> TypeKind i) -> TypeKind i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
removeAllQualified

    sizeof :: TypeKind i -> Natural
sizeof CTInt = 4
    sizeof CTChar = 1
    sizeof (CTSigned x :: TypeKind i
x) = TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof TypeKind i
x
    sizeof (CTShort CTInt) = 2
    sizeof (CTShort (CTSigned x :: TypeKind i
x)) = TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof (TypeKind i -> Natural) -> TypeKind i -> Natural
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTShort TypeKind i
x
    sizeof (CTLong CTInt) = 8
    sizeof (CTLong (CTSigned x :: TypeKind i
x)) = TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof (TypeKind i -> Natural) -> TypeKind i -> Natural
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTLong TypeKind i
x
    sizeof (CTLong x :: TypeKind i
x) = TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof TypeKind i
x
    sizeof CTBool = 1
    sizeof CTVoid = 1 -- Non standard
    sizeof (CTPtr _) = 8
    sizeof (CTArray v :: Natural
v t :: TypeKind i
t) = Natural
v Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof TypeKind i
t
    sizeof (CTEnum t :: TypeKind i
t _) = TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof TypeKind i
t
    sizeof t :: TypeKind i
t@(CTStruct m :: Map Text (StructMember i)
m)
        | Map Text (StructMember i) -> Bool
forall k a. Map k a -> Bool
M.null Map Text (StructMember i)
m = 1
        | Bool
otherwise = let sn :: StructMember i
sn = (StructMember i -> StructMember i -> Ordering)
-> [StructMember i] -> StructMember i
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Natural -> Ordering)
 -> (StructMember i -> Natural) -> StructMember i -> Ordering)
-> (StructMember i -> Natural)
-> (Natural -> Ordering)
-> StructMember i
-> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Natural -> Ordering)
-> (StructMember i -> Natural) -> StructMember i -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) StructMember i -> Natural
forall i. StructMember i -> Natural
smOffset ((Natural -> Ordering) -> StructMember i -> Ordering)
-> (StructMember i -> Natural -> Ordering)
-> StructMember i
-> StructMember i
-> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Natural -> Natural -> Ordering)
-> (StructMember i -> Natural)
-> StructMember i
-> Natural
-> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructMember i -> Natural
forall i. StructMember i -> Natural
smOffset) ([StructMember i] -> StructMember i)
-> [StructMember i] -> StructMember i
forall a b. (a -> b) -> a -> b
$ Map Text (StructMember i) -> [StructMember i]
forall k a. Map k a -> [a]
M.elems Map Text (StructMember i)
m in
            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
alignas (Natural -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ StructMember i -> Natural
forall i. StructMember i -> Natural
smOffset StructMember i
sn Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof (StructMember i -> TypeKind i
forall i. StructMember i -> TypeKind i
smType StructMember i
sn)) (Natural -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ TypeKind i -> Natural
forall a. CType a => a -> Natural
alignof TypeKind i
t)
    sizeof CTUndef = 0
    sizeof (CTIncomplete _) = 0
    sizeof _ = String -> Natural
forall a. HasCallStack => String -> a
error "sizeof: sould not reach here"

    alignof :: TypeKind i -> Natural
alignof CTInt = 4
    alignof CTChar = 1
    alignof (CTSigned x :: TypeKind i
x) = TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof TypeKind i
x
    alignof (CTShort CTInt) = 2
    alignof (CTShort (CTSigned x :: TypeKind i
x)) = TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof (TypeKind i -> Natural) -> TypeKind i -> Natural
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTShort TypeKind i
x
    alignof (CTLong CTInt) = 8
    alignof (CTLong (CTSigned x :: TypeKind i
x)) = TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof (TypeKind i -> Natural) -> TypeKind i -> Natural
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTLong TypeKind i
x
    alignof (CTLong x :: TypeKind i
x) = TypeKind i -> Natural
forall a. CType a => a -> Natural
alignof TypeKind i
x
    alignof CTBool = 1
    alignof CTVoid = 1 -- Non standard
    alignof (CTPtr _) = 8
    alignof (CTArray _ t :: TypeKind i
t) = TypeKind i -> Natural
forall a. CType a => a -> Natural
alignof (TypeKind i -> Natural) -> TypeKind i -> Natural
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall a. CType a => a -> a
removeAllExtents TypeKind i
t
    alignof (CTEnum t :: TypeKind i
t _) = TypeKind i -> Natural
forall a. CType a => a -> Natural
alignof TypeKind i
t
    alignof (CTIncomplete (IncompleteArray t :: TypeKind i
t))
        | TypeKind i -> Bool
forall a. CType a => a -> Bool
isFundamental TypeKind i
t = TypeKind i -> Natural
forall a. CType a => a -> Natural
alignof TypeKind i
t
        | Bool
otherwise = 0
    alignof (CTIncomplete _) = 1
    alignof (CTStruct m :: Map Text (StructMember i)
m)
        | Map Text (StructMember i) -> Bool
forall k a. Map k a -> Bool
M.null Map Text (StructMember i)
m = 1
        | Bool
otherwise = [Natural] -> Natural
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Natural] -> Natural) -> [Natural] -> Natural
forall a b. (a -> b) -> a -> b
$ (StructMember i -> Natural) -> [StructMember i] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map (TypeKind i -> Natural
forall a. CType a => a -> Natural
alignof (TypeKind i -> Natural)
-> (StructMember i -> TypeKind i) -> StructMember i -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructMember i -> TypeKind i
forall i. StructMember i -> TypeKind i
smType) ([StructMember i] -> [Natural]) -> [StructMember i] -> [Natural]
forall a b. (a -> b) -> a -> b
$ Map Text (StructMember i) -> [StructMember i]
forall k a. Map k a -> [a]
M.elems Map Text (StructMember i)
m
    alignof CTUndef = 0
    alignof _ = String -> Natural
forall a. HasCallStack => String -> a
error "alignof: sould not reach here"

    deref :: TypeKind i -> Maybe (TypeKind i)
deref (CTPtr x :: TypeKind i
x) = TypeKind i -> Maybe (TypeKind i)
forall a. a -> Maybe a
Just TypeKind i
x
    deref ct :: TypeKind i
ct@(CTArray _ _) = TypeKind i -> Maybe (TypeKind i)
forall a. a -> Maybe a
Just (TypeKind i -> Maybe (TypeKind i))
-> TypeKind i -> Maybe (TypeKind i)
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
f TypeKind i
ct
        where
            f :: TypeKind i -> TypeKind i
f (CTArray n :: Natural
n c :: TypeKind i
c@(CTArray _ _)) = Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CTArray Natural
n (TypeKind i -> TypeKind i
f TypeKind i
c)
            f (CTArray _ t :: TypeKind i
t)               = TypeKind i
t
            f t :: TypeKind i
t                           = TypeKind i
t
    deref (CTIncomplete (IncompleteArray (CTArray _ _))) = Maybe (TypeKind i)
forall a. Maybe a
Nothing
    deref (CTIncomplete (IncompleteArray t :: TypeKind i
t)) = TypeKind i -> Maybe (TypeKind i)
forall a. a -> Maybe a
Just TypeKind i
t
    deref _ = Maybe (TypeKind i)
forall a. Maybe a
Nothing

    ctorPtr :: Natural -> TypeKind i -> TypeKind i
ctorPtr n :: Natural
n = ((TypeKind i -> TypeKind i)
 -> (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i)
-> (TypeKind i -> TypeKind i)
-> [TypeKind i -> TypeKind i]
-> TypeKind i
-> TypeKind i
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (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
forall a. a -> a
id ([TypeKind i -> TypeKind i] -> TypeKind i -> TypeKind i)
-> [TypeKind i -> TypeKind i] -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ Int -> (TypeKind i -> TypeKind i) -> [TypeKind i -> TypeKind i]
forall a. Int -> a -> [a]
replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTPtr

    dctorPtr :: TypeKind i -> (TypeKind i, TypeKind i -> TypeKind i)
dctorPtr (CTPtr x :: TypeKind i
x) = ((TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i)
-> (TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, TypeKind i -> TypeKind i)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTPtr (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))
-> (TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, TypeKind i -> TypeKind i)
forall a b. (a -> b) -> a -> b
$ TypeKind i -> (TypeKind i, TypeKind i -> TypeKind i)
forall a. CType a => a -> (a, a -> a)
dctorPtr TypeKind i
x
    dctorPtr x :: TypeKind i
x         = (TypeKind i
x, TypeKind i -> TypeKind i
forall a. a -> a
id)

    dctorArray :: TypeKind i -> (TypeKind i, TypeKind i -> TypeKind i)
dctorArray (CTArray n :: Natural
n x :: TypeKind i
x) = ((TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i)
-> (TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, TypeKind i -> TypeKind i)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CTArray Natural
n (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))
-> (TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, TypeKind i -> TypeKind i)
forall a b. (a -> b) -> a -> b
$ TypeKind i -> (TypeKind i, TypeKind i -> TypeKind i)
forall a. CType a => a -> (a, a -> a)
dctorArray TypeKind i
x
    dctorArray x :: TypeKind i
x             = (TypeKind i
x, TypeKind i -> TypeKind i
forall a. a -> a
id)

    removeAllExtents :: TypeKind i -> TypeKind i
removeAllExtents (CTArray _ t :: TypeKind i
t)                      = TypeKind i -> TypeKind i
forall a. CType a => a -> a
removeAllExtents TypeKind i
t
    removeAllExtents (CTIncomplete (IncompleteArray t :: TypeKind i
t)) = TypeKind i -> TypeKind i
forall a. CType a => a -> a
removeAllExtents TypeKind i
t
    removeAllExtents x :: TypeKind i
x                                  = TypeKind i
x

    conversion :: TypeKind i -> TypeKind i -> TypeKind i
conversion l :: TypeKind i
l r :: TypeKind i
r
        | TypeKind i
l TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i
r = TypeKind i
l
        | Bool
otherwise = TypeKind i -> TypeKind i -> TypeKind i
forall a. Ord a => a -> a -> a
max TypeKind i
l TypeKind i
r

    {-# INLINE implicitInt #-}
    implicitInt :: TypeKind i -> TypeKind i
implicitInt (CTLong x :: TypeKind i
x)   = TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTLong (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall a. CType a => a -> a
implicitInt TypeKind i
x
    implicitInt (CTShort x :: TypeKind i
x)  = TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTShort (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall a. CType a => a -> a
implicitInt TypeKind i
x
    implicitInt (CTSigned x :: TypeKind i
x) = TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CTSigned (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
forall a. CType a => a -> a
implicitInt TypeKind i
x
    implicitInt CTUndef      = TypeKind i
forall i. TypeKind i
CTInt
    implicitInt x :: TypeKind i
x            = TypeKind i
x


instance TypeKindBase TypeKind where
    {-# INLINE isCTArray #-}
    isCTArray :: TypeKind i -> Bool
isCTArray (CTArray _ _) = Bool
True
    isCTArray _             = Bool
False

    {-# INLINE isArray #-}
    isArray :: TypeKind i -> Bool
isArray = [TypeKind i -> Bool] -> TypeKind i -> Bool
forall a. [a -> Bool] -> a -> Bool
lor [TypeKind i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
isCTArray, TypeKind i -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
isIncompleteArray]

    {-# INLINE isCTStruct #-}
    isCTStruct :: TypeKind i -> Bool
isCTStruct (CTStruct _) = Bool
True
    isCTStruct _            = Bool
False

    {-# INLINE isCTUndef #-}
    isCTUndef :: TypeKind i -> Bool
isCTUndef CTUndef = Bool
True
    isCTUndef _       = Bool
False

    {-# INLINE isCTIncomplete #-}
    isCTIncomplete :: TypeKind i -> Bool
isCTIncomplete (CTIncomplete _) = Bool
True
    isCTIncomplete _                = Bool
False

    {-# INLINE makeCTArray #-}
    makeCTArray :: [Natural] -> TypeKind i -> TypeKind i
makeCTArray ns :: [Natural]
ns t :: TypeKind i
t = (TypeKind i -> Natural -> TypeKind i)
-> TypeKind i -> [Natural] -> TypeKind i
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Natural -> TypeKind i -> TypeKind i)
-> TypeKind i -> Natural -> TypeKind i
forall a b c. (a -> b -> c) -> b -> a -> c
flip Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CTArray) TypeKind i
t [Natural]
ns

    concatCTArray :: TypeKind i -> TypeKind i -> Maybe (TypeKind i)
concatCTArray l :: TypeKind i
l@(CTArray _ _) r :: TypeKind i
r@(CTArray n :: Natural
n r' :: TypeKind i
r')
        | TypeKind i -> TypeKind i
forall a. CType a => a -> a
removeAllExtents TypeKind i
l TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i -> TypeKind i
forall a. CType a => a -> a
removeAllExtents TypeKind i
r = TypeKind i -> Maybe (TypeKind i)
forall a. a -> Maybe a
Just (TypeKind i -> Maybe (TypeKind i))
-> TypeKind i -> Maybe (TypeKind i)
forall a b. (a -> b) -> a -> b
$ Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CTArray Natural
n (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i -> TypeKind i
forall i i. TypeKind i -> TypeKind i -> TypeKind i
f TypeKind i
l TypeKind i
r'
        | Bool
otherwise = Maybe (TypeKind i)
forall a. Maybe a
Nothing
        where
            f :: TypeKind i -> TypeKind i -> TypeKind i
f l' :: TypeKind i
l'@(CTArray _ _) (CTArray n'' :: Natural
n'' r'' :: TypeKind i
r'') = Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CTArray Natural
n'' (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i -> TypeKind i
f TypeKind i
l' TypeKind i
r''
            f l' :: TypeKind i
l' _                               = TypeKind i
l'
    concatCTArray l :: TypeKind i
l@(CTIncomplete (IncompleteArray _)) r :: TypeKind i
r@(CTArray n :: Natural
n r' :: TypeKind i
r')
        | TypeKind i -> TypeKind i
forall a. CType a => a -> a
removeAllExtents TypeKind i
l TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i -> TypeKind i
forall a. CType a => a -> a
removeAllExtents TypeKind i
r = TypeKind i -> Maybe (TypeKind i)
forall a. a -> Maybe a
Just (TypeKind i -> Maybe (TypeKind i))
-> TypeKind i -> Maybe (TypeKind i)
forall a b. (a -> b) -> a -> b
$ Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CTArray Natural
n (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i -> TypeKind i
forall i i. TypeKind i -> TypeKind i -> TypeKind i
f TypeKind i
l TypeKind i
r'
        | Bool
otherwise = Maybe (TypeKind i)
forall a. Maybe a
Nothing
        where
            f :: TypeKind i -> TypeKind i -> TypeKind i
f l' :: TypeKind i
l'@(CTIncomplete (IncompleteArray _)) (CTArray n' :: Natural
n' r'' :: TypeKind i
r'') = Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CTArray Natural
n' (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i -> TypeKind i
f TypeKind i
l' TypeKind i
r''
            f l' :: TypeKind i
l' _ = TypeKind i
l'
    concatCTArray _ _ = Maybe (TypeKind i)
forall a. Maybe a
Nothing

    {-# INLINE toTypeKind #-}
    toTypeKind :: TypeKind i -> TypeKind i
toTypeKind = TypeKind i -> TypeKind i
forall a. a -> a
id

    {-# INLINE mapTypeKind #-}
    mapTypeKind :: (TypeKind i -> TypeKind j) -> TypeKind i -> TypeKind j
mapTypeKind = (TypeKind i -> TypeKind j) -> TypeKind i -> TypeKind j
forall a. a -> a
id

instance IncompleteBase TypeKind where
    {-# INLINE isIncompleteArray #-}
    isIncompleteArray :: TypeKind i -> Bool
isIncompleteArray (CTIncomplete x :: Incomplete i
x) = Incomplete i -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
isIncompleteArray Incomplete i
x
    isIncompleteArray (CTArray _ x :: TypeKind i
x)    = TypeKind i -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
isIncompleteArray TypeKind i
x
    isIncompleteArray _                = Bool
False
    {-# INLINE isIncompleteStruct #-}
    isIncompleteStruct :: TypeKind i -> Bool
isIncompleteStruct (CTIncomplete x :: Incomplete i
x) = Incomplete i -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
isIncompleteStruct Incomplete i
x
    isIncompleteStruct _                = Bool
False
    {-# INLINE fromIncompleteStruct #-}
    fromIncompleteStruct :: TypeKind i -> Maybe Text
fromIncompleteStruct (CTIncomplete x :: Incomplete i
x) = Incomplete i -> Maybe Text
forall (a :: * -> *) i. IncompleteBase a => a i -> Maybe Text
fromIncompleteStruct Incomplete i
x
    fromIncompleteStruct _                = Maybe Text
forall a. Maybe a
Nothing
    {-# INLINE fromIncompleteArray #-}
    fromIncompleteArray :: TypeKind i -> Maybe (TypeKind i)
fromIncompleteArray (CTIncomplete x :: Incomplete i
x) = Incomplete i -> Maybe (TypeKind i)
forall (a :: * -> *) i.
IncompleteBase a =>
a i -> Maybe (TypeKind i)
fromIncompleteArray Incomplete i
x
    fromIncompleteArray (CTArray _ x :: TypeKind i
x)    = TypeKind i -> Maybe (TypeKind i)
forall (a :: * -> *) i.
IncompleteBase a =>
a i -> Maybe (TypeKind i)
fromIncompleteArray TypeKind i
x
    fromIncompleteArray _                = Maybe (TypeKind i)
forall a. Maybe a
Nothing
    {-# INLINE isValidIncomplete #-}
    isValidIncomplete :: TypeKind i -> Bool
isValidIncomplete (CTIncomplete x :: Incomplete i
x) = Incomplete i -> Bool
forall (a :: * -> *) i. (IncompleteBase a, Ord i) => a i -> Bool
isValidIncomplete Incomplete i
x
    isValidIncomplete (CTArray _ x :: TypeKind i
x)    = TypeKind i -> Bool
forall (a :: * -> *) i. (IncompleteBase a, Ord i) => a i -> Bool
isValidIncomplete TypeKind i
x
    isValidIncomplete _                = Bool
True

{-# INLINE alignas #-}
-- | `alignas` align to @n@.
alignas :: (Bits a, Num a, Enum a) => a -> a -> a
alignas :: a -> a -> a
alignas !a
n !a
aval = a -> a
forall a. Enum a => a -> a
pred (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
aval) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> a
forall a. Bits a => a -> a
complement (a -> a
forall a. Enum a => a -> a
pred a
aval)

-- | `lookupMember` search the specified member by its name from `CTStruct`.
lookupMember :: T.Text -> TypeKind i -> Maybe (StructMember i)
lookupMember :: Text -> TypeKind i -> Maybe (StructMember i)
lookupMember t :: Text
t (CTStruct m :: Map Text (StructMember i)
m) = Text -> Map Text (StructMember i) -> Maybe (StructMember i)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
t Map Text (StructMember i)
m
lookupMember _ _            = Maybe (StructMember i)
forall a. Maybe a
Nothing