generator-lib/wrappi_types.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 open Camlp4.PreCast
  20
  21 open Wrappi_utils
  22
  23 open Printf
  24
  25 type ptype =
  26   | TBool
  27   | TBuffer
  28   | TEnum of string
  29   | TFile
  30   | THash of ptype
  31   | TInt
  32   | TInt32
  33   | TInt64
  34   | TList of ptype
  35   | TNullable of ptype
  36   | TString
  37   | TStruct of string
  38   | TTypedef of string
  39   | TUInt32
  40   | TUInt64
  41   | TUnion of string
  42
  43 type prec
  44
  45 type parameter = string * ptype * prec option
  46
  47 type rtype = RVoid | RStaticString | Return of ptype
  48
  49 type ftype = rtype * parameter list * parameter list
  50
  51 type c_code = {
  52   cc_loc : Camlp4.PreCast.Loc.t;
  53   cc_code : string;
  54 }
  55
  56 type entry_point = {
  57   ep_loc : Camlp4.PreCast.Loc.t;
  58   ep_local : bool;
  59   ep_name : string;
  60   ep_ftype : ftype;
  61   ep_code : c_code option;
  62   ep_includes : string list;
  63 }
  64
  65 type typedef = {
  66   td_loc : Camlp4.PreCast.Loc.t;
  67   td_name : string;
  68   td_type : ptype;
  69 }
  70
  71 type enum = {
  72   en_loc : Camlp4.PreCast.Loc.t;
  73   en_name : string;
  74   en_identifiers : string array;
  75 }
  76
  77 type struct_decl = {
  78   sd_loc : Camlp4.PreCast.Loc.t;
  79   sd_name : string;
  80   sd_identifiers : string array;
  81   sd_fields : ptype array;
  82 }
  83
  84 type union = {
  85   un_loc : Camlp4.PreCast.Loc.t;
  86   un_name : string;
  87   un_identifiers : string array;
  88   un_fields : ptype array;
  89 }
  90
  91 type api = {
  92   api_typedefs : typedef StringMap.t;
  93   api_enums : enum StringMap.t;
  94   api_structs : struct_decl StringMap.t;
  95   api_unions : union StringMap.t;
  96   api_entry_points : entry_point StringMap.t;
  97 }
  98
  99 let iter xs f =
 100   let xs = StringMap.bindings xs in
 101   let cmp (a, _) (b, _) = compare a b in
 102   let xs = List.sort cmp xs in
 103   List.iter (fun (_, x) -> f x) xs
 104
 105 let iter_typedefs { api_typedefs = tds } f = iter tds f
 106 let iter_enums { api_enums = ens } f = iter ens f
 107 let iter_structs { api_structs = sds } f = iter sds f
 108 let iter_unions { api_unions = uns } f = iter uns f
 109 let iter_entry_points { api_entry_points = eps } f = iter eps f
 110
 111 let rec string_of_ptype = function
 112   | TBool -> "bool"
 113   | TBuffer -> "buffer"
 114   | TEnum name -> sprintf "enum %s" name
 115   | TFile -> "file"
 116   | THash t -> sprintf "hash(%s)" (string_of_ptype t)
 117   | TInt -> "int"
 118   | TInt32 -> "int32"
 119   | TInt64 -> "int64"
 120   | TList t -> sprintf "list(%s)" (string_of_ptype t)
 121   | TNullable t -> sprintf "nullable(%s)" (string_of_ptype t)
 122   | TString -> "string"
 123   | TStruct name -> sprintf "struct %s" name
 124   | TTypedef name -> name
 125   | TUInt32 -> "uint32"
 126   | TUInt64 -> "uint64"
 127   | TUnion name -> sprintf "union %s" name
 128 let string_of_rtype = function
 129   | RVoid -> "void"
 130   | RStaticString -> "static_string"
 131   | Return t -> string_of_ptype t
 132 let string_of_parameter (name, t, _) =
 133   sprintf "%s %s" (string_of_ptype t) name
 134 let string_of_parameters params =
 135   sprintf "(%s)" (String.concat ", " (List.map string_of_parameter params))
 136 let string_of_ftype (ret, req, opt) =
 137   sprintf "%s %s %s"
 138     (string_of_rtype ret) (string_of_parameters req) (string_of_parameters opt)
 139 let string_of_c_code code = code.cc_code
 140
 141 let string_of_typedef td =
 142   sprintf "typedef %s %s" td.td_name (string_of_ptype td.td_type)
 143
 144 let string_of_enum en =
 145   sprintf "enum %s {%s}" en.en_name
 146     (String.concat ", " (Array.to_list en.en_identifiers))
 147
 148 let string_of_struct sd = assert false
 149 let string_of_union un = assert false
 150
 151 let string_of_entry_point ep =
 152   sprintf "entry_point%s %s %s <<%s>>"
 153     (*(Loc.to_string ep.ep_loc)*)
 154     (if ep.ep_local then " local" else "")
 155     ep.ep_name
 156     (string_of_ftype ep.ep_ftype)
 157     (match ep.ep_code with
 158     | None -> "/* implicit */"
 159     | Some code -> string_of_c_code code)