generator-macros/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  *
  22  * For information about quotations, see:
  23  * http://brion.inria.fr/gallium/index.php/Quotation
  24  *)
  25
  26 open Camlp4.PreCast
  27 open Syntax
  28 open Ast
  29
  30 open Wrappi_types
  31
  32 (* Convert a plain list into a list AST. *)
  33 let rec expr_of_list _loc = function
  34   | [] -> <:expr< [] >>
  35   | h::t -> let t = expr_of_list _loc t in <:expr< $h$ :: $t$ >>
  36
  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$ >>
  41
  42 let add_entry_point _loc name parameters return_type code =
  43   let parameters = List.map (
  44     fun (name, t) -> <:expr< ($str:name$, $t$) >>
  45   ) parameters in
  46   let parameters = expr_of_list _loc parameters in
  47
  48   let code = expr_of_option _loc code in
  49
  50   <:str_item<
  51     let ep = { Wrappi_types.ep_name = $str:name$;
  52                ep_params = $parameters$;
  53                ep_return = $return_type$;
  54                ep_code = $code$ } in
  55     Wrappi_globals.add_entry_point ep
  56   >>
  57
  58 let () =
  59   (* Quotation expander for C code. *)
  60   let c_quotation_expander _loc _ code =
  61     (* XXX Expand %- or $- expressions in code. *)
  62     (* XXX Escape >> in code. *)
  63     ExStr (_loc, code)
  64   in
  65   Quotation.add "c" Quotation.DynAst.expr_tag c_quotation_expander;
  66
  67   (* Default quotation expander (<< .. >>) should be C code ("c"). *)
  68   Quotation.default := "c"
  69
  70 ;;
  71
  72 (* Extend the regular OCaml grammar. *)
  73 EXTEND Gram
  74   GLOBAL: str_item;
  75
  76   (* A parameter or return type. *)
  77   any_type: [
  78     [ "int32" -> <:expr< Wrappi_types.TInt32 >> ]
  79   | [ "int64" -> <:expr< Wrappi_types.TInt64 >> ]
  80   | [ t = LIDENT -> <:expr< Wrappi_types.Type $str:t$ >> ]
  81   ];
  82
  83   (* A return type. *)
  84   return_type: [
  85     [ "err" -> <:expr< Wrappi_types.RErr >> ]
  86   | [ t = any_type -> <:expr< Wrappi_types.Return $t$ >> ]
  87   ];
  88
  89   (* A single function parameter. *)
  90   parameter: [[ t = any_type; name = LIDENT -> (name, t) ]];
  91
  92   str_item: LEVEL "top" [
  93     [ "entry_point";
  94       return_type = return_type; name = LIDENT;
  95       "("; parameters = LIST0 parameter SEP ","; ")";
  96       code = OPT [ code = expr -> code ] ->
  97       add_entry_point _loc name parameters return_type code
  98     ]
  99   ];
 100
 101 END