{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- | Views of C datatypes. While "Language.C.Types.Parse" defines datatypes for
-- representing the concrete syntax tree of C types, this module provides
-- friendlier views of C types, by turning them into a data type matching more
-- closely how we read and think about types, both in Haskell and in C. To
-- appreciate the difference, look at the difference between
-- 'P.ParameterDeclaration' and 'ParameterDeclaration'.
--
-- As a bonus, routines are provided for describing types in natural language
-- (English) -- see 'describeParameterDeclaration' and 'describeType'.

module Language.C.Types
  ( -- * Types
    P.CIdentifier
  , P.unCIdentifier
  , P.cIdentifierFromString
  , P.StorageClassSpecifier(..)
  , P.TypeQualifier(..)
  , P.FunctionSpecifier(..)
  , P.ArrayType(..)
  , Specifiers(..)
  , Type(..)
  , TypeSpecifier(..)
  , Sign(..)
  , ParameterDeclaration(..)

    -- * Parsing
  , P.TypeNames
  , P.CParser
  , P.CParserContext
  , P.cCParserContext
  , P.runCParser
  , P.quickCParser
  , P.quickCParser_
  , parseParameterDeclaration
  , parseParameterList
  , parseIdentifier
  , parseEnableCpp
  , parseType

    -- * Convert to and from high-level views
  , UntangleErr(..)
  , untangleParameterDeclaration
  , tangleParameterDeclaration

    -- * To english
  , describeParameterDeclaration
  , describeType
  ) where

import           Control.Arrow (second)
import           Control.Monad (when, unless, forM_, forM)
import           Control.Monad.State (execState, modify)
import           Control.Monad.Reader (ask)
import           Data.List (partition, intersperse)
import           Data.Maybe (fromMaybe)
import           Data.Typeable (Typeable)
import           Text.PrettyPrint.ANSI.Leijen ((</>), (<+>))
import qualified Text.PrettyPrint.ANSI.Leijen as PP

#if MIN_VERSION_base(4,9,0)
import           Data.Semigroup (Semigroup, (<>))
#else
import           Data.Monoid ((<>))
#endif

#if __GLASGOW_HASKELL__ < 710
import           Data.Foldable (Foldable)
import           Data.Functor ((<$>))
import           Data.Monoid (Monoid(..))
import           Data.Traversable (Traversable)
#endif

import qualified Language.C.Types.Parse as P

------------------------------------------------------------------------
-- Proper types

data TypeSpecifier
  = Void
  | Bool
  | Char (Maybe Sign)
  | Short Sign
  | Int Sign
  | Long Sign
  | LLong Sign
  | Float
  | Double
  | LDouble
  | TypeName P.CIdentifier
  | Struct P.CIdentifier
  | Enum P.CIdentifier
  | Template P.CIdentifier [TypeSpecifier]
  | TemplateConst String
  | TemplatePointer TypeSpecifier
  deriving (Typeable, Int -> TypeSpecifier -> ShowS
[TypeSpecifier] -> ShowS
TypeSpecifier -> String
(Int -> TypeSpecifier -> ShowS)
-> (TypeSpecifier -> String)
-> ([TypeSpecifier] -> ShowS)
-> Show TypeSpecifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeSpecifier] -> ShowS
$cshowList :: [TypeSpecifier] -> ShowS
show :: TypeSpecifier -> String
$cshow :: TypeSpecifier -> String
showsPrec :: Int -> TypeSpecifier -> ShowS
$cshowsPrec :: Int -> TypeSpecifier -> ShowS
Show, TypeSpecifier -> TypeSpecifier -> Bool
(TypeSpecifier -> TypeSpecifier -> Bool)
-> (TypeSpecifier -> TypeSpecifier -> Bool) -> Eq TypeSpecifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSpecifier -> TypeSpecifier -> Bool
$c/= :: TypeSpecifier -> TypeSpecifier -> Bool
== :: TypeSpecifier -> TypeSpecifier -> Bool
$c== :: TypeSpecifier -> TypeSpecifier -> Bool
Eq, Eq TypeSpecifier
Eq TypeSpecifier
-> (TypeSpecifier -> TypeSpecifier -> Ordering)
-> (TypeSpecifier -> TypeSpecifier -> Bool)
-> (TypeSpecifier -> TypeSpecifier -> Bool)
-> (TypeSpecifier -> TypeSpecifier -> Bool)
-> (TypeSpecifier -> TypeSpecifier -> Bool)
-> (TypeSpecifier -> TypeSpecifier -> TypeSpecifier)
-> (TypeSpecifier -> TypeSpecifier -> TypeSpecifier)
-> Ord TypeSpecifier
TypeSpecifier -> TypeSpecifier -> Bool
TypeSpecifier -> TypeSpecifier -> Ordering
TypeSpecifier -> TypeSpecifier -> TypeSpecifier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeSpecifier -> TypeSpecifier -> TypeSpecifier
$cmin :: TypeSpecifier -> TypeSpecifier -> TypeSpecifier
max :: TypeSpecifier -> TypeSpecifier -> TypeSpecifier
$cmax :: TypeSpecifier -> TypeSpecifier -> TypeSpecifier
>= :: TypeSpecifier -> TypeSpecifier -> Bool
$c>= :: TypeSpecifier -> TypeSpecifier -> Bool
> :: TypeSpecifier -> TypeSpecifier -> Bool
$c> :: TypeSpecifier -> TypeSpecifier -> Bool
<= :: TypeSpecifier -> TypeSpecifier -> Bool
$c<= :: TypeSpecifier -> TypeSpecifier -> Bool
< :: TypeSpecifier -> TypeSpecifier -> Bool
$c< :: TypeSpecifier -> TypeSpecifier -> Bool
compare :: TypeSpecifier -> TypeSpecifier -> Ordering
$ccompare :: TypeSpecifier -> TypeSpecifier -> Ordering
$cp1Ord :: Eq TypeSpecifier
Ord)

data Specifiers = Specifiers
  { Specifiers -> [StorageClassSpecifier]
storageClassSpecifiers :: [P.StorageClassSpecifier]
  , Specifiers -> [TypeQualifier]
typeQualifiers :: [P.TypeQualifier]
  , Specifiers -> [FunctionSpecifier]
functionSpecifiers :: [P.FunctionSpecifier]
  } deriving (Typeable, Int -> Specifiers -> ShowS
[Specifiers] -> ShowS
Specifiers -> String
(Int -> Specifiers -> ShowS)
-> (Specifiers -> String)
-> ([Specifiers] -> ShowS)
-> Show Specifiers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Specifiers] -> ShowS
$cshowList :: [Specifiers] -> ShowS
show :: Specifiers -> String
$cshow :: Specifiers -> String
showsPrec :: Int -> Specifiers -> ShowS
$cshowsPrec :: Int -> Specifiers -> ShowS
Show, Specifiers -> Specifiers -> Bool
(Specifiers -> Specifiers -> Bool)
-> (Specifiers -> Specifiers -> Bool) -> Eq Specifiers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Specifiers -> Specifiers -> Bool
$c/= :: Specifiers -> Specifiers -> Bool
== :: Specifiers -> Specifiers -> Bool
$c== :: Specifiers -> Specifiers -> Bool
Eq)

#if MIN_VERSION_base(4,9,0)
instance Semigroup Specifiers where
  Specifiers [StorageClassSpecifier]
x1 [TypeQualifier]
y1 [FunctionSpecifier]
z1 <> :: Specifiers -> Specifiers -> Specifiers
<> Specifiers [StorageClassSpecifier]
x2 [TypeQualifier]
y2 [FunctionSpecifier]
z2 =
    [StorageClassSpecifier]
-> [TypeQualifier] -> [FunctionSpecifier] -> Specifiers
Specifiers ([StorageClassSpecifier]
x1 [StorageClassSpecifier]
-> [StorageClassSpecifier] -> [StorageClassSpecifier]
forall a. [a] -> [a] -> [a]
++ [StorageClassSpecifier]
x2) ([TypeQualifier]
y1 [TypeQualifier] -> [TypeQualifier] -> [TypeQualifier]
forall a. [a] -> [a] -> [a]
++ [TypeQualifier]
y2) ([FunctionSpecifier]
z1 [FunctionSpecifier] -> [FunctionSpecifier] -> [FunctionSpecifier]
forall a. [a] -> [a] -> [a]
++ [FunctionSpecifier]
z2)
#endif

instance Monoid Specifiers where
  mempty :: Specifiers
mempty = [StorageClassSpecifier]
-> [TypeQualifier] -> [FunctionSpecifier] -> Specifiers
Specifiers [] [] []

#if !MIN_VERSION_base(4,11,0)
  mappend (Specifiers x1 y1 z1) (Specifiers x2 y2 z2) =
    Specifiers (x1 ++ x2) (y1 ++ y2) (z1 ++ z2)
#endif

