Some delayed maintenance.

Fixes for multimodule targets.


git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@6407 626c5289-ae23-0410-ae9c-e8d60b6d4f22

Lib/ocaml/class.swg

@@ -1,18 +1,39 @@
 (*Stream:class_ctors*)
 let create_$classname_from_ptr raw_ptr =
   C_obj 
-    (let rec invoke_inner raw_ptr mth arg = 
+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 method_name,application = 
-	      List.hd 
-		(List.filter (fun (x,y) -> x = mth) method_table) in
+	    let application = Hashtbl.find h mth in
 	      application
 		(match arg with 
 		     C_list l -> (C_list (raw_ptr :: l)) 
 		   | C_void -> (C_list [ raw_ptr ])
 		   | v -> (C_list [ raw_ptr ; v ]))
-	  with 
-	      (Failure "hd") -> 
+	  with Not_found -> 
 		(* Try parent classes *)
 		begin
 		  let parent_classes = [
@@ -30,30 +51,16 @@ let create_$classname_from_ptr raw_ptr =
 		      | [] ->
 			  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))
+		end
+	end in
+	  (fun mth arg -> invoke_inner raw_ptr mth arg)
+end
 
 let _ = Callback.register 
           "create_$normalized_from_ptr"
           create_$classname_from_ptr
 
+
 (*Stream:mli*)
 val create_$classname_from_ptr : c_obj -> c_obj
 

Lib/ocaml/mlheading.swg

@@ -1,4 +0,0 @@
-(* -*- tuareg -*- *)
-
-open Swig
-

Lib/ocaml/mliheading.swg

@@ -1,3 +0,0 @@
-(* -*- tuareg -*- *)
-
-open Swig

Lib/ocaml/ocaml.i

@@ -3,10 +3,6 @@
    This file is parsed by SWIG before reading any other interface
    file. */
 
-/* Insert ML/MLI Common stuff */
-%insert(mli) "mliheading.swg"
-%insert(ml) "mlheading.swg"
-
 /* Insert common stuff */
 %insert(runtime) "common.swg"
 

Lib/ocaml/ocaml.swg

@@ -28,6 +28,7 @@ extern "C" {
 #define C_enum 16
 #define C_director_core 17
 
+
 /* Cast a pointer if possible; returns 1 if successful */
     
     SWIGSTATIC int
@@ -242,20 +243,8 @@ extern "C" {
 	    failwith("Need array or list");
     }
 
-#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);
+	return caml_alloc(x,y);
     }
 
     SWIGSTATIC value caml_array_new( int n ) {
@@ -586,6 +575,16 @@ extern "C" {
 	}	
     }
 
+    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
 }
 #endif

Lib/ocaml/ocamldec.swg

@@ -81,13 +81,7 @@ CAMLextern int64 Int64_val(caml_value_t v);
 #define SWIG_Int64_val(v) Int64_val(v)
 #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)
 

Lib/ocaml/preamble.swg

@@ -1,6 +1,4 @@
 %insert(mli) %{
-type c_obj = c_enum_tag c_obj_t
-
 exception BadArgs of string
 exception BadMethodName of c_obj * string * string
 exception NotObject of c_obj
@@ -10,8 +8,6 @@ exception InvalidDirectorCall of c_obj
 %}
 
 %insert(ml) %{
-type c_obj = c_enum_tag c_obj_t
-
 exception BadArgs of string
 exception BadMethodName of c_obj * string * string
 exception NotObject of c_obj

Lib/ocaml/swig.ml

@@ -2,6 +2,8 @@
 open Int32
 open Int64
 
+type enum = [ `Int of int ]
+
 type 'a c_obj_t = 
     C_void
   | C_bool of bool
@@ -23,15 +25,15 @@ type 'a c_obj_t =
   | C_enum of 'a
   | C_director_core of 'a c_obj_t * 'a c_obj_t option ref
 
-type empty_enum = [ `SWIGFake | `Int of int ]
+type c_obj = enum c_obj_t
 
 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
-
+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 
@@ -39,13 +41,8 @@ let rec invoke obj =
     | _ -> raise (NotObject (Obj.magic obj))
 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 fnhelper arg =
+  match arg with C_list l -> l | C_void -> [] | _ -> [ arg ]
 
 let rec get_int x = 
   match x with
@@ -109,8 +106,6 @@ let addr_of obj =
     | _ -> raise (Failure "Not a pointer.")
 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
 let make_string s = C_string s
@@ -146,3 +141,21 @@ let new_derived_object cfun x_class args =
     ob_ref := Some obj ;
       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)

Lib/ocaml/swig.mli

@@ -1,4 +1,7 @@
 (* -*- tuareg -*- *)
+
+type enum = [ `Int of int ]
+
 type 'a c_obj_t = 
     C_void
   | C_bool of bool
@@ -20,13 +23,13 @@ type 'a c_obj_t =
   | C_enum of 'a
   | C_director_core of 'a c_obj_t * 'a c_obj_t option ref
 
-type empty_enum = [ `SWIGFake | `Int of int ]
+type c_obj = enum c_obj_t
 
-exception InvalidDirectorCall of empty_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 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 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
 val get_float : 'a c_obj_t -> float
@@ -54,3 +57,5 @@ val new_derived_object:
   ('a c_obj_t -> string -> 'a c_obj_t -> 'a c_obj_t) ->
   '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

Lib/ocaml/typeregister.swg

@@ -3,9 +3,10 @@
   static int       typeinit = 0;
   int       i;
   if (!typeinit) {
+     SWIG_Ocaml_LookupTypePointer();
      for (i = 0; swig_types_initial[i]; i++) {
         swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]);
      }
      typeinit = 1;
   }
-}
+}