preprocessor/pa_wrap.ml

   1 (* wrappi
   2  * Copyright (C) 2011 Red Hat Inc.
   3  *
   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.
   8  *
   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.
  13  *
  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.
  17  *)
  18
  19 (* For general information about camlp4, see:
  20  * http://brion.inria.fr/gallium/index.php/Camlp4
  21  * For information about quotations, see:
  22  * http://brion.inria.fr/gallium/index.php/Quotation
  23  *)
  24
  25 open Camlp4.PreCast
  26 open Syntax
  27 open Ast
  28
  29 open Wrappi_types
  30
  31 let add_entry_point _loc name parameters return_type code =
  32   (* XXX *)
  33   <:str_item< >>
  34
  35 let () =
  36   (* Quotation expander for C code. *)
  37   let c_quotation_expander _loc _ code =
  38     (* XXX Expand %- or $- expressions in code. *)
  39     ExStr (_loc, code)
  40   in
  41   Quotation.add "c" Quotation.DynAst.expr_tag c_quotation_expander;
  42
  43   (* Default quotation expander (<< .. >>) should be C code ("c"). *)
  44   Quotation.default := "c"
  45
  46 ;;
  47
  48 (* Extend the regular OCaml grammar. *)
  49 EXTEND Gram
  50   GLOBAL: str_item;
  51
  52   (* A parameter or return type. *)
  53   any_type: [
  54     [ "int32" -> TInt32 ]
  55   | [ "int64" -> TInt64 ]
  56   | [ t = LIDENT -> Type t ]
  57   ];
  58
  59   (* A return type. *)
  60   return_type: [
  61     [ "err" -> RErr ]
  62   | [ t = any_type -> Return t ]
  63   ];
  64
  65   (* A single function parameter. *)
  66   parameter: [[ t = any_type; name = LIDENT -> (t, name) ]];
  67
  68   str_item: LEVEL "top" [
  69     [ "entry_point";
  70       return_type = return_type; name = LIDENT;
  71       "("; parameters = LIST0 parameter SEP ","; ")";
  72       code = OPT [ code = expr -> code ] ->
  73       add_entry_point _loc name parameters return_type code
  74     ]
  75   ];
  76
  77 END