Add preprocessor.

[wrappi.git] / preprocessor / pa_wrap.ml

diff --git a/preprocessor/pa_wrap.ml b/preprocessor/pa_wrap.ml
new file mode 100644 (file)
index 0000000..c8e8af8
--- /dev/null
+++ b/preprocessor/pa_wrap.ml
@@ -0,0 +1,77 @@
+(* 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.
+ *)
+
+(* For general information about camlp4, see:
+ * http://brion.inria.fr/gallium/index.php/Camlp4
+ * For information about quotations, see:
+ * http://brion.inria.fr/gallium/index.php/Quotation
+ *)
+
+open Camlp4.PreCast
+open Syntax
+open Ast
+
+open Wrappi_types
+
+let add_entry_point _loc name parameters return_type code =
+  (* XXX *)
+  <:str_item< >>
+
+let () =
+  (* Quotation expander for C code. *)
+  let c_quotation_expander _loc _ code =
+    (* XXX Expand %- or $- expressions in code. *)
+    ExStr (_loc, code)
+  in
+  Quotation.add "c" Quotation.DynAst.expr_tag c_quotation_expander;
+
+  (* Default quotation expander (<< .. >>) should be C code ("c"). *)
+  Quotation.default := "c"
+
+;;
+
+(* Extend the regular OCaml grammar. *)
+EXTEND Gram
+  GLOBAL: str_item;
+
+  (* A parameter or return type. *)
+  any_type: [
+    [ "int32" -> TInt32 ]
+  | [ "int64" -> TInt64 ]
+  | [ t = LIDENT -> Type t ]
+  ];
+
+  (* A return type. *)
+  return_type: [
+    [ "err" -> RErr ]
+  | [ t = any_type -> Return t ]
+  ];
+
+  (* A single function parameter. *)
+  parameter: [[ t = any_type; name = LIDENT -> (t, name) ]];
+
+  str_item: LEVEL "top" [
+    [ "entry_point";
+      return_type = return_type; name = LIDENT;
+      "("; parameters = LIST0 parameter SEP ","; ")";
+      code = OPT [ code = expr -> code ] ->
+      add_entry_point _loc name parameters return_type code
+    ]
+  ];
+
+END