module Language.C99.Simple.Util where

import GHC.Exts (fromList)

import           Language.C99.Simple.AST
import qualified Language.C99.AST         as C

import Language.C99.Util


-- Append two declaration specs
appendspecs :: C.DeclnSpecs -> C.DeclnSpecs -> C.DeclnSpecs
appendspecs :: DeclnSpecs -> DeclnSpecs -> DeclnSpecs
appendspecs DeclnSpecs
x DeclnSpecs
y = let rec :: DeclnSpecs -> Maybe DeclnSpecs
rec DeclnSpecs
x' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DeclnSpecs -> DeclnSpecs -> DeclnSpecs
appendspecs DeclnSpecs
x' DeclnSpecs
y in case DeclnSpecs
x of
  C.DeclnSpecsType TypeSpec
ts Maybe DeclnSpecs
Nothing  -> TypeSpec -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsType TypeSpec
ts (forall a. a -> Maybe a
Just DeclnSpecs
y)
  C.DeclnSpecsQual TypeQual
qs Maybe DeclnSpecs
Nothing  -> TypeQual -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsQual TypeQual
qs (forall a. a -> Maybe a
Just DeclnSpecs
y)

  C.DeclnSpecsType TypeSpec
ts (Just DeclnSpecs
x) -> TypeSpec -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsType TypeSpec
ts (DeclnSpecs -> Maybe DeclnSpecs
rec DeclnSpecs
x)
  C.DeclnSpecsQual TypeQual
qs (Just DeclnSpecs
x) -> TypeQual -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsQual TypeQual
qs (DeclnSpecs -> Maybe DeclnSpecs
rec DeclnSpecs
x)