data Type i
  = TypeSpecifier Specifiers TypeSpecifier
  | Ptr [P.TypeQualifier] (Type i)
  | Array (P.ArrayType i) (Type i)
  | Proto (Type i) [ParameterDeclaration i]
  deriving (Typeable, Int -> Type i -> ShowS
[Type i] -> ShowS
Type i -> String
(Int -> Type i -> ShowS)
-> (Type i -> String) -> ([Type i] -> ShowS) -> Show (Type i)
forall i. Show i => Int -> Type i -> ShowS
forall i. Show i => [Type i] -> ShowS
forall i. Show i => Type i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type i] -> ShowS
$cshowList :: forall i. Show i => [Type i] -> ShowS
show :: Type i -> String
$cshow :: forall i. Show i => Type i -> String
showsPrec :: Int -> Type i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> Type i -> ShowS
Show, Type i -> Type i -> Bool
(Type i -> Type i -> Bool)
-> (Type i -> Type i -> Bool) -> Eq (Type i)
forall i. Eq i => Type i -> Type i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type i -> Type i -> Bool
$c/= :: forall i. Eq i => Type i -> Type i -> Bool
== :: Type i -> Type i -> Bool
$c== :: forall i. Eq i => Type i -> Type i -> Bool
Eq, a -> Type b -> Type a
(a -> b) -> Type a -> Type b
(forall a b. (a -> b) -> Type a -> Type b)
-> (forall a b. a -> Type b -> Type a) -> Functor Type
forall a b. a -> Type b -> Type a
forall a b. (a -> b) -> Type a -> Type b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Type b -> Type a
$c<$ :: forall a b. a -> Type b -> Type a
fmap :: (a -> b) -> Type a -> Type b
$cfmap :: forall a b. (a -> b) -> Type a -> Type b
Functor, Type a -> Bool
(a -> m) -> Type a -> m
(a -> b -> b) -> b -> Type a -> b
(forall m. Monoid m => Type m -> m)
-> (forall m a. Monoid m => (a -> m) -> Type a -> m)
-> (forall m a. Monoid m => (a -> m) -> Type a -> m)
-> (forall a b. (a -> b -> b) -> b -> Type a -> b)
-> (forall a b. (a -> b -> b) -> b -> Type a -> b)
-> (forall b a. (b -> a -> b) -> b -> Type a -> b)
-> (forall b a. (b -> a -> b) -> b -> Type a -> b)
-> (forall a. (a -> a -> a) -> Type a -> a)
-> (forall a. (a -> a -> a) -> Type a -> a)
-> (forall a. Type a -> [a])
-> (forall a. Type a -> Bool)
-> (forall a. Type a -> Int)
-> (forall a. Eq a => a -> Type a -> Bool)
-> (forall a. Ord a => Type a -> a)
-> (forall a. Ord a => Type a -> a)
-> (forall a. Num a => Type a -> a)
-> (forall a. Num a => Type a -> a)
-> Foldable Type
forall a. Eq a => a -> Type a -> Bool
forall a. Num a => Type a -> a
forall a. Ord a => Type a -> a
forall m. Monoid m => Type m -> m
forall a. Type a -> Bool
forall a. Type a -> Int
forall a. Type a -> [a]
forall a. (a -> a -> a) -> Type a -> a
forall m a. Monoid m => (a -> m) -> Type a -> m
forall b a. (b -> a -> b) -> b -> Type a -> b
forall a b. (a -> b -> b) -> b -> Type a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Type a -> a
$cproduct :: forall a. Num a => Type a -> a
sum :: Type a -> a
$csum :: forall a. Num a => Type a -> a
minimum :: Type a -> a
$cminimum :: forall a. Ord a => Type a -> a
maximum :: Type a -> a
$cmaximum :: forall a. Ord a => Type a -> a
elem :: a -> Type a -> Bool
$celem :: forall a. Eq a => a -> Type a -> Bool
length :: Type a -> Int
$clength :: forall a. Type a -> Int
null :: Type a -> Bool
$cnull :: forall a. Type a -> Bool
toList :: Type a -> [a]
$ctoList :: forall a. Type a -> [a]
foldl1 :: (a -> a -> a) -> Type a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Type a -> a
foldr1 :: (a -> a -> a) -> Type a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Type a -> a
foldl' :: (b -> a -> b) -> b -> Type a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Type a -> b
foldl :: (b -> a -> b) -> b -> Type a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Type a -> b
foldr' :: (a -> b -> b) -> b -> Type a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Type a -> b
foldr :: (a -> b -> b) -> b -> Type a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Type a -> b
foldMap' :: (a -> m) -> Type a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Type a -> m
foldMap :: (a -> m) -> Type a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Type a -> m
fold :: Type m -> m
$cfold :: forall m. Monoid m => Type m -> m
Foldable, Functor Type
Foldable Type
Functor Type
-> Foldable Type
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Type a -> f (Type b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Type (f a) -> f (Type a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Type a -> m (Type b))
-> (forall (m :: * -> *) a. Monad m => Type (m a) -> m (Type a))
-> Traversable Type
(a -> f b) -> Type a -> f (Type b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Type (m a) -> m (Type a)
forall (f :: * -> *) a. Applicative f => Type (f a) -> f (Type a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Type a -> m (Type b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Type a -> f (Type b)
sequence :: Type (m a) -> m (Type a)
$csequence :: forall (m :: * -> *) a. Monad m => Type (m a) -> m (Type a)
mapM :: (a -> m b) -> Type a -> m (Type b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Type a -> m (Type b)
sequenceA :: Type (f a) -> f (Type a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Type (f a) -> f (Type a)
traverse :: (a -> f b) -> Type a -> f (Type b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Type a -> f (Type b)
$cp2Traversable :: Foldable Type
$cp1Traversable :: Functor Type
Traversable)

data Sign
  = Signed
  | Unsigned
  deriving (Typeable, Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show, Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c== :: Sign -> Sign -> Bool
Eq, Eq Sign
Eq Sign
-> (Sign -> Sign -> Ordering)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Sign)
-> (Sign -> Sign -> Sign)
-> Ord Sign
Sign -> Sign -> Bool
Sign -> Sign -> Ordering
Sign -> Sign -> Sign
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Sign -> Sign -> Sign
$cmin :: Sign -> Sign -> Sign
max :: Sign -> Sign -> Sign
$cmax :: Sign -> Sign -> Sign
>= :: Sign -> Sign -> Bool
$c>= :: Sign -> Sign -> Bool
> :: Sign -> Sign -> Bool
$c> :: Sign -> Sign -> Bool
<= :: Sign -> Sign -> Bool
$c<= :: Sign -> Sign -> Bool
< :: Sign -> Sign -> Bool
$c< :: Sign -> Sign -> Bool
compare :: Sign -> Sign -> Ordering
$ccompare :: Sign -> Sign -> Ordering
$cp1Ord :: Eq Sign
Ord)

data ParameterDeclaration i = ParameterDeclaration
  { ParameterDeclaration i -> Maybe i
parameterDeclarationId :: Maybe i
  , ParameterDeclaration i -> Type i
parameterDeclarationType :: (Type i)
  } deriving (Typeable, Int -> ParameterDeclaration i -> ShowS
[ParameterDeclaration i] -> ShowS
ParameterDeclaration i -> String
(Int -> ParameterDeclaration i -> ShowS)
-> (ParameterDeclaration i -> String)
-> ([ParameterDeclaration i] -> ShowS)
-> Show (ParameterDeclaration i)
forall i. Show i => Int -> ParameterDeclaration i -> ShowS
forall i. Show i => [ParameterDeclaration i] -> ShowS
forall i. Show i => ParameterDeclaration i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterDeclaration i] -> ShowS
$cshowList :: forall i. Show i => [ParameterDeclaration i] -> ShowS
show :: ParameterDeclaration i -> String
$cshow :: forall i. Show i => ParameterDeclaration i -> String
showsPrec :: Int -> ParameterDeclaration i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> ParameterDeclaration i -> ShowS
Show, ParameterDeclaration i -> ParameterDeclaration i -> Bool
(ParameterDeclaration i -> ParameterDeclaration i -> Bool)
-> (ParameterDeclaration i -> ParameterDeclaration i -> Bool)
-> Eq (ParameterDeclaration i)
forall i.
Eq i =>
ParameterDeclaration i -> ParameterDeclaration i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterDeclaration i -> ParameterDeclaration i -> Bool
$c/= :: forall i.
Eq i =>
ParameterDeclaration i -> ParameterDeclaration i -> Bool
== :: ParameterDeclaration i -> ParameterDeclaration i -> Bool
$c== :: forall i.
Eq i =>
ParameterDeclaration i -> ParameterDeclaration i -> Bool
Eq, a -> ParameterDeclaration b -> ParameterDeclaration a
(a -> b) -> ParameterDeclaration a -> ParameterDeclaration b
(forall a b.
 (a -> b) -> ParameterDeclaration a -> ParameterDeclaration b)
-> (forall a b.
    a -> ParameterDeclaration b -> ParameterDeclaration a)
-> Functor ParameterDeclaration
forall a b. a -> ParameterDeclaration b -> ParameterDeclaration a
forall a b.
(a -> b) -> ParameterDeclaration a -> ParameterDeclaration b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ParameterDeclaration b -> ParameterDeclaration a
$c<$ :: forall a b. a -> ParameterDeclaration b -> ParameterDeclaration a
fmap :: (a -> b) -> ParameterDeclaration a -> ParameterDeclaration b
$cfmap :: forall a b.
(a -> b) -> ParameterDeclaration a -> ParameterDeclaration b
Functor, ParameterDeclaration a -> Bool
(a -> m) -> ParameterDeclaration a -> m
(a -> b -> b) -> b -> ParameterDeclaration a -> b
(forall m. Monoid m => ParameterDeclaration m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ParameterDeclaration a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ParameterDeclaration a -> m)
-> (forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b)
-> (forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b)
-> (forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b)
-> (forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b)
-> (forall a. (a -> a -> a) -> ParameterDeclaration a -> a)
-> (forall a. (a -> a -> a) -> ParameterDeclaration a -> a)
-> (forall a. ParameterDeclaration a -> [a])
-> (forall a. ParameterDeclaration a -> Bool)
-> (forall a. ParameterDeclaration a -> Int)
-> (forall a. Eq a => a -> ParameterDeclaration a -> Bool)
-> (forall a. Ord a => ParameterDeclaration a -> a)
-> (forall a. Ord a => ParameterDeclaration a -> a)
-> (forall a. Num a => ParameterDeclaration a -> a)
-> (forall a. Num a => ParameterDeclaration a -> a)
-> Foldable ParameterDeclaration
forall a. Eq a => a -> ParameterDeclaration a -> Bool
forall a. Num a => ParameterDeclaration a -> a
forall a. Ord a => ParameterDeclaration a -> a
forall m. Monoid m => ParameterDeclaration m -> m
forall a. ParameterDeclaration a -> Bool
forall a. ParameterDeclaration a -> Int
forall a. ParameterDeclaration a -> [a]
forall a. (a -> a -> a) -> ParameterDeclaration a -> a
forall m a. Monoid m => (a -> m) -> ParameterDeclaration a -> m
forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b
forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: ParameterDeclaration a -> a
$cproduct :: forall a. Num a => ParameterDeclaration a -> a
sum :: ParameterDeclaration a -> a
$csum :: forall a. Num a => ParameterDeclaration a -> a
minimum :: ParameterDeclaration a -> a
$cminimum :: forall a. Ord a => ParameterDeclaration a -> a
maximum :: ParameterDeclaration a -> a
$cmaximum :: forall a. Ord a => ParameterDeclaration a -> a
elem :: a -> ParameterDeclaration a -> Bool
$celem :: forall a. Eq a => a -> ParameterDeclaration a -> Bool
length :: ParameterDeclaration a -> Int
$clength :: forall a. ParameterDeclaration a -> Int
null :: ParameterDeclaration a -> Bool
$cnull :: forall a. ParameterDeclaration a -> Bool
toList :: ParameterDeclaration a -> [a]
$ctoList :: forall a. ParameterDeclaration a -> [a]
foldl1 :: (a -> a -> a) -> ParameterDeclaration a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ParameterDeclaration a -> a
foldr1 :: (a -> a -> a) -> ParameterDeclaration a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ParameterDeclaration a -> a
foldl' :: (b -> a -> b) -> b -> ParameterDeclaration a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b
foldl :: (b -> a -> b) -> b -> ParameterDeclaration a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b
foldr' :: (a -> b -> b) -> b -> ParameterDeclaration a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b
foldr :: (a -> b -> b) -> b -> ParameterDeclaration a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b
foldMap' :: (a -> m) -> ParameterDeclaration a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ParameterDeclaration a -> m
foldMap :: (a -> m) -> ParameterDeclaration a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ParameterDeclaration a -> m
fold :: ParameterDeclaration m -> m
$cfold :: forall m. Monoid m => ParameterDeclaration m -> m
Foldable, Functor ParameterDeclaration
Foldable ParameterDeclaration
Functor ParameterDeclaration
-> Foldable ParameterDeclaration
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ParameterDeclaration a -> f (ParameterDeclaration b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ParameterDeclaration (f a) -> f (ParameterDeclaration a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ParameterDeclaration a -> m (ParameterDeclaration b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ParameterDeclaration (m a) -> m (ParameterDeclaration a))
-> Traversable ParameterDeclaration
(a -> f b) -> ParameterDeclaration a -> f (ParameterDeclaration b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ParameterDeclaration (m a) -> m (ParameterDeclaration a)
forall (f :: * -> *) a.
Applicative f =>
ParameterDeclaration (f a) -> f (ParameterDeclaration a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ParameterDeclaration a -> m (ParameterDeclaration b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ParameterDeclaration a -> f (ParameterDeclaration b)
sequence :: ParameterDeclaration (m a) -> m (ParameterDeclaration a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ParameterDeclaration (m a) -> m (ParameterDeclaration a)
mapM :: (a -> m b) -> ParameterDeclaration a -> m (ParameterDeclaration b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ParameterDeclaration a -> m (ParameterDeclaration b)
sequenceA :: ParameterDeclaration (f a) -> f (ParameterDeclaration a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ParameterDeclaration (f a) -> f (ParameterDeclaration a)
traverse :: (a -> f b) -> ParameterDeclaration a -> f (ParameterDeclaration b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ParameterDeclaration a -> f (ParameterDeclaration b)
$cp2Traversable :: Foldable ParameterDeclaration
$cp1Traversable :: Functor ParameterDeclaration
Traversable)

------------------------------------------------------------------------
-- Conversion

data UntangleErr
  = MultipleDataTypes [P.DeclarationSpecifier]
  | NoDataTypes [P.DeclarationSpecifier]
  | IllegalSpecifiers String [P.TypeSpecifier]
  deriving (Typeable, Int -> UntangleErr -> ShowS
[UntangleErr] -> ShowS
UntangleErr -> String
(Int -> UntangleErr -> ShowS)
-> (UntangleErr -> String)
-> ([UntangleErr] -> ShowS)
-> Show UntangleErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UntangleErr] -> ShowS
$cshowList :: [UntangleErr] -> ShowS
show :: UntangleErr -> String
$cshow :: UntangleErr -> String
showsPrec :: Int -> UntangleErr -> ShowS
$cshowsPrec :: Int -> UntangleErr -> ShowS
Show, UntangleErr -> UntangleErr -> Bool
(UntangleErr -> UntangleErr -> Bool)
-> (UntangleErr -> UntangleErr -> Bool) -> Eq UntangleErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UntangleErr -> UntangleErr -> Bool
$c/= :: UntangleErr -> UntangleErr -> Bool
== :: UntangleErr -> UntangleErr -> Bool
$c== :: UntangleErr -> UntangleErr -> Bool
Eq)

failConversion :: UntangleErr -> Either UntangleErr a
failConversion :: UntangleErr -> Either UntangleErr a
failConversion = UntangleErr -> Either UntangleErr a
forall a b. a -> Either a b
Left

untangleParameterDeclaration
  :: P.ParameterDeclaration i -> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration :: ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration P.ParameterDeclaration{[DeclarationSpecifier]
DeclaratorOrAbstractDeclarator i
parameterDeclarationDeclarator :: forall i.
ParameterDeclaration i -> DeclaratorOrAbstractDeclarator i
parameterDeclarationSpecifiers :: forall i. ParameterDeclaration i -> [DeclarationSpecifier]
parameterDeclarationDeclarator :: DeclaratorOrAbstractDeclarator i
parameterDeclarationSpecifiers :: [DeclarationSpecifier]
..} = do
  (Specifiers
specs, TypeSpecifier
tySpec) <- [DeclarationSpecifier]
-> Either UntangleErr (Specifiers, TypeSpecifier)
untangleDeclarationSpecifiers [DeclarationSpecifier]
parameterDeclarationSpecifiers
  let baseTy :: Type i
baseTy = Specifiers -> TypeSpecifier -> Type i
forall i. Specifiers -> TypeSpecifier -> Type i
TypeSpecifier Specifiers
specs TypeSpecifier
tySpec
  (Maybe i
mbS, Type i
ty) <- case DeclaratorOrAbstractDeclarator i
parameterDeclarationDeclarator of
    P.IsDeclarator Declarator i
decltor -> do
      (i
s, Type i
ty) <- Type i -> Declarator i -> Either UntangleErr (i, Type i)
forall i. Type i -> Declarator i -> Either UntangleErr (i, Type i)
untangleDeclarator Type i
forall i. Type i
baseTy Declarator i
decltor
      (Maybe i, Type i) -> Either UntangleErr (Maybe i, Type i)
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> Maybe i
forall a. a -> Maybe a
Just i
s, Type i
ty)
    P.IsAbstractDeclarator AbstractDeclarator i
decltor ->
      (Maybe i
forall a. Maybe a
Nothing, ) (Type i -> (Maybe i, Type i))
-> Either UntangleErr (Type i)
-> Either UntangleErr (Maybe i, Type i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type i -> AbstractDeclarator i -> Either UntangleErr (Type i)
forall i.
Type i -> AbstractDeclarator i -> Either UntangleErr (Type i)
untangleAbstractDeclarator Type i
forall i. Type i
baseTy AbstractDeclarator i
decltor
  ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParameterDeclaration i
 -> Either UntangleErr (ParameterDeclaration i))
-> ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
forall a b. (a -> b) -> a -> b
$ Maybe i -> Type i -> ParameterDeclaration i
forall i. Maybe i -> Type i -> ParameterDeclaration i
ParameterDeclaration Maybe i
mbS Type i
ty

untangleDeclarationSpecifiers
  :: [P.DeclarationSpecifier] -> Either UntangleErr (Specifiers, TypeSpecifier)
untangleDeclarationSpecifiers :: [DeclarationSpecifier]
-> Either UntangleErr (Specifiers, TypeSpecifier)
untangleDeclarationSpecifiers [DeclarationSpecifier]
declSpecs = do
  let ([StorageClassSpecifier]
pStorage, [TypeSpecifier]
pTySpecs, [TypeQualifier]
pTyQuals, [FunctionSpecifier]
pFunSpecs) = (State
   ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
    [FunctionSpecifier])
   ()
 -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier])
 -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier]))
-> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
    [FunctionSpecifier])
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
-> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
    [FunctionSpecifier])
forall a b c. (a -> b -> c) -> b -> a -> c
flip State
  ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
   [FunctionSpecifier])
  ()
-> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
    [FunctionSpecifier])
-> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
    [FunctionSpecifier])
forall s a. State s a -> s -> s
execState ([], [], [], []) (State
   ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
    [FunctionSpecifier])
   ()
 -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier]))
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
-> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
    [FunctionSpecifier])
