--- /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: error: %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 line %d\n"
+ (Loc.file_name old_loc) (Loc.start_line old_loc);
+ eprintf " second definition at %s line %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
+ let td = StringMap.find tname !tds in
+ let t = td.td_type in
+ (* The typedef may be a typedef, so we need to recursively
+ * resolve the type.
+ *)
+ resolve_typedefs "typedef" td.td_name td.td_loc t
+ with Not_found ->
+ eprintf "generator: error: could not resolve typedef %s to a basic type\n"
+ tname;
+ eprintf " in definition of %s %s at %s line %d\n"
+ thing name (Loc.file_name loc) (Loc.start_line loc);
+ exit 1
+
+let resolve_typedefs_in_ret thing name loc = function
+ | (RVoid
+ | RStaticString) 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 (
+ fun (name, t) ->
+ let t = resolve_typedefs "enum" sd.sd_name sd.sd_loc t in
+ (name, t)
+ ) 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 (
+ fun (name, t) ->
+ let t = resolve_typedefs "union" un.un_name un.un_loc t in
+ (name, t)
+ ) 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 }
git.annexia.org / wrappi.git / blobdiff