/configure
/generator-lib/config.ml
/generator/generator
+/generator/stamp-generator
/install-sh
+/lib/wrappi.h
/libtool
/ltmain.sh
/m4/libtool.m4
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX -I ../generator-lib
+OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX -I +camlp4 -I ../generator-lib
OCAMLOPTFLAGS = $(OCAMLCFLAGS)
PP = -pp '$(CAMLP4O) ../generator-macros/pa_wrap.cmo -impl'
wrappi_types.cmi:
wrappi_types.cmo: wrappi_types.cmi
wrappi_types.cmx: wrappi_types.cmi
+wrappi_utils.cmi:
+wrappi_utils.cmo: wrappi_utils.cmi
+wrappi_utils.cmx: wrappi_utils.cmi
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX -I +camlp4
+OCAMLPACKAGES = -package unix,camlp4.lib
+
+OCAMLCFLAGS = \
+ -g -warn-error CDEFLMPSUVYZX \
+ $(OCAMLPACKAGES)
OCAMLOPTFLAGS = $(OCAMLCFLAGS)
# In alphabetical order.
wrappi_globals.mli \
wrappi_globals.ml \
wrappi_types.mli \
- wrappi_types.ml
+ wrappi_types.ml \
+ wrappi_utils.mli \
+ wrappi_utils.ml
# In dependency order.
OBJECTS = \
config.cmo \
+ wrappi_utils.cmo \
wrappi_types.cmo \
wrappi_globals.cmo
type c_code = string
type entry_point = {
- (*ep_loc : Camlp4.PreCast.Loc.t;*)
+ ep_loc : Camlp4.PreCast.Loc.t;
ep_name : string;
ep_params : parameter list;
ep_return : return_type;
ep_code : c_code option;
}
+type api = {
+ api_entry_points : entry_point list;
+}
+
let string_of_any_type = function
| TInt32 -> "int32"
| TInt64 -> "int64"
(** C code. *)
type entry_point = {
- (*ep_loc : Camlp4.PreCast.Loc.t;*)
+ ep_loc : Camlp4.PreCast.Loc.t;
ep_name : string;
ep_params : parameter list;
ep_return : return_type;
}
(** An API entry point. *)
+type api = {
+ api_entry_points : entry_point list;
+}
+(** This single structure describes the whole API. *)
+
val string_of_any_type : any_type -> string
val string_of_return_type : return_type -> string
val string_of_parameter : parameter -> string
--- /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 Printf
+
+let failwithf fs = ksprintf failwith fs
+
+let files_equal n1 n2 =
+ let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
+ match Sys.command cmd with
+ | 0 -> true
+ | 1 -> false
+ | i -> failwithf "%s: failed with error code %d" cmd i
+
+let count_chars c str =
+ let count = ref 0 in
+ for i = 0 to String.length str - 1 do
+ if c = String.unsafe_get str i then incr count
+ done;
+ !count
--- /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.
+ *)
+
+val failwithf : ('a, unit, string, 'b) format4 -> 'a
+(** Like [failwith] but supports printf-like arguments. *)
+
+val files_equal : string -> string -> bool
+(** [files_equal filename1 filename2] returns true if the files contain
+ the same content. *)
+
+val count_chars : char -> string -> int
+(** Count number of times the character occurs in string. *)
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX
+OCAMLPACKAGES = -package unix,camlp4.lib
+
+OCAMLCFLAGS = \
+ -g -warn-error CDEFLMPSUVYZX \
+ -I ../generator-lib $(OCAMLPACKAGES)
OCAMLOPTFLAGS = $(OCAMLCFLAGS)
noinst_SCRIPTS = pa_wrap.cmo
pa_wrap.cmo: pa_wrap.ml ../generator-lib/generator_lib.cma
- $(OCAMLFIND) ocamlc -I +camlp4 -I ../generator-lib \
- dynlink.cma camlp4lib.cma generator_lib.cma \
+ $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) \
+ -linkpkg generator_lib.cma \
-pp $(CAMLP4OF) \
-c $< -o $@
| None -> <:expr< None >>
| Some x -> <:expr< Some $x$ >>
+(* Convert a _loc to an AST. *)
+let expr_of_loc _loc loc =
+ let file_name,
+ start_line, start_bol, start_off,
+ stop_line, stop_bol, stop_off,
+ ghost = Loc.to_tuple loc in
+ <:expr< Camlp4.PreCast.Loc.of_tuple
+ ($str:file_name$,
+ $`int:start_line$, $`int:start_bol$, $`int:start_off$,
+ $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
+ $`bool:ghost$) >>
+
let add_entry_point _loc name parameters return_type code =
let parameters = List.map (
fun (name, t) -> <:expr< ($str:name$, $t$) >>
let code = expr_of_option _loc code in
+ let loc = expr_of_loc _loc _loc in
+
<:str_item<
- let ep = { Wrappi_types.ep_name = $str:name$;
+ let ep = { Wrappi_types.ep_loc = $loc$;
+ ep_name = $str:name$;
ep_params = $parameters$;
ep_return = $return_type$;
ep_code = $code$ } in
-wrappi_main.cmo:
-wrappi_main.cmx:
+wrappi_boilerplate.cmi:
+wrappi_boilerplate.cmo: wrappi_pr.cmi wrappi_boilerplate.cmi
+wrappi_boilerplate.cmx: wrappi_pr.cmx wrappi_boilerplate.cmi
+wrappi_c.cmi:
+wrappi_c.cmo: wrappi_pr.cmi wrappi_boilerplate.cmi wrappi_c.cmi
+wrappi_c.cmx: wrappi_pr.cmx wrappi_boilerplate.cmx wrappi_c.cmi
+wrappi_main.cmo: wrappi_pr.cmi wrappi_c.cmi
+wrappi_main.cmx: wrappi_pr.cmx wrappi_c.cmx
+wrappi_pr.cmi:
+wrappi_pr.cmo: wrappi_pr.cmi
+wrappi_pr.cmx: wrappi_pr.cmi
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX -I ../generator-lib
+OCAMLPACKAGES = -package unix,camlp4.lib
+
+OCAMLCFLAGS = \
+ -g -warn-error CDEFLMPSUVYZX \
+ -I ../generator-lib $(OCAMLPACKAGES)
OCAMLOPTFLAGS = $(OCAMLCFLAGS)
# In alphabetical order.
-SOURCES = wrappi_main.ml
+SOURCES = \
+ wrappi_boilerplate.mli \
+ wrappi_boilerplate.ml \
+ wrappi_c.mli \
+ wrappi_c.ml \
+ wrappi_main.ml \
+ wrappi_pr.mli \
+ wrappi_pr.ml
# In dependency order.
-OBJECTS = wrappi_main.cmo
+OBJECTS = \
+ wrappi_pr.cmo \
+ wrappi_boilerplate.cmo \
+ wrappi_c.cmo \
+ wrappi_main.cmo
noinst_SCRIPTS = generator
generator: $(OBJECTS) ../generator-lib/generator_lib.cma ../APIs/apis.cma
- $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) \
+ $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -linkpkg \
../generator-lib/generator_lib.cma ../APIs/apis.cma \
$(OBJECTS) \
-o $@
%.cmx: %.ml
$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -c $< -o $@
-CLEANFILES = *.cmi *.cmo *.cmx *~ generator
+# Run the generator.
+noinst_DATA = stamp-generator
+
+stamp-generator: generator
+ cd $(top_srcdir) && generator/generator
depend: .depend
-.depend: $(wildcard *.mli) $(wildcard *.ml)
+.depend: $(SOURCES)
rm -f $@ $@-t
$(OCAMLFIND) ocamldep $^ | \
$(SED) -e 's/ *$$//' | \
include .depend
+CLEANFILES = *.cmi *.cmo *.cmx *~ generator
+
SUFFIXES = .cmo .cmi .cmx .ml .mli .mll .mly
--- /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 Unix
+open Printf
+
+open Wrappi_pr
+
+let copyright_years =
+ let this_year = 1900 + (localtime (time ())).tm_year in
+ if this_year > 2011 then sprintf "2011-%04d" this_year else "2011"
+
+(* Generate a header block in a number of standard styles. *)
+type comment_style =
+ | CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
+ | ErlangStyle
+type license = GPLv2plus | LGPLv2plus
+
+let generate_header comment license =
+ let inputs = [ "generator/wrappi_*.ml" ] in
+ let c = match comment with
+ | CStyle -> pr "/* "; " *"
+ | CPlusPlusStyle -> pr "// "; "//"
+ | HashStyle -> pr "# "; "#"
+ | OCamlStyle -> pr "(* "; " *"
+ | HaskellStyle -> pr "{- "; " "
+ | ErlangStyle -> pr "%% "; "% " in
+ pr "wrappi generated file\n";
+ pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
+ List.iter (pr "%s %s\n" c) inputs;
+ pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
+ pr "%s\n" c;
+ pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
+ pr "%s\n" c;
+ (match license with
+ | GPLv2plus ->
+ pr "%s This program is free software; you can redistribute it and/or modify\n" c;
+ pr "%s it under the terms of the GNU General Public License as published by\n" c;
+ pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
+ pr "%s (at your option) any later version.\n" c;
+ pr "%s\n" c;
+ pr "%s This program is distributed in the hope that it will be useful,\n" c;
+ pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
+ pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
+ pr "%s GNU General Public License for more details.\n" c;
+ pr "%s\n" c;
+ pr "%s You should have received a copy of the GNU General Public License along\n" c;
+ pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
+ pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
+
+ | LGPLv2plus ->
+ pr "%s This library is free software; you can redistribute it and/or\n" c;
+ pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
+ pr "%s License as published by the Free Software Foundation; either\n" c;
+ pr "%s version 2 of the License, or (at your option) any later version.\n" c;
+ pr "%s\n" c;
+ pr "%s This library is distributed in the hope that it will be useful,\n" c;
+ pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
+ pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
+ pr "%s Lesser General Public License for more details.\n" c;
+ pr "%s\n" c;
+ pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
+ pr "%s License along with this library; if not, write to the Free Software\n" c;
+ pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
+ );
+ (match comment with
+ | CStyle -> pr " */\n"
+ | CPlusPlusStyle
+ | ErlangStyle
+ | HashStyle -> ()
+ | OCamlStyle -> pr " *)\n"
+ | HaskellStyle -> pr "-}\n"
+ );
+ pr "\n"
--- /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.
+ *)
+
+type comment_style =
+ | CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
+ | ErlangStyle
+type license = GPLv2plus | LGPLv2plus
+
+val generate_header : comment_style -> license -> unit
--- /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 Wrappi_pr
+open Wrappi_boilerplate
+
+let generate_lib_wrappi_h api =
+ generate_header CStyle LGPLv2plus;
+
+ pr "\
+#ifndef WRAPPI_H_
+#define WRAPPI_H_
+
+#ifdef __cplusplus
+extern \"C\" {
+#endif
+
+";
+
+
+
+
+ pr "\
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* WRAPPI_H_ */
+"
+
+let generate api =
+ output_to "lib/wrappi.h" generate_lib_wrappi_h api
--- /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.
+ *)
+
+val generate : Wrappi_types.api -> unit
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+open Unix
open Printf
+open Wrappi_pr
+
let eps = Wrappi_globals.get_entry_points ()
+let nr_eps = List.length eps
let dump_and_exit () =
- printf "entry points:\n";
+ printf "entry points (%d):\n" nr_eps;
List.iter (fun ep ->
printf " %s\n" (Wrappi_types.string_of_entry_point ep)
in
let argspec = Arg.align [
- "--dump", Arg.Unit dump_and_exit, " Dump API data and exit.";
- "--version", Arg.Unit display_version, " Display version number and exit.";
+ "--dump", Arg.Unit dump_and_exit, " Dump API data and exit";
+ "--version", Arg.Unit display_version, " Display version number and exit";
] in
let anon_fun str = raise (Arg.Bad "generator: unknown parameter") in
- let usage_msg = "wrappi generator: generates lots of code
+ let usage_msg = "
+NAME
+ wrappi generator - generate a lot of code
+
+SYNOPSIS
To run the generator normally (note it MUST be run from the top
level SOURCE directory):
OPTIONS" in
Arg.parse argspec anon_fun usage_msg
+let perror msg = function
+ | Unix_error (err, _, _) ->
+ eprintf "%s: %s\n" msg (error_message err)
+ | exn ->
+ eprintf "%s: %s\n" msg (Printexc.to_string exn)
+
let () =
- printf "generator, %d entry points\n" (List.length eps)
+ printf "generator, %d entry points\n" nr_eps;
+
+ (* Acquire a lock so parallel builds won't run the generator
+ * simultaneously. It's assumed that ./configure.ac only exists in
+ * the top level source directory. Note the lock is released
+ * implicitly when the program exits.
+ *)
+ let lock_fd =
+ try openfile "configure.ac" [O_RDWR] 0
+ with
+ | Unix_error (ENOENT, _, _) ->
+ eprintf "\
+You are probably running this from the wrong directory.
+Run it from the top source directory using the command
+ make -C generator stamp-generator
+";
+ exit 1
+ | exn ->
+ perror "open: configure.ac" exn;
+ exit 1 in
+
+ (try lockf lock_fd F_LOCK 1
+ with exn ->
+ perror "lock: configure.ac" exn;
+ exit 1);
+
+ (* Create a structure that we'll pass around to each generator function. *)
+ let api = {
+ Wrappi_types.api_entry_points = eps
+ } in
+
+ (* Generate code. *)
+ Wrappi_c.generate api;
+
+ printf "generated %d lines of code in %d files\n"
+ (get_lines_generated ()) (List.length (get_files_generated ()));
+
+ (* Create the stamp file last and unconditionally. This is used
+ * by the Makefile to know when we must rerun the generator.
+ *)
+ let chan = open_out "generator/stamp-generator" in
+ fprintf chan "1\n";
+ close_out chan
--- /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 Unix
+open Printf
+
+open Wrappi_utils
+
+(* Output channel, 'pr' prints to this. *)
+let chan = ref Pervasives.stdout
+
+(* Number of lines generated. *)
+let lines = ref 0
+
+(* Name of each file generated. *)
+let files = ref []
+
+(* Print-to-current-output function, used everywhere. It has
+ * printf-like semantics.
+ *)
+let pr fs =
+ ksprintf
+ (fun str ->
+ let i = count_chars '\n' str in
+ lines := !lines + i;
+ output_string !chan str
+ ) fs
+
+let output_to filename k a =
+ files := filename :: !files;
+
+ let filename_new = filename ^ ".new" in
+ chan := open_out filename_new;
+ k a;
+ close_out !chan;
+ chan := Pervasives.stdout;
+
+ (* Is the new file different from the current file? *)
+ if Sys.file_exists filename && files_equal filename filename_new then
+ unlink filename_new (* same, so skip it *)
+ else (
+ (* different, overwrite old one *)
+ (try chmod filename 0o644 with Unix_error _ -> ());
+ rename filename_new filename;
+ chmod filename 0o444;
+ printf "written %s\n%!" filename;
+ )
+
+let get_lines_generated () =
+ !lines
+
+let get_files_generated () =
+ List.rev !files
--- /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
+ *)
+
+(** Printing and current output file. *)
+
+val pr : ('a, unit, string, unit) format4 -> 'a
+(** General printing function which prints to the current output file. *)
+
+val output_to : string -> ('a -> unit) -> 'a -> unit
+(** [output_to filename f] runs [f] and writes the result to [filename].
+ [filename] is only updated if the output is different from what
+ is in the file already. *)
+
+val get_lines_generated : unit -> int
+(** Return number of lines of code generated. *)
+
+val get_files_generated : unit -> string list
+(** Return names of the files that were generated. *)