More implementation code.
authorRichard W.M. Jones <rjones@redhat.com>
Sun, 1 Jan 2012 14:30:25 +0000 (14:30 +0000)
committerRichard W.M. Jones <rjones@redhat.com>
Sun, 1 Jan 2012 14:30:25 +0000 (14:30 +0000)
APIs/filesize.api
APIs/mknod.api
generator-lib/wrappi_types.ml
generator-lib/wrappi_types.mli
generator-macros/pa_wrap.ml
generator/wrappi_c_impl.ml
lib/implementation_files.mk

index 89a4063..218a1da 100644 (file)
@@ -28,6 +28,7 @@ off_t filesize (pathname path)
 
   return buf.st_size;
 >>
+includes ["sys/types.h"; "sys/stat.h"; "unistd.h"]
 
 (*
 mknod_block
index 85c6458..07d2cca 100644 (file)
@@ -25,6 +25,7 @@ void mknod_char (pathname path, fileperm perm, uint64 major, uint64 minor)
   }
   return 0;
 >>
+includes [ "sys/types.h"; "sys/stat.h"; "fcntl.h"; "unistd.h" ]
 
 (*
 mknod_block
index 588ad70..f738f95 100644 (file)
@@ -56,6 +56,7 @@ type entry_point = {
   ep_name : string;
   ep_ftype : ftype;
   ep_code : c_code option;
+  ep_includes : string list;
 }
 
 type typedef = {
index 04283d5..94cf371 100644 (file)
@@ -58,6 +58,7 @@ type entry_point = {
   ep_name : string;
   ep_ftype : ftype;
   ep_code : c_code option;
+  ep_includes : string list;
 }
 (** An API entry point. *)
 
index ffd9e6b..c176fe2 100644 (file)
@@ -51,7 +51,7 @@ let expr_of_loc _loc loc =
      $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
      $`bool:ghost$) >>
 
-let add_entry_point _loc local name parameters rtype code =
+let add_entry_point _loc local name parameters rtype code includes =
   let loc = expr_of_loc _loc _loc in
 
   let local =
@@ -64,12 +64,15 @@ let add_entry_point _loc local name parameters rtype code =
 
   let code = expr_of_option _loc code in
 
+  let includes = match includes with None -> <:expr< [] >> | Some xs -> xs in
+
   <:str_item<
     let ep = { Wrappi_types.ep_loc = $loc$;
                ep_local = $local$;
                ep_name = $str:name$;
                ep_ftype = ($rtype$, $parameters$, []);
-               ep_code = $code$ } in
+               ep_code = $code$;
+               ep_includes = $includes$ } in
     Wrappi_accumulator.add_entry_point ep
   >>
 
@@ -135,8 +138,10 @@ EXTEND Gram
       local = OPT "local";
       rtype = rtype; name = LIDENT;
       "("; parameters = LIST0 parameter SEP ","; ")";
-      code = OPT [ code = expr -> code ] ->
-      add_entry_point _loc local name parameters rtype code
+      code = OPT [ code = expr -> code ];
+      includes = OPT [ "includes"; includes = expr -> includes ]
+      ->
+      add_entry_point _loc local name parameters rtype code includes
     ]
   | [ "typedef"; t = ptype; name = LIDENT ->
       add_typedef _loc name t
index 50673fc..8742fad 100644 (file)
@@ -25,6 +25,50 @@ open Wrappi_pr
 
 open Printf
 
+let c_of_ptype ~param = function
+  | TBool -> "int"
+  | TBuffer -> assert false (* XXX not implemented *)
+  | TEnum name -> sprintf "enum wrap_%s" name
+  | TFile -> if param then "const char *" else "char *"
+  | THash t -> if param then "char * const *" else "char **"
+  | TInt -> "int" (* XXX not int, correct type depends on preconditions *)
+  | TInt32 -> "int32_t"
+  | TInt64 -> "int64_t"
+  | TList t -> assert false (* XXX not implemented *)
+  | TNullable TString -> if param then "const char *" else "char *"
+  | TNullable _ -> assert false (* XXX may be implemented in future *)
+  | TString -> if param then "const char *" else "char *"
+  | TStruct name -> sprintf "struct wrap_%s" name
+  | TTypedef name -> assert false (* should never happen *)
+  | TUInt32 -> "uint32_t"
+  | TUInt64 -> "uint64_t"
+  | TUnion name -> sprintf "union wrap_%s" name
+
+let c_of_rtype = function
+  | RVoid -> "void"
+  | Return t -> c_of_ptype ~param:false t
+
+let pr_decl ep =
+  let ret, req, opt = ep.ep_ftype in
+  pr "%s\n" (c_of_rtype ret);
+  pr "wrap_%s (wrap_h *w" ep.ep_name;
+
+  (* Required parameters. *)
+  List.iter (
+    fun (name, t, _) ->
+      let t = c_of_ptype ~param:true t in
+      let sep = (* "const char *" - omit space after asterisk *)
+        let len = String.length t in
+        if isalnum t.[len-1] then " " else "" in
+      pr ", %s%s%s" t sep name
+  ) req;
+
+  (* Optional parameters. *)
+  if opt <> [] then
+    pr ", ...";
+
+  pr ")\n"
+
 let generate_implementation ep =
   generate_header CStyle LGPLv2plus;
 
@@ -33,18 +77,40 @@ let generate_implementation ep =
 
 #include <stdio.h>
 #include <stdlib.h>
+";
+  List.iter (pr "#include <%s>\n") ep.ep_includes;
+
+pr "\
 
 #include \"wrappi.h\"
 
 #include \"internal.h\"
 
-"
+/* Automatically generated implementation of '%s'.
+ * This API was defined in '%s' at line %d.
+ */
+
+" ep.ep_name (Loc.file_name ep.ep_loc) (Loc.start_line ep.ep_loc);
 
   (* Depending on whether this is a local or remote function, include
    * different definitions here.
    *)
   (*if ep.ep_local then ... *)
 
+  pr_decl ep;
+
+  pr "\
+{
+#line %d \"%s\"
+" (Loc.start_line ep.ep_loc) (Loc.file_name ep.ep_loc);
+
+  (match ep.ep_code with
+  | None -> ()
+  | Some code -> pr "%s" code
+  );
+
+  pr "}\n"
+
 (* Make a unique, reproducible filename for each entry point. *)
 let filename_of_ep ep =
   let filename = Loc.file_name ep.ep_loc in
index 8760929..4631ce5 100644 (file)
@@ -3,7 +3,7 @@
 #   generator/wrappi_*.ml
 # ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.
 #
-# Copyright (C) 2011 Red Hat Inc.
+# Copyright (C) 2011-2012 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