2 * Copyright (C) 2011 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
26 let check_not_defined name new_ map thing get_loc =
28 let old = StringMap.find name map in
29 eprintf "generator: error: %s %s redefined\n" thing name;
30 let old_loc = get_loc old in
31 let new_loc = get_loc new_ in
32 eprintf " first definition at %s line %d\n"
33 (Loc.file_name old_loc) (Loc.start_line old_loc);
34 eprintf " second definition at %s line %d\n"
35 (Loc.file_name new_loc) (Loc.start_line new_loc);
40 let tds = ref StringMap.empty
42 let name = td.td_name in
43 check_not_defined name td !tds "typedef" (fun td -> td.td_loc);
44 tds := StringMap.add name td !tds
46 let ens = ref StringMap.empty
48 let name = en.en_name in
49 check_not_defined name en !ens "enum" (fun en -> en.en_loc);
50 ens := StringMap.add name en !ens
52 let sds = ref StringMap.empty
54 let name = sd.sd_name in
55 check_not_defined name sd !sds "struct" (fun sd -> sd.sd_loc);
56 sds := StringMap.add name sd !sds
58 let uns = ref StringMap.empty
60 let name = un.un_name in
61 check_not_defined name un !uns "union" (fun un -> un.un_loc);
62 uns := StringMap.add name un !uns
64 let eps = ref StringMap.empty
65 let add_entry_point ep =
66 let name = ep.ep_name in
67 check_not_defined name ep !eps "entry_point" (fun ep -> ep.ep_loc);
68 eps := StringMap.add name ep !eps
70 let rec resolve_typedefs thing name loc = function
84 | THash t -> THash (resolve_typedefs thing name loc t)
85 | TList t -> TList (resolve_typedefs thing name loc t)
86 | TNullable t -> TNullable (resolve_typedefs thing name loc t)
90 let td = StringMap.find tname !tds in
92 (* The typedef may be a typedef, so we need to recursively
95 resolve_typedefs "typedef" td.td_name td.td_loc t
97 eprintf "generator: error: could not resolve typedef %s to a basic type\n"
99 eprintf " in definition of %s %s at %s line %d\n"
100 thing name (Loc.file_name loc) (Loc.start_line loc);
103 let resolve_typedefs_in_ret thing name loc = function
105 | RStaticString) as t -> t
106 | Return t -> Return (resolve_typedefs thing name loc t)
115 (* Resolve typedefs in all ptypes in everything. *)
116 let sds = StringMap.map (
118 let fields = sd.sd_fields in
120 Array.map (resolve_typedefs "enum" sd.sd_name sd.sd_loc) fields in
121 { sd with sd_fields = fields }
124 let uns = StringMap.map (
126 let fields = un.un_fields in
128 Array.map (resolve_typedefs "union" un.un_name un.un_loc) fields in
129 { un with un_fields = fields }
132 let eps = StringMap.map (
134 let name = ep.ep_name in
135 let loc = ep.ep_loc in
136 let ret, req, opt = ep.ep_ftype in
137 let ret = resolve_typedefs_in_ret "entry_point" name loc ret in
140 n, resolve_typedefs "entry_point" name loc t, prec
144 n, resolve_typedefs "entry_point" name loc t, prec
146 { ep with ep_ftype = (ret, req, opt) }
149 { api_typedefs = tds;
153 api_entry_points = eps }