Update of /cvsroot/swig/SWIG/Lib/ocaml In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15927/Lib/ocaml Modified Files: class.swg ocaml.i ocaml.swg ocamldec.swg preamble.swg swig.ml swig.mli typeregister.swg Removed Files: mlheading.swg mliheading.swg Log Message: Some delayed maintenance. Fixes for multimodule targets. Index: typeregister.swg =================================================================== RCS file: /cvsroot/swig/SWIG/Lib/ocaml/typeregister.swg,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** typeregister.swg 19 Mar 2003 16:24:46 -0000 1.1 --- typeregister.swg 17 Oct 2004 07:56:17 -0000 1.2 *************** *** 4,7 **** --- 4,8 ---- int i; if (!typeinit) { + SWIG_Ocaml_LookupTypePointer(); for (i = 0; swig_types_initial[i]; i++) { swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]); *************** *** 9,11 **** typeinit = 1; } ! } \ No newline at end of file --- 10,12 ---- typeinit = 1; } ! } Index: ocaml.swg =================================================================== RCS file: /cvsroot/swig/SWIG/Lib/ocaml/ocaml.swg,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** ocaml.swg 12 Dec 2003 07:12:42 -0000 1.13 --- ocaml.swg 17 Oct 2004 07:56:17 -0000 1.14 *************** *** 29,32 **** --- 29,33 ---- #define C_director_core 17 + /* Cast a pointer if possible; returns 1 if successful */ *************** *** 243,260 **** } - #ifdef __cplusplus - namespace caml { - extern "C" - #endif - CAML_VALUE alloc(int,int); - #ifdef __cplusplus - }; - #endif - SWIGSTATIC CAML_VALUE caml_swig_alloc(int x,int y) { ! #ifdef __cplusplus ! using namespace caml; ! #endif ! return alloc(x,y); } --- 244,249 ---- } SWIGSTATIC CAML_VALUE caml_swig_alloc(int x,int y) { ! return caml_alloc(x,y); } *************** *** 587,590 **** --- 576,589 ---- } + static void SWIG_Ocaml_LookupTypePointer() { + CAML_VALUE mod_pointer, pointer; + + mod_pointer = caml_val_ptr(swig_type_list_handle, NULL); + pointer = callback(*caml_named_value("swig_find_type_info"), mod_pointer); + if (SWIG_Tag_val(pointer) == C_ptr) { + swig_type_list_handle = (swig_type_info **)(void *)(long)SWIG_Int64_val(SWIG_Field(pointer,0)); + } + } + #ifdef __cplusplus } Index: preamble.swg =================================================================== RCS file: /cvsroot/swig/SWIG/Lib/ocaml/preamble.swg,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** preamble.swg 4 Dec 2003 06:15:07 -0000 1.2 --- preamble.swg 17 Oct 2004 07:56:17 -0000 1.3 *************** *** 1,5 **** %insert(mli) %{ - type c_obj = c_enum_tag c_obj_t - exception BadArgs of string exception BadMethodName of c_obj * string * string --- 1,3 ---- *************** *** 11,16 **** %insert(ml) %{ - type c_obj = c_enum_tag c_obj_t - exception BadArgs of string exception BadMethodName of c_obj * string * string --- 9,12 ---- --- mlheading.swg DELETED --- Index: swig.ml =================================================================== RCS file: /cvsroot/swig/SWIG/Lib/ocaml/swig.ml,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** swig.ml 4 Dec 2003 06:15:07 -0000 1.7 --- swig.ml 17 Oct 2004 07:56:17 -0000 1.8 *************** *** 3,6 **** --- 3,8 ---- open Int64 + type enum = [ `Int of int ] + type 'a c_obj_t = C_void *************** *** 24,36 **** | C_director_core of 'a c_obj_t * 'a c_obj_t option ref ! type empty_enum = [ `SWIGFake | `Int of int ] exception BadArgs of string exception BadMethodName of string * string ! exception NotObject of empty_enum c_obj_t ! exception NotEnumType of empty_enum c_obj_t ! exception LabelNotFromThisEnum of empty_enum c_obj_t ! exception InvalidDirectorCall of empty_enum c_obj_t ! let rec invoke obj = match obj with --- 26,38 ---- | C_director_core of 'a c_obj_t * 'a c_obj_t option ref ! 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 *************** *** 40,50 **** let _ = Callback.register "swig_runmethod" invoke ! let fnhelper fin f arg = ! let args = match arg with C_list l -> l | C_void -> [] | _ -> [ arg ] in ! match f args with ! [] -> C_void ! | [ x ] -> (if fin then Gc.finalise ! (fun x -> ignore ((invoke x) "~" C_void)) x) ; x ! | lst -> C_list lst let rec get_int x = --- 42,47 ---- let _ = Callback.register "swig_runmethod" invoke ! let fnhelper arg = ! match arg with C_list l -> l | C_void -> [] | _ -> [ arg ] let rec get_int x = *************** *** 110,115 **** let _ = Callback.register "caml_obj_ptr" addr_of - let convert_c_obj a = Obj.magic a - let make_float f = C_float f let make_double f = C_double f --- 107,110 ---- *************** *** 147,148 **** --- 142,161 ---- obj end + + let swig_current_type_info = ref C_void + let find_type_info obj = + match obj with + C_ptr _ -> if !swig_current_type_info = C_void + then begin + swig_current_type_info := obj ; + obj + end else + !swig_current_type_info + | _ -> raise (Failure "Internal error: passed non pointer to find_type_info") + let _ = Callback.register "swig_find_type_info" find_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) Index: ocaml.i =================================================================== RCS file: /cvsroot/swig/SWIG/Lib/ocaml/ocaml.i,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** ocaml.i 4 Dec 2003 06:15:06 -0000 1.10 --- ocaml.i 17 Oct 2004 07:56:17 -0000 1.11 *************** *** 4,11 **** file. */ - /* Insert ML/MLI Common stuff */ - %insert(mli) "mliheading.swg" - %insert(ml) "mlheading.swg" - /* Insert common stuff */ %insert(runtime) "common.swg" --- 4,7 ---- --- mliheading.swg DELETED --- Index: swig.mli =================================================================== RCS file: /cvsroot/swig/SWIG/Lib/ocaml/swig.mli,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** swig.mli 4 Dec 2003 06:15:07 -0000 1.4 --- swig.mli 17 Oct 2004 07:56:17 -0000 1.5 *************** *** 1,3 **** --- 1,6 ---- (* -*- tuareg -*- *) + + type enum = [ `Int of int ] + type 'a c_obj_t = C_void *************** *** 21,31 **** | C_director_core of 'a c_obj_t * 'a c_obj_t option ref ! type empty_enum = [ `SWIGFake | `Int of int ] ! exception InvalidDirectorCall of empty_enum c_obj_t ! val invoke : 'a c_obj_t -> (string -> 'a c_obj_t -> 'a c_obj_t) ! val convert_c_obj : 'a c_obj_t -> 'b c_obj_t ! val fnhelper : bool -> ('a c_obj_t list -> 'a c_obj_t list) -> 'a c_obj_t -> 'a c_obj_t val get_int : 'a c_obj_t -> int --- 24,34 ---- | C_director_core of 'a c_obj_t * 'a c_obj_t option ref ! type c_obj = enum c_obj_t ! exception InvalidDirectorCall of c_obj ! exception NoSuchClass of string ! val invoke : ('a c_obj_t) -> (string -> 'a c_obj_t -> 'a c_obj_t) ! val fnhelper : 'a c_obj_t -> 'a c_obj_t list val get_int : 'a c_obj_t -> int *************** *** 55,56 **** --- 58,61 ---- 'a c_obj_t -> 'a c_obj_t + val register_class_byname : string -> ('a c_obj_t -> 'a c_obj_t) -> unit + val create_class : string -> 'a c_obj_t -> 'a c_obj_t Index: class.swg =================================================================== RCS file: /cvsroot/swig/SWIG/Lib/ocaml/class.swg,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** class.swg 4 Dec 2003 06:15:06 -0000 1.2 --- class.swg 17 Oct 2004 07:56:17 -0000 1.3 *************** *** 2,10 **** let create_$classname_from_ptr raw_ptr = C_obj ! (let rec invoke_inner raw_ptr mth arg = try ! let method_name,application = ! List.hd ! (List.filter (fun (x,y) -> x = mth) method_table) in application (match arg with --- 2,32 ---- let create_$classname_from_ptr raw_ptr = C_obj ! begin ! let h = Hashtbl.create 20 in ! List.iter (fun (nm,fn) -> Hashtbl.replace h nm fn) ! [ "nop", (fun args -> C_void) ; ! $classbody ! "&", (fun args -> raw_ptr) ; ! ":parents", ! (fun args -> ! C_list ! (let out = ref [] in ! Hashtbl.iter (fun x y -> out := (x,y) :: !out) h ; ! (List.map ! (fun (x,y) -> ! C_string (String.sub x 2 ((String.length x) - 2))) ! (List.filter ! (fun (x,y) -> ! ((String.length x) > 2) ! && x.[0] == ':' && x.[1] == ':') !out)))) ; ! ":classof", (fun args -> C_string "$realname") ; ! ":methods", (fun args -> ! C_list (let out = ref [] in ! Hashtbl.iter (fun x y -> out := (C_string x) :: !out) h ; !out)) ! ] ; ! let rec invoke_inner raw_ptr mth arg = ! begin try ! let application = Hashtbl.find h mth in application (match arg with *************** *** 12,17 **** | C_void -> (C_list [ raw_ptr ]) | v -> (C_list [ raw_ptr ; v ])) ! with ! (Failure "hd") -> (* Try parent classes *) begin --- 34,38 ---- | C_void -> (C_list [ raw_ptr ]) | v -> (C_list [ raw_ptr ; v ])) ! with Not_found -> (* Try parent classes *) begin *************** *** 31,53 **** raise (BadMethodName (raw_ptr,mth,"$realname")) in try_parent parent_classes raw_ptr ! end ! and method_table = [ ! "nop", (fun args -> C_void) ; ! $classbody ! "&", (fun args -> raw_ptr) ; ! ":parents", ! (fun args -> ! C_list ! (List.map ! (fun (x,y) -> ! C_string (String.sub x 2 ((String.length x) - 2))) ! (List.filter ! (fun (x,y) -> ! ((String.length x) > 2) ! && x.[0] == ':' && x.[1] == ':') method_table))) ; ! ":classof", (fun args -> C_string "$realname") ; ! ":methods", (fun args -> C_list (List.map (fun (x,y) -> C_string x) ! method_table)) ] in ! (fun mth arg -> invoke_inner raw_ptr mth arg)) let _ = Callback.register --- 52,59 ---- raise (BadMethodName (raw_ptr,mth,"$realname")) in try_parent parent_classes raw_ptr ! end ! end in ! (fun mth arg -> invoke_inner raw_ptr mth arg) ! end let _ = Callback.register *************** *** 55,58 **** --- 61,65 ---- create_$classname_from_ptr + (*Stream:mli*) val create_$classname_from_ptr : c_obj -> c_obj Index: ocamldec.swg =================================================================== RCS file: /cvsroot/swig/SWIG/Lib/ocaml/ocamldec.swg,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** ocamldec.swg 4 Dec 2003 06:15:07 -0000 1.10 --- ocamldec.swg 17 Oct 2004 07:56:17 -0000 1.11 *************** *** 82,92 **** #endif - #if defined(SWIG_NOINCLUDE) - # define SWIGSTATIC - #elif defined(SWIG_GLOBAL) - # define SWIGSTATIC - #else # define SWIGSTATIC static - #endif #define SWIG_NewPointerObj(p,type,flags) caml_val_ptr(p,type) --- 82,86 ---- |