module Language.C99.Simple.Translate where

import Prelude hiding (LT, GT)

import GHC.Exts             (fromList)
import Control.Monad.State  (State, execState, get, put)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE

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

import Language.C99.Util
import Language.C99.Simple.Util

translate :: TransUnit -> TransUnit
translate = TransUnit -> TransUnit
transtransunit

transtransunit :: TransUnit -> C.TransUnit
transtransunit :: TransUnit -> TransUnit
transtransunit (TransUnit [Decln]
declns [FunDef]
fundefs) = forall l. IsList l => [Item l] -> l
fromList ([ExtDecln]
declns' forall a. [a] -> [a] -> [a]
++ [ExtDecln]
fundefs') where
  declns' :: [ExtDecln]
declns'  = forall a b. (a -> b) -> [a] -> [b]
map (Decln -> ExtDecln
C.ExtDecln forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decln -> Decln
transdecln) [Decln]
declns
  fundefs' :: [ExtDecln]
fundefs' = forall a b. (a -> b) -> [a] -> [b]
map (FunDef -> ExtDecln
C.ExtFun   forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef -> FunDef
transfundef) [FunDef]
fundefs

transfundef :: FunDef -> C.FunDef
transfundef :: FunDef -> FunDef
transfundef (FunDef Maybe StorageSpec
storespec Type
ty Ident
name [Param]
params [Decln]
decln [Stmt]
ss) =
  DeclnSpecs -> Declr -> Maybe DeclnList -> CompoundStmt -> FunDef
C.FunDef DeclnSpecs
dspecs Declr
declr forall a. Maybe a
Nothing CompoundStmt
body where
    dspecs :: DeclnSpecs
dspecs   = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs Maybe StorageSpec
storespec Type
ty
    body :: CompoundStmt
body     = [Decln] -> [Stmt] -> CompoundStmt
compound [Decln]
decln [Stmt]
ss
    declr :: Declr
declr    = forall s a. State s a -> s -> s
execState (Type -> State Declr ()
getdeclr Type
ty) Declr
fundeclr
    fundeclr :: Declr
fundeclr = Maybe Ptr -> DirectDeclr -> Declr
C.Declr forall a. Maybe a
Nothing (Ident -> [Param] -> DirectDeclr
fundirectdeclr Ident
name [Param]
params)

transdecln :: Decln -> C.Decln
transdecln :: Decln -> Decln
transdecln Decln
decln = case Decln
decln of
  FunDecln Maybe StorageSpec
storespec Type
ty Ident
name [Param]
params -> DeclnSpecs -> Maybe InitDeclrList -> Decln
C.Decln DeclnSpecs
dspecs Maybe InitDeclrList
dlist where
    dspecs :: DeclnSpecs
dspecs     = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs Maybe StorageSpec
storespec Type
ty
    dlist :: Maybe InitDeclrList
dlist      = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ InitDeclr -> InitDeclrList
C.InitDeclrBase forall a b. (a -> b) -> a -> b
$ Declr -> InitDeclr
C.InitDeclr Declr
declr
    declr :: Declr
declr      = forall s a. State s a -> s -> s
execState (Type -> State Declr ()
getdeclr Type
ty) Declr
fundeclr
    fundeclr :: Declr
fundeclr   = Maybe Ptr -> DirectDeclr -> Declr
C.Declr forall a. Maybe a
Nothing (Ident -> [Param] -> DirectDeclr
fundirectdeclr Ident
name [Param]
params)

  VarDecln Maybe StorageSpec
storespec Type
ty Ident
name Maybe Init
init -> DeclnSpecs -> Maybe InitDeclrList -> Decln
C.Decln DeclnSpecs
dspecs Maybe InitDeclrList
dlist where
    dspecs :: DeclnSpecs
dspecs = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs Maybe StorageSpec
storespec Type
ty
    dlist :: Maybe InitDeclrList
dlist  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Maybe Init
init of
      Maybe Init
Nothing  -> InitDeclr -> InitDeclrList
C.InitDeclrBase forall a b. (a -> b) -> a -> b
$ Declr -> InitDeclr
C.InitDeclr      Declr
declr
      Just Init
val -> InitDeclr -> InitDeclrList
C.InitDeclrBase forall a b. (a -> b) -> a -> b
$ Declr -> Init -> InitDeclr
C.InitDeclrInitr Declr
declr (Init -> Init
transinit Init
val)
    declr :: Declr
declr  = forall s a. State s a -> s -> s
execState (Type -> State Declr ()
getdeclr Type
ty) (Ident -> Declr
identdeclr Ident
name)

  TypeDecln Type
ty -> DeclnSpecs -> Maybe InitDeclrList -> Decln
C.Decln DeclnSpecs
dspecs forall a. Maybe a
Nothing where
    dspecs :: DeclnSpecs
dspecs = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs forall a. Maybe a
Nothing Type
ty

transparamdecln :: Param -> C.ParamDecln
transparamdecln :: Param -> ParamDecln
transparamdecln (Param Type
ty Ident
name) = DeclnSpecs -> Declr -> ParamDecln
C.ParamDecln DeclnSpecs
dspecs Declr
declr where
  dspecs :: DeclnSpecs
dspecs = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs forall a. Maybe a
Nothing Type
ty
  declr :: Declr
declr  = forall s a. State s a -> s -> s
execState (Type -> State Declr ()
getdeclr Type
ty) (Ident -> Declr
identdeclr Ident
name)

transparam :: Param -> C.Decln
transparam :: Param -> Decln
transparam (Param Type
ty Ident
name) = DeclnSpecs -> Maybe InitDeclrList -> Decln
C.Decln DeclnSpecs
dspecs Maybe InitDeclrList
dlist where
  dspecs :: DeclnSpecs
dspecs = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs forall a. Maybe a
Nothing Type
ty
  dlist :: Maybe InitDeclrList
dlist  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ InitDeclr -> InitDeclrList
C.InitDeclrBase forall a b. (a -> b) -> a -> b
$ Declr -> InitDeclr
C.InitDeclr Declr
declr
  declr :: Declr
declr  = forall s a. State s a -> s -> s
execState (Type -> State Declr ()
getdeclr Type
ty) (Ident -> Declr
identdeclr Ident
name)

getdeclr :: Type -> State C.Declr ()
getdeclr :: Type -> State Declr ()
getdeclr Type
ty = case Type
ty of
  Type      Type
ty'     -> do
    Type -> State Declr ()
getdeclr Type
ty'
    Declr
declr <- forall s (m :: * -> *). MonadState s m => m s
get
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectDeclr -> Declr
C.Declr forall a. Maybe a
Nothing (Declr -> DirectDeclr
C.DirectDeclrDeclr Declr
declr)

  TypeSpec  TypeSpec
ty' -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Ptr       Type
ty' -> do
    let (Maybe TypeQualList
quals, Type
ty'') = Type -> (Maybe TypeQualList, Type)
gettypequals Type
ty'
    Declr
declr <- forall s (m :: * -> *). MonadState s m => m s
get
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Ptr -> Declr -> Declr
insertptr (Maybe TypeQualList -> Ptr
C.PtrBase Maybe TypeQualList
quals) Declr
declr
    Type -> State Declr ()
getdeclr Type
ty''

  Array Type
ty' Maybe Expr
len -> do
    let lenexpr :: Maybe AssignExpr
lenexpr = (forall a b. Wrap a b => a -> b
wrapforall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
len
    C.Declr Maybe Ptr
ptr DirectDeclr
declr <- forall s (m :: * -> *). MonadState s m => m s
get
    let ddeclr :: DirectDeclr
ddeclr = case Maybe Ptr
ptr of
          Maybe Ptr
Nothing -> DirectDeclr
declr
          Just Ptr
_  -> Declr -> DirectDeclr
C.DirectDeclrDeclr forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectDeclr -> Declr
C.Declr Maybe Ptr
ptr DirectDeclr
declr
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectDeclr -> Declr
C.Declr forall a. Maybe a
Nothing (DirectDeclr
-> Maybe TypeQualList -> Maybe AssignExpr -> DirectDeclr
C.DirectDeclrArray1 DirectDeclr
ddeclr forall a. Maybe a
Nothing Maybe AssignExpr
lenexpr)
    Type -> State Declr ()
getdeclr Type
ty'

  Const    Type
ty' -> Type -> State Declr ()
getdeclr Type
ty'
  Restrict Type
ty' -> Type -> State Declr ()
getdeclr Type
ty'
  Volatile Type
ty' -> Type -> State Declr ()
getdeclr Type
ty'


getdeclnspecs :: Maybe StorageSpec -> Type -> C.DeclnSpecs
getdeclnspecs :: Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs Maybe StorageSpec
storespec Type
ty = DeclnSpecs
dspecs where
  dspecs :: DeclnSpecs
dspecs = case Maybe StorageSpec
storespec of
    Maybe StorageSpec
Nothing   -> DeclnSpecs
tyspec
    Just StorageSpec
spec -> StorageClassSpec -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsStorage (StorageSpec -> StorageClassSpec
transstorespec StorageSpec
spec) (forall a. a -> Maybe a
Just DeclnSpecs
tyspec)

  tyspec :: DeclnSpecs
tyspec = case Type
ty of
    Type     Type
ty'   -> Type -> DeclnSpecs
rec Type
ty'
    TypeSpec TypeSpec
ty'   -> [TypeSpec] -> DeclnSpecs
foldtypespecs forall a b. (a -> b) -> a -> b
$ TypeSpec -> [TypeSpec]
spec2spec TypeSpec
ty'
    Ptr      Type
ty'   -> Type -> DeclnSpecs
rec (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Type -> (Maybe TypeQualList, Type)
gettypequals Type
ty')
    Array    Type
ty' Maybe Expr
_ -> Type -> DeclnSpecs
rec Type
ty'
    Const    Type
ty'   -> TypeQual -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsQual TypeQual
C.QConst    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Type -> DeclnSpecs
rec Type
ty')
    Restrict Type
ty'   -> TypeQual -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsQual TypeQual
C.QRestrict (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Type -> DeclnSpecs
rec Type
ty')
    Volatile Type
ty'   -> TypeQual -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsQual TypeQual
C.QVolatile (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Type -> DeclnSpecs
rec Type
ty')

  rec :: Type -> DeclnSpecs
rec = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs forall a. Maybe a
Nothing

transstorespec :: StorageSpec -> C.StorageClassSpec
transstorespec :: StorageSpec -> StorageClassSpec
transstorespec StorageSpec
spec = case StorageSpec
spec of
  StorageSpec
Typedef  -> StorageClassSpec
C.STypedef
  StorageSpec
Extern   -> StorageClassSpec
C.SExtern
  StorageSpec
Static   -> StorageClassSpec
C.SStatic
  StorageSpec
Auto     -> StorageClassSpec
C.SAuto
  StorageSpec
Register -> StorageClassSpec
C.SRegister

spec2spec :: TypeSpec -> [C.TypeSpec]
spec2spec :: TypeSpec -> [TypeSpec]
spec2spec TypeSpec
ts = case TypeSpec
ts of
  TypeSpec
Void                -> [TypeSpec
C.TVoid]
  TypeSpec
Char                -> [TypeSpec
C.TChar]
  TypeSpec
Signed_Char         -> [TypeSpec
C.TSigned, TypeSpec
C.TChar]
  TypeSpec
Unsigned_Char       -> [TypeSpec
C.TUnsigned, TypeSpec
C.TChar]

  TypeSpec
Short               -> [TypeSpec
C.TShort]
  TypeSpec
Signed_Short        -> [TypeSpec
C.TSigned, TypeSpec
C.TShort]
  TypeSpec
Short_Int           -> [TypeSpec
C.TShort, TypeSpec
C.TInt]
  TypeSpec
Signed_Short_Int    -> [TypeSpec
C.TSigned, TypeSpec
C.TShort, TypeSpec
C.TInt]

  TypeSpec
Unsigned_Short      -> [TypeSpec
C.TUnsigned, TypeSpec
C.TShort]
  TypeSpec
Unsigned_Short_Int  -> [TypeSpec
C.TUnsigned, TypeSpec
C.TShort, TypeSpec
C.TInt]

  TypeSpec
Int                 -> [TypeSpec
C.TInt]
  TypeSpec
Signed              -> [TypeSpec
C.TSigned]
  TypeSpec
Signed_Int          -> [TypeSpec
C.TSigned, TypeSpec
C.TInt]

  TypeSpec
Unsigned            -> [TypeSpec
C.TUnsigned]
  TypeSpec
Unsigned_Int        -> [TypeSpec
C.TUnsigned, TypeSpec
C.TInt]

  TypeSpec
Long                -> [TypeSpec
C.TLong]
  TypeSpec
Signed_Long         -> [TypeSpec
C.TSigned, TypeSpec
C.TLong]
  TypeSpec
Long_Int            -> [TypeSpec
C.TLong, TypeSpec
C.TInt]
  TypeSpec
Signed_Long_Int     -> [TypeSpec
C.TSigned, TypeSpec
C.TLong, TypeSpec
C.TInt]

  TypeSpec
Unsigned_Long       -> [TypeSpec
C.TUnsigned, TypeSpec
C.TLong]
  TypeSpec
Unsgined_Long_Int   -> [TypeSpec
C.TUnsigned, TypeSpec
C.TLong, TypeSpec
C.TInt]

  TypeSpec
Long_Long           -> [TypeSpec
C.TLong, TypeSpec
C.TLong]
  TypeSpec
Signed_Long_Long    -> [TypeSpec
C.TSigned, TypeSpec
C.TLong, TypeSpec
C.TLong]
  TypeSpec
Long_Long_Int       -> [TypeSpec
C.TLong, TypeSpec
C.TLong, TypeSpec
C.TInt]
  TypeSpec
Signed_Long_Long_Int-> [TypeSpec
C.TSigned, TypeSpec
C.TLong, TypeSpec
C.TLong, TypeSpec
C.TInt]

  TypeSpec
Unsigned_Long_Long      -> [TypeSpec
C.TUnsigned, TypeSpec
C.TLong, TypeSpec
C.TLong]
  TypeSpec
Unsigned_Long_Long_Int  -> [TypeSpec
C.TUnsigned, TypeSpec
C.TLong, TypeSpec
C.TLong, TypeSpec
C.TInt]

  TypeSpec
Float               -> [TypeSpec
C.TFloat]
  TypeSpec
Double              -> [TypeSpec
C.TDouble]
  TypeSpec
Long_Double         -> [TypeSpec
C.TLong, TypeSpec
C.TDouble]
  TypeSpec
Bool                -> [TypeSpec
C.TBool]
  TypeSpec
Float_Complex       -> [TypeSpec
C.TComplex, TypeSpec
C.TFloat]
  TypeSpec
Double_Complex      -> [TypeSpec
C.TComplex, TypeSpec
C.TDouble]
  TypeSpec
Long_Double_Complex -> [TypeSpec
C.TLong, TypeSpec
C.TDouble, TypeSpec
C.TComplex]
  TypedefName Ident
name -> [TypedefName -> TypeSpec
C.TTypedef forall a b. (a -> b) -> a -> b
$ Ident -> TypedefName
C.TypedefName forall a b. (a -> b) -> a -> b
$ Ident -> Ident
ident Ident
name]
  Struct      Ident
name -> [StructOrUnionSpec -> TypeSpec
C.TStructOrUnion forall a b. (a -> b) -> a -> b
$ StructOrUnion -> Ident -> StructOrUnionSpec
C.StructOrUnionForwDecln StructOrUnion
C.Struct (Ident -> Ident
ident Ident
name)]
  StructDecln Maybe Ident
name NonEmpty FieldDecln
declns -> [StructOrUnionSpec -> TypeSpec
C.TStructOrUnion forall a b. (a -> b) -> a -> b
$ StructOrUnion
-> Maybe Ident -> StructDeclnList -> StructOrUnionSpec
C.StructOrUnionDecln StructOrUnion
C.Struct (Ident -> Ident
ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Ident
name) StructDeclnList
declns'] where
    declns' :: StructDeclnList
declns' = NonEmpty FieldDecln -> StructDeclnList
transfielddeclns NonEmpty FieldDecln
declns
  Union      Ident
name -> [StructOrUnionSpec -> TypeSpec
C.TStructOrUnion forall a b. (a -> b) -> a -> b
$ StructOrUnion -> Ident -> StructOrUnionSpec
C.StructOrUnionForwDecln StructOrUnion
C.Union (Ident -> Ident
ident Ident
name)]
  UnionDecln Maybe Ident
name NonEmpty FieldDecln
declns -> [StructOrUnionSpec -> TypeSpec
C.TStructOrUnion forall a b. (a -> b) -> a -> b
$ StructOrUnion
-> Maybe Ident -> StructDeclnList -> StructOrUnionSpec
C.StructOrUnionDecln StructOrUnion
C.Union (Ident -> Ident
ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Ident
name) StructDeclnList
declns'] where
    declns' :: StructDeclnList
declns' = NonEmpty FieldDecln -> StructDeclnList
transfielddeclns NonEmpty FieldDecln
declns
  Enum      Ident
name -> [EnumSpec -> TypeSpec
C.TEnum forall a b. (a -> b) -> a -> b
$ Ident -> EnumSpec
C.EnumSpecForw (Ident -> Ident
ident Ident
name)]
  EnumDecln Maybe Ident
name NonEmpty Ident
declns -> [EnumSpec -> TypeSpec
C.TEnum forall a b. (a -> b) -> a -> b
$ Maybe Ident -> EnumrList -> EnumSpec
C.EnumSpec (Ident -> Ident
ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Ident
name) EnumrList
declns'] where
    declns' :: EnumrList
declns' = NonEmpty Ident -> EnumrList
transvariantdeclns NonEmpty Ident
declns

transfielddeclns :: NonEmpty FieldDecln -> C.StructDeclnList
transfielddeclns :: NonEmpty FieldDecln -> StructDeclnList
transfielddeclns (FieldDecln
decln NE.:| [FieldDecln]
declns) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl StructDeclnList -> FieldDecln -> StructDeclnList
step (FieldDecln -> StructDeclnList
base FieldDecln
decln) [FieldDecln]
declns
  where
    base :: FieldDecln -> StructDeclnList
base FieldDecln
d    = StructDecln -> StructDeclnList
C.StructDeclnBase (FieldDecln -> StructDecln
transfielddecln FieldDecln
d)
    step :: StructDeclnList -> FieldDecln -> StructDeclnList
step StructDeclnList
ds FieldDecln
d = StructDeclnList -> StructDecln -> StructDeclnList
C.StructDeclnCons StructDeclnList
ds (FieldDecln -> StructDecln
transfielddecln FieldDecln
d)

transfielddecln :: FieldDecln -> C.StructDecln
transfielddecln :: FieldDecln -> StructDecln
transfielddecln (FieldDecln Type
ty Ident
name) = SpecQualList -> StructDeclrList -> StructDecln
C.StructDecln SpecQualList
quals StructDeclrList
declrlist where
  declrlist :: StructDeclrList
declrlist = StructDeclr -> StructDeclrList
C.StructDeclrBase forall a b. (a -> b) -> a -> b
$ Declr -> StructDeclr
C.StructDeclr Declr
declr
  declr :: Declr
declr = forall s a. State s a -> s -> s
execState (Type -> State Declr ()
getdeclr Type
ty) (Ident -> Declr
identdeclr Ident
name)
  quals :: SpecQualList
quals = Type -> SpecQualList
getspecquals Type
ty

transvariantdeclns :: NonEmpty Ident -> C.EnumrList
transvariantdeclns :: NonEmpty Ident -> EnumrList
transvariantdeclns (Ident
decln NE.:| [Ident]
declns) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl EnumrList -> Ident -> EnumrList
step (Ident -> EnumrList
base Ident
decln) [Ident]
declns
  where
    base :: Ident -> EnumrList
base Ident
d    = Enumr -> EnumrList
C.EnumrBase (Ident -> Enumr
transvariantdecln Ident
d)
    step :: EnumrList -> Ident -> EnumrList
step EnumrList
ds Ident
d = EnumrList -> Enumr -> EnumrList
C.EnumrCons EnumrList
ds (Ident -> Enumr
transvariantdecln Ident
d)

transvariantdecln :: Ident -> C.Enumr
transvariantdecln :: Ident -> Enumr
transvariantdecln Ident
name = EnumConst -> Enumr
C.Enumr (Ident -> EnumConst
C.Enum (Ident -> Ident
ident Ident
name))

getspecquals :: Type -> C.SpecQualList
getspecquals :: Type -> SpecQualList
getspecquals Type
ty = case Type
ty of
  Type     Type
ty'     -> Type -> SpecQualList
getspecquals Type
ty'
  TypeSpec TypeSpec
ts      -> [TypeSpec] -> SpecQualList
foldtypequals forall a b. (a -> b) -> a -> b
$ TypeSpec -> [TypeSpec]
spec2spec TypeSpec
ts
  Ptr      Type
ty'     -> Type -> SpecQualList
getspecquals Type
ty'
  Array    Type
ty' Maybe Expr
len -> Type -> SpecQualList
getspecquals Type
ty'
  Const    Type
ty'     -> TypeQual -> Maybe SpecQualList -> SpecQualList
C.SpecQualQual TypeQual
C.QConst    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Type -> SpecQualList
getspecquals Type
ty')
  Restrict Type
ty'     -> TypeQual -> Maybe SpecQualList -> SpecQualList
C.SpecQualQual TypeQual
C.QRestrict (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Type -> SpecQualList
getspecquals Type
ty')
  Volatile Type
ty'     -> TypeQual -> Maybe SpecQualList -> SpecQualList
C.SpecQualQual TypeQual
C.QVolatile (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Type -> SpecQualList
getspecquals Type
ty')


transexpr :: Expr -> C.Expr
transexpr :: Expr -> Expr
transexpr Expr
e = case Expr
e of
  Ident      Ident
i         -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Ident -> PrimExpr
C.PrimIdent forall a b. (a -> b) -> a -> b
$ Ident -> Ident
ident Ident
i
  LitBool    Bool
b         -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Bool -> PrimExpr
litbool   Bool
b
  LitInt     Integer
i         -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Integer -> UnaryExpr
litint    Integer
i
  LitFloat   Float
f         -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Float -> UnaryExpr
litfloat  Float
f
  LitDouble  Double
d         -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Double -> UnaryExpr
litdouble Double
d
  LitString  Ident
s         -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Ident -> UnaryExpr
litstring Ident
s
  Index      Expr
arr Expr
idx   -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> PostfixExpr
indexexpr Expr
arr Expr
idx
  Funcall    Expr
fun [Expr]
args  -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> [Expr] -> PostfixExpr
funcall   Expr
fun [Expr]
args
  Dot        Expr
e   Ident
field -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Ident -> PostfixExpr
dotexpr   Expr
e Ident
field
  Arrow      Expr
e   Ident
field -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Ident -> PostfixExpr
arrowexpr Expr
e Ident
field
  InitVal    TypeName
ty  NonEmpty InitItem
init  -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ TypeName -> NonEmpty InitItem -> PostfixExpr
initexpr  TypeName
ty NonEmpty InitItem
init
  UnaryOp    UnaryOp
op Expr
e      -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ UnaryOp -> Expr -> UnaryExpr
unaryop UnaryOp
op Expr
e
  Cast       TypeName
ty Expr
e      -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ TypeName -> Expr -> CastExpr
castexpr TypeName
ty Expr
e
  BinaryOp   BinaryOp
op Expr
e1 Expr
e2  -> BinaryOp -> Expr -> Expr -> Expr
binaryop BinaryOp
op Expr
e1 Expr
e2
  AssignOp   AssignOp
op Expr
e1 Expr
e2  -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ AssignOp -> Expr -> Expr -> AssignExpr
assignop AssignOp
op Expr
e1 Expr
e2
  Cond       Expr
c Expr
e1 Expr
e2   -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> CondExpr
condexpr Expr
c Expr
e1 Expr
e2
  SizeOf     Expr
e         -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ UnaryExpr -> UnaryExpr
C.UnarySizeExpr (forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e)
  SizeOfType TypeName
ty        -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ TypeName -> UnaryExpr
C.UnarySizeType (TypeName -> TypeName
transtypename TypeName
ty)


unaryop :: UnaryOp -> Expr -> C.UnaryExpr
unaryop :: UnaryOp -> Expr -> UnaryExpr
unaryop UnaryOp
op Expr
e = case UnaryOp
op of
    UnaryOp
Inc     -> UnaryExpr -> UnaryExpr
C.UnaryInc          (forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Dec     -> UnaryExpr -> UnaryExpr
C.UnaryDec          (forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Ref     -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UORef   (forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
DeRef   -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UODeref (forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Plus    -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UOPlus  (forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Min     -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UOMin   (forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
BoolNot -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UOBNot  (forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Not     -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UONot   (forall a b. Wrap a b => a -> b
wrap Expr
e')
  where
    e' :: Expr
e' = Expr -> Expr
transexpr Expr
e

binaryop :: BinaryOp -> Expr -> Expr -> C.Expr
binaryop :: BinaryOp -> Expr -> Expr -> Expr
binaryop BinaryOp
op Expr
e1 Expr
e2 = case BinaryOp
op of
    BinaryOp
Mult   -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ MultExpr -> CastExpr -> MultExpr
C.MultMult   (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Div    -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ MultExpr -> CastExpr -> MultExpr
C.MultDiv    (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Mod    -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ MultExpr -> CastExpr -> MultExpr
C.MultMod    (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Add    -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ AddExpr -> MultExpr -> AddExpr
C.AddPlus    (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Sub    -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ AddExpr -> MultExpr -> AddExpr
C.AddMin     (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
ShiftL -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ ShiftExpr -> AddExpr -> ShiftExpr
C.ShiftLeft  (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
ShiftR -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ ShiftExpr -> AddExpr -> ShiftExpr
C.ShiftRight (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
LT     -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ RelExpr -> ShiftExpr -> RelExpr
C.RelLT      (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
GT     -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ RelExpr -> ShiftExpr -> RelExpr
C.RelGT      (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
LE     -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ RelExpr -> ShiftExpr -> RelExpr
C.RelLE      (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
GE     -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ RelExpr -> ShiftExpr -> RelExpr
C.RelGE      (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Eq     -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ EqExpr -> RelExpr -> EqExpr
C.EqEq       (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
NEq    -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ EqExpr -> RelExpr -> EqExpr
C.EqNEq      (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
And    -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ AndExpr -> EqExpr -> AndExpr
C.And        (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
XOr    -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ XOrExpr -> AndExpr -> XOrExpr
C.XOr        (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Or     -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ OrExpr -> XOrExpr -> OrExpr
C.Or         (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
LAnd   -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ LAndExpr -> OrExpr -> LAndExpr
C.LAnd       (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
LOr    -> forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ LOrExpr -> LAndExpr -> LOrExpr
C.LOr        (forall a b. Wrap a b => a -> b
wrap Expr
e1') (forall a b. Wrap a b => a -> b
wrap Expr
e2')
  where
    e1' :: Expr
e1' = Expr -> Expr
transexpr Expr
e1
    e2' :: Expr
e2' = Expr -> Expr
transexpr Expr
e2

assignop :: AssignOp -> Expr -> Expr -> C.AssignExpr
assignop :: AssignOp -> Expr -> Expr -> AssignExpr
assignop AssignOp
op Expr
e1 Expr
e2 = UnaryExpr -> AssignOp -> AssignExpr -> AssignExpr
C.Assign UnaryExpr
e1' AssignOp
op' AssignExpr
e2' where
  e1' :: UnaryExpr
e1' = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e1
  e2' :: AssignExpr
e2' = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e2
  op' :: AssignOp
op' = case AssignOp
op of
    AssignOp
Assign       -> AssignOp
C.AEq
    AssignOp
AssignMult   -> AssignOp
C.ATimes
    AssignOp
AssignDiv    -> AssignOp
C.ADiv
    AssignOp
AssignMod    -> AssignOp
C.AMod
    AssignOp
AssignAdd    -> AssignOp
C.AAdd
    AssignOp
AssignSub    -> AssignOp
C.ASub
    AssignOp
AssignShiftL -> AssignOp
C.AShiftL
    AssignOp
AssignShiftR -> AssignOp
C.AShiftR
    AssignOp
AssignAnd    -> AssignOp
C.AAnd
    AssignOp
AssignXOr    -> AssignOp
C.AXOr
    AssignOp
AssignOr     -> AssignOp
C.AOr

transinit :: Init -> C.Init
transinit :: Init -> Init
transinit (InitExpr Expr
e)  = AssignExpr -> Init
C.InitExpr (forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e)
transinit (InitList NonEmpty InitItem
es) = InitList -> Init
C.InitList (NonEmpty InitItem -> InitList
transinitlist NonEmpty InitItem
es)

transinitlist :: NonEmpty InitItem -> C.InitList
transinitlist :: NonEmpty InitItem -> InitList
transinitlist (InitItem
x NE.:| [InitItem]
xs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl InitList -> InitItem -> InitList
step (InitItem -> InitList
base InitItem
x) [InitItem]
xs
  where
    base :: InitItem -> InitList
base (InitItem Maybe Ident
mident Init
y)    = Maybe Design -> Init -> InitList
C.InitBase    (Ident -> Design
transdesigr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Ident
mident) (Init -> Init
transinit Init
y)
    step :: InitList -> InitItem -> InitList
step InitList
ys (InitItem Maybe Ident
mident Init
y) = InitList -> Maybe Design -> Init -> InitList
C.InitCons InitList
ys (Ident -> Design
transdesigr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Ident
mident) (Init -> Init
transinit Init
y)

transdesigr :: Ident -> C.Design
transdesigr :: Ident -> Design
transdesigr = DesigrList -> Design
C.Design forall b c a. (b -> c) -> (a -> b) -> a -> c
. Desigr -> DesigrList
C.DesigrBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Desigr
C.DesigrIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident
ident

initexpr :: TypeName -> NonEmpty InitItem -> C.PostfixExpr
initexpr :: TypeName -> NonEmpty InitItem -> PostfixExpr
initexpr TypeName
ty NonEmpty InitItem
inits = TypeName -> InitList -> PostfixExpr
C.PostfixInits TypeName
ty' InitList
inits' where
  ty' :: TypeName
ty'    = TypeName -> TypeName
transtypename TypeName
ty
  inits' :: InitList
inits' = NonEmpty InitItem -> InitList
transinititems NonEmpty InitItem
inits

transinititems :: NonEmpty InitItem -> C.InitList
transinititems :: NonEmpty InitItem -> InitList
transinititems = NonEmpty InitItem -> InitList
transinitlist

indexexpr :: Expr -> Expr -> PostfixExpr
indexexpr Expr
arr Expr
idx = PostfixExpr -> Expr -> PostfixExpr
C.PostfixIndex PostfixExpr
arr' Expr
idx' where
  arr' :: PostfixExpr
arr' = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
arr
  idx' :: Expr
idx' = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
idx

dotexpr :: Expr -> Ident -> PostfixExpr
dotexpr Expr
e Ident
field = PostfixExpr -> Ident -> PostfixExpr
C.PostfixDot PostfixExpr
e' Ident
field' where
  e' :: PostfixExpr
e'     = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e
  field' :: Ident
field' = Ident -> Ident
ident Ident
field

arrowexpr :: Expr -> Ident -> PostfixExpr
arrowexpr Expr
e Ident
field = PostfixExpr -> Ident -> PostfixExpr
C.PostfixArrow PostfixExpr
e' Ident
field' where
  e' :: PostfixExpr
e'     = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e
  field' :: Ident
field' = Ident -> Ident
ident Ident
field

castexpr :: TypeName -> Expr -> CastExpr
castexpr TypeName
ty Expr
e = TypeName -> CastExpr -> CastExpr
C.Cast TypeName
ty' CastExpr
e' where
  ty' :: TypeName
ty' = TypeName -> TypeName
transtypename TypeName
ty
  e' :: CastExpr
e'  = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e

funcall :: Expr -> [Expr] -> PostfixExpr
funcall Expr
fun [Expr]
args = PostfixExpr -> Maybe ArgExprList -> PostfixExpr
C.PostfixFunction PostfixExpr
fun' Maybe ArgExprList
args' where
  fun' :: PostfixExpr
fun'  = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
fun
  args' :: Maybe ArgExprList
args' = case [AssignExpr]
argses of
    [] -> forall a. Maybe a
Nothing
    [AssignExpr]
_  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList [AssignExpr]
argses

  argses :: [C.AssignExpr]
  argses :: [AssignExpr]
argses = forall a b. (a -> b) -> [a] -> [b]
map forall a b. Wrap a b => a -> b
wrap [Expr]
exprs

  exprs :: [C.Expr]
  exprs :: [Expr]
exprs = forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
transexpr [Expr]
args

condexpr :: Expr -> Expr -> Expr -> CondExpr
condexpr Expr
c Expr
e1 Expr
e2 = LOrExpr -> Expr -> CondExpr -> CondExpr
C.Cond LOrExpr
c' Expr
e1' CondExpr
e2' where
  c' :: LOrExpr
c'  = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
c
  e1' :: Expr
e1' = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e1
  e2' :: CondExpr
e2' = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e2

transtypename :: TypeName -> C.TypeName
transtypename :: TypeName -> TypeName
transtypename (TypeName Type
ty) = SpecQualList -> Maybe AbstractDeclr -> TypeName
C.TypeName SpecQualList
specquals Maybe AbstractDeclr
adeclr where
  specquals :: SpecQualList
specquals = Type -> SpecQualList
getspecquals Type
ty
  adeclr :: Maybe AbstractDeclr
adeclr    = forall s a. State s a -> s -> s
execState (Type -> State (Maybe AbstractDeclr) ()
getabstractdeclr Type
ty) forall a. Maybe a
Nothing

getabstractdeclr :: Type -> State (Maybe C.AbstractDeclr) ()
getabstractdeclr :: Type -> State (Maybe AbstractDeclr) ()
getabstractdeclr Type
ty = case Type
ty of
  Type Type
ty' -> do
    Type -> State (Maybe AbstractDeclr) ()
getabstractdeclr Type
ty'
    Maybe AbstractDeclr
adeclr <- forall s (m :: * -> *). MonadState s m => m s
get
    case Maybe AbstractDeclr
adeclr of
      Maybe AbstractDeclr
Nothing      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just AbstractDeclr
adeclr' -> forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectAbstractDeclr -> AbstractDeclr
C.AbstractDeclrDirect forall a. Maybe a
Nothing DirectAbstractDeclr
dadeclr where
        dadeclr :: DirectAbstractDeclr
dadeclr = AbstractDeclr -> DirectAbstractDeclr
C.DirectAbstractDeclr AbstractDeclr
adeclr'

  TypeSpec TypeSpec
ts -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Ptr Type
ty' -> do
    let (Maybe TypeQualList
quals, Type
ty'') = Type -> (Maybe TypeQualList, Type)
gettypequals Type
ty'
        ptr :: Ptr
ptr           = Maybe TypeQualList -> Ptr
C.PtrBase Maybe TypeQualList
quals
    Maybe AbstractDeclr
adeclr <- forall s (m :: * -> *). MonadState s m => m s
get
    case Maybe AbstractDeclr
adeclr of
      Maybe AbstractDeclr
Nothing      -> forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Ptr -> AbstractDeclr
C.AbstractDeclr Ptr
ptr
      Just AbstractDeclr
adeclr' -> forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectAbstractDeclr -> AbstractDeclr
C.AbstractDeclrDirect (forall a. a -> Maybe a
Just Ptr
ptr) DirectAbstractDeclr
dadeclr where
        dadeclr :: DirectAbstractDeclr
dadeclr = AbstractDeclr -> DirectAbstractDeclr
C.DirectAbstractDeclr AbstractDeclr
adeclr'
    Type -> State (Maybe AbstractDeclr) ()
getabstractdeclr Type
ty''

  Array Type
ty' Maybe Expr
len -> do
    let lenexpr :: Maybe AssignExpr
lenexpr       = (forall a b. Wrap a b => a -> b
wrapforall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
len
        emptyarrdeclr :: DirectAbstractDeclr
emptyarrdeclr = Maybe DirectAbstractDeclr
-> Maybe TypeQualList -> Maybe AssignExpr -> DirectAbstractDeclr
C.DirectAbstractDeclrArray1 forall a. Maybe a
Nothing forall a. Maybe a
Nothing Maybe AssignExpr
lenexpr
    Maybe AbstractDeclr
adeclr <- forall s (m :: * -> *). MonadState s m => m s
get
    let declr :: AbstractDeclr
declr = case Maybe AbstractDeclr
adeclr of
          Maybe AbstractDeclr
Nothing -> Maybe Ptr -> DirectAbstractDeclr -> AbstractDeclr
C.AbstractDeclrDirect forall a. Maybe a
Nothing DirectAbstractDeclr
emptyarrdeclr
          Just AbstractDeclr
adeclr -> case AbstractDeclr
adeclr of
            C.AbstractDeclrDirect Maybe Ptr
mptr DirectAbstractDeclr
adeclr' -> Maybe Ptr -> DirectAbstractDeclr -> AbstractDeclr
C.AbstractDeclrDirect Maybe Ptr
mptr DirectAbstractDeclr
arrdeclr where
              arrdeclr :: DirectAbstractDeclr
arrdeclr = Maybe DirectAbstractDeclr
-> Maybe TypeQualList -> Maybe AssignExpr -> DirectAbstractDeclr
C.DirectAbstractDeclrArray1 (forall a. a -> Maybe a
Just DirectAbstractDeclr
adeclr') forall a. Maybe a
Nothing Maybe AssignExpr
lenexpr
            C.AbstractDeclr Ptr
ptr -> Maybe Ptr -> DirectAbstractDeclr -> AbstractDeclr
C.AbstractDeclrDirect (forall a. a -> Maybe a
Just Ptr
ptr) DirectAbstractDeclr
emptyarrdeclr
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just AbstractDeclr
declr
    Type -> State (Maybe AbstractDeclr) ()
getabstractdeclr Type
ty'

  Const    Type
ty' -> Type -> State (Maybe AbstractDeclr) ()
getabstractdeclr Type
ty'
  Restrict Type
ty' -> Type -> State (Maybe AbstractDeclr) ()
getabstractdeclr Type
ty'
  Volatile Type
ty' -> Type -> State (Maybe AbstractDeclr) ()
getabstractdeclr Type
ty'

transstmt :: Stmt -> C.Stmt
transstmt :: Stmt -> Stmt
transstmt Stmt
stmt = case Stmt
stmt of
  Expr    Expr
e                  -> Expr -> Stmt
exprstmt Expr
e
  If      Expr
cond [Stmt]
ss            -> Expr -> [Stmt] -> Stmt
ifstmt Expr
cond [Stmt]
ss
  IfElse  Expr
cond [Stmt]
ssthen [Stmt]
sselse -> Expr -> [Stmt] -> [Stmt] -> Stmt
ifelsestmt Expr
cond [Stmt]
ssthen [Stmt]
sselse
  Switch  Expr
cond [Case]
cases         -> Expr -> [Case] -> Stmt
switchstmt Expr
cond [Case]
cases
  While   Expr
cond [Stmt]
ss            -> Expr -> [Stmt] -> Stmt
whilestmt Expr
cond [Stmt]
ss
  For     Expr
start Expr
end Expr
step [Stmt]
ss  -> Maybe Expr -> Maybe Expr -> Maybe Expr -> [Stmt] -> Stmt
forstmt (forall a. a -> Maybe a
Just Expr
start) (forall a. a -> Maybe a
Just Expr
end) (forall a. a -> Maybe a
Just Expr
step) [Stmt]
ss
  ForInf                 [Stmt]
ss  -> Maybe Expr -> Maybe Expr -> Maybe Expr -> [Stmt] -> Stmt
forstmt forall a. Maybe a
Nothing      forall a. Maybe a
Nothing    forall a. Maybe a
Nothing     [Stmt]
ss
  Stmt
Continue                   -> JumpStmt -> Stmt
C.StmtJump forall a b. (a -> b) -> a -> b
$ JumpStmt
C.JumpContinue
  Stmt
Break                      -> JumpStmt -> Stmt
C.StmtJump forall a b. (a -> b) -> a -> b
$ JumpStmt
C.JumpBreak
  Label   Ident
name   Stmt
s           -> Ident -> Stmt -> Stmt
labelstmt Ident
name Stmt
s
  Return  Maybe Expr
e                  -> Maybe Expr -> Stmt
returnstmt Maybe Expr
e

exprstmt :: Expr -> C.Stmt
exprstmt :: Expr -> Stmt
exprstmt Expr
e = ExprStmt -> Stmt
C.StmtExpr   forall a b. (a -> b) -> a -> b
$ Maybe Expr -> ExprStmt
C.ExprStmt (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e)

ifstmt :: Expr -> [Stmt] -> C.Stmt
ifstmt :: Expr -> [Stmt] -> Stmt
ifstmt Expr
cond [Stmt]
ss = SelectStmt -> Stmt
C.StmtSelect forall a b. (a -> b) -> a -> b
$ Expr -> Stmt -> SelectStmt
C.SelectIf Expr
cond' Stmt
body where
  cond' :: Expr
cond' = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
cond
  body :: Stmt
body  = [Decln] -> [Stmt] -> Stmt
compoundstmt [] [Stmt]
ss

ifelsestmt :: Expr -> [Stmt] -> [Stmt] -> C.Stmt
ifelsestmt :: Expr -> [Stmt] -> [Stmt] -> Stmt
ifelsestmt Expr
cond [Stmt]
ssthen [Stmt]
sselse =
  SelectStmt -> Stmt
C.StmtSelect forall a b. (a -> b) -> a -> b
$ Expr -> Stmt -> Stmt -> SelectStmt
C.SelectIfElse Expr
cond' Stmt
ssthen' Stmt
sselse' where
    cond' :: Expr
cond'  = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
cond
    ssthen' :: Stmt
ssthen' = [Decln] -> [Stmt] -> Stmt
compoundstmt [] [Stmt]
ssthen
    sselse' :: Stmt
sselse' = [Decln] -> [Stmt] -> Stmt
compoundstmt [] [Stmt]
sselse

switchstmt :: Expr -> [Case] -> C.Stmt
switchstmt :: Expr -> [Case] -> Stmt
switchstmt Expr
cond [Case]
cs = SelectStmt -> Stmt
C.StmtSelect forall a b. (a -> b) -> a -> b
$ Expr -> Stmt -> SelectStmt
C.SelectSwitch Expr
cond' Stmt
cs' where
  cond' :: Expr
cond' = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
cond
  cs' :: Stmt
cs'   = [Case] -> Stmt
casestmt [Case]
cs

whilestmt :: Expr -> [Stmt] -> C.Stmt
whilestmt :: Expr -> [Stmt] -> Stmt
whilestmt Expr
cond [Stmt]
ss = IterStmt -> Stmt
C.StmtIter forall a b. (a -> b) -> a -> b
$ Expr -> Stmt -> IterStmt
C.IterWhile Expr
cond' Stmt
ss' where
  cond' :: Expr
cond' = forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
cond
  ss' :: Stmt
ss'   = [Decln] -> [Stmt] -> Stmt
compoundstmt [] [Stmt]
ss

forstmt :: Maybe Expr -> Maybe Expr -> Maybe Expr -> [Stmt] -> C.Stmt
forstmt :: Maybe Expr -> Maybe Expr -> Maybe Expr -> [Stmt] -> Stmt
forstmt Maybe Expr
start Maybe Expr
end Maybe Expr
step [Stmt]
ss =
  IterStmt -> Stmt
C.StmtIter forall a b. (a -> b) -> a -> b
$ Maybe Expr -> Maybe Expr -> Maybe Expr -> Stmt -> IterStmt
C.IterForUpdate Maybe Expr
start' Maybe Expr
end' Maybe Expr
step' Stmt
ss' where
    start' :: Maybe Expr
start' = (forall a b. Wrap a b => a -> b
wrapforall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
start
    end' :: Maybe Expr
end'   = (forall a b. Wrap a b => a -> b
wrapforall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
end
    step' :: Maybe Expr
step'  = (forall a b. Wrap a b => a -> b
wrapforall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
step
    ss' :: Stmt
ss'    = [Decln] -> [Stmt] -> Stmt
compoundstmt [] [Stmt]
ss

labelstmt :: String -> Stmt -> C.Stmt
labelstmt :: Ident -> Stmt -> Stmt
labelstmt Ident
name Stmt
s = LabeledStmt -> Stmt
C.StmtLabeled forall a b. (a -> b) -> a -> b
$ Ident -> Stmt -> LabeledStmt
C.LabeledIdent (Ident -> Ident
ident Ident
name) (Stmt -> Stmt
transstmt Stmt
s)

returnstmt :: Maybe Expr -> C.Stmt
returnstmt :: Maybe Expr -> Stmt
returnstmt Maybe Expr
e = JumpStmt -> Stmt
C.StmtJump forall a b. (a -> b) -> a -> b
$ Maybe Expr -> JumpStmt
C.JumpReturn ((forall a b. Wrap a b => a -> b
wrapforall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
e)

casestmt :: [Case] -> C.Stmt
casestmt :: [Case] -> Stmt
casestmt [Case]
cs =
  CompoundStmt -> Stmt
C.StmtCompound forall a b. (a -> b) -> a -> b
$ Maybe BlockItemList -> CompoundStmt
C.Compound (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Case -> BlockItem
casestmt' [Case]
cs) where
    casestmt' :: Case -> BlockItem
casestmt' Case
cs = Stmt -> BlockItem
C.BlockItemStmt forall a b. (a -> b) -> a -> b
$ LabeledStmt -> Stmt
C.StmtLabeled forall a b. (a -> b) -> a -> b
$ case Case
cs of
      Case  Expr
e Stmt
s -> ConstExpr -> Stmt -> LabeledStmt
C.LabeledCase (CondExpr -> ConstExpr
C.Const forall a b. (a -> b) -> a -> b
$ forall a b. Wrap a b => a -> b
wrap forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e) (Stmt -> Stmt
transstmt Stmt
s)
      Default Stmt
s -> Stmt -> LabeledStmt
C.LabeledDefault (Stmt -> Stmt
transstmt Stmt
s)

compound :: [Decln] -> [Stmt] -> C.CompoundStmt
compound :: [Decln] -> [Stmt] -> CompoundStmt
compound [Decln]
ds [Stmt]
ss = Maybe BlockItemList -> CompoundStmt
C.Compound (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList [BlockItem]
items) where
  items :: [BlockItem]
items = [BlockItem]
ds' forall a. [a] -> [a] -> [a]
++ [BlockItem]
ss'
  ss' :: [BlockItem]
ss' = forall a b. (a -> b) -> [a] -> [b]
map (Stmt -> BlockItem
C.BlockItemStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt -> Stmt
transstmt) [Stmt]
ss
  ds' :: [BlockItem]
ds' = forall a b. (a -> b) -> [a] -> [b]
map (Decln -> BlockItem
C.BlockItemDecln forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decln -> Decln
transdecln) [Decln]
ds

compoundstmt :: [Decln] -> [Stmt] -> C.Stmt
compoundstmt :: [Decln] -> [Stmt] -> Stmt
compoundstmt [Decln]
ds [Stmt]
ss = CompoundStmt -> Stmt
C.StmtCompound forall a b. (a -> b) -> a -> b
$ [Decln] -> [Stmt] -> CompoundStmt
compound [Decln]
ds [Stmt]
ss

fundirectdeclr :: Ident -> [Param] -> C.DirectDeclr
fundirectdeclr :: Ident -> [Param] -> DirectDeclr
fundirectdeclr Ident
name [Param]
params = DirectDeclr -> ParamTypeList -> DirectDeclr
C.DirectDeclrFun1 DirectDeclr
namedeclr ParamTypeList
params' where
  namedeclr :: DirectDeclr
namedeclr = Ident -> DirectDeclr
C.DirectDeclrIdent forall a b. (a -> b) -> a -> b
$ Ident -> Ident
ident Ident
name
  params' :: ParamTypeList
params'   = ParamList -> ParamTypeList
C.ParamTypeList forall a b. (a -> b) -> a -> b
$ [ParamDecln] -> ParamList
voidparamlist forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Param -> ParamDecln
transparamdecln [Param]
params