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' = DeclnSpecs -> Maybe DeclnSpecs
forall a. a -> Maybe a
Just (DeclnSpecs -> Maybe DeclnSpecs) -> DeclnSpecs -> Maybe DeclnSpecs
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 (DeclnSpecs -> Maybe DeclnSpecs
forall a. a -> Maybe a
Just DeclnSpecs
y)
  C.DeclnSpecsQual TypeQual
qs Maybe DeclnSpecs
Nothing  -> TypeQual -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsQual TypeQual
qs (DeclnSpecs -> Maybe DeclnSpecs
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 (Ptr -> Maybe Ptr
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 (Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
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 = ([Item TypeQualList] -> Maybe TypeQualList
forall a. IsList a => [Item a] -> Maybe a
f [Item TypeQualList]
[TypeQual]
quals, Type
ty') where
  f :: [Item a] -> Maybe a
f [] = Maybe a
forall a. Maybe a
Nothing
  f [Item a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [Item a] -> a
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
qualTypeQual -> [TypeQual] -> [TypeQual]
forall 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 Maybe TypeQualList
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' ([TypeSpec] -> [TypeSpec]
forall a. [a] -> [a]
reverse [TypeSpec]
ts) where
  foldtypespecs' :: [TypeSpec] -> DeclnSpecs
foldtypespecs' []     = [Char] -> DeclnSpecs
forall a. HasCallStack => [Char] -> a
error [Char]
"DeclnSpecs can't be empty"
  foldtypespecs' (TypeSpec
t:[TypeSpec]
ts) = (DeclnSpecs -> TypeSpec -> DeclnSpecs)
-> DeclnSpecs -> [TypeSpec] -> DeclnSpecs
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 Maybe DeclnSpecs
forall a. Maybe a
Nothing
    step :: DeclnSpecs -> TypeSpec -> DeclnSpecs
step DeclnSpecs
x TypeSpec
y = TypeSpec -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsType TypeSpec
y (DeclnSpecs -> Maybe DeclnSpecs
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' ([TypeSpec] -> [TypeSpec]
forall a. [a] -> [a]
reverse [TypeSpec]
ts) where
  foldtypequals' :: [TypeSpec] -> SpecQualList
foldtypequals' []     = [Char] -> SpecQualList
forall a. HasCallStack => [Char] -> a
error [Char]
"SpecQualList can't be empty"
  foldtypequals' (TypeSpec
t:[TypeSpec]
ts) = (SpecQualList -> TypeSpec -> SpecQualList)
-> SpecQualList -> [TypeSpec] -> SpecQualList
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 Maybe SpecQualList
forall a. Maybe a
Nothing
    step :: SpecQualList -> TypeSpec -> SpecQualList
step SpecQualList
x TypeSpec
y = TypeSpec -> Maybe SpecQualList -> SpecQualList
C.SpecQualType TypeSpec
y (SpecQualList -> Maybe SpecQualList
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