123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251 |
- type signedness = Signed | Unsigned
- type shortness = IShort | ILong | INone
- type int_attr = {
- ia_signedness : signedness;
- ia_shortness : shortness;
- }
- type atype =
- | Char of signedness
- | Long of signedness
- | LLong of signedness
- | Int of int_attr
- | Float | Double | LDouble
- | Int8 | Int16 | Int32 | Int64
- | UInt8 | UInt16 | UInt32 | UInt64
- | Void | WChar | SizeT
- | Struct of string
- | Union of string
- | Enum of string
- | Foreign of string
- | Ptr of atype
- type ptr_direction =
- | PtrIn | PtrOut | PtrInOut | PtrNoDirection
- type attr_value =
- | AString of string
- | ANumber of int
- type ptr_size = {
- ps_size : attr_value option;
- ps_sizefunc : string option;
- ps_count : attr_value option;
- }
- let empty_ptr_size = {
- ps_size = None;
- ps_sizefunc = None;
- ps_count = None;
- }
- type ptr_attr = {
- pa_direction : ptr_direction;
- pa_size : ptr_size;
- pa_isptr : bool;
- pa_isary : bool;
- pa_isstr : bool;
- pa_iswstr : bool;
- pa_rdonly : bool;
- pa_chkptr : bool;
- }
- type parameter_type =
- | PTVal of atype
- | PTPtr of atype * ptr_attr
- type call_conv = CC_CDECL | CC_STDCALL | CC_FASTCALL | CC_NONE
- let get_call_conv_str (cc: call_conv) =
- match cc with
- CC_CDECL -> "CDECL"
- | CC_STDCALL -> "STDCALL"
- | CC_FASTCALL -> "FASTCALL"
- | CC_NONE -> "NOCONVENTION"
- type func_attr = {
- fa_dllimport : bool;
- fa_convention: call_conv;
- }
- type declarator = {
- identifier : string;
- array_dims : int list;
- }
- let is_array (declr: declarator) = declr.array_dims <> []
- type pdecl = parameter_type * declarator
- type mdecl = atype * declarator
- type struct_def = {
- sname : string;
- mlist : mdecl list;
- }
- type enum_val = EnumValNone | EnumVal of attr_value
- type enum_ele = string * enum_val
- type enum_def = {
- enname: string;
- enbody: enum_ele list;
- }
- type composite_type =
- StructDef of struct_def
- | UnionDef of struct_def
- | EnumDef of enum_def
- type func_decl = {
- fname : string;
- rtype : atype;
- plist : pdecl list;
- }
- type trusted_func = {
- tf_fdecl : func_decl;
- tf_is_priv : bool;
- }
- type untrusted_func = {
- uf_fdecl : func_decl;
- uf_fattr : func_attr;
- uf_allow_list : string list;
- uf_propagate_errno : bool;
- }
- type enclave_func =
- | Trusted of trusted_func
- | Untrusted of untrusted_func
- type import_decl = {
- mname : string;
- flist : string list;
- }
- type expr =
- | Interface of enclave_func list
- | Composite of composite_type
- | Importing of import_decl
- | Include of string
- type enclave = {
- ename : string;
- eexpr : expr list;
- }
- let rec get_tystr (ty: atype) =
- match ty with
- | Char sn ->
- (match sn with
- Signed -> "char"
- | Unsigned -> "unsigned char")
- | Long sn ->
- (match sn with
- Signed -> "long"
- | Unsigned -> "unsigned long")
- | LLong sn ->
- (match sn with
- Signed -> "long long"
- | Unsigned -> "unsigned long long")
- | Int ia ->
- Printf.sprintf "%s%sint"
- (if ia.ia_signedness = Unsigned then "unsigned " else "")
- (match ia.ia_shortness with
- IShort -> "short "
- | ILong -> "long "
- | INone -> "")
- | Float -> "float"
- | Double -> "double"
- | LDouble -> "long double"
- | Int8 -> "int8_t"
- | Int16 -> "int16_t"
- | Int32 -> "int32_t"
- | Int64 -> "int64_t"
- | UInt8 -> "uint8_t"
- | UInt16 -> "uint16_t"
- | UInt32 -> "uint32_t"
- | UInt64 -> "uint64_t"
- | Void -> "void"
- | SizeT -> "size_t"
- | WChar -> "wchar_t"
- | Struct id -> "struct " ^ id
- | Union id -> "union " ^ id
- | Enum id -> "enum " ^ id
- | Foreign s -> s
- | Ptr ty -> get_tystr(ty) ^ "*"
- let get_param_atype (pt: parameter_type) =
- match pt with
- | PTVal t -> t
- | PTPtr (t, _) -> t
- let attr_value_to_string (attr: attr_value) =
- match attr with
- ANumber n -> Printf.sprintf "%d" n
- | AString s -> s
|