forall a b. (a -> b) -> a -> b
$ do
        [DeclarationSpecifier]
-> (DeclarationSpecifier
    -> State
         ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
          [FunctionSpecifier])
         ())
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([DeclarationSpecifier] -> [DeclarationSpecifier]
forall a. [a] -> [a]
reverse [DeclarationSpecifier]
declSpecs) ((DeclarationSpecifier
  -> State
       ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
        [FunctionSpecifier])
       ())
 -> State
      ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
       [FunctionSpecifier])
      ())
-> (DeclarationSpecifier
    -> State
         ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
          [FunctionSpecifier])
         ())
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall a b. (a -> b) -> a -> b
$ \DeclarationSpecifier
declSpec -> case DeclarationSpecifier
declSpec of
          P.StorageClassSpecifier StorageClassSpecifier
x -> (([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
  [FunctionSpecifier])
 -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier]))
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
   [FunctionSpecifier])
  -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier]))
 -> State
      ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
       [FunctionSpecifier])
      ())
-> (([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier])
    -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
        [FunctionSpecifier]))
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall a b. (a -> b) -> a -> b
$ \([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d) -> (StorageClassSpecifier
xStorageClassSpecifier
-> [StorageClassSpecifier] -> [StorageClassSpecifier]
forall a. a -> [a] -> [a]
:[StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d)
          P.TypeSpecifier TypeSpecifier
x -> (([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
  [FunctionSpecifier])
 -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier]))
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
   [FunctionSpecifier])
  -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier]))
 -> State
      ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
       [FunctionSpecifier])
      ())
-> (([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier])
    -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
        [FunctionSpecifier]))
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall a b. (a -> b) -> a -> b
$ \([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d) -> ([StorageClassSpecifier]
a, TypeSpecifier
xTypeSpecifier -> [TypeSpecifier] -> [TypeSpecifier]
forall a. a -> [a] -> [a]
:[TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d)
          P.TypeQualifier TypeQualifier
x -> (([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
  [FunctionSpecifier])
 -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier]))
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
   [FunctionSpecifier])
  -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier]))
 -> State
      ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
       [FunctionSpecifier])
      ())
-> (([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier])
    -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
        [FunctionSpecifier]))
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall a b. (a -> b) -> a -> b
$ \([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d) -> ([StorageClassSpecifier]
a, [TypeSpecifier]
b, TypeQualifier
xTypeQualifier -> [TypeQualifier] -> [TypeQualifier]
forall a. a -> [a] -> [a]
:[TypeQualifier]
c, [FunctionSpecifier]
d)
          P.FunctionSpecifier FunctionSpecifier
x -> (([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
  [FunctionSpecifier])
 -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier]))
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
   [FunctionSpecifier])
  -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier]))
 -> State
      ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
       [FunctionSpecifier])
      ())
-> (([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
     [FunctionSpecifier])
    -> ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
        [FunctionSpecifier]))
-> State
     ([StorageClassSpecifier], [TypeSpecifier], [TypeQualifier],
      [FunctionSpecifier])
     ()
