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

transfundef :: FunDef -> C.FunDef
transfundef :: FunDef -> FunDef
transfundef (FunDef Type
ty Ident
name [Param]
params [Decln]
decln [Stmt]
ss) =
  DeclnSpecs -> Declr -> Maybe DeclnList -> CompoundStmt -> FunDef
C.FunDef DeclnSpecs
dspecs Declr
declr Maybe DeclnList
forall a. Maybe a
Nothing CompoundStmt
body where
    dspecs :: DeclnSpecs
dspecs   = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs Maybe StorageSpec
forall a. Maybe a
Nothing Type
ty
    body :: CompoundStmt
body     = [Decln] -> [Stmt] -> CompoundStmt
compound [Decln]
decln [Stmt]
ss
    declr :: Declr
declr    = State 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 Maybe Ptr
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      = InitDeclrList -> Maybe InitDeclrList
forall a. a -> Maybe a
Just (InitDeclrList -> Maybe InitDeclrList)
-> InitDeclrList -> Maybe InitDeclrList
forall a b. (a -> b) -> a -> b
$ InitDeclr -> InitDeclrList
C.InitDeclrBase (InitDeclr -> InitDeclrList) -> InitDeclr -> InitDeclrList
forall a b. (a -> b) -> a -> b
$ Declr -> InitDeclr
C.InitDeclr Declr
declr
    declr :: Declr
declr      = State 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 Maybe Ptr
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  = InitDeclrList -> Maybe InitDeclrList
forall a. a -> Maybe a
Just (InitDeclrList -> Maybe InitDeclrList)
-> InitDeclrList -> Maybe InitDeclrList
forall a b. (a -> b) -> a -> b
$ case Maybe Init
init of
      Maybe Init
Nothing  -> InitDeclr -> InitDeclrList
C.InitDeclrBase (InitDeclr -> InitDeclrList) -> InitDeclr -> InitDeclrList
forall a b. (a -> b) -> a -> b
$ Declr -> InitDeclr
C.InitDeclr      Declr
declr
      Just Init
val -> InitDeclr -> InitDeclrList
C.InitDeclrBase (InitDeclr -> InitDeclrList) -> InitDeclr -> InitDeclrList
forall a b. (a -> b) -> a -> b
$ Declr -> Init -> InitDeclr
C.InitDeclrInitr Declr
declr (Init -> Init
transinit Init
val)
    declr :: Declr
declr  = State 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 Maybe InitDeclrList
forall a. Maybe a
Nothing where
    dspecs :: DeclnSpecs
dspecs = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs Maybe StorageSpec
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 Maybe StorageSpec
forall a. Maybe a
Nothing Type
ty
  declr :: Declr
declr  = State 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 Maybe StorageSpec
forall a. Maybe a
Nothing Type
ty
  dlist :: Maybe InitDeclrList
dlist  = InitDeclrList -> Maybe InitDeclrList
forall a. a -> Maybe a
Just (InitDeclrList -> Maybe InitDeclrList)
-> InitDeclrList -> Maybe InitDeclrList
forall a b. (a -> b) -> a -> b
$ InitDeclr -> InitDeclrList
C.InitDeclrBase (InitDeclr -> InitDeclrList) -> InitDeclr -> InitDeclrList
forall a b. (a -> b) -> a -> b
$ Declr -> InitDeclr
C.InitDeclr Declr
declr
  declr :: Declr
declr  = State 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 <- StateT Declr Identity Declr
forall s (m :: * -> *). MonadState s m => m s
get
    Declr -> State Declr ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Declr -> State Declr ()) -> Declr -> State Declr ()
forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectDeclr -> Declr
C.Declr Maybe Ptr
forall a. Maybe a
Nothing (Declr -> DirectDeclr
C.DirectDeclrDeclr Declr
declr)

  TypeSpec  TypeSpec
ty' -> () -> State Declr ()
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 <- StateT Declr Identity Declr
forall s (m :: * -> *). MonadState s m => m s
get
    Declr -> State Declr ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Declr -> State Declr ()) -> Declr -> State Declr ()
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 = (Expr -> AssignExpr
forall a b. Wrap a b => a -> b
wrap(Expr -> AssignExpr) -> (Expr -> Expr) -> Expr -> AssignExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) (Expr -> AssignExpr) -> Maybe Expr -> Maybe AssignExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
len
    C.Declr Maybe Ptr
