symbolTab.ml

(** Time-stamp: <modified the 27/03/2008 (at 11:16) by Erwan Jahier> *)

(*
Sous-module pour SyntaxTab 
*)
open Lxm
open SyntaxTree
open SyntaxTreeCore
open Errors

type 'a hereflagged =
  Here of 'a
| NotHere of Ident.long

type t = {
  st_consts: (Ident.t , (const_info srcflagged) hereflagged) Hashtbl.t ;
  st_types : (Ident.t , (type_info  srcflagged) hereflagged) Hashtbl.t ;
  st_nodes : (Ident.t , (node_info  srcflagged) hereflagged) Hashtbl.t ;
} 

(* Création/initialisation d'une symbol_tab *)
let create () = 
  let consts_tbl = Hashtbl.create 50
  and types_tbl  = Hashtbl.create 50
  and nodes_tbl  = Hashtbl.create 50
  in
(*    List.iter (fun (n,xx) -> Hashtbl.add nodes_tbl n xx) predef_node_list; *)
    {
      st_consts = consts_tbl;
      st_types  = types_tbl;
      st_nodes  = nodes_tbl;
    }

let find_type (this: t) (id: Ident.t) lxm =
  try Hashtbl.find (this.st_types) id
  with Not_found -> raise (Compile_error(lxm, "unknown type"))

  
let find_const (this: t) (id: Ident.t) lxm = 
  try Hashtbl.find (this.st_consts) id
  with Not_found -> 
    raise (Compile_error(lxm, "unknown constant"))


let find_node (this: t) (id: Ident.t) lxm =
  try Hashtbl.find (this.st_nodes) id
  with Not_found -> raise (Compile_error(lxm, "unknown node"))


(* Manip de SymbolTab.t *)
let add_import_const (this: t) (id: Ident.t) (aid: Ident.long) = (
  Hashtbl.replace (this.st_consts) id (NotHere aid)
)

let add_import_type (this: t) (id: Ident.t) (aid: Ident.long) = (
  Hashtbl.replace (this.st_types) id (NotHere aid)
)

let add_import_node (this: t) (id: Ident.t) (aid: Ident.long) = (
  Hashtbl.replace (this.st_nodes) id (NotHere aid)
)

let add_const (this: t) (n: Ident.t) (cix: const_info  srcflagged) = (
  Hashtbl.replace this.st_consts n (Here cix)
)

let add_type (this: t) (n: Ident.t) (tix: type_info srcflagged) = (
  Hashtbl.replace this.st_types n (Here tix) ;
  (* cas particulier des types enums *)
  match tix.it with
      EnumType (_, ecl) -> (
	let tname = Lxm.str tix.src in
	let treat_enum_const ec = (
	  let te = Named_type_exp { Ident.id_pack = None; Ident.id_id = tname} in
	  let tex = Lxm.flagit te tix.src in
	  let ci = EnumConst (ec.it, tex) in
	    add_const this ec.it (Lxm.flagit ci (ec.src))
	) in
	  List.iter treat_enum_const ecl
      )
    | _ -> ()
)

let add_node (this: t) (n: Ident.t) (oix: node_info  srcflagged) = (
	Hashtbl.add this.st_nodes n (Here oix)
)

let iter_types this f = ( Hashtbl.iter f this.st_types)
let iter_consts this f = ( Hashtbl.iter f this.st_consts)
let iter_nodes this f = ( Hashtbl.iter f this.st_nodes)

let dump this = (
 (* A FAIRE (si besoin ...) *)
)