(* 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_types
open Wrappi_utils

open Printf

let check_not_defined name new_ map thing get_loc =
  try
    let old = StringMap.find name map in
    eprintf "generator: error: %s %s redefined\n" thing name;
    let old_loc = get_loc old in
    let new_loc = get_loc new_ in
    eprintf "  first definition at %s line %d\n"
      (Loc.file_name old_loc) (Loc.start_line old_loc);
    eprintf "  second definition at %s line %d\n"
      (Loc.file_name new_loc) (Loc.start_line new_loc);
    exit 1
  with
    Not_found -> ()

let tds = ref StringMap.empty
let add_typedef td =
  let name = td.td_name in
  check_not_defined name td !tds "typedef" (fun td -> td.td_loc);
  tds := StringMap.add name td !tds

let ens = ref StringMap.empty
let add_enum en =
  let name = en.en_name in
  check_not_defined name en !ens "enum" (fun en -> en.en_loc);
  ens := StringMap.add name en !ens

let sds = ref StringMap.empty
let add_struct sd =
  let name = sd.sd_name in
  check_not_defined name sd !sds "struct" (fun sd -> sd.sd_loc);
  sds := StringMap.add name sd !sds

let uns = ref StringMap.empty
let add_union un =
  let name = un.un_name in
  check_not_defined name un !uns "union" (fun un -> un.un_loc);
  uns := StringMap.add name un !uns

let eps = ref StringMap.empty
let add_entry_point ep =
  let name = ep.ep_name in
  check_not_defined name ep !eps "entry_point" (fun ep -> ep.ep_loc);
  eps := StringMap.add name ep !eps

let rec resolve_typedefs thing name loc = function
  | (TBool
        | TBuffer
        | TEnum _
        | TFile
        | TInt
        | TInt32
        | TInt64
        | TString
        | TStruct _
        | TUInt32
        | TUInt64
        | TUnion _) as t -> t

  | THash t -> THash (resolve_typedefs thing name loc t)
  | TList t -> TList (resolve_typedefs thing name loc t)
  | TNullable t -> TNullable (resolve_typedefs thing name loc t)

  | TTypedef tname ->
    try
      let td = StringMap.find tname !tds in
      let t = td.td_type in
      (* The typedef may be a typedef, so we need to recursively
       * resolve the type.
       *)
      resolve_typedefs "typedef" td.td_name td.td_loc t
    with Not_found ->
      eprintf "generator: error: could not resolve typedef %s to a basic type\n"
        tname;
      eprintf "  in definition of %s %s at %s line %d\n"
        thing name (Loc.file_name loc) (Loc.start_line loc);
      exit 1

let resolve_typedefs_in_ret thing name loc = function
  | RVoid as t -> t
  | Return t -> Return (resolve_typedefs thing name loc t)

let get_api () =
  let tds = !tds in
  let ens = !ens in
  let sds = !sds in
  let uns = !uns in
  let eps = !eps in

  (* Resolve typedefs in all ptypes in everything. *)
  let sds = StringMap.map (
    fun sd ->
      let fields = sd.sd_fields in
      let fields =
        Array.map (resolve_typedefs "enum" sd.sd_name sd.sd_loc) fields in
      { sd with sd_fields = fields }
  ) sds in

  let uns = StringMap.map (
    fun un ->
      let fields = un.un_fields in
      let fields =
        Array.map (resolve_typedefs "union" un.un_name un.un_loc) fields in
      { un with un_fields = fields }
  ) uns in

  let eps = StringMap.map (
    fun ep ->
      let name = ep.ep_name in
      let loc = ep.ep_loc in
      let ret, req, opt = ep.ep_ftype in
      let ret = resolve_typedefs_in_ret "entry_point" name loc ret in
      let req = List.map (
        fun (n, t, prec) ->
          n, resolve_typedefs "entry_point" name loc t, prec
      ) req in
      let opt = List.map (
        fun (n, t, prec) ->
          n, resolve_typedefs "entry_point" name loc t, prec
      ) opt in
      { ep with ep_ftype = (ret, req, opt) }
  ) eps in

  { api_typedefs = tds;
    api_enums = ens;
    api_structs = sds;
    api_unions = uns;
    api_entry_points = eps }