module Language.Trans.CStruct2CopilotStruct
(
mkCStruct
, camelCaseTypeName
)
where
import Data.Char ( toUpper )
import Language.Copilot.CStruct ( CField (CArray, CPlain), CStruct(..) )
import qualified Language.C.AbsC as C
mkCStruct :: C.ExternalDeclaration -> Either String CStruct
mkCStruct :: ExternalDeclaration -> Either String CStruct
mkCStruct (C.MkExternalDeclarationFunctionDefinition FunctionDefinition
_) = String -> Either String CStruct
forall a b. a -> Either a b
Left String
"C files must contain struct definitions only."
mkCStruct (C.MkExternalDeclarationDeclaration (C.MkDeclaration DeclarationSpecifiers
specifiers InitDeclarationListOpt
initDecl)) =
case DeclarationSpecifiers
specifiers of
C.DeclarationSpecifiers (C.MkDeclarationSpecifierStorageClass StorageClassSpecifier
C.MkStorageClassSpecifierTypedef) [DeclarationSpecifier]
s ->
let [C.MkDeclarationSpecifierTypeSpecifier (C.MkTypeSpecifierStructOrUnion (C.MkStructOrUnionSpecifierWithFields StructOrUnion
C.MkStructOrUnionStruct IdentifierOpt
_structName [StructDeclaration]
u))] = [DeclarationSpecifier]
s
(C.MkInitDeclarationListOptJust [C.MkInitDeclaratorUninitialized (C.MkDeclarator PointerOpt
C.MkPointerOptNothing (C.MkDirectDeclaratorIdentifier (C.Identifier String
t)))]) = InitDeclarationListOpt
initDecl
name :: Either a String
name = String -> Either a String
forall a b. b -> Either a b
Right String
t
fields :: Either String [CField]
fields = (StructDeclaration -> Either String CField)
-> [StructDeclaration] -> Either String [CField]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM StructDeclaration -> Either String CField
buildCField [StructDeclaration]
u
in String -> [CField] -> CStruct
CStruct (String -> [CField] -> CStruct)
-> Either String String -> Either String ([CField] -> CStruct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String String
forall {a}. Either a String
name Either String ([CField] -> CStruct)
-> Either String [CField] -> Either String CStruct
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String [CField]
fields
DeclarationSpecifiers
_ -> String -> Either String CStruct
forall a b. a -> Either a b
Left String
"C files must contain struct definitions only."
buildCField :: C.StructDeclaration -> Either String CField
buildCField :: StructDeclaration -> Either String CField
buildCField (C.MkStructDeclaration [SpecifierQualifier]
field [StructDeclarator]
name)
| Integer
fieldLength Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = String -> String -> Integer -> CField
CArray (String -> String -> Integer -> CField)
-> Either String String
-> Either String (String -> Integer -> CField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String String
fieldType Either String (String -> Integer -> CField)
-> Either String String -> Either String (Integer -> CField)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String String
fieldName Either String (Integer -> CField)
-> Either String Integer -> Either String CField
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> Either String Integer
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
fieldLength
| Bool
otherwise = String -> String -> CField
CPlain (String -> String -> CField)
-> Either String String -> Either String (String -> CField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String String
fieldType Either String (String -> CField)
-> Either String String -> Either String CField
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String String
fieldName
where
fieldType :: Either String String
fieldType = SpecifierQualifier -> Either String String
extractFieldType ([SpecifierQualifier] -> SpecifierQualifier
forall a. HasCallStack => [a] -> a
head [SpecifierQualifier]
field)
fieldName :: Either String String
fieldName = StructDeclarator -> Either String String
forall n. Read n => StructDeclarator -> Either String n
extractFieldName ([StructDeclarator] -> StructDeclarator
forall a. HasCallStack => [a] -> a
head [StructDeclarator]
name)
fieldLength :: Integer
fieldLength = StructDeclarator -> Integer
extractFieldLength ([StructDeclarator] -> StructDeclarator
forall a. HasCallStack => [a] -> a
head [StructDeclarator]
name)
extractFieldType :: C.SpecifierQualifier -> Either String String
(C.MkSpecifierQualifierTypeSpecifier TypeSpecifier
t) = String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ TypeSpecifier -> String
showTypeSpecifier TypeSpecifier
t
extractFieldType (C.MkSpecifierQualifierTypeQualifier TypeQualifier
_) = String -> Either String String
forall a b. a -> Either a b
Left String
"type qualifiers."
showTypeSpecifier :: C.TypeSpecifier -> String
showTypeSpecifier :: TypeSpecifier -> String
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierFloat = String
"float"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierDouble = String
"double"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierUInt8 = String
"uint8_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierUInt16 = String
"uint16_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierUInt32 = String
"uint32_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierUInt64 = String
"uint64_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt8 = String
"int8_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt16 = String
"int16_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt32 = String
"int32_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt64 = String
"int64_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt = String
"int"
extractFieldName :: Read n => C.StructDeclarator -> Either String n
(C.MkStructDeclaratorDeclarator (C.MkDeclarator PointerOpt
C.MkPointerOptNothing (C.MkDirectDeclaratorIdentifier (C.Identifier String
d)))) = n -> Either String n
forall a b. b -> Either a b
Right (n -> Either String n) -> n -> Either String n
forall a b. (a -> b) -> a -> b
$ String -> n
forall a. Read a => String -> a
read (String -> n) -> String -> n
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
d
extractFieldName (C.MkStructDeclaratorDeclarator
(C.MkDeclarator
PointerOpt
C.MkPointerOptNothing
(C.MkDirectDeclaratorConstantExpressionOpt
(C.MkDirectDeclaratorIdentifier (C.Identifier String
i))
ConstantExpressionOpt
_arrayLength
)
)
) = n -> Either String n
forall a b. b -> Either a b
Right (n -> Either String n) -> n -> Either String n
forall a b. (a -> b) -> a -> b
$ String -> n
forall a. Read a => String -> a
read (String -> n) -> String -> n
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
i
extractFieldName StructDeclarator
_ = String -> Either String n
forall a b. a -> Either a b
Left (String -> Either String n) -> String -> Either String n
forall a b. (a -> b) -> a -> b
$ String
"only struct declarations that are IDs without a"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" pointer, or plain arrays without a pointer, are"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" supported."
extractFieldLength :: C.StructDeclarator -> Integer
(C.MkStructDeclaratorDeclarator
(C.MkDeclarator
PointerOpt
C.MkPointerOptNothing
(C.MkDirectDeclaratorConstantExpressionOpt
DirectDeclarator
_varIdent
(C.MkConditionalExpressionJust
(C.MkConstantExpression
(C.Expression12
(C.MkCastExpression1
(C.MkUnaryExpressionPostfix
(C.MkPostfixExpression1
(C.MkPrimaryExpressionIdentifier (C.Identifier String
_n))
)
)
)
)
)
)
)
) ) = Integer
99
extractFieldLength (C.MkStructDeclaratorDeclarator
(C.MkDeclarator
PointerOpt
C.MkPointerOptNothing
(C.MkDirectDeclaratorConstantExpressionOpt
DirectDeclarator
_varIdent
(C.MkConditionalExpressionJust
(C.MkConstantExpression
(C.Expression12
(C.MkCastExpression1
(C.MkUnaryExpressionPostfix
(C.MkPostfixExpression1
(C.MkPrimaryExpressionConstant (C.MkConstantInteger (C.IntegerConstant String
i))
)
)
)
)
)
)
)
)
)
) = String -> Integer
forall a. Read a => String -> a
read String
i
extractFieldLength StructDeclarator
_ = Integer
0
camelCaseTypeName :: String -> String
camelCaseTypeName :: String -> String
camelCaseTypeName [] = []
camelCaseTypeName (Char
x:String
xs) = Char -> Char
toUpper Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelCaseTypeName' String
xs
where
camelCaseTypeName' :: String -> String
camelCaseTypeName' :: String -> String
camelCaseTypeName' [] = []
camelCaseTypeName' String
"_t" = []
camelCaseTypeName' (Char
'_':Char
y:String
ys) = Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelCaseTypeName' String
ys
camelCaseTypeName' (Char
y:String
ys) = Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelCaseTypeName' String
ys