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.
23 open Wrappi_boilerplate
28 let c_of_ptype ~param = function
30 | TBuffer -> assert false (* XXX not implemented *)
31 | TEnum name -> sprintf "enum wrap_%s" name
32 | TFile -> if param then "const char *" else "char *"
33 | THash t -> if param then "char * const *" else "char **"
34 | TInt -> "int" (* XXX not int, correct type depends on preconditions *)
37 | TList t -> assert false (* XXX not implemented *)
38 | TNullable TString -> if param then "const char *" else "char *"
39 | TNullable _ -> assert false (* XXX may be implemented in future *)
40 | TString -> if param then "const char *" else "char *"
41 | TStruct name -> sprintf "struct wrap_%s" name
42 | TTypedef name -> assert false (* should never happen *)
43 | TUInt32 -> "uint32_t"
44 | TUInt64 -> "uint64_t"
45 | TUnion name -> sprintf "union wrap_%s" name
47 let c_of_rtype = function
49 | Return t -> c_of_ptype ~param:false t
52 let ret, req, opt = ep.ep_ftype in
53 pr "%s\n" (c_of_rtype ret);
54 pr "wrap_%s (wrap_h *w" ep.ep_name;
56 (* Required parameters. *)
59 let t = c_of_ptype ~param:true t in
60 let sep = (* "const char *" - omit space after asterisk *)
61 let len = String.length t in
62 if isalnum t.[len-1] then " " else "" in
63 pr ", %s%s%s" t sep name
66 (* Optional parameters. *)
72 let generate_implementation ep =
73 generate_header CStyle LGPLv2plus;
81 List.iter (pr "#include <%s>\n") ep.ep_includes;
87 #include \"internal.h\"
89 /* Automatically generated implementation of '%s'.
90 * This API was defined in '%s' at line %d.
93 " ep.ep_name (Loc.file_name ep.ep_loc) (Loc.start_line ep.ep_loc);
95 (* Depending on whether this is a local or remote function, include
96 * different definitions here.
98 (*if ep.ep_local then ... *)
105 " (Loc.start_line ep.ep_loc) (Loc.file_name ep.ep_loc);
107 (match ep.ep_code with
109 | Some code -> pr "%s" code
114 (* Make a unique, reproducible filename for each entry point. *)
115 let filename_of_ep ep =
116 let filename = Loc.file_name ep.ep_loc in
117 let filename = Filename.basename filename in
119 try Filename.chop_extension filename
120 with Invalid_argument _ -> filename in
121 let filename = sprintf "%s-%s.c" filename ep.ep_name in
124 let generate_lib_implementation_files_mk api =
125 generate_header HashStyle GPLv2plus;
127 let eps = StringMap.bindings api.api_entry_points in
128 let cmp (a, _) (b, _) = compare a b in
129 let eps = List.sort cmp eps in
130 let eps = List.map snd eps in
132 let rec loop = function
134 | [ep] -> pr "\t%s\n" (filename_of_ep ep)
135 | ep :: eps -> pr "\t%s \\\n" (filename_of_ep ep); loop eps
138 pr "local_implementation_files := \\\n";
140 loop (List.filter (fun ep -> ep.ep_local) eps);
143 pr "remote_implementation_files := \\\n";
145 loop (List.filter (fun ep -> not ep.ep_local) eps)
148 let gitignores = ref [] in
150 iter_entry_points api (
152 let filename = filename_of_ep ep in
154 gitignores := ("/" ^ filename) :: !gitignores;
156 output_to ("lib/" ^ filename) generate_implementation ep
159 let gitignores = List.rev !gitignores in
160 output_to "lib/.gitignore"
161 (fun () -> List.iter (pr "%s\n") gitignores) ();
163 output_to "lib/implementation_files.mk"
164 generate_lib_implementation_files_mk api