ptr DirectDeclr
declr <- StateT Declr Identity 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 (Declr -> DirectDeclr) -> Declr -> DirectDeclr
forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectDeclr -> Declr
C.Declr Maybe Ptr
ptr DirectDeclr
declr
    Declr -> State Declr ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Declr -> State Declr ()) -> Declr -> State Declr ()
forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectDeclr -> Declr
C.Declr Maybe Ptr
forall a. Maybe a
Nothing (DirectDeclr
-> Maybe TypeQualList -> Maybe AssignExpr -> DirectDeclr
C.DirectDeclrArray1 DirectDeclr
ddeclr Maybe TypeQualList
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) (DeclnSpecs -> Maybe DeclnSpecs
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 ([TypeSpec] -> DeclnSpecs) -> [TypeSpec] -> DeclnSpecs
forall a b. (a -> b) -> a -> b
$ TypeSpec -> [TypeSpec]
spec2spec TypeSpec
ty'
    Ptr      Type
ty'   -> Type -> DeclnSpecs
rec ((Maybe TypeQualList, Type) -> Type
forall a b. (a, b) -> b
snd ((Maybe TypeQualList, Type) -> Type)
-> (Maybe TypeQualList, Type) -> Type
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    (DeclnSpecs -> Maybe DeclnSpecs
forall a. a -> Maybe a
Just (DeclnSpecs -> Maybe DeclnSpecs) -> DeclnSpecs -> Maybe DeclnSpecs
forall a b. (a -> b) -> a -> b
$ Type -> DeclnSpecs
rec Type
ty')
    Restrict Type
ty'   -> TypeQual -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsQual TypeQual
C.QRestrict (DeclnSpecs -> Maybe DeclnSpecs
forall a. a -> Maybe a
Just (DeclnSpecs -> Maybe DeclnSpecs) -> DeclnSpecs -> Maybe DeclnSpecs
forall a b. (a -> b) -> a -> b
$ Type -> DeclnSpecs
rec Type
ty')
    Volatile Type
ty'   -> TypeQual -> Maybe DeclnSpecs -> DeclnSpecs
C.DeclnSpecsQual TypeQual
C.QVolatile (DeclnSpecs -> Maybe DeclnSpecs
forall a. a -> Maybe a
Just (DeclnSpecs -> Maybe DeclnSpecs) -> DeclnSpecs -> Maybe DeclnSpecs
forall a b. (a -> b) -> a -> b
$ Type -> DeclnSpecs
rec Type
ty')

  rec :: Type -> DeclnSpecs
rec = Maybe StorageSpec -> Type -> DeclnSpecs
getdeclnspecs Maybe StorageSpec
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 (TypedefName -> TypeSpec) -> TypedefName -> TypeSpec
forall a b. (a -> b) -> a -> b
$ Ident -> TypedefName
C.TypedefName (Ident -> TypedefName) -> Ident -> TypedefName
forall a b. (a -> b) -> a -> b
$ Ident -> Ident
ident Ident
name]
  Struct      Ident
name -> [StructOrUnionSpec -> TypeSpec
C.TStructOrUnion (StructOrUnionSpec -> TypeSpec) -> StructOrUnionSpec -> TypeSpec
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 (StructOrUnionSpec -> TypeSpec) -> StructOrUnionSpec -> TypeSpec
forall a b. (a -> b) -> a -> b
$ StructOrUnion
-> Maybe Ident -> StructDeclnList -> StructOrUnionSpec
C.StructOrUnionDecln StructOrUnion
C.Struct (Ident -> Ident
ident (Ident -> Ident) -> Maybe Ident -> Maybe 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 (StructOrUnionSpec -> TypeSpec) -> StructOrUnionSpec -> TypeSpec
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 (StructOrUnionSpec -> TypeSpec) -> StructOrUnionSpec -> TypeSpec
forall a b. (a -> b) -> a -> b
$ StructOrUnion
-> Maybe Ident -> StructDeclnList -> StructOrUnionSpec
C.StructOrUnionDecln StructOrUnion
C.Union (Ident -> Ident
ident (Ident -> Ident) -> Maybe Ident -> Maybe 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 (EnumSpec -> TypeSpec) -> EnumSpec -> TypeSpec
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 (EnumSpec -> TypeSpec) -> EnumSpec -> TypeSpec
forall a b. (a -> b) -> a -> b
$ Maybe Ident -> EnumrList -> EnumSpec
C.EnumSpec (Ident -> Ident
ident (Ident -> Ident) -> Maybe Ident -> Maybe 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) = (StructDeclnList -> FieldDecln -> StructDeclnList)
-> StructDeclnList -> [FieldDecln] -> StructDeclnList
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 (StructDeclr -> StructDeclrList) -> StructDeclr -> StructDeclrList
forall a b. (a -> b) -> a -> b
$ Declr -> StructDeclr
C.StructDeclr Declr
declr
  declr :: Declr
declr = State 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) = (EnumrList -> Ident -> EnumrList)
-> EnumrList -> [Ident] -> EnumrList
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 ([TypeSpec] -> SpecQualList) -> [TypeSpec] -> SpecQualList
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    (SpecQualList -> Maybe SpecQualList
forall a. a -> Maybe a
Just (SpecQualList -> Maybe SpecQualList)
-> SpecQualList -> Maybe SpecQualList
forall a b. (a -> b) -> a -> b
$ Type -> SpecQualList
getspecquals Type
ty')
  Restrict Type
ty'     -> TypeQual -> Maybe SpecQualList -> SpecQualList
C.SpecQualQual TypeQual
C.QRestrict (SpecQualList -> Maybe SpecQualList
forall a. a -> Maybe a
Just (SpecQualList -> Maybe SpecQualList)
-> SpecQualList -> Maybe SpecQualList
forall a b. (a -> b) -> a -> b
$ Type -> SpecQualList
getspecquals Type
ty')
  Volatile Type
ty'     -> TypeQual -> Maybe SpecQualList -> SpecQualList
C.SpecQualQual TypeQual
C.QVolatile (SpecQualList -> Maybe SpecQualList
forall a. a -> Maybe a
Just (SpecQualList -> Maybe SpecQualList)
-> SpecQualList -> Maybe SpecQualList
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         -> PrimExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (PrimExpr -> Expr) -> PrimExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Ident -> PrimExpr
C.PrimIdent (Ident -> PrimExpr) -> Ident -> PrimExpr
forall a b. (a -> b) -> a -> b
$ Ident -> Ident
ident Ident
i
  LitBool   Bool
b         -> PrimExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (PrimExpr -> Expr) -> PrimExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Bool -> PrimExpr
litbool   Bool
b
  LitInt    Integer
i         -> UnaryExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (UnaryExpr -> Expr) -> UnaryExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Integer -> UnaryExpr
litint    Integer
i
  LitFloat  Float
f         -> UnaryExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (UnaryExpr -> Expr) -> UnaryExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Float -> UnaryExpr
litfloat  Float
f
  LitDouble Double
d         -> UnaryExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (UnaryExpr -> Expr) -> UnaryExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Double -> UnaryExpr
litdouble Double
d
  LitString Ident
s         -> UnaryExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (UnaryExpr -> Expr) -> UnaryExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Ident -> UnaryExpr
litstring Ident
s
  Index     Expr
arr Expr
idx   -> PostfixExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (PostfixExpr -> Expr) -> PostfixExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> PostfixExpr
indexexpr Expr
arr Expr
idx
  Funcall   Expr
fun [Expr]
args  -> PostfixExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (PostfixExpr -> Expr) -> PostfixExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> [Expr] -> PostfixExpr
funcall   Expr
fun [Expr]
args
  Dot       Expr
e   Ident
field -> PostfixExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (PostfixExpr -> Expr) -> PostfixExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Ident -> PostfixExpr
dotexpr   Expr
e Ident
field
  Arrow     Expr
e   Ident
field -> PostfixExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (PostfixExpr -> Expr) -> PostfixExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Ident -> PostfixExpr
arrowexpr Expr
e Ident
field
  InitVal   TypeName
ty  NonEmpty InitItem
init  -> PostfixExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (PostfixExpr -> Expr) -> PostfixExpr -> Expr
forall a b. (a -> b) -> a -> b
$ TypeName -> NonEmpty InitItem -> PostfixExpr
initexpr  TypeName
ty NonEmpty InitItem
init
  UnaryOp   UnaryOp
op Expr
e      -> UnaryExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (UnaryExpr -> Expr) -> UnaryExpr -> Expr
forall a b. (a -> b) -> a -> b
$ UnaryOp -> Expr -> UnaryExpr
unaryop UnaryOp
op Expr
e
  Cast      TypeName
ty Expr
e      -> CastExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (CastExpr -> Expr) -> CastExpr -> Expr
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  -> AssignExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (AssignExpr -> Expr) -> AssignExpr -> Expr
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   -> CondExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (CondExpr -> Expr) -> CondExpr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> CondExpr
condexpr Expr
c Expr
e1 Expr
e2


unaryop :: UnaryOp -> Expr -> C.UnaryExpr
unaryop :: UnaryOp -> Expr -> UnaryExpr
unaryop UnaryOp
op Expr
e = case UnaryOp
op of
    UnaryOp
Inc     -> UnaryExpr -> UnaryExpr
C.UnaryInc          (Expr -> UnaryExpr
forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Dec     -> UnaryExpr -> UnaryExpr
C.UnaryDec          (Expr -> UnaryExpr
forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Ref     -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UORef   (Expr -> CastExpr
forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
DeRef   -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UODeref (Expr -> CastExpr
forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Plus    -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UOPlus  (Expr -> CastExpr
forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Min     -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UOMin   (Expr -> CastExpr
forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
BoolNot -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UOBNot  (Expr -> CastExpr
forall a b. Wrap a b => a -> b
wrap Expr
e')
    UnaryOp
Not     -> UnaryOp -> CastExpr -> UnaryExpr
C.UnaryOp UnaryOp
C.UONot   (Expr -> CastExpr
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   -> MultExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (MultExpr -> Expr) -> MultExpr -> Expr
forall a b. (a -> b) -> a -> b
$ MultExpr -> CastExpr -> MultExpr
C.MultMult   (Expr -> MultExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> CastExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Div    -> MultExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (MultExpr -> Expr) -> MultExpr -> Expr
forall a b. (a -> b) -> a -> b
$ MultExpr -> CastExpr -> MultExpr
C.MultDiv    (Expr -> MultExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> CastExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Mod    -> MultExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (MultExpr -> Expr) -> MultExpr -> Expr
forall a b. (a -> b) -> a -> b
$ MultExpr -> CastExpr -> MultExpr
C.MultMod    (Expr -> MultExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> CastExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Add    -> AddExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (AddExpr -> Expr) -> AddExpr -> Expr
forall a b. (a -> b) -> a -> b
$ AddExpr -> MultExpr -> AddExpr
C.AddPlus    (Expr -> AddExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> MultExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Sub    -> AddExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (AddExpr -> Expr) -> AddExpr -> Expr
forall a b. (a -> b) -> a -> b
$ AddExpr -> MultExpr -> AddExpr
C.AddMin     (Expr -> AddExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> MultExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
ShiftL -> ShiftExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (ShiftExpr -> Expr) -> ShiftExpr -> Expr
forall a b. (a -> b) -> a -> b
$ ShiftExpr -> AddExpr -> ShiftExpr
C.ShiftLeft  (Expr -> ShiftExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> AddExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
ShiftR -> ShiftExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (ShiftExpr -> Expr) -> ShiftExpr -> Expr
forall a b. (a -> b) -> a -> b
$ ShiftExpr -> AddExpr -> ShiftExpr
C.ShiftRight (Expr -> ShiftExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> AddExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
LT     -> RelExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (RelExpr -> Expr) -> RelExpr -> Expr
forall a b. (a -> b) -> a -> b
$ RelExpr -> ShiftExpr -> RelExpr
C.RelLT      (Expr -> RelExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> ShiftExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
GT     -> RelExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (RelExpr -> Expr) -> RelExpr -> Expr
forall a b. (a -> b) -> a -> b
$ RelExpr -> ShiftExpr -> RelExpr
C.RelGT      (Expr -> RelExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> ShiftExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
LE     -> RelExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (RelExpr -> Expr) -> RelExpr -> Expr
forall a b. (a -> b) -> a -> b
$ RelExpr -> ShiftExpr -> RelExpr
C.RelLE      (Expr -> RelExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> ShiftExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
GE     -> RelExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (RelExpr -> Expr) -> RelExpr -> Expr
forall a b. (a -> b) -> a -> b
$ RelExpr -> ShiftExpr -> RelExpr
C.RelGE      (Expr -> RelExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> ShiftExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Eq     -> EqExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (EqExpr -> Expr) -> EqExpr -> Expr
forall a b. (a -> b) -> a -> b
$ EqExpr -> RelExpr -> EqExpr
C.EqEq       (Expr -> EqExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> RelExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
NEq    -> EqExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (EqExpr -> Expr) -> EqExpr -> Expr
forall a b. (a -> b) -> a -> b
$ EqExpr -> RelExpr -> EqExpr
C.EqNEq      (Expr -> EqExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> RelExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
And    -> AndExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (AndExpr -> Expr) -> AndExpr -> Expr
forall a b. (a -> b) -> a -> b
$ AndExpr -> EqExpr -> AndExpr
C.And        (Expr -> AndExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> EqExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
XOr    -> XOrExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (XOrExpr -> Expr) -> XOrExpr -> Expr
forall a b. (a -> b) -> a -> b
$ XOrExpr -> AndExpr -> XOrExpr
C.XOr        (Expr -> XOrExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> AndExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
Or     -> OrExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (OrExpr -> Expr) -> OrExpr -> Expr
forall a b. (a -> b) -> a -> b
$ OrExpr -> XOrExpr -> OrExpr
C.Or         (Expr -> OrExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> XOrExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
LAnd   -> LAndExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (LAndExpr -> Expr) -> LAndExpr -> Expr
forall a b. (a -> b) -> a -> b
$ LAndExpr -> OrExpr -> LAndExpr
C.LAnd       (Expr -> LAndExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> OrExpr
forall a b. Wrap a b => a -> b
wrap Expr
e2')
    BinaryOp
LOr    -> LOrExpr -> Expr
forall a b. Wrap a b => a -> b
wrap (LOrExpr -> Expr) -> LOrExpr -> Expr
forall a b. (a -> b) -> a -> b
$ LOrExpr -> LAndExpr -> LOrExpr
C.LOr        (Expr -> LOrExpr
forall a b. Wrap a b => a -> b
wrap Expr
e1') (Expr -> LAndExpr
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' = Expr -> UnaryExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> UnaryExpr) -> Expr -> UnaryExpr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e1
  e2' :: AssignExpr
e2' = Expr -> AssignExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> AssignExpr) -> Expr -> AssignExpr
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 (Expr -> AssignExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> AssignExpr) -> Expr -> AssignExpr
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) = (InitList -> InitItem -> InitList)
-> InitList -> [InitItem] -> InitList
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 (Ident -> Design) -> Maybe Ident -> Maybe Design
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 (Ident -> Design) -> Maybe Ident -> Maybe Design
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 (DesigrList -> Design) -> (Ident -> DesigrList) -> Ident -> Design
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Desigr -> DesigrList
C.DesigrBase (Desigr -> DesigrList) -> (Ident -> Desigr) -> Ident -> DesigrList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Desigr
C.DesigrIdent (Ident -> Desigr) -> (Ident -> Ident) -> Ident -> Desigr
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' = Expr -> PostfixExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> PostfixExpr) -> Expr -> PostfixExpr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
arr
  idx' :: Expr
idx' = Expr -> Expr
forall a b. Wrap a b => a -> b
wrap (Expr -> Expr) -> Expr -> Expr
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'     = Expr -> PostfixExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> PostfixExpr) -> Expr -> PostfixExpr
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'     = Expr -> PostfixExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> PostfixExpr) -> Expr -> PostfixExpr
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'  = Expr -> CastExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> CastExpr) -> Expr -> CastExpr
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'  = Expr -> PostfixExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> PostfixExpr) -> Expr -> PostfixExpr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
fun
  args' :: Maybe ArgExprList
args' = case [AssignExpr]
argses of
    [] -> Maybe ArgExprList
forall a. Maybe a
Nothing
    [AssignExpr]
_  -> ArgExprList -> Maybe ArgExprList
forall a. a -> Maybe a
Just (ArgExprList -> Maybe ArgExprList)
-> ArgExprList -> Maybe ArgExprList
forall a b. (a -> b) -> a -> b
$ [Item ArgExprList] -> ArgExprList
forall l. IsList l => [Item l] -> l
fromList [Item ArgExprList]
[AssignExpr]
argses

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

  exprs :: [C.Expr]
  exprs :: [Expr]
exprs = (Expr -> Expr) -> [Expr] -> [Expr]
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'  = Expr -> LOrExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> LOrExpr) -> Expr -> LOrExpr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
c
  e1' :: Expr
e1' = Expr -> Expr
forall a b. Wrap a b => a -> b
wrap (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
transexpr Expr
e1
  e2' :: CondExpr
e2' = Expr -> CondExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> CondExpr) -> Expr -> CondExpr
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    = State (Maybe AbstractDeclr) ()
-> Maybe AbstractDeclr -> Maybe AbstractDeclr
forall s a. State s a -> s -> s
execState (Type -> State (Maybe AbstractDeclr) ()
getabstractdeclr Type
ty) Maybe AbstractDeclr
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 <- StateT (Maybe AbstractDeclr) Identity (Maybe AbstractDeclr)
forall s (m :: * -> *). MonadState s m => m s
get
    case Maybe AbstractDeclr
adeclr of
      Maybe AbstractDeclr
Nothing      -> () -> State (Maybe AbstractDeclr) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just AbstractDeclr
adeclr' -> Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ())
-> Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ()
forall a b. (a -> b) -> a -> b
$ AbstractDeclr -> Maybe AbstractDeclr
forall a. a -> Maybe a
Just (AbstractDeclr -> Maybe AbstractDeclr)
-> AbstractDeclr -> Maybe AbstractDeclr
forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectAbstractDeclr -> AbstractDeclr
C.AbstractDeclrDirect Maybe Ptr
forall a. Maybe a
Nothing DirectAbstractDeclr
dadeclr where
        dadeclr :: DirectAbstractDeclr
dadeclr = AbstractDeclr -> DirectAbstractDeclr
C.DirectAbstractDeclr AbstractDeclr
adeclr'

  TypeSpec TypeSpec
ts -> () -> State (Maybe AbstractDeclr) ()
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 <- StateT (Maybe AbstractDeclr) Identity (Maybe AbstractDeclr)
forall s (m :: * -> *). MonadState s m => m s
get
    case Maybe AbstractDeclr
adeclr of
      Maybe AbstractDeclr
Nothing      -> Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ())
-> Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ()
forall a b. (a -> b) -> a -> b
$ AbstractDeclr -> Maybe AbstractDeclr
forall a. a -> Maybe a
Just (AbstractDeclr -> Maybe AbstractDeclr)
-> AbstractDeclr -> Maybe AbstractDeclr
forall a b. (a -> b) -> a -> b
$ Ptr -> AbstractDeclr
C.AbstractDeclr Ptr
ptr
      Just AbstractDeclr
adeclr' -> Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ())
-> Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ()
forall a b. (a -> b) -> a -> b
$ AbstractDeclr -> Maybe AbstractDeclr
forall a. a -> Maybe a
Just (AbstractDeclr -> Maybe AbstractDeclr)
-> AbstractDeclr -> Maybe AbstractDeclr
forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> DirectAbstractDeclr -> AbstractDeclr
C.AbstractDeclrDirect (Ptr -> Maybe Ptr
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       = (Expr -> AssignExpr
forall a b. Wrap a b => a -> b
wrap(Expr -> AssignExpr) -> (Expr -> Expr) -> Expr -> AssignExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) (Expr -> AssignExpr) -> Maybe Expr -> Maybe AssignExpr
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 Maybe DirectAbstractDeclr
forall a. Maybe a
Nothing Maybe TypeQualList
forall a. Maybe a
Nothing Maybe AssignExpr
lenexpr
    Maybe AbstractDeclr
adeclr <- StateT (Maybe AbstractDeclr) Identity (Maybe AbstractDeclr)
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 Maybe Ptr
forall a. Maybe a
Nothing DirectAbstractDeclr
emptyarrdeclr
          Just 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 (DirectAbstractDeclr -> Maybe DirectAbstractDeclr
forall a. a -> Maybe a
Just DirectAbstractDeclr
adeclr') Maybe TypeQualList
forall a. Maybe a
Nothing Maybe AssignExpr
lenexpr
            C.AbstractDeclr Ptr
ptr -> Maybe Ptr -> DirectAbstractDeclr -> AbstractDeclr
C.AbstractDeclrDirect (Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just Ptr
ptr) DirectAbstractDeclr
emptyarrdeclr
    Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ())
-> Maybe AbstractDeclr -> State (Maybe AbstractDeclr) ()
forall a b. (a -> b) -> a -> b
$ AbstractDeclr -> Maybe AbstractDeclr
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 (Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
start) (Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
end) (Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
step) [Stmt]
ss
  ForInf                 [Stmt]
ss  -> Maybe Expr -> Maybe Expr -> Maybe Expr -> [Stmt] -> Stmt
forstmt Maybe Expr
forall a. Maybe a
Nothing      Maybe Expr
forall a. Maybe a
Nothing    Maybe Expr
forall a. Maybe a
Nothing     [Stmt]
ss
  Stmt
Continue                   -> JumpStmt -> Stmt
C.StmtJump (JumpStmt -> Stmt) -> JumpStmt -> Stmt
forall a b. (a -> b) -> a -> b
$ JumpStmt
C.JumpContinue
  Stmt
Break                      -> JumpStmt -> Stmt
C.StmtJump (JumpStmt -> Stmt) -> JumpStmt -> Stmt
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   (ExprStmt -> Stmt) -> ExprStmt -> Stmt
forall a b. (a -> b) -> a -> b
$ Maybe Expr -> ExprStmt
C.ExprStmt (Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
forall a b. Wrap a b => a -> b
wrap (Expr -> Expr) -> Expr -> Expr
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 (SelectStmt -> Stmt) -> SelectStmt -> Stmt
forall a b. (a -> b) -> a -> b
$ Expr -> Stmt -> SelectStmt
C.SelectIf Expr
cond' Stmt
body where
  cond' :: Expr
cond' = Expr -> Expr
forall a b. Wrap a b => a -> b
wrap (Expr -> Expr) -> Expr -> Expr
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 (SelectStmt -> Stmt) -> SelectStmt -> Stmt
forall a b. (a -> b) -> a -> b
$ Expr -> Stmt -> Stmt -> SelectStmt
C.SelectIfElse Expr
cond' Stmt
ssthen' Stmt
sselse' where
    cond' :: Expr
cond'  = Expr -> Expr
forall a b. Wrap a b => a -> b
wrap (Expr -> Expr) -> Expr -> Expr
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 (SelectStmt -> Stmt) -> SelectStmt -> Stmt
forall a b. (a -> b) -> a -> b
$ Expr -> Stmt -> SelectStmt
C.SelectSwitch Expr
cond' Stmt
cs' where
  cond' :: Expr
cond' = Expr -> Expr
forall a b. Wrap a b => a -> b
wrap (Expr -> Expr) -> Expr -> Expr
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 (IterStmt -> Stmt) -> IterStmt -> Stmt
forall a b. (a -> b) -> a -> b
$ Expr -> Stmt -> IterStmt
C.IterWhile Expr
cond' Stmt
ss' where
  cond' :: Expr
cond' = Expr -> Expr
forall a b. Wrap a b => a -> b
wrap (Expr -> Expr) -> Expr -> Expr
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 (IterStmt -> Stmt) -> IterStmt -> Stmt
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' = (Expr -> Expr
forall a b. Wrap a b => a -> b
wrap(Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
start
    end' :: Maybe Expr
end'   = (Expr -> Expr
forall a b. Wrap a b => a -> b
wrap(Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
end
    step' :: Maybe Expr
step'  = (Expr -> Expr
forall a b. Wrap a b => a -> b
wrap(Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) (Expr -> Expr) -> Maybe Expr -> Maybe Expr
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 (LabeledStmt -> Stmt) -> LabeledStmt -> Stmt
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 (JumpStmt -> Stmt) -> JumpStmt -> Stmt
forall a b. (a -> b) -> a -> b
$ Maybe Expr -> JumpStmt
C.JumpReturn ((Expr -> Expr
forall a b. Wrap a b => a -> b
wrap(Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Expr -> Expr
transexpr) (Expr -> Expr) -> Maybe Expr -> Maybe Expr
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 (CompoundStmt -> Stmt) -> CompoundStmt -> Stmt
forall a b. (a -> b) -> a -> b
$ Maybe BlockItemList -> CompoundStmt
C.Compound (BlockItemList -> Maybe BlockItemList
forall a. a -> Maybe a
Just (BlockItemList -> Maybe BlockItemList)
-> BlockItemList -> Maybe BlockItemList
forall a b. (a -> b) -> a -> b
$ [Item BlockItemList] -> BlockItemList
forall l. IsList l => [Item l] -> l
fromList ([Item BlockItemList] -> BlockItemList)
-> [Item BlockItemList] -> BlockItemList
forall a b. (a -> b) -> a -> b
$ (Case -> BlockItem) -> [Case] -> [BlockItem]
forall a b. (a -> b) -> [a] -> [b]
map Case -> BlockItem
casestmt' [Case]
cs) where
    casestmt' :: Case -> BlockItem
casestmt' Case
cs = Stmt -> BlockItem
C.BlockItemStmt (Stmt -> BlockItem) -> Stmt -> BlockItem
forall a b. (a -> b) -> a -> b
$ LabeledStmt -> Stmt
C.StmtLabeled (LabeledStmt -> Stmt) -> LabeledStmt -> Stmt
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 (CondExpr -> ConstExpr) -> CondExpr -> ConstExpr
forall a b. (a -> b) -> a -> b
$ Expr -> CondExpr
forall a b. Wrap a b => a -> b
wrap (Expr -> CondExpr) -> Expr -> CondExpr
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 (BlockItemList -> Maybe BlockItemList
forall a. a -> Maybe a
Just (BlockItemList -> Maybe BlockItemList)
-> BlockItemList -> Maybe BlockItemList
forall a b. (a -> b) -> a -> b
$ [Item BlockItemList] -> BlockItemList
forall l. IsList l => [Item l] -> l
fromList [Item BlockItemList]
[BlockItem]
items) where
  items :: [BlockItem]
items = [BlockItem]
ds' [BlockItem] -> [BlockItem] -> [BlockItem]
forall a. [a] -> [a] -> [a]
++ [BlockItem]
ss'
  ss' :: [BlockItem]
ss' = (Stmt -> BlockItem) -> [Stmt] -> [BlockItem]
forall a b. (a -> b) -> [a] -> [b]
map (Stmt -> BlockItem
C.BlockItemStmt (Stmt -> BlockItem) -> (Stmt -> Stmt) -> Stmt -> BlockItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt -> Stmt
transstmt) [Stmt]
ss
  ds' :: [BlockItem]
ds' = (Decln -> BlockItem) -> [Decln] -> [BlockItem]
forall a b. (a -> b) -> [a] -> [b]
map (Decln -> BlockItem
C.BlockItemDecln (Decln -> BlockItem) -> (Decln -> Decln) -> Decln -> BlockItem
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 (CompoundStmt -> Stmt) -> CompoundStmt -> Stmt
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 (Ident -> DirectDeclr) -> Ident -> DirectDeclr
forall a b. (a -> b) -> a -> b
$ Ident -> Ident
ident Ident
name
  params' :: ParamTypeList
params'   = ParamList -> ParamTypeList
C.ParamTypeList (ParamList -> ParamTypeList) -> ParamList -> ParamTypeList
forall a b. (a -> b) -> a -> b
$ [ParamDecln] -> ParamList
voidparamlist ([ParamDecln] -> ParamList) -> [ParamDecln] -> ParamList
forall a b. (a -> b) -> a -> b
$ (Param -> ParamDecln) -> [Param] -> [ParamDecln]
forall a b. (a -> b) -> [a] -> [b]
map Param -> ParamDecln
transparamdecln [Param]
params