X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=generator-lib%2Fwrappi_types.ml;h=ef3a8bd5094c97a361ccd910c044d10ad1d8ba17;hb=6964a24290a2d645b3155353e08750f37930146a;hp=8dfa31b6ad02ad35d8399719766a096b68b44504;hpb=ff4a39eec0c3d92b7fda62341e0734e07d5d2987;p=wrappi.git diff --git a/generator-lib/wrappi_types.ml b/generator-lib/wrappi_types.ml index 8dfa31b..ef3a8bd 100644 --- a/generator-lib/wrappi_types.ml +++ b/generator-lib/wrappi_types.ml @@ -18,46 +18,135 @@ open Camlp4.PreCast +open Wrappi_utils + open Printf -type any_type = TInt32 | TInt64 | Type of string +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 parameter = string * any_type +type rtype = RErr | Return of ptype -type return_type = RErr | Return of any_type +type ftype = rtype * parameter list * parameter list type c_code = string type entry_point = { ep_loc : Camlp4.PreCast.Loc.t; ep_name : string; - ep_params : parameter list; - ep_return : return_type; + 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_entry_points : entry_point list; + 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 string_of_any_type = function +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" - | Type s -> s -let string_of_return_type = function + | 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_any_type t -let string_of_parameter (name, t) = - sprintf "%s %s" (string_of_any_type t) name + | 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 = - "(" ^ String.concat ", " (List.map string_of_parameter 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 <<%s>>" + sprintf "entry_point %s %s <<%s>>" (*(Loc.to_string ep.ep_loc)*) - (string_of_return_type ep.ep_return) ep.ep_name - (string_of_parameters ep.ep_params) + (string_of_ftype ep.ep_ftype) (match ep.ep_code with | None -> "/* implicit */" | Some code -> string_of_c_code code)