+typedef int fileperm ;; (* XXX preconditions XXX *)
+typedef string pathname ;;
+
entry_point
err mknod_char (pathname path, fileperm perm, uint64 major, uint64 minor)
<<
config.cmo:
config.cmx:
-wrappi_globals.cmi: wrappi_types.cmi
-wrappi_globals.cmo: wrappi_types.cmi wrappi_globals.cmi
-wrappi_globals.cmx: wrappi_types.cmx wrappi_globals.cmi
-wrappi_types.cmi:
-wrappi_types.cmo: wrappi_types.cmi
-wrappi_types.cmx: wrappi_types.cmi
+wrappi_accumulator.cmi: wrappi_types.cmi
+wrappi_accumulator.cmo: wrappi_utils.cmi wrappi_types.cmi wrappi_accumulator.cmi
+wrappi_accumulator.cmx: wrappi_utils.cmx wrappi_types.cmx wrappi_accumulator.cmi
+wrappi_types.cmi: wrappi_utils.cmi
+wrappi_types.cmo: wrappi_utils.cmi wrappi_types.cmi
+wrappi_types.cmx: wrappi_utils.cmx wrappi_types.cmi
wrappi_utils.cmi:
wrappi_utils.cmo: wrappi_utils.cmi
wrappi_utils.cmx: wrappi_utils.cmi
# In alphabetical order.
SOURCES = \
config.ml \
- wrappi_globals.mli \
- wrappi_globals.ml \
+ wrappi_accumulator.mli \
+ wrappi_accumulator.ml \
wrappi_types.mli \
wrappi_types.ml \
wrappi_utils.mli \
config.cmo \
wrappi_utils.cmo \
wrappi_types.cmo \
- wrappi_globals.cmo
+ wrappi_accumulator.cmo
noinst_SCRIPTS = generator_lib.cma
--- /dev/null
+(* wrappi
+ * Copyright (C) 2011 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Camlp4.PreCast
+
+open Wrappi_types
+open Wrappi_utils
+
+open Printf
+
+let check_not_defined name new_ map thing get_loc =
+ try
+ let old = StringMap.find name map in
+ eprintf "generator: %s %s redefined\n" thing name;
+ let old_loc = get_loc old in
+ let new_loc = get_loc new_ in
+ eprintf " first definition at %s:%d\n"
+ (Loc.file_name old_loc) (Loc.start_line old_loc);
+ eprintf " second definition at %s:%d\n"
+ (Loc.file_name new_loc) (Loc.start_line new_loc);
+ exit 1
+ with
+ Not_found -> ()
+
+let tds = ref StringMap.empty
+let add_typedef td =
+ let name = td.td_name in
+ check_not_defined name td !tds "typedef" (fun td -> td.td_loc);
+ tds := StringMap.add name td !tds
+
+let ens = ref StringMap.empty
+let add_enum en =
+ let name = en.en_name in
+ check_not_defined name en !ens "enum" (fun en -> en.en_loc);
+ ens := StringMap.add name en !ens
+
+let sds = ref StringMap.empty
+let add_struct sd =
+ let name = sd.sd_name in
+ check_not_defined name sd !sds "struct" (fun sd -> sd.sd_loc);
+ sds := StringMap.add name sd !sds
+
+let uns = ref StringMap.empty
+let add_union un =
+ let name = un.un_name in
+ check_not_defined name un !uns "union" (fun un -> un.un_loc);
+ uns := StringMap.add name un !uns
+
+let eps = ref StringMap.empty
+let add_entry_point ep =
+ let name = ep.ep_name in
+ check_not_defined name ep !eps "entry_point" (fun ep -> ep.ep_loc);
+ eps := StringMap.add name ep !eps
+
+let rec resolve_typedefs thing name loc = function
+ | (TBool
+ | TBuffer
+ | TEnum _
+ | TFile
+ | TInt
+ | TInt32
+ | TInt64
+ | TString
+ | TStruct _
+ | TUInt32
+ | TUInt64
+ | TUnion _) as t -> t
+
+ | THash t -> THash (resolve_typedefs thing name loc t)
+ | TList t -> TList (resolve_typedefs thing name loc t)
+ | TNullable t -> TNullable (resolve_typedefs thing name loc t)
+
+ | TTypedef tname ->
+ try (StringMap.find tname !tds).td_type
+ with Not_found ->
+ eprintf "generator: could not resolve typedef %s\n" tname;
+ eprintf " in definition of %s %s at %s:%d\n"
+ thing name (Loc.file_name loc) (Loc.start_line loc);
+ exit 1
+
+let resolve_typedefs_in_ret thing name loc = function
+ | RErr as t -> t
+ | Return t -> Return (resolve_typedefs thing name loc t)
+
+let get_api () =
+ let tds = !tds in
+ let ens = !ens in
+ let sds = !sds in
+ let uns = !uns in
+ let eps = !eps in
+
+ (* Resolve typedefs in all ptypes in everything. *)
+ let sds = StringMap.map (
+ fun sd ->
+ let fields = sd.sd_fields in
+ let fields =
+ Array.map (resolve_typedefs "enum" sd.sd_name sd.sd_loc) fields in
+ { sd with sd_fields = fields }
+ ) sds in
+
+ let uns = StringMap.map (
+ fun un ->
+ let fields = un.un_fields in
+ let fields =
+ Array.map (resolve_typedefs "union" un.un_name un.un_loc) fields in
+ { un with un_fields = fields }
+ ) uns in
+
+ let eps = StringMap.map (
+ fun ep ->
+ let name = ep.ep_name in
+ let loc = ep.ep_loc in
+ let ret, req, opt = ep.ep_ftype in
+ let ret = resolve_typedefs_in_ret "entry_point" name loc ret in
+ let req = List.map (
+ fun (n, t, prec) ->
+ n, resolve_typedefs "entry_point" name loc t, prec
+ ) req in
+ let opt = List.map (
+ fun (n, t, prec) ->
+ n, resolve_typedefs "entry_point" name loc t, prec
+ ) opt in
+ { ep with ep_ftype = (ret, req, opt) }
+ ) eps in
+
+ { api_typedefs = tds;
+ api_enums = ens;
+ api_structs = sds;
+ api_unions = uns;
+ api_entry_points = eps }
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-(** Globals.
+(** Accumulator.
- These global lists are built up when the generator starts
- running, populated by each compiled API file that is linked
- in during each file's initializer. *)
+ This module "accumulates" the typedefs, entry points etc as they
+ are declared (see pa_wrap.ml).
+ It then performs some manipulations on the API, mainly resolving
+ typedefs within types, and constructs a {!Wrappi_types.api}
+ object which describes the whole API. *)
+
+val add_typedef : Wrappi_types.typedef -> unit
+val add_enum : Wrappi_types.enum -> unit
+val add_struct : Wrappi_types.struct_decl -> unit
+val add_union : Wrappi_types.union -> unit
val add_entry_point : Wrappi_types.entry_point -> unit
-val get_entry_points : unit -> Wrappi_types.entry_point list
+
+val get_api : unit -> Wrappi_types.api
+++ /dev/null
-(* wrappi
- * Copyright (C) 2011 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-open Wrappi_types
-
-(* Could return these in any order we want since they are all
- * independent, but for neatness let's choose to return them in name
- * order.
- *)
-
-let eps = ref []
-let add_entry_point ep = eps := ep :: !eps
-
-let get_entry_points () =
- List.sort (fun { ep_name = a } { ep_name = b } -> compare a b ) !eps
open Camlp4.PreCast
+open Wrappi_utils
+
open Printf
-type any_type =
- | TFilePerm
+type ptype =
+ | TBool
+ | TBuffer
+ | TEnum of string
+ | TFile
+ | THash of ptype
+ | TInt
| TInt32
| TInt64
- | TPathname
+ | 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
- | TFilePerm -> "fileperm"
+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"
- | TPathname -> "pathname"
+ | 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"
-let string_of_return_type = function
+ | 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)
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-type any_type =
- | TFilePerm
- | TInt32
- | TInt64
- | TPathname
- | TUInt32
- | TUInt64
-(** Any API parameter or return type. *)
-
-type parameter = string * any_type
-(** API parameter (argument name and type). *)
-
-type return_type = RErr | Return of any_type
-(** API return type. A superset of {!any_type} because we allow the
+type ptype =
+ | TBool (** Boolean *)
+ | TBuffer (** 8 bit buffer of limited length *)
+ | TEnum of string (** Enumerated type *)
+ | TFile (** arbitrary length file in/out *)
+ | THash of ptype (** Hash of string -> ptype *)
+ | TInt (** Integer: MUST have preconditions *)
+ | TInt32 (** Signed 32 bit integer *)
+ | TInt64 (** Signed 64 bit integer *)
+ | TList of ptype (** List/array of values *)
+ | TNullable of ptype (** NULLable type modifier *)
+ | TString (** String (non-null) *)
+ | TStruct of string (** Struct *)
+ | TTypedef of string (** Typedef (before being resolved) *)
+ | TUInt32 (** Unsigned 32 bit integer *)
+ | TUInt64 (** Unsigned 64 bit integer *)
+ | TUnion of string (** Qualified union *)
+(** API parameter type. *)
+
+type prec
+(** Parameter precondition (XXX not implemented yet). *)
+
+type parameter = string * ptype * prec option
+(** API parameter (argument name, type, optional precondition). *)
+
+type rtype = RErr | Return of ptype
+(** API return type. A superset of {!ptype} because we allow the
special value [RErr] for dealing with errno. *)
+type ftype = rtype * parameter list * parameter list
+(** A function type. Return type, list of required parameters, list
+ of optional parameters. *)
+
type c_code = string
(** C code. *)
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;
}
(** An API entry point. *)
+type typedef = {
+ td_loc : Camlp4.PreCast.Loc.t;
+ td_name : string;
+ td_type : ptype;
+}
+(** A typedef. *)
+
+type enum = {
+ en_loc : Camlp4.PreCast.Loc.t;
+ en_name : string;
+ en_identifiers : string array;
+}
+(** An enum. *)
+
+type struct_decl = {
+ sd_loc : Camlp4.PreCast.Loc.t;
+ sd_name : string;
+ sd_identifiers : string array;
+ sd_fields : ptype array;
+}
+(** A struct declaration. *)
+
+type union = {
+ un_loc : Camlp4.PreCast.Loc.t;
+ un_name : string;
+ un_identifiers : string array;
+ un_fields : ptype array;
+}
+(** A qualified union declaration. *)
+
type api = {
- api_entry_points : entry_point list;
+ api_typedefs : typedef Wrappi_utils.StringMap.t;
+ api_enums : enum Wrappi_utils.StringMap.t;
+ api_structs : struct_decl Wrappi_utils.StringMap.t;
+ api_unions : union Wrappi_utils.StringMap.t;
+ api_entry_points : entry_point Wrappi_utils.StringMap.t;
}
-(** This single structure describes the whole API. *)
+(** This single structure describes the whole API. Each map is from
+ name of thing -> thing. *)
+
+val iter_typedefs : api -> (typedef -> unit) -> unit
+val iter_enums : api -> (enum -> unit) -> unit
+val iter_structs : api -> (struct_decl -> unit) -> unit
+val iter_unions : api -> (union -> unit) -> unit
+val iter_entry_points : api -> (entry_point -> unit) -> unit
+(** For convenience, iteration always presents the objects in name order. *)
-val string_of_any_type : any_type -> string
-val string_of_return_type : return_type -> string
+val string_of_ptype : ptype -> string
+val string_of_rtype : rtype -> string
val string_of_parameter : parameter -> string
val string_of_parameters : parameter list -> string
+val string_of_ftype : ftype -> string
val string_of_c_code : c_code -> string
+val string_of_typedef : typedef -> string
+val string_of_enum : enum -> string
+val string_of_struct : struct_decl -> string
+val string_of_union : union -> string
val string_of_entry_point : entry_point -> string
(** Convert structures to strings for printing, debugging etc. *)
if c = String.unsafe_get str i then incr count
done;
!count
+
+module StringMap = Map.Make (String)
val count_chars : char -> string -> int
(** Count number of times the character occurs in string. *)
+
+module StringMap : sig
+ type key = String.t
+ type 'a t = 'a Map.Make(String).t
+ val empty : 'a t
+ val is_empty : 'a t -> bool
+ val mem : key -> 'a t -> bool
+ val add : key -> 'a -> 'a t -> 'a t
+ val singleton : key -> 'a -> 'a t
+ val remove : key -> 'a t -> 'a t
+ val merge :
+ (key -> 'a option -> 'b option -> 'c option) ->
+ 'a t -> 'b t -> 'c t
+ val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+ val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+ val iter : (key -> 'a -> unit) -> 'a t -> unit
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ val for_all : (key -> 'a -> bool) -> 'a t -> bool
+ val exists : (key -> 'a -> bool) -> 'a t -> bool
+ val filter : (key -> 'a -> bool) -> 'a t -> 'a t
+ val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+ val cardinal : 'a t -> int
+ val bindings : 'a t -> (key * 'a) list
+ val min_binding : 'a t -> key * 'a
+ val max_binding : 'a t -> key * 'a
+ val choose : 'a t -> key * 'a
+ val split : key -> 'a t -> 'a t * 'a option * 'a t
+ val find : key -> 'a t -> 'a
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+end
$`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
$`bool:ghost$) >>
-let add_entry_point _loc name parameters return_type code =
+let add_entry_point _loc name parameters rtype code =
+ let loc = expr_of_loc _loc _loc in
+
let parameters = List.map (
- fun (name, t) -> <:expr< ($str:name$, $t$) >>
+ fun (name, t) -> <:expr< ($str:name$, $t$, None) >>
) parameters in
let parameters = expr_of_list _loc parameters in
let code = expr_of_option _loc code in
- let loc = expr_of_loc _loc _loc in
-
<:str_item<
let ep = { Wrappi_types.ep_loc = $loc$;
ep_name = $str:name$;
- ep_params = $parameters$;
- ep_return = $return_type$;
+ ep_ftype = ($rtype$, $parameters$, []);
ep_code = $code$ } in
- Wrappi_globals.add_entry_point ep
+ Wrappi_accumulator.add_entry_point ep
+ >>
+
+let add_typedef _loc name t =
+ let loc = expr_of_loc _loc _loc in
+
+ <:str_item<
+ let td = { Wrappi_types.td_loc = $loc$;
+ td_name = $str:name$;
+ td_type = $t$ } in
+ Wrappi_accumulator.add_typedef td
>>
let () =
GLOBAL: str_item;
(* A parameter or return type. *)
- any_type: [
- [ "fileperm" -> <:expr< Wrappi_types.TFilePerm >> ]
+ ptype: [
+ [ "buffer" -> <:expr< Wrappi_types.TBuffer >> ]
+ | [ "file" -> <:expr< Wrappi_types.TFile >> ]
+ | [ "hash"; "("; t = ptype; ")" -> <:expr< Wrappi_types.THash $t$ >> ]
+ | [ "int" -> <:expr< Wrappi_types.TInt >> ]
| [ "int32" -> <:expr< Wrappi_types.TInt32 >> ]
| [ "int64" -> <:expr< Wrappi_types.TInt64 >> ]
- | [ "pathname" -> <:expr< Wrappi_types.TPathname >> ]
+ | [ "list"; "("; t = ptype; ")" -> <:expr< Wrappi_types.TList $t$ >> ]
+ | [ "nullable"; "("; t = ptype; ")" -> <:expr< Wrappi_types.TNullable $t$ >> ]
+ | [ "string" -> <:expr< Wrappi_types.TString >> ]
+ | [ "struct"; name = LIDENT -> <:expr< Wrappi_types.TStruct $str:name$ >> ]
| [ "uint32" -> <:expr< Wrappi_types.TUInt32 >> ]
| [ "uint64" -> <:expr< Wrappi_types.TUInt64 >> ]
+ | [ name = LIDENT -> <:expr< Wrappi_types.TTypedef $str:name$ >> ]
];
(* A return type. *)
- return_type: [
+ rtype: [
[ "err" -> <:expr< Wrappi_types.RErr >> ]
- | [ t = any_type -> <:expr< Wrappi_types.Return $t$ >> ]
+ | [ t = ptype -> <:expr< Wrappi_types.Return $t$ >> ]
];
- (* A single function parameter. *)
- parameter: [[ t = any_type; name = LIDENT -> (name, t) ]];
+ (* A single function parameter. XXX Preconditions. *)
+ parameter: [[ t = ptype; name = LIDENT -> (name, t) ]];
str_item: LEVEL "top" [
[ "entry_point";
- return_type = return_type; name = LIDENT;
+ rtype = rtype; name = LIDENT;
"("; parameters = LIST0 parameter SEP ","; ")";
code = OPT [ code = expr -> code ] ->
- add_entry_point _loc name parameters return_type code
+ add_entry_point _loc name parameters rtype code
+ ]
+ | [ "typedef"; t = ptype; name = LIDENT ->
+ add_typedef _loc name t
]
];
open Printf
-let c_of_any_type = function
- | TFilePerm -> "int"
+let c_of_ptype ~param = function
+ | TBool -> "int"
+ | TBuffer -> assert false (* XXX not implemented *)
+ | TEnum name -> sprintf "enum wrap_%s" name
+ | TFile -> if param then "const char *" else "char *"
+ | THash t -> if param then "char * const *" else "char **"
+ | TInt -> "intXXX" (* XXX depends on preconditions *)
| TInt32 -> "int32_t"
| TInt64 -> "int64_t"
- | TPathname -> "const char *"
+ | TList t -> assert false (* XXX not implemented *)
+ | TNullable TString -> if param then "const char *" else "char *"
+ | TNullable _ -> assert false (* XXX may be implemented in future *)
+ | TString -> if param then "const char *" else "char *"
+ | TStruct name -> sprintf "struct wrap_%s" name
+ | TTypedef name -> assert false (* should never happen *)
| TUInt32 -> "uint32_t"
| TUInt64 -> "uint64_t"
+ | TUnion name -> sprintf "union wrap_%s" name
-let c_of_return_type = function
+let c_of_rtype = function
| RErr -> "int"
- | Return t -> c_of_any_type t
+ | Return t -> c_of_ptype ~param:false t
let generate_lib_wrappi_h api =
generate_header CStyle LGPLv2plus;
/* API entry points. */
";
- List.iter (
+ iter_entry_points api (
fun ep ->
- pr "extern %s wrap_%s (wrap_h *w, %s);\n"
- (c_of_return_type ep.ep_return)
- ep.ep_name
- (String.concat ", "
- (List.map (
- fun (name, t) ->
- let t = c_of_any_type t in
- let last_char = t.[String.length t - 1] in
- let sep = if isalnum last_char then " " else "" in
- sprintf "%s%s%s" t sep name
- ) ep.ep_params))
- ) api.api_entry_points;
+ let ret, req, opt = ep.ep_ftype in
+ pr "extern %s wrap_%s (wrap_h *w" (c_of_rtype ret) ep.ep_name;
+
+ (* Required parameters. *)
+ List.iter (
+ fun (name, t, _) ->
+ let t = c_of_ptype ~param:true t in
+ let sep = (* "const char *" - omit space after asterisk *)
+ let len = String.length t in
+ if isalnum t.[len-1] then " " else "" in
+ pr ", %s%s%s" t sep name
+ ) req;
+
+ (* Optional parameters. *)
+ if opt <> [] then
+ pr ", ...";
+
+ pr ");\n"
+
+ );
pr "\
open Unix
open Printf
+open Wrappi_utils
+open Wrappi_types
open Wrappi_pr
-let eps = Wrappi_globals.get_entry_points ()
-let nr_eps = List.length eps
+let api = Wrappi_accumulator.get_api ()
+let nr_tds = StringMap.cardinal api.api_typedefs
+let nr_ens = StringMap.cardinal api.api_enums
+let nr_sds = StringMap.cardinal api.api_structs
+let nr_uns = StringMap.cardinal api.api_unions
+let nr_eps = StringMap.cardinal api.api_entry_points
let dump_and_exit () =
- printf "entry points (%d):\n" nr_eps;
+ printf "typedefs (%d):\n" nr_tds;
+ iter_typedefs api (fun td -> printf " %s\n" (string_of_typedef td));
+
+ printf "enums (%d):\n" nr_ens;
+ iter_enums api (fun en -> printf " %s\n" (string_of_enum en));
+
+ printf "structs (%d):\n" nr_sds;
+ iter_structs api (fun sd -> printf " %s\n" (string_of_struct sd));
- List.iter (fun ep ->
- printf " %s\n" (Wrappi_types.string_of_entry_point ep)
- ) eps;
+ printf "unions (%d):\n" nr_uns;
+ iter_unions api (fun un -> printf " %s\n" (string_of_union un));
+
+ printf "entry points (%d):\n" nr_eps;
+ iter_entry_points api (fun ep -> printf " %s\n" (string_of_entry_point ep));
exit 0
eprintf "%s: %s\n" msg (Printexc.to_string exn)
let () =
- printf "generator, %d entry points\n" nr_eps;
+ printf "generator, %d typedefs, %d enums, %d structs, %d unions, %d entry points\n"
+ nr_tds nr_ens nr_sds nr_uns nr_eps;
(* Acquire a lock so parallel builds won't run the generator
* simultaneously. It's assumed that ./configure.ac only exists in
perror "lock: configure.ac" exn;
exit 1);
- (* Create a structure that we'll pass around to each generator function. *)
- let api = {
- Wrappi_types.api_entry_points = eps
- } in
-
(* Generate code. *)
Wrappi_c.generate api;
git.annexia.org / wrappi.git / commitdiff