forall a b. (a -> b) -> a -> b
$ \([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d) -> ([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, FunctionSpecifier
xFunctionSpecifier -> [FunctionSpecifier] -> [FunctionSpecifier]
forall a. a -> [a] -> [a]
:[FunctionSpecifier]
d)
  -- Split data type and specifiers
  let ([TypeSpecifier]
dataTypes, [TypeSpecifier]
specs) =
        (TypeSpecifier -> Bool)
-> [TypeSpecifier] -> ([TypeSpecifier], [TypeSpecifier])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\TypeSpecifier
x -> Bool -> Bool
not (TypeSpecifier
x TypeSpecifier -> [TypeSpecifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TypeSpecifier
P.SIGNED, TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.LONG, TypeSpecifier
P.SHORT])) [TypeSpecifier]
pTySpecs
  let illegalSpecifiers :: String -> Either UntangleErr a
illegalSpecifiers String
s = UntangleErr -> Either UntangleErr a
forall a. UntangleErr -> Either UntangleErr a
failConversion (UntangleErr -> Either UntangleErr a)
-> UntangleErr -> Either UntangleErr a
forall a b. (a -> b) -> a -> b
$ String -> [TypeSpecifier] -> UntangleErr
IllegalSpecifiers String
s [TypeSpecifier]
specs
  -- Find out sign, if present
  Maybe Sign
mbSign0 <- case (TypeSpecifier -> Bool) -> [TypeSpecifier] -> [TypeSpecifier]
forall a. (a -> Bool) -> [a] -> [a]
filter (TypeSpecifier -> TypeSpecifier -> Bool
forall a. Eq a => a -> a -> Bool
== TypeSpecifier
P.SIGNED) [TypeSpecifier]
specs of
    []  -> Maybe Sign -> Either UntangleErr (Maybe Sign)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Sign
forall a. Maybe a
Nothing
    [TypeSpecifier
_] -> Maybe Sign -> Either UntangleErr (Maybe Sign)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Sign -> Either UntangleErr (Maybe Sign))
-> Maybe Sign -> Either UntangleErr (Maybe Sign)
forall a b. (a -> b) -> a -> b
$ Sign -> Maybe Sign
forall a. a -> Maybe a
Just Sign
Signed
    TypeSpecifier
_:[TypeSpecifier]
_ -> String -> Either UntangleErr (Maybe Sign)
forall a. String -> Either UntangleErr a
illegalSpecifiers String
"conflicting/duplicate sign information"
  Maybe Sign
mbSign <- case (Maybe Sign
mbSign0, (TypeSpecifier -> Bool) -> [TypeSpecifier] -> [TypeSpecifier]
forall a. (a -> Bool) -> [a] -> [a]
filter (TypeSpecifier -> TypeSpecifier -> Bool
forall a. Eq a => a -> a -> Bool
== TypeSpecifier
P.UNSIGNED) [TypeSpecifier]
specs) of
    (Maybe Sign
Nothing, []) -> Maybe Sign -> Either UntangleErr (Maybe Sign)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Sign
forall a. Maybe a
Nothing
    (Maybe Sign
Nothing, [TypeSpecifier
_]) -> Maybe Sign -> Either UntangleErr (Maybe Sign)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Sign -> Either UntangleErr (Maybe Sign))
-> Maybe Sign -> Either UntangleErr (Maybe Sign)
forall a b. (a -> b) -> a -> b
$ Sign -> Maybe Sign
forall a. a -> Maybe a
Just Sign
Unsigned
    (Just Sign
b, []) -> Maybe Sign -> Either UntangleErr (Maybe Sign)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Sign -> Either UntangleErr (Maybe Sign))
-> Maybe Sign -> Either UntangleErr (Maybe Sign)
forall a b. (a -> b) -> a -> b
$ Sign -> Maybe Sign
forall a. a -> Maybe a
Just Sign
b
    (Maybe Sign, [TypeSpecifier])
_ -> String -> Either UntangleErr (Maybe Sign)
forall a. String -> Either UntangleErr a
illegalSpecifiers String
"conflicting/duplicate sign information"
  let sign :: Sign
sign = Sign -> Maybe Sign -> Sign
forall a. a -> Maybe a -> a
fromMaybe Sign
Signed Maybe Sign
mbSign
  -- Find out length
  let longs :: Int
longs = [TypeSpecifier] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TypeSpecifier] -> Int) -> [TypeSpecifier] -> Int
forall a b. (a -> b) -> a -> b
$ (TypeSpecifier -> Bool) -> [TypeSpecifier] -> [TypeSpecifier]
forall a. (a -> Bool) -> [a] -> [a]
filter (TypeSpecifier -> TypeSpecifier -> Bool
forall a. Eq a => a -> a -> Bool
== TypeSpecifier
P.LONG) [TypeSpecifier]
specs
  let shorts :: Int
shorts = [TypeSpecifier] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TypeSpecifier] -> Int) -> [TypeSpecifier] -> Int
forall a b. (a -> b) -> a -> b
$ (TypeSpecifier -> Bool) -> [TypeSpecifier] -> [TypeSpecifier]
forall a. (a -> Bool) -> [a] -> [a]
filter (TypeSpecifier -> TypeSpecifier -> Bool
forall a. Eq a => a -> a -> Bool
== TypeSpecifier
P.SHORT) [TypeSpecifier]
specs
  Bool -> Either UntangleErr () -> Either UntangleErr ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
longs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
shorts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Either UntangleErr () -> Either UntangleErr ())
-> Either UntangleErr () -> Either UntangleErr ()
forall a b. (a -> b) -> a -> b
$ String -> Either UntangleErr ()
forall a. String -> Either UntangleErr a
illegalSpecifiers String
"both long and short"
  -- Find out data type
  TypeSpecifier
dataType <- case [TypeSpecifier]
dataTypes of
    [TypeSpecifier
x] -> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
x
    [] | Int
longs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
shorts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
P.INT
    [] -> UntangleErr -> Either UntangleErr TypeSpecifier
forall a. UntangleErr -> Either UntangleErr a
failConversion (UntangleErr -> Either UntangleErr TypeSpecifier)
-> UntangleErr -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ [DeclarationSpecifier] -> UntangleErr
NoDataTypes [DeclarationSpecifier]
declSpecs
    TypeSpecifier
_:[TypeSpecifier]
_ -> UntangleErr -> Either UntangleErr TypeSpecifier
forall a. UntangleErr -> Either UntangleErr a
failConversion (UntangleErr -> Either UntangleErr TypeSpecifier)
-> UntangleErr -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ [DeclarationSpecifier] -> UntangleErr
MultipleDataTypes [DeclarationSpecifier]
declSpecs
  -- Check if things are compatible with one another
  let checkNoSpecs :: Either UntangleErr ()
checkNoSpecs =
        Bool -> Either UntangleErr () -> Either UntangleErr ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TypeSpecifier] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeSpecifier]
specs) (Either UntangleErr () -> Either UntangleErr ())
-> Either UntangleErr () -> Either UntangleErr ()
forall a b. (a -> b) -> a -> b
$ String -> Either UntangleErr ()
forall a. String -> Either UntangleErr a
illegalSpecifiers String
"expecting no specifiers"
  let checkNoLength :: Either UntangleErr ()
checkNoLength =
        Bool -> Either UntangleErr () -> Either UntangleErr ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
longs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
shorts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Either UntangleErr () -> Either UntangleErr ())
-> Either UntangleErr () -> Either UntangleErr ()
forall a b. (a -> b) -> a -> b
$ String -> Either UntangleErr ()
forall a. String -> Either UntangleErr a
illegalSpecifiers String
"unexpected long/short"
  let type2type :: TypeSpecifier -> Either UntangleErr TypeSpecifier
type2type TypeSpecifier
dat = case TypeSpecifier
dat of
        P.Template CIdentifier
s [TypeSpecifier]
args -> do
          Either UntangleErr ()
checkNoSpecs
          [TypeSpecifier]
args' <- [TypeSpecifier]
-> (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> Either UntangleErr [TypeSpecifier]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TypeSpecifier]
args TypeSpecifier -> Either UntangleErr TypeSpecifier
type2type
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ CIdentifier -> [TypeSpecifier] -> TypeSpecifier
Template CIdentifier
s [TypeSpecifier]
args'
        P.TemplateConst String
s -> do
          Either UntangleErr ()
checkNoSpecs
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ String -> TypeSpecifier
TemplateConst String
s
        P.TemplatePointer TypeSpecifier
s -> do
          Either UntangleErr ()
checkNoSpecs
          TypeSpecifier
s' <- TypeSpecifier -> Either UntangleErr TypeSpecifier
type2type TypeSpecifier
s
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ TypeSpecifier -> TypeSpecifier
TemplatePointer TypeSpecifier
s'
        P.TypeName CIdentifier
s -> do
          Either UntangleErr ()
checkNoSpecs
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ CIdentifier -> TypeSpecifier
TypeName CIdentifier
s
        P.Struct CIdentifier
s -> do
          Either UntangleErr ()
checkNoSpecs
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ CIdentifier -> TypeSpecifier
Struct CIdentifier
s
        P.Enum CIdentifier
s -> do
          Either UntangleErr ()
checkNoSpecs
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ CIdentifier -> TypeSpecifier
Enum CIdentifier
s
        TypeSpecifier
P.VOID -> do
          Either UntangleErr ()
checkNoSpecs
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
Void
        TypeSpecifier
P.BOOL -> do
          Either UntangleErr ()
checkNoLength
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ TypeSpecifier
Bool
        TypeSpecifier
P.CHAR -> do
          Either UntangleErr ()
checkNoLength
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ Maybe Sign -> TypeSpecifier
Char Maybe Sign
mbSign
        TypeSpecifier
P.INT | Int
longs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
shorts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> do
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ Sign -> TypeSpecifier
Int Sign
sign
        TypeSpecifier
P.INT | Int
longs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> do
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ Sign -> TypeSpecifier
Long Sign
sign
        TypeSpecifier
P.INT | Int
longs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> do
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ Sign -> TypeSpecifier
LLong Sign
sign
        TypeSpecifier
P.INT | Int
shorts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> do
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeSpecifier -> Either UntangleErr TypeSpecifier)
-> TypeSpecifier -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ Sign -> TypeSpecifier
Short Sign
sign
        TypeSpecifier
P.INT -> do
          String -> Either UntangleErr TypeSpecifier
forall a. String -> Either UntangleErr a
illegalSpecifiers String
"too many long/short"
        TypeSpecifier
P.FLOAT -> do
          Either UntangleErr ()
checkNoLength
          TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
Float
        TypeSpecifier
P.DOUBLE -> do
          if Int
longs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
            then TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
LDouble
            else do
              Either UntangleErr ()
checkNoLength
              TypeSpecifier -> Either UntangleErr TypeSpecifier
forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
Double
        TypeSpecifier
_ -> do
          String -> Either UntangleErr TypeSpecifier
forall a. HasCallStack => String -> a
error (String -> Either UntangleErr TypeSpecifier)
-> String -> Either UntangleErr TypeSpecifier
forall a b. (a -> b) -> a -> b
$ String
"untangleDeclarationSpecifiers impossible: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeSpecifier -> String
forall a. Show a => a -> String
show TypeSpecifier
dataType
  TypeSpecifier
