jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Some delayed maintenance.

Browse source 
Fixes for multimodule targets.


git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@6407 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Art Yerkes 2004-10-17 07:56:17 +00:00
commit db57b0d6d8
14 changed files with 165 additions and 142 deletions
Download patch file Download diff file Expand all files Collapse all files

15
CHANGES.current
View file

@ -1,6 +1,21 @@
Version 1.3.23 (in progress)
============================
10/17/2004: arty
[OCAML]
- Tweak to enum typing for soundness in the presence of multiple
modules.
- global functions are now unambiguous in multiple loaded modules.
- Fixed test case code to build multimodule test cases correctly.
- There is no way to share overload resolution across modules
because of soundness issues. If the user wants to call some
function foo from an arbitrary module bar, they will have to
use Bar._foo to call it correctly. Later I will fix the
camlp4 module to do something clever in this case.
- Promided performance overhaul of class mechanism.
- Removed symbol hack for ocaml-3.07 and below which is not needed
for ocaml-3.08 and above.
10/16/2004: wuzzeb (John Lenz)
[CHICKEN]
- Completly change how chicken.cxx handles CLOS and generic code.

3
Examples/test-suite/imports_a.h
View file

@ -1,5 +1,8 @@
enum GlobalEnum { globalenum1=1, globalenum2 };
/* This function should be static as it will be emitted into the code for
* every module. All _static targets would fail here with a multiple
* definition if this is not static. */
GlobalEnum global_test(GlobalEnum e) { return e; }
class A {

13
Examples/test-suite/ocaml/Makefile.in
View file

@ -13,9 +13,13 @@ top_builddir = @top_builddir@
C_TEST_CASES =
run_testcase = \
if [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then ( \
if [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) -a \
-f $(top_srcdir)/Examples/test-suite/$*.list ] ; then ( \
ocamlc -c $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
ocamlc swig.cmo -custom -g -cc '$(CXX)' -o runme $(srcdir)/$*\.cmo $(srcdir)/$*\_runme.cmo $(srcdir)/$*\_wrap.o && \
ocamlc swig.cmo -custom -g -cc '$(CXX)' -o runme `cat $(top_srcdir)/Examples/test-suite/$(*).list | sed -e 's/\(.*\)/\1_wrap.o \1.cmo/g'`&& ./runme) ; \
elif [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then ( \
ocamlc -c $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
ocamlc swig.cmo -custom -g -cc '$(CXX)' -o runme $(srcdir)/$(*)_runme.cmo $(srcdir)/$(*)_wrap.o && \
./runme) ; \
fi ;
@ -61,10 +65,10 @@ include $(srcdir)/../common.mk
%.multicpptest:
echo $@ >> testing
$(setup) \
($(swig_and_compile_multi_cpp); ) && \
$(setup) \
$(run_testcase) \
if [ -f $(@:%.multicpptest=%_a_wrap.o) ] ; then \
if [ -f $(@:%.multicpptest=%_runtime_wrap.o) ] ; then \
echo $@ >> success ; \
fi
@ -74,4 +78,3 @@ include $(srcdir)/../common.mk
clean:
$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile ocaml_clean

57
Lib/ocaml/class.swg
View file

@ -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

4
Lib/ocaml/mlheading.swg
View file

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

3
Lib/ocaml/mliheading.swg
View file

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

4
Lib/ocaml/ocaml.i
View file

@ -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"

25
Lib/ocaml/ocaml.swg
View file

@ -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

6
Lib/ocaml/ocamldec.swg
View file

@ -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)

4
Lib/ocaml/preamble.swg
View file

@ -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

43
Lib/ocaml/swig.ml
View file

@ -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)

15
Lib/ocaml/swig.mli
View file

@ -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

3
Lib/ocaml/typeregister.swg
View file

@ -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;
}
}
}

112
Source/Modules/ocaml.cxx
View file

