Combine generator subdirectories into one.

[wrappi.git] / generator / wrappi_types.ml

diff --git a/generator/wrappi_types.ml b/generator/wrappi_types.ml
new file mode 100644 (file)
index 0000000..84e008c
--- /dev/null
+++ b/generator/wrappi_types.ml
@@ -0,0 +1,157 @@
+(* 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_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 = RVoid | RStaticString | Return of ptype
+
+type ftype = rtype * parameter list * parameter list
+
+type c_code = {
+  cc_loc : Camlp4.PreCast.Loc.t;
+  cc_code : string;
+}
+
+type entry_point = {
+  ep_loc : Camlp4.PreCast.Loc.t;
+  ep_local : bool;
+  ep_name : string;
+  ep_ftype : ftype;
+  ep_code : c_code option;
+  ep_includes : string list;
+}
+
+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_fields : (string * ptype) array;
+}
+
+type union = {
+  un_loc : Camlp4.PreCast.Loc.t;
+  un_name : string;
+  un_fields : (string * 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
+  | RVoid -> "void"
+  | RStaticString -> "static_string"
+  | 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.cc_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>>"
+    (*(Loc.to_string ep.ep_loc)*)
+    (if ep.ep_local then " local" else "")
+    ep.ep_name
+    (string_of_ftype ep.ep_ftype)
+    (match ep.ep_code with
+    | None -> "/* implicit */"
+    | Some code -> string_of_c_code code)