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 rtype code =
55 let loc = expr_of_loc _loc _loc in
57 let parameters = List.map (
58 fun (name, t) -> <:expr< ($str:name$, $t$, None) >>
60 let parameters = expr_of_list _loc parameters in
62 let code = expr_of_option _loc code in
65 let ep = { Wrappi_types.ep_loc = $loc$;
67 ep_ftype = ($rtype$, $parameters$, []);
69 Wrappi_accumulator.add_entry_point ep
72 let add_typedef _loc name t =
73 let loc = expr_of_loc _loc _loc in
76 let td = { Wrappi_types.td_loc = $loc$;
79 Wrappi_accumulator.add_typedef td
83 (* Quotation expander for C code. *)
84 let c_quotation_expander _loc _ code =
85 (* XXX Expand %- or $- expressions in code. *)
86 (* XXX Escape >> in code. *)
89 Quotation.add "c" Quotation.DynAst.expr_tag c_quotation_expander;
91 (* Default quotation expander (<< .. >>) should be C code ("c"). *)
92 Quotation.default := "c"
96 (* Extend the regular OCaml grammar. *)
100 (* A parameter or return type. *)
102 [ "buffer" -> <:expr< Wrappi_types.TBuffer >> ]
103 | [ "file" -> <:expr< Wrappi_types.TFile >> ]
104 | [ "hash"; "("; t = ptype; ")" -> <:expr< Wrappi_types.THash $t$ >> ]
105 | [ "int" -> <:expr< Wrappi_types.TInt >> ]
106 | [ "int32" -> <:expr< Wrappi_types.TInt32 >> ]
107 | [ "int64" -> <:expr< Wrappi_types.TInt64 >> ]
108 | [ "list"; "("; t = ptype; ")" -> <:expr< Wrappi_types.TList $t$ >> ]
109 | [ "nullable"; "("; t = ptype; ")" -> <:expr< Wrappi_types.TNullable $t$ >> ]
110 | [ "string" -> <:expr< Wrappi_types.TString >> ]
111 | [ "struct"; name = LIDENT -> <:expr< Wrappi_types.TStruct $str:name$ >> ]
112 | [ "uint32" -> <:expr< Wrappi_types.TUInt32 >> ]
113 | [ "uint64" -> <:expr< Wrappi_types.TUInt64 >> ]
114 | [ name = LIDENT -> <:expr< Wrappi_types.TTypedef $str:name$ >> ]
119 [ "err" -> <:expr< Wrappi_types.RErr >> ]
120 | [ t = ptype -> <:expr< Wrappi_types.Return $t$ >> ]
123 (* A single function parameter. XXX Preconditions. *)
124 parameter: [[ t = ptype; name = LIDENT -> (name, t) ]];
126 str_item: LEVEL "top" [
128 rtype = rtype; name = LIDENT;
129 "("; parameters = LIST0 parameter SEP ","; ")";
130 code = OPT [ code = expr -> code ] ->
131 add_entry_point _loc name parameters rtype code
133 | [ "typedef"; t = ptype; name = LIDENT ->
134 add_typedef _loc name t