{-# LANGUAGE DeriveGeneric #-}
module Htcc.CRules.Types.StorageClass (
StorageClass (..),
StorageClassBase (..)
) where
import Control.DeepSeq (NFData (..))
import Data.Tuple.Extra (first, second)
import GHC.Generics (Generic)
import Htcc.CRules.Types.CType
import Htcc.CRules.Types.TypeKind
data StorageClass i = SCAuto (TypeKind i)
| SCStatic (TypeKind i)
| SCRegister (TypeKind i)
| SCUndef (TypeKind i)
deriving (StorageClass i -> StorageClass i -> Bool
(StorageClass i -> StorageClass i -> Bool)
-> (StorageClass i -> StorageClass i -> Bool)
-> Eq (StorageClass i)
forall i. Eq i => StorageClass i -> StorageClass i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageClass i -> StorageClass i -> Bool
$c/= :: forall i. Eq i => StorageClass i -> StorageClass i -> Bool
== :: StorageClass i -> StorageClass i -> Bool
$c== :: forall i. Eq i => StorageClass i -> StorageClass i -> Bool
Eq, (forall x. StorageClass i -> Rep (StorageClass i) x)
-> (forall x. Rep (StorageClass i) x -> StorageClass i)
-> Generic (StorageClass i)
forall x. Rep (StorageClass i) x -> StorageClass i
forall x. StorageClass i -> Rep (StorageClass i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (StorageClass i) x -> StorageClass i
forall i x. StorageClass i -> Rep (StorageClass i) x
$cto :: forall i x. Rep (StorageClass i) x -> StorageClass i
$cfrom :: forall i x. StorageClass i -> Rep (StorageClass i) x
Generic)
class StorageClassBase a where
isSCStatic :: a i -> Bool
{-# INLINE fromsc #-}
fromsc :: StorageClass i -> TypeKind i
fromsc :: StorageClass i -> TypeKind i
fromsc (SCAuto t :: TypeKind i
t) = TypeKind i
t
fromsc (SCStatic t :: TypeKind i
t) = TypeKind i
t
fromsc (SCRegister t :: TypeKind i
t) = TypeKind i
t
fromsc (SCUndef t :: TypeKind i
t) = TypeKind i
t
{-# INLINE picksc #-}
picksc :: StorageClass i -> TypeKind j -> StorageClass j
picksc :: StorageClass i -> TypeKind j -> StorageClass j
picksc (SCAuto _) = TypeKind j -> StorageClass j
forall i. TypeKind i -> StorageClass i
SCAuto
picksc (SCStatic _) = TypeKind j -> StorageClass j
forall i. TypeKind i -> StorageClass i
SCStatic
picksc (SCRegister _) = TypeKind j -> StorageClass j
forall i. TypeKind i -> StorageClass i
SCRegister
picksc (SCUndef _) = TypeKind j -> StorageClass j
forall i. TypeKind i -> StorageClass i
SCUndef
{-# INLINE isSameSC #-}
isSameSC :: StorageClass i -> StorageClass i -> Bool
isSameSC :: StorageClass i -> StorageClass i -> Bool
isSameSC (SCAuto _) (SCAuto _) = Bool
True
isSameSC (SCStatic _) (SCStatic _) = Bool
True
isSameSC (SCRegister _) (SCRegister _) = Bool
True
isSameSC (SCUndef _) (SCUndef _) = Bool
True
isSameSC _ _ = Bool
False
instance Ord i => Ord (StorageClass i) where
compare :: StorageClass i -> StorageClass i -> Ordering
compare x :: StorageClass i
x y :: StorageClass i
y = TypeKind i -> TypeKind i -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
x) (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
y)
instance Show i => Show (StorageClass i) where
show :: StorageClass i -> String
show (SCAuto CTUndef) = "auto"
show (SCAuto t :: TypeKind i
t) = "auto " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
t
show (SCStatic CTUndef) = "static"
show (SCStatic t :: TypeKind i
t) = "static " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
t
show (SCRegister CTUndef) = "register"
show (SCRegister t :: TypeKind i
t) = "register " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
t
show (SCUndef CTUndef) = "undefined"
show (SCUndef t :: TypeKind i
t) = TypeKind i -> String
forall a. Show a => a -> String
show TypeKind i
t
instance Ord i => CType (StorageClass i) where
isFundamental :: StorageClass i -> Bool
isFundamental = TypeKind i -> Bool
forall a. CType a => a -> Bool
isFundamental (TypeKind i -> Bool)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
qualify :: StorageClass i -> StorageClass i -> Maybe (StorageClass i)
qualify x :: StorageClass i
x y :: StorageClass i
y
| StorageClass i -> StorageClass i -> Bool
forall i. StorageClass i -> StorageClass i -> Bool
isSameSC StorageClass i
x StorageClass i
y = StorageClass i -> TypeKind i -> StorageClass i
forall i j. StorageClass i -> TypeKind j -> StorageClass j
picksc StorageClass i
x (TypeKind i -> StorageClass i)
-> Maybe (TypeKind i) -> Maybe (StorageClass i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeKind i -> TypeKind i -> Maybe (TypeKind i)
forall a. CType a => a -> a -> Maybe a
qualify (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
x) (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
y)
| Bool
otherwise = Maybe (StorageClass i)
forall a. Maybe a
Nothing
sizeof :: StorageClass i -> Natural
sizeof = TypeKind i -> Natural
forall a. CType a => a -> Natural
sizeof (TypeKind i -> Natural)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
alignof :: StorageClass i -> Natural
alignof = TypeKind i -> Natural
forall a. CType a => a -> Natural
alignof (TypeKind i -> Natural)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
deref :: StorageClass i -> Maybe (StorageClass i)
deref x :: StorageClass i
x = StorageClass i -> TypeKind i -> StorageClass i
forall i j. StorageClass i -> TypeKind j -> StorageClass j
picksc StorageClass i
x (TypeKind i -> StorageClass i)
-> Maybe (TypeKind i) -> Maybe (StorageClass i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeKind i -> Maybe (TypeKind i)
forall a. CType a => a -> Maybe a
deref (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
x)
ctorPtr :: Natural -> StorageClass i -> StorageClass i
ctorPtr n :: Natural
n = (TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
mapTypeKind (Natural -> TypeKind i -> TypeKind i
forall a. CType a => Natural -> a -> a
ctorPtr Natural
n)
dctorPtr :: StorageClass i
-> (StorageClass i, StorageClass i -> StorageClass i)
dctorPtr x :: StorageClass i
x = (TypeKind i -> StorageClass i)
-> (TypeKind i, StorageClass i -> StorageClass i)
-> (StorageClass i, StorageClass i -> StorageClass i)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (StorageClass i -> TypeKind i -> StorageClass i
forall i j. StorageClass i -> TypeKind j -> StorageClass j
picksc StorageClass i
x) ((TypeKind i, StorageClass i -> StorageClass i)
-> (StorageClass i, StorageClass i -> StorageClass i))
-> (TypeKind i, StorageClass i -> StorageClass i)
-> (StorageClass i, StorageClass i -> StorageClass i)
forall a b. (a -> b) -> a -> b
$ ((TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i)
-> (TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, StorageClass i -> StorageClass i)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (\f :: TypeKind i -> TypeKind i
f y :: StorageClass i
y -> StorageClass i -> TypeKind i -> StorageClass i
forall i j. StorageClass i -> TypeKind j -> StorageClass j
picksc StorageClass i
y (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
f (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
y) ((TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, StorageClass i -> StorageClass i))
-> (TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, StorageClass i -> StorageClass 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 -> (TypeKind i, TypeKind i -> TypeKind i))
-> TypeKind i -> (TypeKind i, TypeKind i -> TypeKind i)
forall a b. (a -> b) -> a -> b
$ StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
x
dctorArray :: StorageClass i
-> (StorageClass i, StorageClass i -> StorageClass i)
dctorArray x :: StorageClass i
x = (TypeKind i -> StorageClass i)
-> (TypeKind i, StorageClass i -> StorageClass i)
-> (StorageClass i, StorageClass i -> StorageClass i)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (StorageClass i -> TypeKind i -> StorageClass i
forall i j. StorageClass i -> TypeKind j -> StorageClass j
picksc StorageClass i
x) ((TypeKind i, StorageClass i -> StorageClass i)
-> (StorageClass i, StorageClass i -> StorageClass i))
-> (TypeKind i, StorageClass i -> StorageClass i)
-> (StorageClass i, StorageClass i -> StorageClass i)
forall a b. (a -> b) -> a -> b
$ ((TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i)
-> (TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, StorageClass i -> StorageClass i)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (\f :: TypeKind i -> TypeKind i
f y :: StorageClass i
y -> StorageClass i -> TypeKind i -> StorageClass i
forall i j. StorageClass i -> TypeKind j -> StorageClass j
picksc StorageClass i
y (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i
f (TypeKind i -> TypeKind i) -> TypeKind i -> TypeKind i
forall a b. (a -> b) -> a -> b
$ StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
y) ((TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, StorageClass i -> StorageClass i))
-> (TypeKind i, TypeKind i -> TypeKind i)
-> (TypeKind i, StorageClass i -> StorageClass 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 -> (TypeKind i, TypeKind i -> TypeKind i))
-> TypeKind i -> (TypeKind i, TypeKind i -> TypeKind i)
forall a b. (a -> b) -> a -> b
$ StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
x
removeAllExtents :: StorageClass i -> StorageClass i
removeAllExtents = (TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
mapTypeKind TypeKind i -> TypeKind i
forall a. CType a => a -> a
removeAllExtents
conversion :: StorageClass i -> StorageClass i -> StorageClass i
conversion x :: StorageClass i
x y :: StorageClass i
y = TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
SCAuto (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind i -> TypeKind i
forall a. CType a => a -> a -> a
conversion (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
x) (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
y)
implicitInt :: StorageClass i -> StorageClass i
implicitInt = (TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
mapTypeKind TypeKind i -> TypeKind i
forall a. CType a => a -> a
implicitInt
instance TypeKindBase StorageClass where
{-# INLINE isCTArray #-}
isCTArray :: StorageClass i -> Bool
isCTArray = TypeKind i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
isCTArray (TypeKind i -> Bool)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
{-# INLINE isArray #-}
isArray :: StorageClass i -> Bool
isArray = TypeKind i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
isArray (TypeKind i -> Bool)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
{-# INLINE isCTStruct #-}
isCTStruct :: StorageClass i -> Bool
isCTStruct = TypeKind i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
isCTStruct (TypeKind i -> Bool)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
{-# INLINE isCTUndef #-}
isCTUndef :: StorageClass i -> Bool
isCTUndef = TypeKind i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
isCTUndef (TypeKind i -> Bool)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
{-# INLINE isCTIncomplete #-}
isCTIncomplete :: StorageClass i -> Bool
isCTIncomplete = TypeKind i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
isCTIncomplete (TypeKind i -> Bool)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
{-# INLINE makeCTArray #-}
makeCTArray :: [Natural] -> StorageClass i -> StorageClass i
makeCTArray ns :: [Natural]
ns = (TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
mapTypeKind ([Natural] -> TypeKind i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => [Natural] -> a i -> a i
makeCTArray [Natural]
ns)
concatCTArray :: StorageClass i -> StorageClass i -> Maybe (StorageClass i)
concatCTArray x :: StorageClass i
x y :: StorageClass i
y
| StorageClass i -> StorageClass i -> Bool
forall i. StorageClass i -> StorageClass i -> Bool
isSameSC StorageClass i
x StorageClass i
y = StorageClass i -> TypeKind i -> StorageClass i
forall i j. StorageClass i -> TypeKind j -> StorageClass j
picksc StorageClass i
x (TypeKind i -> StorageClass i)
-> Maybe (TypeKind i) -> Maybe (StorageClass i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeKind i -> TypeKind i -> Maybe (TypeKind i)
forall (a :: * -> *) i.
(TypeKindBase a, Ord i) =>
a i -> a i -> Maybe (a i)
concatCTArray (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
x) (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
y)
| Bool
otherwise = Maybe (StorageClass i)
forall a. Maybe a
Nothing
{-# INLINE toTypeKind #-}
toTypeKind :: StorageClass i -> TypeKind i
toTypeKind = StorageClass i -> TypeKind i
forall i. StorageClass i -> TypeKind i
fromsc
{-# INLINE mapTypeKind #-}
mapTypeKind :: (TypeKind i -> TypeKind j) -> StorageClass i -> StorageClass j
mapTypeKind f :: TypeKind i -> TypeKind j
f sc :: StorageClass i
sc = StorageClass i -> TypeKind j -> StorageClass j
forall i j. StorageClass i -> TypeKind j -> StorageClass j
picksc StorageClass i
sc (TypeKind j -> StorageClass j) -> TypeKind j -> StorageClass j
forall a b. (a -> b) -> a -> b
$ TypeKind i -> TypeKind j
f (TypeKind i -> TypeKind j) -> TypeKind i -> TypeKind j
forall a b. (a -> b) -> a -> b
$ StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind StorageClass i
sc
instance IncompleteBase StorageClass where
{-# INLINE isIncompleteArray #-}
isIncompleteArray :: StorageClass i -> Bool
isIncompleteArray = TypeKind i -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
isIncompleteArray (TypeKind i -> Bool)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
{-# INLINE isIncompleteStruct #-}
isIncompleteStruct :: StorageClass i -> Bool
isIncompleteStruct = TypeKind i -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
isIncompleteStruct (TypeKind i -> Bool)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
{-# INLINE fromIncompleteStruct #-}
fromIncompleteStruct :: StorageClass i -> Maybe Text
fromIncompleteStruct = TypeKind i -> Maybe Text
forall (a :: * -> *) i. IncompleteBase a => a i -> Maybe Text
fromIncompleteStruct (TypeKind i -> Maybe Text)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
{-# INLINE fromIncompleteArray #-}
fromIncompleteArray :: StorageClass i -> Maybe (TypeKind i)
fromIncompleteArray = TypeKind i -> Maybe (TypeKind i)
forall (a :: * -> *) i.
IncompleteBase a =>
a i -> Maybe (TypeKind i)
fromIncompleteArray (TypeKind i -> Maybe (TypeKind i))
-> (StorageClass i -> TypeKind i)
-> StorageClass i
-> Maybe (TypeKind i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
{-# INLINE isValidIncomplete #-}
isValidIncomplete :: StorageClass i -> Bool
isValidIncomplete = TypeKind i -> Bool
forall (a :: * -> *) i. (IncompleteBase a, Ord i) => a i -> Bool
isValidIncomplete (TypeKind i -> Bool)
-> (StorageClass i -> TypeKind i) -> StorageClass i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
toTypeKind
instance StorageClassBase StorageClass where
{-# INLINE isSCStatic #-}
isSCStatic :: StorageClass i -> Bool
isSCStatic (SCStatic _) = Bool
True
isSCStatic _ = Bool
False
instance NFData i => NFData (StorageClass i)