Add more realistic type system.

[wrappi.git] / generator-lib / wrappi_types.ml

diff --git a/generator-lib/wrappi_types.ml b/generator-lib/wrappi_types.ml
index 8dfa31b..ef3a8bd 100644 (file)
--- a/generator-lib/wrappi_types.ml
+++ b/generator-lib/wrappi_types.ml
@@ -18,46 +18,135 @@
 
 open Camlp4.PreCast
 
+open Wrappi_utils
+
 open Printf
 
-type any_type = TInt32 | TInt64 | Type of string
+type ptype =
+  | TBool
+  | TBuffer
+  | TEnum of string
+  | TFile
+  | THash of ptype
+  | TInt
+  | TInt32
+  | TInt64
+  | TList of ptype
+  | TNullable of ptype
+  | TString
+  | TStruct of string
+  | TTypedef of string
+  | TUInt32
+  | TUInt64
+  | TUnion of string
+
+type prec
+
+type parameter = string * ptype * prec option
 
-type parameter = string * any_type
+type rtype = RErr | Return of ptype
 
-type return_type = RErr | Return of any_type
+type ftype = rtype * parameter list * parameter list
 
 type c_code = string
 
 type entry_point = {
   ep_loc : Camlp4.PreCast.Loc.t;
   ep_name : string;
-  ep_params : parameter list;
-  ep_return : return_type;
+  ep_ftype : ftype;
   ep_code : c_code option;
 }
 
+type typedef = {
+  td_loc : Camlp4.PreCast.Loc.t;
+  td_name : string;
+  td_type : ptype;
+}
+
+type enum = {
+  en_loc : Camlp4.PreCast.Loc.t;
+  en_name : string;
+  en_identifiers : string array;
+}
+
+type struct_decl = {
+  sd_loc : Camlp4.PreCast.Loc.t;
+  sd_name : string;
+  sd_identifiers : string array;
+  sd_fields : ptype array;
+}
+
+type union = {
+  un_loc : Camlp4.PreCast.Loc.t;
+  un_name : string;
+  un_identifiers : string array;
+  un_fields : ptype array;
+}
+
 type api = {
-  api_entry_points : entry_point list;
+  api_typedefs : typedef StringMap.t;
+  api_enums : enum StringMap.t;
+  api_structs : struct_decl StringMap.t;
+  api_unions : union StringMap.t;
+  api_entry_points : entry_point StringMap.t;
 }
 
-let string_of_any_type = function
+let iter xs f =
+  let xs = StringMap.bindings xs in
+  let cmp (a, _) (b, _) = compare a b in
+  let xs = List.sort cmp xs in
+  List.iter (fun (_, x) -> f x) xs
+
+let iter_typedefs { api_typedefs = tds } f = iter tds f
+let iter_enums { api_enums = ens } f = iter ens f
+let iter_structs { api_structs = sds } f = iter sds f
+let iter_unions { api_unions = uns } f = iter uns f
+let iter_entry_points { api_entry_points = eps } f = iter eps f
+
+let rec string_of_ptype = function
+  | TBool -> "bool"
+  | TBuffer -> "buffer"
+  | TEnum name -> sprintf "enum %s" name
+  | TFile -> "file"
+  | THash t -> sprintf "hash(%s)" (string_of_ptype t)
+  | TInt -> "int"
   | TInt32 -> "int32"
   | TInt64 -> "int64"
-  | Type s -> s
-let string_of_return_type = function
+  | TList t -> sprintf "list(%s)" (string_of_ptype t)
+  | TNullable t -> sprintf "nullable(%s)" (string_of_ptype t)
+  | TString -> "string"
+  | TStruct name -> sprintf "struct %s" name
+  | TTypedef name -> name
+  | TUInt32 -> "uint32"
+  | TUInt64 -> "uint64"
+  | TUnion name -> sprintf "union %s" name
+let string_of_rtype = function
   | RErr -> "err"
-  | Return t -> string_of_any_type t
-let string_of_parameter (name, t) =
-  sprintf "%s %s" (string_of_any_type t) name
+  | Return t -> string_of_ptype t
+let string_of_parameter (name, t, _) =
+  sprintf "%s %s" (string_of_ptype t) name
 let string_of_parameters params =
-  "(" ^ String.concat ", " (List.map string_of_parameter params) ^ ")"
+  sprintf "(%s)" (String.concat ", " (List.map string_of_parameter params))
+let string_of_ftype (ret, req, opt) =
+  sprintf "%s %s %s"
+    (string_of_rtype ret) (string_of_parameters req) (string_of_parameters opt)
 let string_of_c_code code = code
+
+let string_of_typedef td =
+  sprintf "typedef %s %s" td.td_name (string_of_ptype td.td_type)
+
+let string_of_enum en =
+  sprintf "enum %s {%s}" en.en_name
+    (String.concat ", " (Array.to_list en.en_identifiers))
+
+let string_of_struct sd = assert false
+let string_of_union un = assert false
+
 let string_of_entry_point ep =
-  sprintf "entry_point %s %s %s <<%s>>"
+  sprintf "entry_point %s %s <<%s>>"
     (*(Loc.to_string ep.ep_loc)*)
-    (string_of_return_type ep.ep_return)
     ep.ep_name
-    (string_of_parameters ep.ep_params)
+    (string_of_ftype ep.ep_ftype)
     (match ep.ep_code with
     | None -> "/* implicit */"
     | Some code -> string_of_c_code code)