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.
19 (* For general information about camlp4, see:
20 * http://brion.inria.fr/gallium/index.php/Camlp4
22 * For information about quotations, see:
23 * http://brion.inria.fr/gallium/index.php/Quotation
32 (* Convert a plain list into a list AST. *)
33 let rec expr_of_list _loc = function
35 | h::t -> let t = expr_of_list _loc t in <:expr< $h$ :: $t$ >>
37 (* Convert an optional type into an option AST. *)
38 let expr_of_option _loc = function
39 | None -> <:expr< None >>
40 | Some x -> <:expr< Some $x$ >>
42 (* Convert a _loc to an AST. *)
43 let expr_of_loc _loc loc =
45 start_line, start_bol, start_off,
46 stop_line, stop_bol, stop_off,
47 ghost = Loc.to_tuple loc in
48 <:expr< Camlp4.PreCast.Loc.of_tuple
50 $`int:start_line$, $`int:start_bol$, $`int:start_off$,
51 $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
54 let add_entry_point _loc name parameters return_type code =
55 let parameters = List.map (
56 fun (name, t) -> <:expr< ($str:name$, $t$) >>
58 let parameters = expr_of_list _loc parameters in
60 let code = expr_of_option _loc code in
62 let loc = expr_of_loc _loc _loc in
65 let ep = { Wrappi_types.ep_loc = $loc$;
67 ep_params = $parameters$;
68 ep_return = $return_type$;
70 Wrappi_globals.add_entry_point ep
74 (* Quotation expander for C code. *)
75 let c_quotation_expander _loc _ code =
76 (* XXX Expand %- or $- expressions in code. *)
77 (* XXX Escape >> in code. *)
80 Quotation.add "c" Quotation.DynAst.expr_tag c_quotation_expander;
82 (* Default quotation expander (<< .. >>) should be C code ("c"). *)
83 Quotation.default := "c"
87 (* Extend the regular OCaml grammar. *)
91 (* A parameter or return type. *)
93 [ "int32" -> <:expr< Wrappi_types.TInt32 >> ]
94 | [ "int64" -> <:expr< Wrappi_types.TInt64 >> ]
95 | [ t = LIDENT -> <:expr< Wrappi_types.Type $str:t$ >> ]
100 [ "err" -> <:expr< Wrappi_types.RErr >> ]
101 | [ t = any_type -> <:expr< Wrappi_types.Return $t$ >> ]
104 (* A single function parameter. *)
105 parameter: [[ t = any_type; name = LIDENT -> (name, t) ]];
107 str_item: LEVEL "top" [
109 return_type = return_type; name = LIDENT;
110 "("; parameters = LIST0 parameter SEP ","; ")";
111 code = OPT [ code = expr -> code ] ->
112 add_entry_point _loc name parameters return_type code