+open Wrappi_utils
+
+open Printf
+
+type ptype =
+ | TBool
+ | TBuffer
+ | TEnum of string
+ | TFile
+ | THash of ptype
+ | TInt
+ | TInt32
+ | TInt64
+ | TList of ptype
+ | TNullable of ptype
+ | TString
+ | TStruct of string
+ | TTypedef of string
+ | TUInt32
+ | TUInt64
+ | TUnion of string
+
+type prec
+
+type parameter = string * ptype * prec option
+
+type rtype = RErr | Return of ptype
+
+type ftype = rtype * parameter list * parameter list
+
+type c_code = string
+
+type entry_point = {
+ ep_loc : Camlp4.PreCast.Loc.t;
+ ep_name : string;
+ ep_ftype : ftype;
+ ep_code : c_code option;
+}
+
+type typedef = {
+ td_loc : Camlp4.PreCast.Loc.t;
+ td_name : string;
+ td_type : ptype;
+}
+
+type enum = {
+ en_loc : Camlp4.PreCast.Loc.t;
+ en_name : string;
+ en_identifiers : string array;
+}
+
+type struct_decl = {
+ sd_loc : Camlp4.PreCast.Loc.t;
+ sd_name : string;
+ sd_identifiers : string array;
+ sd_fields : ptype array;
+}
+
+type union = {
+ un_loc : Camlp4.PreCast.Loc.t;
+ un_name : string;
+ un_identifiers : string array;
+ un_fields : ptype array;
+}
+
+type api = {
+ api_typedefs : typedef StringMap.t;
+ api_enums : enum StringMap.t;
+ api_structs : struct_decl StringMap.t;
+ api_unions : union StringMap.t;
+ api_entry_points : entry_point StringMap.t;
+}
+
+let iter xs f =
+ let xs = StringMap.bindings xs in
+ let cmp (a, _) (b, _) = compare a b in
+ let xs = List.sort cmp xs in
+ List.iter (fun (_, x) -> f x) xs
+
+let iter_typedefs { api_typedefs = tds } f = iter tds f
+let iter_enums { api_enums = ens } f = iter ens f
+let iter_structs { api_structs = sds } f = iter sds f
+let iter_unions { api_unions = uns } f = iter uns f
+let iter_entry_points { api_entry_points = eps } f = iter eps f
+
+let rec string_of_ptype = function
+ | TBool -> "bool"
+ | TBuffer -> "buffer"
+ | TEnum name -> sprintf "enum %s" name
+ | TFile -> "file"
+ | THash t -> sprintf "hash(%s)" (string_of_ptype t)
+ | TInt -> "int"
+ | TInt32 -> "int32"
+ | TInt64 -> "int64"
+ | TList t -> sprintf "list(%s)" (string_of_ptype t)
+ | TNullable t -> sprintf "nullable(%s)" (string_of_ptype t)
+ | TString -> "string"
+ | TStruct name -> sprintf "struct %s" name
+ | TTypedef name -> name
+ | TUInt32 -> "uint32"
+ | TUInt64 -> "uint64"
+ | TUnion name -> sprintf "union %s" name
+let string_of_rtype = function
+ | RErr -> "err"
+ | Return t -> string_of_ptype t
+let string_of_parameter (name, t, _) =
+ sprintf "%s %s" (string_of_ptype t) name
+let string_of_parameters params =
+ sprintf "(%s)" (String.concat ", " (List.map string_of_parameter params))
+let string_of_ftype (ret, req, opt) =
+ sprintf "%s %s %s"
+ (string_of_rtype ret) (string_of_parameters req) (string_of_parameters opt)
+let string_of_c_code code = code
+
+let string_of_typedef td =
+ sprintf "typedef %s %s" td.td_name (string_of_ptype td.td_type)
+
+let string_of_enum en =
+ sprintf "enum %s {%s}" en.en_name
+ (String.concat ", " (Array.to_list en.en_identifiers))
+
+let string_of_struct sd = assert false
+let string_of_union un = assert false
+
+let string_of_entry_point ep =
+ sprintf "entry_point %s %s <<%s>>"
+ (*(Loc.to_string ep.ep_loc)*)
+ ep.ep_name
+ (string_of_ftype ep.ep_ftype)
+ (match ep.ep_code with
+ | None -> "/* implicit */"
+ | Some code -> string_of_c_code code)