$`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
$`bool:ghost$) >>
-let add_entry_point _loc local name parameters rtype code =
+let add_entry_point _loc local name parameters rtype code includes =
let loc = expr_of_loc _loc _loc in
let local =
let code = expr_of_option _loc code in
+ let includes = match includes with None -> <:expr< [] >> | Some xs -> xs in
+
<:str_item<
let ep = { Wrappi_types.ep_loc = $loc$;
ep_local = $local$;
ep_name = $str:name$;
ep_ftype = ($rtype$, $parameters$, []);
- ep_code = $code$ } in
+ ep_code = $code$;
+ ep_includes = $includes$ } in
Wrappi_accumulator.add_entry_point ep
>>
local = OPT "local";
rtype = rtype; name = LIDENT;
"("; parameters = LIST0 parameter SEP ","; ")";
- code = OPT [ code = expr -> code ] ->
- add_entry_point _loc local name parameters rtype code
+ code = OPT [ code = expr -> code ];
+ includes = OPT [ "includes"; includes = expr -> includes ]
+ ->
+ add_entry_point _loc local name parameters rtype code includes
]
| [ "typedef"; t = ptype; name = LIDENT ->
add_typedef _loc name t
open Printf
+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 -> "int" (* XXX not int, correct type depends on preconditions *)
+ | TInt32 -> "int32_t"
+ | TInt64 -> "int64_t"
+ | 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_rtype = function
+ | RVoid -> "void"
+ | Return t -> c_of_ptype ~param:false t
+
+let pr_decl ep =
+ let ret, req, opt = ep.ep_ftype in
+ pr "%s\n" (c_of_rtype ret);
+ pr "wrap_%s (wrap_h *w" 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"
+
let generate_implementation ep =
generate_header CStyle LGPLv2plus;
#include <stdio.h>
#include <stdlib.h>
+";
+ List.iter (pr "#include <%s>\n") ep.ep_includes;
+
+pr "\
#include \"wrappi.h\"
#include \"internal.h\"
-"
+/* Automatically generated implementation of '%s'.
+ * This API was defined in '%s' at line %d.
+ */
+
+" ep.ep_name (Loc.file_name ep.ep_loc) (Loc.start_line ep.ep_loc);
(* Depending on whether this is a local or remote function, include
* different definitions here.
*)
(*if ep.ep_local then ... *)
+ pr_decl ep;
+
+ pr "\
+{
+#line %d \"%s\"
+" (Loc.start_line ep.ep_loc) (Loc.file_name ep.ep_loc);
+
+ (match ep.ep_code with
+ | None -> ()
+ | Some code -> pr "%s" code
+ );
+
+ pr "}\n"
+
(* Make a unique, reproducible filename for each entry point. *)
let filename_of_ep ep =
let filename = Loc.file_name ep.ep_loc in