(* 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 Printf

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 rtype = RErr | Return of ptype

type ftype = rtype * parameter list * parameter list

type c_code = string

type entry_point = {
  ep_loc : Camlp4.PreCast.Loc.t;
  ep_name : string;
  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_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 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"
  | 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_ptype t
let string_of_parameter (name, t, _) =
  sprintf "%s %s" (string_of_ptype t) name
let string_of_parameters 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>>"
    (*(Loc.to_string ep.ep_loc)*)
    ep.ep_name
    (string_of_ftype ep.ep_ftype)
    (match ep.ep_code with
    | None -> "/* implicit */"
    | Some code -> string_of_c_code code)