From 6964a24290a2d645b3155353e08750f37930146a Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Fri, 30 Dec 2011 21:52:42 +0000 Subject: [PATCH] Add more realistic type system. --- APIs/mknod.api | 3 + generator-lib/.depend | 12 +- generator-lib/Makefile.am | 6 +- generator-lib/wrappi_accumulator.ml | 145 +++++++++++++++++++++ .../{wrappi_globals.mli => wrappi_accumulator.mli} | 18 ++- generator-lib/wrappi_globals.ml | 30 ----- generator-lib/wrappi_types.ml | 118 ++++++++++++++--- generator-lib/wrappi_types.mli | 103 ++++++++++++--- generator-lib/wrappi_utils.ml | 2 + generator-lib/wrappi_utils.mli | 31 +++++ generator-macros/pa_wrap.ml | 51 +++++--- generator/wrappi_c.ml | 55 +++++--- generator/wrappi_main.ml | 35 +++-- 13 files changed, 480 insertions(+), 129 deletions(-) create mode 100644 generator-lib/wrappi_accumulator.ml rename generator-lib/{wrappi_globals.mli => wrappi_accumulator.mli} (61%) delete mode 100644 generator-lib/wrappi_globals.ml diff --git a/APIs/mknod.api b/APIs/mknod.api index bc0ba02..6c06a5b 100644 --- a/APIs/mknod.api +++ b/APIs/mknod.api @@ -1,3 +1,6 @@ +typedef int fileperm ;; (* XXX preconditions XXX *) +typedef string pathname ;; + entry_point err mknod_char (pathname path, fileperm perm, uint64 major, uint64 minor) << diff --git a/generator-lib/.depend b/generator-lib/.depend index 6da3c94..d922e9f 100644 --- a/generator-lib/.depend +++ b/generator-lib/.depend @@ -1,11 +1,11 @@ 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 diff --git a/generator-lib/Makefile.am b/generator-lib/Makefile.am index a33d115..f502f2d 100644 --- a/generator-lib/Makefile.am +++ b/generator-lib/Makefile.am @@ -25,8 +25,8 @@ OCAMLOPTFLAGS = $(OCAMLCFLAGS) # 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 \ @@ -37,7 +37,7 @@ OBJECTS = \ config.cmo \ wrappi_utils.cmo \ wrappi_types.cmo \ - wrappi_globals.cmo + wrappi_accumulator.cmo noinst_SCRIPTS = generator_lib.cma diff --git a/generator-lib/wrappi_accumulator.ml b/generator-lib/wrappi_accumulator.ml new file mode 100644 index 0000000..1254979 --- /dev/null +++ b/generator-lib/wrappi_accumulator.ml @@ -0,0 +1,145 @@ +(* 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 } diff --git a/generator-lib/wrappi_globals.mli b/generator-lib/wrappi_accumulator.mli similarity index 61% rename from generator-lib/wrappi_globals.mli rename to generator-lib/wrappi_accumulator.mli index 488cda8..4e457dc 100644 --- a/generator-lib/wrappi_globals.mli +++ b/generator-lib/wrappi_accumulator.mli @@ -16,11 +16,19 @@ * 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 diff --git a/generator-lib/wrappi_globals.ml b/generator-lib/wrappi_globals.ml deleted file mode 100644 index 5d68a4f..0000000 --- a/generator-lib/wrappi_globals.ml +++ /dev/null @@ -1,30 +0,0 @@ -(* 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 diff --git a/generator-lib/wrappi_types.ml b/generator-lib/wrappi_types.ml index 957d479..ef3a8bd 100644 --- a/generator-lib/wrappi_types.ml +++ b/generator-lib/wrappi_types.ml @@ -18,55 +18,135 @@ 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) diff --git a/generator-lib/wrappi_types.mli b/generator-lib/wrappi_types.mli index 6bd58f0..b836685 100644 --- a/generator-lib/wrappi_types.mli +++ b/generator-lib/wrappi_types.mli @@ -16,43 +16,106 @@ * 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. *) diff --git a/generator-lib/wrappi_utils.ml b/generator-lib/wrappi_utils.ml index 4474423..958c55e 100644 --- a/generator-lib/wrappi_utils.ml +++ b/generator-lib/wrappi_utils.ml @@ -40,3 +40,5 @@ let count_chars c str = if c = String.unsafe_get str i then incr count done; !count + +module StringMap = Map.Make (String) diff --git a/generator-lib/wrappi_utils.mli b/generator-lib/wrappi_utils.mli index c08b402..f01ed81 100644 --- a/generator-lib/wrappi_utils.mli +++ b/generator-lib/wrappi_utils.mli @@ -31,3 +31,34 @@ val files_equal : string -> string -> bool 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 diff --git a/generator-macros/pa_wrap.ml b/generator-macros/pa_wrap.ml index a73484a..b4fea3a 100644 --- a/generator-macros/pa_wrap.ml +++ b/generator-macros/pa_wrap.ml @@ -51,23 +51,32 @@ let expr_of_loc _loc loc = $`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 () = @@ -89,30 +98,40 @@ EXTEND Gram 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 ] ]; diff --git a/generator/wrappi_c.ml b/generator/wrappi_c.ml index 62fb48d..1a04234 100644 --- a/generator/wrappi_c.ml +++ b/generator/wrappi_c.ml @@ -23,17 +23,28 @@ open Wrappi_boilerplate 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; @@ -63,20 +74,28 @@ extern void wrap_close (wrap_h *w); /* 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 "\ diff --git a/generator/wrappi_main.ml b/generator/wrappi_main.ml index 42b2140..ffcef60 100644 --- a/generator/wrappi_main.ml +++ b/generator/wrappi_main.ml @@ -19,17 +19,32 @@ 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 @@ -70,7 +85,8 @@ let perror msg = function 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 @@ -96,11 +112,6 @@ Run it from the top source directory using the command 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; -- 1.8.3.1