    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 b a. (b -> a -> b) -> b -> [a] -> b
    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 b a. (b -> a -> b) -> b -> [a] -> b
    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