@ -259,18 +259,19 @@ public:
Printf( f_mlbody, "let module_name = \"%s\"\n", module );
Printf( f_mlibody, "val module_name : string\n" );
Printf( f_enum_to_int,
"let enum_to_int x v =\n"
" match v with C_enum y -> (\n"
" match (x : c_enum_type) with\n"
" `unknown -> "
" (match (y : c_enum_tag) with\n"
" `int (x : int) -> C_int x\n"
" | _ -> raise (LabelNotFromThisEnum v))\n" );
"let enum_to_int x (v : c_obj) =\n"
" match v with\n"
" C_enum _y ->\n"
" (let y = _y in match (x : c_enum_type) with\n"
" `unknown -> "
" (match (Obj.magic y) with\n"
" `Int x -> C_int x\n"
" | _ -> raise (LabelNotFromThisEnum v))\n" );
Printf( f_int_to_enum,
"let int_to_enum x y =\n"
" match (x : c_enum_type) with\n"
" `unknown -> C_enum (`int y)\n" );
" `unknown -> C_enum (`Int y)\n" );
Swig_banner (f_runtime);
@ -281,12 +282,9 @@ public:
/* Produce the enum_to_int and int_to_enum functions */
Printf(f_enumtypes_type,"type c_enum_type = [ \n `unknown\n" );
Printf(f_enumtypes_value,
"type c_enum_tag = [\n"
" `SWIGFake\n"
"| `int of int\n" );
Printf(f_enumtypes_type,"open Swig\n"
"type c_enum_type = [ \n `unknown\n" );
Printf(f_enumtypes_value,"type c_enum_value = [ \n `Int of int\n" );
String *mlfile = NewString("");
String *mlifile = NewString("");
@ -328,7 +326,8 @@ public:
"let _ = f_init ()\n",
module, module );
Printf( f_enumtypes_type, "]\n" );
Printf( f_enumtypes_value, "]\n" );
Printf( f_enumtypes_value, "]\n\n"
"type c_obj = c_enum_value c_obj_t\n" );
SwigType_emit_type_table (f_runtime, f_wrappers);
/* Close all of the files */
@ -462,8 +461,11 @@ public:
if (overname) {
Append(wname, overname);
}
/* Do this to disambiguate functions emitted from different modules */
Append(wname, module);
Setattr(n,"wrap:name",wname);
// Build the name for Scheme.
Printv(proc_name,"_",iname,NIL);
String *mangled_name = mangleNameForCaml(proc_name);
@ -731,7 +733,6 @@ public:
if( !Getattr(n,"sym:nextSibling") ) {
int maxargs;
Wrapper *df = NewWrapper();
String *dname = Swig_name_wrapper(iname);
String *dispatch =
Swig_overload_dispatch(n,
"free(argv);\n"
@ -740,9 +741,15 @@ public:
Wrapper_add_local(df, "_v", "int _v = 0");
Wrapper_add_local(df, "argv", "CAML_VALUE *argv");
/* Undifferentiate name .. this is the dispatch function */
wname = Swig_name_wrapper(iname);
/* Do this to disambiguate functions emitted from different
* modules */
Append(wname, module);
Printv(df->def,
"SWIGEXT CAML_VALUE ",dname,"(CAML_VALUE args) {\n"
"SWIGEXT CAML_VALUE ",wname,"(CAML_VALUE args) {\n"
" CAMLparam1(args);\n"
" int i;\n"
" int argc = caml_list_length(args);\n",NIL);
@ -756,34 +763,25 @@ public:
Printv(df->code,"}\n",NIL);
Wrapper_print(df,f_wrappers);
Printf(f_mlbody,
"external %s_f : c_obj list -> c_obj list = \"%s\" ;;\n"
"let %s = fnhelper %s %s_f\n",
mangled_name, dname, mangled_name,
newobj ? "true" : "false",
mangled_name );
if( !classmode || in_constructor || in_destructor ||
static_member_function )
Printf(f_mlibody,
"(* overload *)\n"
"val %s : c_obj -> c_obj\n", mangled_name );
DelWrapper(df);
Delete(dispatch);
Delete(dname);
}
} else {
Printf(f_mlbody,
"external %s_f : c_obj list -> c_obj list = \"%s\" ;;\n"
"let %s = fnhelper %s %s_f\n",
mangled_name, wname, mangled_name, newobj ? "true" : "false",
mangled_name );
if( !classmode || in_constructor || in_destructor ||
static_member_function )
Printf(f_mlibody,
"(* Non-overload *)\n"
"val %s : c_obj -> c_obj\n", mangled_name );
}
Printf(f_mlbody,
"external %s_f : c_obj list -> c_obj list = \"%s\" ;;\n"
"let %s arg = match %s_f (fnhelper arg) with\n"
" [] -> C_void\n"
"| [x] -> (if %s then Gc.finalise \n"
" (fun x -> ignore ((invoke x) \"~\" C_void)) x) ; x\n"
"| lst -> C_list lst ;;\n",
mangled_name, wname,
mangled_name, mangled_name, newobj ? "true" : "false");
if( !classmode || in_constructor || in_destructor ||
static_member_function )
Printf(f_mlibody,
"val %s : c_obj -> c_obj\n", mangled_name );
Delete(proc_name);
Delete(source);
@ -896,16 +894,15 @@ public:
if( Getattr( n, "feature:immutable" ) ) {
Printf( f_mlbody,
"external __%s : c_obj -> c_obj = \"%s\" \n"
"let _%s = __%s C_void\n",
mname, var_name, mname, mname );
Printf( f_mlibody, "val _%s : c_obj\n", iname );
"external _%s : c_obj -> c_obj = \"%s\" \n",
mname, var_name );
Printf( f_mlibody, "val _%s : c_obj -> c_obj\n", iname );
if( const_enum ) {
Printf( f_enum_to_int,
" | `%s -> _%s\n",
" | `%s -> _%s C_void\n",
mname, mname );
Printf( f_int_to_enum,
" if y = (get_int _%s) then `%s else\n",
" if y = (get_int (_%s C_void)) then `%s else\n",
mname, mname );
}
} else {
@ -1194,13 +1191,14 @@ public:
Iterator b;
b = First(baselist);
while (b.item) {
String *bname = Getattr(b.item, "ocaml:ctor");
String *bname = Getattr(b.item, "name");
if (bname) {
String *base_create = NewString("");
Printv(base_create,"(Swig.create_class \"",bname,"\")",NIL);
Printv(f_class_ctors,
" \"::",bname,"\", (fun args -> "
"create_",bname,"_from_ptr raw_ptr) ;\n",NIL);
Printv( base_classes, "create_", bname, "_from_ptr ;\n",
NIL );
" \"::",bname,"\", (fun args -> ",
base_create," args) ;\n",NIL);
Printv( base_classes, base_create, " ;\n", NIL );
}
b = Next(b);
}
@ -1390,7 +1388,7 @@ public:
if( oname && !seen_enum ) {
const_enum = true;
Printf( f_enum_to_int, "| `%s -> (match (y : c_enum_tag) with\n", oname );
Printf( f_enum_to_int, "| `%s -> (match (Obj.magic y) with\n", oname );
Printf( f_int_to_enum, "| `%s -> C_enum (\n", oname );
/* * * * A note about enum name resolution * * * *
* This code should now work, but I think we can do a bit better.
@ -1421,10 +1419,10 @@ public:
int ret = Language::enumDeclaration(n);
if( const_enum ) {
Printf( f_int_to_enum, "`int y)\n" );
Printf( f_int_to_enum, "`Int y)\n" );
Printf( f_enum_to_int,
"| `int (x : int) -> C_int x\n"
"| _ -> raise (Failure \"Unknown enum tag\"))\n" );
"| `Int x -> C_int x\n"
"| _ -> raise (LabelNotFromThisEnum v))\n" );
}
const_enum = false;