(* $Id: direct.ml 1870 2013-07-29 22:20:12Z gerd $ *)

(* Set the direct flag on declarations only using allowed constructions *)

open Syntax

let mark_decls_suited_for_direct_mapping dl =
  let typemap = Hashtbl.create 100 in
  List.iter
    (function
         Typedef td ->
           if not (Hashtbl.mem typemap td.decl_symbol.xdr_name) then begin
             (* Only get the first type definition *)
             Hashtbl.add
               typemap
               td.decl_symbol.xdr_name
               td
           end
       | _ -> ()
    )
    dl;
  
  let visited = Hashtbl.create 100 in
  let visiting = Hashtbl.create 100 in

  let rec visit_decl td =
    Hashtbl.add visiting td.decl_symbol.xdr_name ();
    td.decl_direct <- visit_type td.decl_type;
    Hashtbl.remove visiting td.decl_symbol.xdr_name;
    Hashtbl.add visited td.decl_symbol.xdr_name ()

  and visit_type t =
    match t with
      | T_opaque_fixed _
      | T_opaque _
      | T_opaque_unlimited
      | T_string _
      | T_string_unlimited
      | T_void
      | T_int _
      | T_uint _
      | T_hyper _
      | T_uhyper _
      | T_double
      | T_float
      | T_bool
      | T_enum _ ->
	  true
      | T_option t1 ->
	  visit_type t1
      | T_struct(_,tdl) ->
	  List.for_all (fun td -> visit_type td.decl_type) tdl
      | T_refer_to(_,n) ->
	  not (Hashtbl.mem visiting !n) && (
	    let td = Hashtbl.find typemap !n in
	    if not (Hashtbl.mem visited !n) then
	      visit_decl td;
	    td.decl_direct
	  )
      | T_array_fixed(_,t1)
      | T_array (_,t1)
      | T_array_unlimited t1 ->
	  visit_type t1
      | T_union u ->
	  List.for_all
	    (fun (_,_,td) -> visit_type td.decl_type) 
	    u.cases &&
	  ( match u.default with
	      | None -> true
	      | Some d -> visit_type d.decl_type
	  )
      | T_mstring _
      | T_mstring_unlimited _ ->
	  false
  in

  List.iter
    (function
         Typedef td -> visit_decl td
       | _ -> ()
    )
    dl