^^&&^^

Edit File: swig.ml

(* -*- tuareg -*- *)
open Int32
open Int64

type enum = [ `Int of int ]

type c_obj = enum c_obj_t

exception BadArgs of string
exception BadMethodName of string * string
exception NotObject of c_obj
exception NotEnumType of c_obj
exception LabelNotFromThisEnum of c_obj
exception InvalidDirectorCall of c_obj
exception NoSuchClass of string
let rec invoke obj = 
  match obj with 
      C_obj o -> o 
    | C_director_core (o,r) -> invoke o
    | _ -> raise (NotObject (Obj.magic obj))
let _ = Callback.register "swig_runmethod" invoke

let fnhelper arg =
  match arg with C_list l -> l | C_void -> [] | _ -> [ arg ]

let rec get_char x =
  (char_of_int (get_int x))

let rec get_string x = 
  match x with 
      C_string str -> str
    | _ -> raise (Failure "Can't convert to string")

let rec get_bool x = 
  match x with
      C_bool b -> b
    | _ -> 
	(try if get_int x != 0 then true else false
	 with _ -> raise (Failure "Can't convert to bool"))

let disown_object obj = 
  match obj with
      C_director_core (o,r) -> r := None
    | _ -> raise (Failure "Not a director core object")
let _ = Callback.register "caml_obj_disown" disown_object
let addr_of obj = 
  match obj with
      C_obj _ -> (invoke obj) "&" C_void
    | C_director_core (self,r) -> (invoke self) "&" C_void
    | C_ptr _ -> obj
    | _ -> raise (Failure "Not a pointer.")
let _ = Callback.register "caml_obj_ptr" addr_of

let make_float f = C_float f
let make_double f = C_double f
let make_string s = C_string s
let make_bool b = C_bool b
let make_char c = C_char c
let make_char_i c = C_char (char_of_int c)
let make_uchar c = C_uchar c
let make_uchar_i c = C_uchar (char_of_int c)
let make_short i = C_short i
let make_ushort i = C_ushort i
let make_int i = C_int i
let make_uint i = C_uint (Int32.of_int i)
let make_int32 i = C_int32 (Int32.of_int i)
let make_int64 i = C_int64 (Int64.of_int i)

let new_derived_object cfun x_class args =
  begin
    let get_object ob =
      match !ob with
          None ->
    raise (NotObject C_void)
        | Some o -> o in
    let ob_ref = ref None in
    let class_fun class_f ob_r =
      (fun meth args -> class_f (get_object ob_r) meth args) in
    let new_class = class_fun x_class ob_ref in
    let dircore = C_director_core (C_obj new_class,ob_ref) in
    let obj =
    cfun (match args with
            C_list argl -> (C_list ((dircore :: argl)))
	  | C_void -> (C_list [ dircore ])
          | a -> (C_list [ dircore ; a ])) in
    ob_ref := Some obj ;
      obj
  end
  
let swig_current_type_info = ref C_void
let find_type_info obj = !swig_current_type_info 
let _ = Callback.register "swig_find_type_info" find_type_info
let set_type_info obj =
  match obj with
    C_ptr _ -> swig_current_type_info := obj ;
               obj
    | _ -> raise (Failure "Internal error: passed non pointer to set_type_info")
let _ = Callback.register "swig_set_type_info" set_type_info

let class_master_list = Hashtbl.create 20
let register_class_byname nm co = 
  Hashtbl.replace class_master_list nm (Obj.magic co)
let create_class nm arg = 
  try (Obj.magic (Hashtbl.find class_master_list nm)) arg with _ -> raise (NoSuchClass nm)