-- Insert a pointer into a declaration
insertptr :: C.Ptr -> C.Declr -> C.Declr
insertptr :: Ptr -> Declr -> Declr
insertptr Ptr
ptr (C.Declr Maybe Ptr
Nothing     DirectDeclr
declr) = Maybe Ptr -> DirectDeclr -> Declr
C.Declr (forall a. a -> Maybe a
Just Ptr
ptr) DirectDeclr
declr
insertptr Ptr
ptr (C.Declr (Just Ptr
ptr') DirectDeclr
declr) = Maybe Ptr -> DirectDeclr -> Declr
C.Declr (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Ptr -> Ptr -> Ptr
appendptr Ptr
ptr Ptr
ptr') DirectDeclr
declr

-- Append pointers, giving a pointer level of the sum of both
appendptr :: C.Ptr -> C.Ptr -> C.Ptr
appendptr :: Ptr -> Ptr -> Ptr
appendptr (C.PtrBase Maybe TypeQualList
quals)      Ptr
ptr = Maybe TypeQualList -> Ptr -> Ptr
C.PtrCons Maybe TypeQualList
quals Ptr
ptr
appendptr (C.PtrCons Maybe TypeQualList
quals Ptr
ptr') Ptr
ptr = Maybe TypeQualList -> Ptr -> Ptr
C.PtrCons Maybe TypeQualList
quals (Ptr -> Ptr -> Ptr
appendptr Ptr
ptr Ptr
ptr')

-- Keep taking qualifiers as long as possible and return the remainder
gettypequals :: Type -> (Maybe C.TypeQualList, Type)
gettypequals :: Type -> (Maybe TypeQualList, Type)
gettypequals Type
ty = (forall {a}. IsList a => [Item a] -> Maybe a
f [TypeQual]
quals, Type
ty') where
  f :: [Item a] -> Maybe a
f [] = forall a. Maybe a
Nothing
  f [Item a]
xs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList [Item a]
xs
  ([TypeQual]
quals, Type
ty') = Type -> ([TypeQual], Type)
gettypequals' Type
ty
  gettypequals' :: Type -> ([TypeQual], Type)
gettypequals' Type
ty = case Type
ty of
    Const    Type
ty' -> TypeQual -> Type -> ([TypeQual], Type)
rec TypeQual
C.QConst    Type
ty'
    Restrict Type
ty' -> TypeQual -> Type -> ([TypeQual], Type)
rec TypeQual
C.QRestrict Type
ty'
    Volatile Type
ty' -> TypeQual -> Type -> ([TypeQual], Type)
rec TypeQual
C.QVolatile Type
ty'
    Type
_            -> ([], Type
ty)
  rec :: TypeQual -> Type -> ([TypeQual], Type)
rec TypeQual
qual Type
ty = let ([TypeQual]
quals, Type
ty') = Type -> ([TypeQual], Type)
gettypequals' Type
ty in (TypeQual
qualforall a. a -> [a] -> [a]
:[TypeQual]
quals, Type
ty')

-- Turn a declr in an array by appending an ArrayDeclr
declrarray :: C.Declr -> Maybe C.AssignExpr -> C.Declr
declrarray :: Declr -> Maybe AssignExpr -> Declr
declrarray (C.Declr Maybe Ptr
ptr DirectDeclr
ddeclr) Maybe AssignExpr
mexpr =
  Maybe Ptr -> DirectDeclr -> Declr
C.Declr Maybe Ptr
ptr (DirectDeclr
-> Maybe TypeQualList -> Maybe AssignExpr -> DirectDeclr
C.DirectDeclrArray1 DirectDeclr
ddeclr forall a. Maybe a
Nothing Maybe AssignExpr
mexpr)

-- Takes a list of C.TypeSpec and turns it into a C.DeclnSpecs
foldtypespecs :: [C.TypeSpec] -> C.DeclnSpecs
foldtypespecs :: [TypeSpec] -> DeclnSpecs
foldtypespecs [TypeSpec]
ts = [TypeSpec] -> DeclnSpecs
foldtypespecs' (forall a. [a] -> [a]
reverse [TypeSpec]
ts) where
  foldtypespecs' :: [TypeSpec] -> DeclnSpecs
foldtypespecs' []     = forall a. HasCallStack => [Char] -> a
error [Char]
"DeclnSpecs can't be empty"
  foldtypespecs' (TypeSpec
t:[TypeSpec]
ts) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DeclnSpecs -> TypeSpec -> DeclnSpecs
step DeclnSpecs
base [TypeSpec]
ts where
    base :: DeclnSpecs
base     = TypeSpec -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsType TypeSpec
t forall a. Maybe a
Nothing
    step :: DeclnSpecs -> TypeSpec -> DeclnSpecs
step DeclnSpecs
x TypeSpec
y = TypeSpec -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsType TypeSpec
y (forall a. a -> Maybe a
Just DeclnSpecs
x)

-- Takes a list of C.TypeSpec and turns it into a C.SpecQualsList
foldtypequals :: [C.TypeSpec] -> C.SpecQualList
foldtypequals :: [TypeSpec] -> SpecQualList
foldtypequals [TypeSpec]
ts = [TypeSpec] -> SpecQualList
foldtypequals' (forall a. [a] -> [a]
reverse [TypeSpec]
ts) where
  foldtypequals' :: [TypeSpec] -> SpecQualList
foldtypequals' []     = forall a. HasCallStack => [Char] -> a
error [Char]
"SpecQualList can't be empty"
  foldtypequals' (TypeSpec
t:[TypeSpec]
ts) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl SpecQualList -> TypeSpec -> SpecQualList
step SpecQualList
base [TypeSpec]
ts where
    base :: SpecQualList
base     = TypeSpec -> Maybe SpecQualList -> SpecQualList
C.SpecQualType TypeSpec
t forall a. Maybe a
Nothing
    step :: SpecQualList -> TypeSpec -> SpecQualList
step SpecQualList
x TypeSpec
y = TypeSpec -> Maybe SpecQualList -> SpecQualList
C.SpecQualType TypeSpec
y (forall a. a -> Maybe a
Just SpecQualList
x)

-- Decay a type: turn an toplevel array into a pointer, usefull for functions
-- returning an array.
decay :: Type -> Type
decay :: Type -> Type
decay (Array Type
ty Maybe Expr
len) = Type -> Type
Ptr Type
ty
decay Type
ty             = Type
ty