tySpec <- TypeSpecifier -> Either UntangleErr TypeSpecifier
type2type TypeSpecifier
dataType
  (Specifiers, TypeSpecifier)
-> Either UntangleErr (Specifiers, TypeSpecifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([StorageClassSpecifier]
-> [TypeQualifier] -> [FunctionSpecifier] -> Specifiers
Specifiers [StorageClassSpecifier]
pStorage [TypeQualifier]
pTyQuals [FunctionSpecifier]
pFunSpecs, TypeSpecifier
tySpec)

untangleDeclarator
  :: forall i. Type i -> P.Declarator i -> Either UntangleErr (i, Type i)
untangleDeclarator :: Type i -> Declarator i -> Either UntangleErr (i, Type i)
untangleDeclarator Type i
ty0 (P.Declarator [Pointer]
ptrs0 DirectDeclarator i
directDecltor) = Type i -> [Pointer] -> Either UntangleErr (i, Type i)
go Type i
ty0 [Pointer]
ptrs0
  where
    go :: Type i -> [P.Pointer] -> Either UntangleErr (i, Type i)
    go :: Type i -> [Pointer] -> Either UntangleErr (i, Type i)
go Type i
ty [] = Type i -> DirectDeclarator i -> Either UntangleErr (i, Type i)
goDirect Type i
ty DirectDeclarator i
directDecltor
    go Type i
ty (P.Pointer [TypeQualifier]
quals : [Pointer]
ptrs) = Type i -> [Pointer] -> Either UntangleErr (i, Type i)
go ([TypeQualifier] -> Type i -> Type i
forall i. [TypeQualifier] -> Type i -> Type i
Ptr [TypeQualifier]
quals Type i
ty) [Pointer]
ptrs

    goDirect :: Type i -> P.DirectDeclarator i -> Either UntangleErr (i, Type i)
    goDirect :: Type i -> DirectDeclarator i -> Either UntangleErr (i, Type i)
goDirect Type i
ty DirectDeclarator i
direct0 = case DirectDeclarator i
direct0 of
      P.DeclaratorRoot i
s -> (i, Type i) -> Either UntangleErr (i, Type i)
forall (m :: * -> *) a. Monad m => a -> m a
return (i
s, Type i
ty)
      P.ArrayOrProto DirectDeclarator i
direct (P.Array ArrayType i
arrayType) ->
        Type i -> DirectDeclarator i -> Either UntangleErr (i, Type i)
goDirect (ArrayType i -> Type i -> Type i
forall i. ArrayType i -> Type i -> Type i
Array ArrayType i
arrayType Type i
ty) DirectDeclarator i
direct
      P.ArrayOrProto DirectDeclarator i
direct (P.Proto [ParameterDeclaration i]
params) -> do
        [ParameterDeclaration i]
params' <- (ParameterDeclaration i
 -> Either UntangleErr (ParameterDeclaration i))
-> [ParameterDeclaration i]
-> Either UntangleErr [ParameterDeclaration i]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
forall i.
ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration [ParameterDeclaration i]
params
        Type i -> DirectDeclarator i -> Either UntangleErr (i, Type i)
goDirect (Type i -> [ParameterDeclaration i] -> Type i
forall i. Type i -> [ParameterDeclaration i] -> Type i
Proto Type i
ty [ParameterDeclaration i]
params') DirectDeclarator i
direct
      P.DeclaratorParens Declarator i
decltor ->
        Type i -> Declarator i -> Either UntangleErr (i, Type i)
forall i. Type i -> Declarator i -> Either UntangleErr (i, Type i)
untangleDeclarator Type i
ty Declarator i
decltor

untangleAbstractDeclarator
  :: forall i. Type i -> P.AbstractDeclarator i -> Either UntangleErr (Type i)
untangleAbstractDeclarator :: Type i -> AbstractDeclarator i -> Either UntangleErr (Type i)
untangleAbstractDeclarator Type i
ty0 (P.AbstractDeclarator [Pointer]
ptrs0 Maybe (DirectAbstractDeclarator i)
mbDirectDecltor) =
  Type i -> [Pointer] -> Either UntangleErr (Type i)
go Type i
ty0 [Pointer]
ptrs0
  where
    go :: Type i -> [P.Pointer] -> Either UntangleErr (Type i)
    go :: Type i -> [Pointer] -> Either UntangleErr (Type i)
go Type i
ty [] = case Maybe (DirectAbstractDeclarator i)
mbDirectDecltor of
      Maybe (DirectAbstractDeclarator i)
Nothing -> Type i -> Either UntangleErr (Type i)
forall (m :: * -> *) a. Monad m => a -> m a
return Type i
ty
      Just DirectAbstractDeclarator i
directDecltor -> Type i -> DirectAbstractDeclarator i -> Either UntangleErr (Type i)
goDirect Type i
ty DirectAbstractDeclarator i
directDecltor
    go Type i
ty (P.Pointer [TypeQualifier]
quals : [Pointer]
ptrs) = Type i -> [Pointer] -> Either UntangleErr (Type i)
go ([TypeQualifier] -> Type i -> Type i
forall i. [TypeQualifier] -> Type i -> Type i
Ptr [TypeQualifier]
quals Type i
ty) [Pointer]
ptrs

    goDirect :: Type i -> P.DirectAbstractDeclarator i -> Either UntangleErr (Type i)
    goDirect :: Type i -> DirectAbstractDeclarator i -> Either UntangleErr (Type i)
goDirect Type i
ty DirectAbstractDeclarator i
direct0 = case DirectAbstractDeclarator i
direct0 of
      P.ArrayOrProtoThere DirectAbstractDeclarator i
direct (P.Array ArrayType i
arrayType) ->
        Type i -> DirectAbstractDeclarator i -> Either UntangleErr (Type i)
goDirect (ArrayType i -> Type i -> Type i
forall i. ArrayType i -> Type i -> Type i
Array ArrayType i
arrayType Type i
ty) DirectAbstractDeclarator i
direct
      P.ArrayOrProtoThere DirectAbstractDeclarator i
direct (P.Proto [ParameterDeclaration i]
params) -> do
        [ParameterDeclaration i]
params' <- (ParameterDeclaration i
 -> Either UntangleErr (ParameterDeclaration i))
-> [ParameterDeclaration i]
-> Either UntangleErr [ParameterDeclaration i]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
forall i.
ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration [ParameterDeclaration i]
params
        Type i -> DirectAbstractDeclarator i -> Either UntangleErr (Type i)
goDirect (Type i -> [ParameterDeclaration i] -> Type i
forall i. Type i -> [ParameterDeclaration i] -> Type i
Proto Type i
ty [ParameterDeclaration i]
params') DirectAbstractDeclarator i
direct
      P.ArrayOrProtoHere (P.Array ArrayType i
arrayType) ->
        Type i -> Either UntangleErr (Type i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type i -> Either UntangleErr (Type i))
-> Type i -> Either UntangleErr (Type i)
forall a b. (a -> b) -> a -> b
$ ArrayType i -> Type i -> Type i
forall i. ArrayType i -> Type i -> Type i
Array ArrayType i
arrayType Type i
ty
      P.ArrayOrProtoHere (P.Proto [ParameterDeclaration i]
params) -> do
        [ParameterDeclaration i]
params' <- (ParameterDeclaration i
 -> Either UntangleErr (ParameterDeclaration i))
-> [ParameterDeclaration i]
-> Either UntangleErr [ParameterDeclaration i]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
forall i.
ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration [ParameterDeclaration i]
params
        Type i -> Either UntangleErr (Type i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type i -> Either UntangleErr (Type i))
-> Type i -> Either UntangleErr (Type i)
forall a b. (a -> b) -> a -> b
$ Type i -> [ParameterDeclaration i] -> Type i
forall i. Type i -> [ParameterDeclaration i] -> Type i
Proto Type i
ty [ParameterDeclaration i]
params'
      P.AbstractDeclaratorParens AbstractDeclarator i
decltor ->
        Type i -> AbstractDeclarator i -> Either UntangleErr (Type i)
forall i.
Type i -> AbstractDeclarator i -> Either UntangleErr (Type i)
untangleAbstractDeclarator Type i
ty AbstractDeclarator i
decltor

------------------------------------------------------------------------
-- Tangling

tangleParameterDeclaration
  :: forall i. ParameterDeclaration i -> P.ParameterDeclaration i
tangleParameterDeclaration :: ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration (ParameterDeclaration Maybe i
mbId Type i
ty00) =
    ([DeclarationSpecifier]
 -> DeclaratorOrAbstractDeclarator i -> ParameterDeclaration i)
-> ([DeclarationSpecifier], DeclaratorOrAbstractDeclarator i)
-> ParameterDeclaration i
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [DeclarationSpecifier]
-> DeclaratorOrAbstractDeclarator i -> ParameterDeclaration i
forall i.
[DeclarationSpecifier]
-> DeclaratorOrAbstractDeclarator i -> ParameterDeclaration i
P.ParameterDeclaration (([DeclarationSpecifier], DeclaratorOrAbstractDeclarator i)
 -> ParameterDeclaration i)
-> ([DeclarationSpecifier], DeclaratorOrAbstractDeclarator i)
-> ParameterDeclaration i
forall a b. (a -> b) -> a -> b
$ case Maybe i
mbId of
      Maybe i
