(* wrappi
 * Copyright (C) 2011 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
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)

open Camlp4.PreCast

open Wrappi_utils
open Wrappi_types
open Wrappi_boilerplate
open Wrappi_pr

open Printf

let inputs = ["wrappi_c_impl.ml"]

let c_of_ptype ~param = function
  | TBool -> "int"
  | TBuffer -> assert false (* XXX not implemented *)
  | TEnum name -> sprintf "wrap_%s_enum" 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 ->
    if param then sprintf "const struct wrap_%s *" name
    else 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"
  | RStaticString -> "const char *"
  | Return t -> c_of_ptype ~param:false t

let pr_defn ?(impl = false) ep =
  let ret, req, opt = ep.ep_ftype in

  if not impl then (
    pr "%s\n" (c_of_rtype ret);
    pr "wrap_%s (wrap_h *w" ep.ep_name
  ) else (
    pr "static %s\n" (c_of_rtype ret);
    pr "impl_%s (struct wrap_internal_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 inputs CStyle LGPLv2plus;

  pr "\
/* Automatically generated implementation of '%s'.
" ep.ep_name;

  if not (Loc.is_ghost ep.ep_loc) then
    pr " * This API was defined in '%s' at line %d.\n"
      (Loc.file_name ep.ep_loc) (Loc.start_line ep.ep_loc);

  pr " */

#include <config.h>

#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <string.h>
#include <assert.h>
";
  List.iter (pr "#include <%s>\n") ep.ep_includes;

pr "\

#include \"wrappi.h\"
#include \"internal.h\"

";

  pr_defn ~impl:(not ep.ep_local) ep;

  pr "{\n";

  (match ep.ep_code with
  | None -> () (* XXX implicit code *)
  | Some { cc_loc = loc; cc_code = code } ->
    (* If the return is a struct/union/list then allocate the structure
     * in a local variable called 'ret' which the function should
     * assign to.
     *)
    let ret, _, _ = ep.ep_ftype in
    (match ret with
    | Return (TStruct name) ->
      pr "  struct wrap_%s *ret = malloc (sizeof *ret);\n" name;
      pr "  if (!ret) {\n";
      pr "    set_error_errno (\"malloc: struct wrap_%%s\", \"%s\");\n" name;
      pr "    return NULL;\n";
      pr "  }\n"
    | _ -> () (* XXX union, list, etc. *)
    );

    (* Make sure included code has correct line numbers. *)
    if not (Loc.is_ghost loc) then
      pr "#line %d \"%s\"\n" (Loc.start_line loc) (Loc.file_name loc);

    pr "%s" code
  );

  pr "}\n";

  (* For remote functions only, we now need to generate the
   * local binding code.
   *)
  if not ep.ep_local then (
    pr "\n";

    pr_defn ep;

    pr "{\n";
    pr "  /* XXX Argument precondition checks here. */\n";
    pr "\n";
    pr "  if (w->scheme == WRAP_SCHEME_LOCAL) {\n";
    pr "    /* Local connection. */\n";
    pr "    ";

    let name = ep.ep_name in
    let ret, req, opt = ep.ep_ftype in

    (match ret with
    | RVoid -> ()
    | _ -> pr "return "
    );

    pr "impl_%s ((struct wrap_internal_h *)w" name;

    (* Required parameters. *)
    List.iter (fun (n, _, _) -> pr ", %s" n) req;

    (* Optional parameters. *)
    if opt <> [] then
      assert false; (* XXX not implemented *)

    pr ");\n";

    (match ret with
    | RVoid -> pr "    return;\n"
    | _ -> ()
    );

    pr "  } else {\n";
    pr "    /* Remote connection. */\n";
    pr "    struct wrap_%s_args args;\n" name;
    pr "    struct wrap_%s_ret ret;\n" name;
    pr "\n";
    List.iter (fun (n, _, _) -> pr "    args.%s = %s;\n" n n) req;

    if opt <> [] then assert false; (* XXX not implemented *)
    pr "\n";

    pr "    memset (&ret, 0, sizeof ret);\n";
    pr "\n";

    pr "    wrap_int_make_request (w, wrap_int_%s_num,\n" name;
    pr "                           &args, &ret);\n";

    (match ret with
    | RVoid -> ()
    | _ ->
      pr "\n";
      pr "    return ret.r;\n"
    );

    pr "  }\n";

    pr "}\n"
  )

let generate_lib_internal_procs_h api =
  generate_header inputs CStyle LGPLv2plus;

  pr "\
#ifndef WRAPPI_INTERNAL_PROCS_H_
#define WRAPPI_INTERNAL_PROCS_H_

";

  pr "\
/* NOTE: These constants can change with each run of the generator.
 * They are only for internal use within the library, eg. for indexing
 * arrays.  The constants must not 'escape' from the library into
 * on-the-wire formats etc.
 */
enum {
";

  iter_entry_points api (
    fun ep -> pr "  wrap_int_%s_num,\n" ep.ep_name
  );

  pr "};\n";
  pr "\n";

  pr "#define wrap_int_nr_procs %d\n" (StringMap.cardinal api.api_entry_points);

  pr "\n";
  pr "#endif /* WRAPPI_INTERNAL_PROCS_H_ */\n"

let generate_lib_internal_procs_c api =
  generate_header inputs CStyle LGPLv2plus;

  pr "\
#include <config.h>

#include <stdlib.h>

#include \"wrappi.h\"
#include \"internal.h\"

/* Defined in lib/call.c */
";

  iter_entry_points api (
    fun ep ->
      pr "extern void wrap_int_call_%s (wrap_h *w, const void *args, void *ret);\n" ep.ep_name
  );
  pr "\n";

  pr "/* Defined in lib/xdr.c */\n";

  iter_entry_points api (
    fun ep ->
      let name = ep.ep_name in
      pr "extern bool_t wrap_int_xdr_%s_args (XDR *, struct wrap_%s_args *);\n" name name;
      pr "extern bool_t wrap_int_xdr_%s_ret (XDR *, struct wrap_%s_ret *);\n" name name
  );
  pr "\n";

  pr "const struct proc_table wrap_int_proc_table[] = {\n";

  iter_entry_points api (
    fun ep ->
      let name = ep.ep_name in
      pr "  [wrap_int_%s_num] = {\n" name;
      pr "    .name = \"%s\",\n" name;
      pr "    .args_struct_size = sizeof (struct wrap_%s_args),\n" name;
      pr "    .ret_struct_size = sizeof (struct wrap_%s_ret),\n" name;
      pr "    .call = &wrap_int_call_%s,\n" name;
      pr "    .args_xdrproc = (xdrproc_t) &wrap_int_xdr_%s_args,\n" name;
      pr "    .ret_xdrproc = (xdrproc_t) &wrap_int_xdr_%s_ret,\n" name;
      pr "  },\n"
  );

  pr "};\n"

let generate_lib_internal_procs_lookup_gperf api =
  generate_header inputs CStyle LGPLv2plus;

  pr "\
%%language=ANSI-C
%%define lookup-function-name wrap_int_gperf_lookup_proc_entry
%%readonly-tables
%%null-strings

%%{
#include <config.h>

#include <stdlib.h>
#include <string.h>

#include \"wrappi.h\"
#include \"internal.h\"
%%}

struct proc_entry;

%%%%
";

  iter_entry_points api (
    fun ep ->
      let name = ep.ep_name in
      pr "%s, wrap_int_%s_num\n" name name
  )

(* Make a unique, reproducible filename for each entry point. *)
let filename_of_ep ep =
  let filename = Loc.file_name ep.ep_loc in
  let filename = Filename.basename filename in
  let filename =
    try Filename.chop_extension filename
    with Invalid_argument _ -> filename in
  let filename = sprintf "%s-%s.c" filename ep.ep_name in
  filename

let generate_lib_implementation_files_mk api =
  generate_header inputs HashStyle GPLv2plus;

  let eps = StringMap.bindings api.api_entry_points in
  let cmp (a, _) (b, _) = compare a b in
  let eps = List.sort cmp eps in
  let eps = List.map snd eps in

  let rec loop = function
    | [] -> ()
    | [ep] -> pr "\t%s\n" (filename_of_ep ep)
    | ep :: eps -> pr "\t%s \\\n" (filename_of_ep ep); loop eps
  in

  pr "local_implementation_files := \\\n";

  loop (List.filter (fun ep -> ep.ep_local && ep.ep_code <> None) eps);

  pr "\n";
  pr "remote_implementation_files := \\\n";

  loop (List.filter (fun ep -> not ep.ep_local) eps)

let generate api =
  let gitignores = ref [] in

  iter_entry_points api (
    fun ep ->
      (* Local entry points which don't have associated code are
       * assumed to be implemented in hand-written code elsewhere under
       * lib/.
       *)
      if not ep.ep_local || ep.ep_code <> None then (
        let filename = filename_of_ep ep in

        gitignores := ("/" ^ filename) :: !gitignores;

        output_to ("lib/" ^ filename) generate_implementation ep
      )
  );

  output_to "lib/internal-procs.h"
    generate_lib_internal_procs_h api;

  output_to "lib/internal-procs.c"
    generate_lib_internal_procs_c api;

  output_to "lib/internal-procs-lookup.gperf"
    generate_lib_internal_procs_lookup_gperf api;

  output_to "lib/implementation_files.mk"
    generate_lib_implementation_files_mk api;

  let gitignores = List.rev !gitignores in
  output_to "lib/.gitignore"
    (fun () -> List.iter (pr "%s\n") gitignores) ()