Nothing -> (AbstractDeclarator i -> DeclaratorOrAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
-> ([DeclarationSpecifier], DeclaratorOrAbstractDeclarator i)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second AbstractDeclarator i -> DeclaratorOrAbstractDeclarator i
forall i. AbstractDeclarator i -> DeclaratorOrAbstractDeclarator i
P.IsAbstractDeclarator (([DeclarationSpecifier], AbstractDeclarator i)
 -> ([DeclarationSpecifier], DeclaratorOrAbstractDeclarator i))
-> ([DeclarationSpecifier], AbstractDeclarator i)
-> ([DeclarationSpecifier], DeclaratorOrAbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty00 Maybe (DirectAbstractDeclarator i)
forall a. Maybe a
Nothing
      Just i
id' -> (Declarator i -> DeclaratorOrAbstractDeclarator i)
-> ([DeclarationSpecifier], Declarator i)
-> ([DeclarationSpecifier], DeclaratorOrAbstractDeclarator i)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Declarator i -> DeclaratorOrAbstractDeclarator i
forall i. Declarator i -> DeclaratorOrAbstractDeclarator i
P.IsDeclarator (([DeclarationSpecifier], Declarator i)
 -> ([DeclarationSpecifier], DeclaratorOrAbstractDeclarator i))
-> ([DeclarationSpecifier], Declarator i)
-> ([DeclarationSpecifier], DeclaratorOrAbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty00 (DirectDeclarator i -> ([DeclarationSpecifier], Declarator i))
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
forall a b. (a -> b) -> a -> b
$ i -> DirectDeclarator i
forall i. i -> DirectDeclarator i
P.DeclaratorRoot i
id'
  where
    goAbstractDirect
      :: Type i -> Maybe (P.DirectAbstractDeclarator i)
      -> ([P.DeclarationSpecifier], P.AbstractDeclarator i)
    goAbstractDirect :: Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty0 Maybe (DirectAbstractDeclarator i)
mbDirect = case Type i
ty0 of
      TypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec ->
        let declSpecs :: [DeclarationSpecifier]
declSpecs = Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec
        in ([DeclarationSpecifier]
declSpecs, [Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
forall i.
[Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
P.AbstractDeclarator [] Maybe (DirectAbstractDeclarator i)
mbDirect)
      Ptr [TypeQualifier]
tyQuals Type i
ty ->
        Type i
-> [Pointer]
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstract Type i
ty [[TypeQualifier] -> Pointer
P.Pointer [TypeQualifier]
tyQuals] Maybe (DirectAbstractDeclarator i)
mbDirect
      Array ArrayType i
arrType Type i
ty ->
        let arr :: ArrayOrProto i
arr = ArrayType i -> ArrayOrProto i
forall i. ArrayType i -> ArrayOrProto i
P.Array ArrayType i
arrType
        in case Maybe (DirectAbstractDeclarator i)
mbDirect of
          Maybe (DirectAbstractDeclarator i)
Nothing ->
            Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty (Maybe (DirectAbstractDeclarator i)
 -> ([DeclarationSpecifier], AbstractDeclarator i))
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a. a -> Maybe a
Just (DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i))
-> DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ ArrayOrProto i -> DirectAbstractDeclarator i
forall i. ArrayOrProto i -> DirectAbstractDeclarator i
P.ArrayOrProtoHere ArrayOrProto i
arr
          Just DirectAbstractDeclarator i
decltor ->
            Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty (Maybe (DirectAbstractDeclarator i)
 -> ([DeclarationSpecifier], AbstractDeclarator i))
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a. a -> Maybe a
Just (DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i))
-> DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ DirectAbstractDeclarator i
-> ArrayOrProto i -> DirectAbstractDeclarator i
forall i.
DirectAbstractDeclarator i
-> ArrayOrProto i -> DirectAbstractDeclarator i
P.ArrayOrProtoThere DirectAbstractDeclarator i
decltor ArrayOrProto i
arr
      Proto Type i
ty [ParameterDeclaration i]
params ->
        let proto :: ArrayOrProto i
proto = [ParameterDeclaration i] -> ArrayOrProto i
forall i. [ParameterDeclaration i] -> ArrayOrProto i
P.Proto ([ParameterDeclaration i] -> ArrayOrProto i)
-> [ParameterDeclaration i] -> ArrayOrProto i
forall a b. (a -> b) -> a -> b
$ (ParameterDeclaration i -> ParameterDeclaration i)
-> [ParameterDeclaration i] -> [ParameterDeclaration i]
forall a b. (a -> b) -> [a] -> [b]
map ParameterDeclaration i -> ParameterDeclaration i
forall i. ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration [ParameterDeclaration i]
params
        in case Maybe (DirectAbstractDeclarator i)
mbDirect of
          Maybe (DirectAbstractDeclarator i)
Nothing ->
            Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty (Maybe (DirectAbstractDeclarator i)
 -> ([DeclarationSpecifier], AbstractDeclarator i))
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a. a -> Maybe a
Just (DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i))
-> DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ ArrayOrProto i -> DirectAbstractDeclarator i
forall i. ArrayOrProto i -> DirectAbstractDeclarator i
P.ArrayOrProtoHere ArrayOrProto i
proto
          Just DirectAbstractDeclarator i
decltor ->
            Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty (Maybe (DirectAbstractDeclarator i)
 -> ([DeclarationSpecifier], AbstractDeclarator i))
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a. a -> Maybe a
Just (DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i))
-> DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ DirectAbstractDeclarator i
-> ArrayOrProto i -> DirectAbstractDeclarator i
forall i.
DirectAbstractDeclarator i
-> ArrayOrProto i -> DirectAbstractDeclarator i
P.ArrayOrProtoThere DirectAbstractDeclarator i
decltor ArrayOrProto i
proto

    goAbstract
      :: Type i -> [P.Pointer] -> Maybe (P.DirectAbstractDeclarator i)
      -> ([P.DeclarationSpecifier], P.AbstractDeclarator i)
    goAbstract :: Type i
-> [Pointer]
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstract Type i
ty0 [Pointer]
ptrs Maybe (DirectAbstractDeclarator i)
mbDirect = case Type i
ty0 of
      TypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec ->
        let declSpecs :: [DeclarationSpecifier]
declSpecs = Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec
        in ([DeclarationSpecifier]
declSpecs, [Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
forall i.
[Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
P.AbstractDeclarator [Pointer]
ptrs Maybe (DirectAbstractDeclarator i)
mbDirect)
      Ptr [TypeQualifier]
tyQuals Type i
ty ->
        Type i
-> [Pointer]
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstract Type i
ty ([TypeQualifier] -> Pointer
P.Pointer [TypeQualifier]
tyQuals Pointer -> [Pointer] -> [Pointer]
forall a. a -> [a] -> [a]
: [Pointer]
ptrs) Maybe (DirectAbstractDeclarator i)
mbDirect
      Array{} ->
        Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty0 (Maybe (DirectAbstractDeclarator i)
 -> ([DeclarationSpecifier], AbstractDeclarator i))
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a. a -> Maybe a
Just (DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i))
-> DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ AbstractDeclarator i -> DirectAbstractDeclarator i
forall i. AbstractDeclarator i -> DirectAbstractDeclarator i
P.AbstractDeclaratorParens (AbstractDeclarator i -> DirectAbstractDeclarator i)
-> AbstractDeclarator i -> DirectAbstractDeclarator i
forall a b. (a -> b) -> a -> b
$
          [Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
forall i.
[Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
P.AbstractDeclarator [Pointer]
ptrs Maybe (DirectAbstractDeclarator i)
mbDirect
      Proto{} ->
        Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty0 (Maybe (DirectAbstractDeclarator i)
 -> ([DeclarationSpecifier], AbstractDeclarator i))
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a. a -> Maybe a
Just (DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i))
-> DirectAbstractDeclarator i -> Maybe (DirectAbstractDeclarator i)
forall a b. (a -> b) -> a -> b
$ AbstractDeclarator i -> DirectAbstractDeclarator i
forall i. AbstractDeclarator i -> DirectAbstractDeclarator i
P.AbstractDeclaratorParens (AbstractDeclarator i -> DirectAbstractDeclarator i)
-> AbstractDeclarator i -> DirectAbstractDeclarator i
forall a b. (a -> b) -> a -> b
$
          [Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
forall i.
[Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
P.AbstractDeclarator [Pointer]
ptrs Maybe (DirectAbstractDeclarator i)
mbDirect

    goConcreteDirect
      :: Type i -> P.DirectDeclarator i
      -> ([P.DeclarationSpecifier], P.Declarator i)
    goConcreteDirect :: Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty0 DirectDeclarator i
direct = case Type i
ty0 of
      TypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec ->
        let declSpecs :: [DeclarationSpecifier]
declSpecs = Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec
        in ([DeclarationSpecifier]
declSpecs, [Pointer] -> DirectDeclarator i -> Declarator i
forall i. [Pointer] -> DirectDeclarator i -> Declarator i
P.Declarator [] DirectDeclarator i
direct)
      Ptr [TypeQualifier]
tyQuals Type i
ty ->
        Type i
-> [Pointer]
-> DirectDeclarator i
-> ([DeclarationSpecifier], Declarator i)
goConcrete Type i
ty [[TypeQualifier] -> Pointer
P.Pointer [TypeQualifier]
tyQuals] DirectDeclarator i
direct
      Array ArrayType i
arrType Type i
ty ->
        Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty (DirectDeclarator i -> ([DeclarationSpecifier], Declarator i))
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
forall a b. (a -> b) -> a -> b
$ DirectDeclarator i -> ArrayOrProto i -> DirectDeclarator i
forall i.
DirectDeclarator i -> ArrayOrProto i -> DirectDeclarator i
P.ArrayOrProto DirectDeclarator i
direct (ArrayOrProto i -> DirectDeclarator i)
-> ArrayOrProto i -> DirectDeclarator i
forall a b. (a -> b) -> a -> b
$ ArrayType i -> ArrayOrProto i
forall i. ArrayType i -> ArrayOrProto i
P.Array ArrayType i
arrType
      Proto Type i
ty [ParameterDeclaration i]
params ->
        Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty (DirectDeclarator i -> ([DeclarationSpecifier], Declarator i))
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
forall a b. (a -> b) -> a -> b
$ DirectDeclarator i -> ArrayOrProto i -> DirectDeclarator i
forall i.
DirectDeclarator i -> ArrayOrProto i -> DirectDeclarator i
P.ArrayOrProto DirectDeclarator i
direct (ArrayOrProto i -> DirectDeclarator i)
-> ArrayOrProto i -> DirectDeclarator i
forall a b. (a -> b) -> a -> b
$
          [ParameterDeclaration i] -> ArrayOrProto i
forall i. [ParameterDeclaration i] -> ArrayOrProto i
P.Proto ([ParameterDeclaration i] -> ArrayOrProto i)
-> [ParameterDeclaration i] -> ArrayOrProto i
forall a b. (a -> b) -> a -> b
$ (ParameterDeclaration i -> ParameterDeclaration i)
-> [ParameterDeclaration i] -> [ParameterDeclaration i]
forall a b. (a -> b) -> [a] -> [b]
map ParameterDeclaration i -> ParameterDeclaration i
forall i. ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration [ParameterDeclaration i]
params

    goConcrete
      :: Type i -> [P.Pointer] -> P.DirectDeclarator i
      -> ([P.DeclarationSpecifier], P.Declarator i)
    goConcrete :: Type i
-> [Pointer]
-> DirectDeclarator i
-> ([DeclarationSpecifier], Declarator i)
goConcrete Type i
ty0 [Pointer]
ptrs DirectDeclarator i
direct = case Type i
ty0 of
      TypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec ->
        let declSpecs :: [DeclarationSpecifier]
declSpecs = Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec
        in ([DeclarationSpecifier]
declSpecs, [Pointer] -> DirectDeclarator i -> Declarator i
forall i. [Pointer] -> DirectDeclarator i -> Declarator i
P.Declarator [Pointer]
ptrs DirectDeclarator i
direct)
      Ptr [TypeQualifier]
tyQuals Type i
ty ->
        Type i
-> [Pointer]
-> DirectDeclarator i
-> ([DeclarationSpecifier], Declarator i)
goConcrete Type i
ty ([TypeQualifier] -> Pointer
P.Pointer [TypeQualifier]
tyQuals Pointer -> [Pointer] -> [Pointer]
forall a. a -> [a] -> [a]
: [Pointer]
ptrs) DirectDeclarator i
direct
      Array{} ->
        Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty0 (DirectDeclarator i -> ([DeclarationSpecifier], Declarator i))
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
forall a b. (a -> b) -> a -> b
$ Declarator i -> DirectDeclarator i
forall i. Declarator i -> DirectDeclarator i
P.DeclaratorParens (Declarator i -> DirectDeclarator i)
-> Declarator i -> DirectDeclarator i
forall a b. (a -> b) -> a -> b
$ [Pointer] -> DirectDeclarator i -> Declarator i
forall i. [Pointer] -> DirectDeclarator i -> Declarator i
P.Declarator [Pointer]
ptrs DirectDeclarator i
direct
      Proto{} ->
        Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty0 (DirectDeclarator i -> ([DeclarationSpecifier], Declarator i))
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
forall a b. (a -> b) -> a -> b
$ Declarator i -> DirectDeclarator i
forall i. Declarator i -> DirectDeclarator i
P.DeclaratorParens (Declarator i -> DirectDeclarator i)
-> Declarator i -> DirectDeclarator i
forall a b. (a -> b) -> a -> b
$ [Pointer] -> DirectDeclarator i -> Declarator i
forall i. [Pointer] -> DirectDeclarator i -> Declarator i
P.Declarator [Pointer]
ptrs DirectDeclarator i
direct

tangleTypeSpecifier :: Specifiers -> TypeSpecifier -> [P.DeclarationSpecifier]
tangleTypeSpecifier :: Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier (Specifiers [StorageClassSpecifier]
storages [TypeQualifier]
tyQuals [FunctionSpecifier]
funSpecs) TypeSpecifier
tySpec =
  let pTySpecs :: TypeSpecifier -> [TypeSpecifier]
pTySpecs TypeSpecifier
ty = case TypeSpecifier
ty of
        TypeSpecifier
Void -> [TypeSpecifier
P.VOID]
        TypeSpecifier
Bool -> [TypeSpecifier
P.BOOL]
        Char Maybe Sign
Nothing -> [TypeSpecifier
P.CHAR]
        Char (Just Sign
Signed) -> [TypeSpecifier
P.SIGNED, TypeSpecifier
P.CHAR]
        Char (Just Sign
Unsigned) -> [TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.CHAR]
        Short Sign
Signed -> [TypeSpecifier
P.SHORT]
        Short Sign
Unsigned -> [TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.SHORT]
        Int Sign
Signed -> [TypeSpecifier
P.INT]
        Int Sign
Unsigned -> [TypeSpecifier
P.UNSIGNED]
        Long Sign
Signed -> [TypeSpecifier
P.LONG]
        Long Sign
Unsigned -> [TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.LONG]
        LLong Sign
Signed -> [TypeSpecifier
P.LONG, TypeSpecifier
P.LONG]
        LLong Sign
Unsigned -> [TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.LONG, TypeSpecifier
P.LONG]
        TypeSpecifier
Float -> [TypeSpecifier
P.FLOAT]
        TypeSpecifier
Double -> [TypeSpecifier
P.DOUBLE]
        TypeSpecifier
LDouble -> [TypeSpecifier
P.LONG, TypeSpecifier
P.DOUBLE]
        TypeName CIdentifier
s -> [CIdentifier -> TypeSpecifier
P.TypeName CIdentifier
s]
        Struct CIdentifier
s -> [CIdentifier -> TypeSpecifier
P.Struct CIdentifier
s]
        Enum CIdentifier
s -> [CIdentifier -> TypeSpecifier
P.Enum CIdentifier
s]
        Template CIdentifier
s [TypeSpecifier]
types -> [CIdentifier -> [TypeSpecifier] -> TypeSpecifier
P.Template CIdentifier
s ([[TypeSpecifier]] -> [TypeSpecifier]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((TypeSpecifier -> [TypeSpecifier])
-> [TypeSpecifier] -> [[TypeSpecifier]]
forall a b. (a -> b) -> [a] -> [b]
map TypeSpecifier -> [TypeSpecifier]
pTySpecs [TypeSpecifier]
types))]
        TemplateConst String
s -> [String -> TypeSpecifier
P.TemplateConst String
s]
        TemplatePointer TypeSpecifier
type' -> [TypeSpecifier -> TypeSpecifier
P.TemplatePointer ([TypeSpecifier] -> TypeSpecifier
forall a. [a] -> a
head (TypeSpecifier -> [TypeSpecifier]
pTySpecs TypeSpecifier
type'))]
  in (StorageClassSpecifier -> DeclarationSpecifier)
-> [StorageClassSpecifier] -> [DeclarationSpecifier]
forall a b. (a -> b) -> [a] -> [b]
map StorageClassSpecifier -> DeclarationSpecifier
P.StorageClassSpecifier [StorageClassSpecifier]
storages [DeclarationSpecifier]
-> [DeclarationSpecifier] -> [DeclarationSpecifier]
forall a. [a] -> [a] -> [a]
++
     (TypeQualifier -> DeclarationSpecifier)
-> [TypeQualifier] -> [DeclarationSpecifier]
forall a b. (a -> b) -> [a] -> [b]
map TypeQualifier -> DeclarationSpecifier
P.TypeQualifier [TypeQualifier]
tyQuals [DeclarationSpecifier]
-> [DeclarationSpecifier] -> [DeclarationSpecifier]
forall a. [a] -> [a] -> [a]
++
     (FunctionSpecifier -> DeclarationSpecifier)
-> [FunctionSpecifier] -> [DeclarationSpecifier]
forall a b. (a -> b) -> [a] -> [b]
map FunctionSpecifier -> DeclarationSpecifier
P.FunctionSpecifier [FunctionSpecifier]
funSpecs [DeclarationSpecifier]
-> [DeclarationSpecifier] -> [DeclarationSpecifier]
forall a. [a] -> [a] -> [a]
++
     (TypeSpecifier -> DeclarationSpecifier)
-> [TypeSpecifier] -> [DeclarationSpecifier]
forall a b. (a -> b) -> [a] -> [b]
map TypeSpecifier -> DeclarationSpecifier
P.TypeSpecifier (TypeSpecifier -> [TypeSpecifier]
pTySpecs TypeSpecifier
tySpec)

------------------------------------------------------------------------
-- To english

describeParameterDeclaration :: PP.Pretty i => ParameterDeclaration i -> PP.Doc
describeParameterDeclaration :: ParameterDeclaration i -> Doc
describeParameterDeclaration (ParameterDeclaration Maybe i
mbId Type i
ty) =
  let idDoc :: Doc
idDoc = case Maybe i
mbId of
        Maybe i
Nothing -> Doc
""
        Just i
id' -> i -> Doc
forall a. Pretty a => a -> Doc
PP.pretty i
id' Doc -> Doc -> Doc
<+> Doc
"is a "
  in Doc
idDoc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Type i -> Doc
forall i. Pretty i => Type i -> Doc
describeType Type i
ty

describeType :: PP.Pretty i => Type i -> PP.Doc
describeType :: Type i -> Doc
describeType Type i
ty0 = case Type i
ty0 of
  TypeSpecifier Specifiers
specs TypeSpecifier
tySpec -> Specifiers -> Doc
engSpecs Specifiers
specs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> TypeSpecifier -> Doc
forall a. Pretty a => a -> Doc
PP.pretty TypeSpecifier
tySpec
  Ptr [TypeQualifier]
quals Type i
ty -> [TypeQualifier] -> Doc
engQuals [TypeQualifier]
quals Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"ptr to" Doc -> Doc -> Doc
<+> Type i -> Doc
forall i. Pretty i => Type i -> Doc
describeType Type i
ty
  Array ArrayType i
arrTy Type i
ty -> ArrayType i -> Doc
forall a. Pretty a => ArrayType a -> Doc
engArrTy ArrayType i
arrTy Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"of" Doc -> Doc -> Doc
<+> Type i -> Doc
forall i. Pretty i => Type i -> Doc
describeType Type i
ty
  Proto Type i
retTy [ParameterDeclaration i]
params ->
     Doc
"function from" Doc -> Doc -> Doc
<+> [ParameterDeclaration i] -> Doc
forall i. Pretty i => [ParameterDeclaration i] -> Doc
engParams [ParameterDeclaration i]
params Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"returning" Doc -> Doc -> Doc
<+> Type i -> Doc
forall i. Pretty i => Type i -> Doc
describeType Type i
retTy
  where
    engSpecs :: Specifiers -> Doc
engSpecs (Specifiers [] [] []) = Doc
""
    engSpecs (Specifiers [StorageClassSpecifier]
x [TypeQualifier]
y [FunctionSpecifier]
z) =
      let xs :: [DeclarationSpecifier]
xs = (StorageClassSpecifier -> DeclarationSpecifier)
-> [StorageClassSpecifier] -> [DeclarationSpecifier]
forall a b. (a -> b) -> [a] -> [b]
map StorageClassSpecifier -> DeclarationSpecifier
P.StorageClassSpecifier [StorageClassSpecifier]
x [DeclarationSpecifier]
-> [DeclarationSpecifier] -> [DeclarationSpecifier]
forall a. [a] -> [a] -> [a]
++ (TypeQualifier -> DeclarationSpecifier)
-> [TypeQualifier] -> [DeclarationSpecifier]
forall a b. (a -> b) -> [a] -> [b]
map TypeQualifier -> DeclarationSpecifier
P.TypeQualifier [TypeQualifier]
y [DeclarationSpecifier]
-> [DeclarationSpecifier] -> [DeclarationSpecifier]
forall a. [a] -> [a] -> [a]
++
               (FunctionSpecifier -> DeclarationSpecifier)
-> [FunctionSpecifier] -> [DeclarationSpecifier]
forall a b. (a -> b) -> [a] -> [b]
map FunctionSpecifier -> DeclarationSpecifier
P.FunctionSpecifier [FunctionSpecifier]
z
      in [Doc] -> Doc
PP.hsep ((DeclarationSpecifier -> Doc) -> [DeclarationSpecifier] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map DeclarationSpecifier -> Doc
forall a. Pretty a => a -> Doc
PP.pretty [DeclarationSpecifier]
xs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" "

    engQuals :: [TypeQualifier] -> Doc
engQuals = [Doc] -> Doc
PP.hsep ([Doc] -> Doc)
-> ([TypeQualifier] -> [Doc]) -> [TypeQualifier] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeQualifier -> Doc) -> [TypeQualifier] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeQualifier -> Doc
forall a. Pretty a => a -> Doc
PP.pretty

    engArrTy :: ArrayType a -> Doc
engArrTy ArrayType a
arrTy = case ArrayType a
arrTy of
      ArrayType a
P.VariablySized -> Doc
"variably sized array "
      P.SizedByInteger Integer
n -> Doc
"array of size" Doc -> Doc -> Doc
<+> String -> Doc
PP.text (Integer -> String
forall a. Show a => a -> String
show Integer
n) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" "
      P.SizedByIdentifier a
s -> Doc
"array of size" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
PP.pretty a
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" "
      ArrayType a
P.Unsized -> Doc
"array "

    engParams :: [ParameterDeclaration i] -> Doc
engParams [] = Doc
""
    engParams [ParameterDeclaration i]
params0 = Doc
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [ParameterDeclaration i] -> Doc
forall i. Pretty i => [ParameterDeclaration i] -> Doc
go [ParameterDeclaration i]
params0 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
") "
      where
        go :: [ParameterDeclaration i] -> Doc
go [ParameterDeclaration i]
xs = case [ParameterDeclaration i]
xs of
          [] -> Doc
""
          [ParameterDeclaration i
x] -> ParameterDeclaration i -> Doc
forall i. Pretty i => ParameterDeclaration i -> Doc
describeParameterDeclaration ParameterDeclaration i
x
          (ParameterDeclaration i
x:[ParameterDeclaration i]
xs') -> ParameterDeclaration i -> Doc
forall i. Pretty i => ParameterDeclaration i -> Doc
describeParameterDeclaration ParameterDeclaration i
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"," Doc -> Doc -> Doc
<+> [ParameterDeclaration i] -> Doc
go [ParameterDeclaration i]
xs'

------------------------------------------------------------------------
-- Convenient parsing

untangleParameterDeclaration'
  :: (P.CParser i m, PP.Pretty i)
  => P.ParameterDeclaration i -> m (ParameterDeclaration i)
untangleParameterDeclaration' :: ParameterDeclaration i -> m (ParameterDeclaration i)
untangleParameterDeclaration' ParameterDeclaration i
pDecl =
  case ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
forall i.
ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration ParameterDeclaration i
pDecl of
    Left UntangleErr
err -> String -> m (ParameterDeclaration i)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (ParameterDeclaration i))
-> String -> m (ParameterDeclaration i)
forall a b. (a -> b) -> a -> b
$ Doc -> String
pretty80 (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
      Doc
"Error while parsing declaration:" Doc -> Doc -> Doc
</> UntangleErr -> Doc
forall a. Pretty a => a -> Doc
PP.pretty UntangleErr
err Doc -> Doc -> Doc
</> ParameterDeclaration i -> Doc
forall a. Pretty a => a -> Doc
PP.pretty ParameterDeclaration i
pDecl
    Right ParameterDeclaration i
x -> ParameterDeclaration i -> m (ParameterDeclaration i)
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterDeclaration i
x

parseParameterDeclaration
  :: (P.CParser i m, PP.Pretty i) => m (ParameterDeclaration i)
parseParameterDeclaration :: m (ParameterDeclaration i)
parseParameterDeclaration =
  ParameterDeclaration i -> m (ParameterDeclaration i)
forall i (m :: * -> *).
(CParser i m, Pretty i) =>
ParameterDeclaration i -> m (ParameterDeclaration i)
untangleParameterDeclaration' (ParameterDeclaration i -> m (ParameterDeclaration i))
-> m (ParameterDeclaration i) -> m (ParameterDeclaration i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (ParameterDeclaration i)
forall i (m :: * -> *). CParser i m => m (ParameterDeclaration i)
P.parameter_declaration

parseParameterList
  :: (P.CParser i m, PP.Pretty i)
  => m [ParameterDeclaration i]
parseParameterList :: m [ParameterDeclaration i]
parseParameterList =
  (ParameterDeclaration i -> m (ParameterDeclaration i))
-> [ParameterDeclaration i] -> m [ParameterDeclaration i]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParameterDeclaration i -> m (ParameterDeclaration i)
forall i (m :: * -> *).
(CParser i m, Pretty i) =>
ParameterDeclaration i -> m (ParameterDeclaration i)
untangleParameterDeclaration' ([ParameterDeclaration i] -> m [ParameterDeclaration i])
-> m [ParameterDeclaration i] -> m [ParameterDeclaration i]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m [ParameterDeclaration i]
forall i (m :: * -> *). CParser i m => m [ParameterDeclaration i]
P.parameter_list

parseIdentifier :: P.CParser i m => m i
parseIdentifier :: m i
parseIdentifier = m i
forall i (m :: * -> *). CParser i m => m i
P.identifier_no_lex

parseEnableCpp :: P.CParser i m => m Bool
parseEnableCpp :: m Bool
parseEnableCpp = do
  CParserContext i
ctx <- m (CParserContext i)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (CParserContext i -> Bool
forall i. CParserContext i -> Bool
P.cpcEnableCpp CParserContext i
ctx)

parseType :: (P.CParser i m, PP.Pretty i) => m (Type i)
parseType :: m (Type i)
parseType = ParameterDeclaration i -> Type i
forall i. ParameterDeclaration i -> Type i
parameterDeclarationType (ParameterDeclaration i -> Type i)
-> m (ParameterDeclaration i) -> m (Type i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ParameterDeclaration i)
forall i (m :: * -> *).
(CParser i m, Pretty i) =>
m (ParameterDeclaration i)
parseParameterDeclaration

------------------------------------------------------------------------
-- Pretty

instance PP.Pretty TypeSpecifier where
  pretty :: TypeSpecifier -> Doc
pretty TypeSpecifier
tySpec = case TypeSpecifier
tySpec of
    TypeSpecifier
Void -> Doc
"void"
    TypeSpecifier
Bool -> Doc
"bool"
    Char Maybe Sign
Nothing -> Doc
"char"
    Char (Just Sign
Signed) -> Doc
"signed char"
    Char (Just Sign
Unsigned) -> Doc
"unsigned char"
    Short Sign
Signed -> Doc
"short"
    Short Sign
Unsigned -> Doc
"unsigned short"
    Int Sign
Signed -> Doc
"int"
    Int Sign
Unsigned -> Doc
"unsigned"
    Long Sign
Signed -> Doc
"long"
    Long Sign
Unsigned -> Doc
"unsigned long"
    LLong Sign
Signed -> Doc
"long long"
    LLong Sign
Unsigned -> Doc
"unsigned long long"
    TypeSpecifier
Float -> Doc
"float"
    TypeSpecifier
Double -> Doc
"double"
    TypeSpecifier
LDouble -> Doc
"long double"
    TypeName CIdentifier
s -> CIdentifier -> Doc
forall a. Pretty a => a -> Doc
PP.pretty CIdentifier
s
    Struct CIdentifier
s -> Doc
"struct" Doc -> Doc -> Doc
<+> CIdentifier -> Doc
forall a. Pretty a => a -> Doc
PP.pretty CIdentifier
s
    Enum CIdentifier
s -> Doc
"enum" Doc -> Doc -> Doc
<+> CIdentifier -> Doc
forall a. Pretty a => a -> Doc
PP.pretty CIdentifier
s
    Template CIdentifier
s [TypeSpecifier]
args -> CIdentifier -> Doc
forall a. Pretty a => a -> Doc
PP.pretty CIdentifier
s Doc -> Doc -> Doc
<+> Doc
"<"  Doc -> Doc -> Doc
<+>  [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
"," ((TypeSpecifier -> Doc) -> [TypeSpecifier] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeSpecifier -> Doc
forall a. Pretty a => a -> Doc
PP.pretty [TypeSpecifier]
args))  Doc -> Doc -> Doc
<+> Doc
">"
    TemplateConst String
s -> String -> Doc
forall a. Pretty a => a -> Doc
PP.pretty String
s
    TemplatePointer TypeSpecifier
s -> TypeSpecifier -> Doc
forall a. Pretty a => a -> Doc
PP.pretty TypeSpecifier
s Doc -> Doc -> Doc
<+> Doc
"*"

instance PP.Pretty UntangleErr where
  pretty :: UntangleErr -> Doc
pretty UntangleErr
err = case UntangleErr
err of
    MultipleDataTypes [DeclarationSpecifier]
specs ->
      Doc
"Multiple data types in" Doc -> Doc -> Doc
</> [DeclarationSpecifier] -> Doc
forall a. Pretty a => [a] -> Doc
PP.prettyList [DeclarationSpecifier]
specs
    IllegalSpecifiers String
s [TypeSpecifier]
specs ->
      Doc
"Illegal specifiers, " Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
s Doc -> Doc -> Doc
<+> Doc
", in" Doc -> Doc -> Doc
</> [TypeSpecifier] -> Doc
forall a. Pretty a => [a] -> Doc
PP.prettyList [TypeSpecifier]
specs
    NoDataTypes [DeclarationSpecifier]
specs ->
      Doc
"No data types in " Doc -> Doc -> Doc
</> [DeclarationSpecifier] -> Doc
forall a. Pretty a => [a] -> Doc
PP.prettyList [DeclarationSpecifier]
specs

instance PP.Pretty i => PP.Pretty (ParameterDeclaration i) where
  pretty :: ParameterDeclaration i -> Doc
pretty = ParameterDeclaration i -> Doc
forall a. Pretty a => a -> Doc
PP.pretty (ParameterDeclaration i -> Doc)
-> (ParameterDeclaration i -> ParameterDeclaration i)
-> ParameterDeclaration i
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterDeclaration i -> ParameterDeclaration i
forall i. ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration

instance PP.Pretty i => PP.Pretty (Type i) where
  pretty :: Type i -> Doc
pretty Type i
ty =
    ParameterDeclaration i -> Doc
forall a. Pretty a => a -> Doc
PP.pretty (ParameterDeclaration i -> Doc) -> ParameterDeclaration i -> Doc
forall a b. (a -> b) -> a -> b
$ ParameterDeclaration i -> ParameterDeclaration i
forall i. ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration (ParameterDeclaration i -> ParameterDeclaration i)
-> ParameterDeclaration i -> ParameterDeclaration i
forall a b. (a -> b) -> a -> b
$ Maybe i -> Type i -> ParameterDeclaration i
forall i. Maybe i -> Type i -> ParameterDeclaration i
ParameterDeclaration Maybe i
forall a. Maybe a
Nothing Type i
ty

------------------------------------------------------------------------
-- Utils

pretty80 :: PP.Doc -> String
pretty80 :: Doc -> String
pretty80 Doc
x = SimpleDoc -> ShowS
PP.displayS (Float -> Int -> Doc -> SimpleDoc
PP.renderPretty Float
0.8 Int
80 Doc
x) String
""