Working example. See Examples/ocaml/shapes.

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

7 files changed, 99 insertions, 32 deletions

diff --git a/Examples/Makefile.in b/Examples/Makefile.in
index 5c1c52a8c..8041e4372 100644
--- a/Examples/Makefile.in
+++ b/Examples/Makefile.in
@@ -510,6 +510,7 @@ mzscheme_clean:
 OCC=@OCAMLC@
 OCAMLDLGEN=@OCAMLDLGEN@
 OCAMLFIND=@OCAMLFIND@
+OCAMLMKTOP=@OCAMLMKTOP@
 NOLINK ?= false
 
 ocaml_static: $(SRCS)
@@ -541,6 +542,18 @@ ocaml_dynamic: $(SRCS)
 		-package dl -linkpkg \
 		$(INTERFACE:%.i=%.cmo) $(PROGFILE:%.ml=%.cmo)
 
+ocaml_static_toplevel: $(SRCS)
+	$(SWIG) -ocaml $(SWIGOPT) $(INTERFACE)
+	$(OCC) -g -c -ccopt -g -ccopt "$(INCLUDES)" $(ISRCS) $(SRCS)
+	$(OCC) -g -c $(INTERFACE:%.i=%.mli)
+	$(OCC) -g -c $(INTERFACE:%.i=%.ml)
+	test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \
+		$(OCC) -c $(PROGFILE)
+	$(NOLINK) || $(OCAMLMKTOP) \
+		-g -ccopt -g -cclib -g -custom -o $(TARGET)_top \
+		$(INTERFACE:%.i=%.cmo) \
+		$(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) -cclib "$(LIBS)"
+
 ocaml_static_cpp: $(SRCS)
 	$(SWIG) -ocaml -c++ $(SWIGOPT) $(INTERFACE)
 	cp $(ICXXSRCS) $(ICXXSRCS:%.cxx=%.c)
@@ -556,6 +569,21 @@ ocaml_static_cpp: $(SRCS)
 		$(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) \
 		-cclib "$(LIBS)" -cc '$(CXX)' 
 
+ocaml_static_cpp_toplevel: $(SRCS)
+	$(SWIG) -ocaml -c++ $(SWIGOPT) $(INTERFACE)
+	cp $(ICXXSRCS) $(ICXXSRCS:%.cxx=%.c)
+	$(OCC) -cc '$(CXX)' -g -c -ccopt -g -ccopt "-xc++ $(INCLUDES)" \
+		$(ICXXSRCS:%.cxx=%.c) $(SRCS) $(CXXSRCS)
+	$(OCC) -g -c $(INTERFACE:%.i=%.mli)
+	$(OCC) -g -c $(INTERFACE:%.i=%.ml)
+	test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \
+		$(OCC) -c $(PROGFILE)
+	$(NOLINK) || $(OCAMLMKTOP) \
+		-g -ccopt -g -cclib -g -custom -o $(TARGET)_top \
+		$(INTERFACE:%.i=%.cmo) \
+		$(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) \
+		-cclib "$(LIBS)" -cc '$(CXX)' 
+
 ocaml_dynamic_cpp: $(SRCS)
 	$(SWIG) -ocaml -c++ $(SWIGOPT) $(INTERFACE)
 	cp $(ICXXSRCS) $(ICXXSRCS:%.cxx=%.c)
diff --git a/Lib/ocaml/director.swg b/Lib/ocaml/director.swg
index ca190a25f..0f7e51569 100644
--- a/Lib/ocaml/director.swg
+++ b/Lib/ocaml/director.swg
@@ -91,10 +91,12 @@ public:
     
     /* wrap a ocaml object, optionally taking ownership */
     __DIRECTOR__(value self, int disown): _self(self), _disown(disown) {
+	register_global_root(&_self);
     }
     
     /* discard our reference at destruction */
     virtual ~__DIRECTOR__() {
+	remove_global_root(&_self);
 	__disown(); 
         // Disown is safe here because we're just divorcing a reference that
 	// points to us.  
@@ -102,7 +104,7 @@ public:
     
     /* return a pointer to the wrapped ocaml object */
     value __get_self() const { 
-	return _self; 
+	return callback(*caml_named_value("caml_director_get_self"),_self); 
     }
 
     /* get the _up flag to determine if the method call should be routed
@@ -188,7 +190,7 @@ let new_derived_object cfun x_class args =
     let obj =
     cfun (match args with
                 C_list argl ->
-	  (C_list ((C_obj new_class) :: argl))
+	  (C_list ((C_director_core (C_obj new_class,ob_ref)) :: argl))
 	  | a -> (C_list [ C_director_core 
 			   (C_obj new_class,ob_ref)  ; a ])) in
     ob_ref := Some obj ;
diff --git a/Lib/ocaml/mlheading.swg b/Lib/ocaml/mlheading.swg
index 791aed716..74f486e1c 100644
--- a/Lib/ocaml/mlheading.swg
+++ b/Lib/ocaml/mlheading.swg
@@ -94,7 +94,8 @@ let disown_object obj =
 let _ = Callback.register "caml_obj_disown" disown_object
 let director_get_self obj = 
   match obj with
-      C_director_core (self,r) -> self
+      C_obj o -> obj
+    | C_director_core (self,r) -> self
     | _ -> raise (Failure "Not a director core object")
 let _ = Callback.register "caml_director_get_self" director_get_self
       
diff --git a/Lib/ocaml/ocaml.i b/Lib/ocaml/ocaml.i
index 8e72c73e1..491da959a 100644
--- a/Lib/ocaml/ocaml.i
+++ b/Lib/ocaml/ocaml.i
@@ -29,3 +29,4 @@
 %include "typemaps.i"
 %include "typecheck.i"
 %include "exception.i"
+%include "director.swg"
diff --git a/Lib/ocaml/typemaps.i b/Lib/ocaml/typemaps.i
index d7e43b2bd..9b620b2c1 100644
--- a/Lib/ocaml/typemaps.i
+++ b/Lib/ocaml/typemaps.i
@@ -190,9 +190,15 @@
     temp = ($*1_ltype) MZ_TO_C($input);
     $1 = &temp;
 }
+%typemap(outv) C_NAME {
+    $1 = MZ_TO_C($input);
+}
 %typemap(argout) C_NAME & {
     swig_result = caml_list_append(swig_result,C_TO_MZ((long)*$1));
 }
+%typemap(inv) C_NAME {
+    args = caml_list_append(args,C_TO_MZ($1_name));
+}
 %enddef
 
 SIMPLE_MAP(bool, caml_val_bool, caml_long_val);
diff --git a/Source/Modules/ocaml.cxx b/Source/Modules/ocaml.cxx
index 5bf60254b..ba7123854 100755
--- a/Source/Modules/ocaml.cxx
+++ b/Source/Modules/ocaml.cxx
@@ -330,7 +330,6 @@ public:
     // Add a symbol for this module
     
     Preprocessor_define ("SWIGOCAML 1",0);
-    
     // Set name of typemaps
     
     SWIG_typemap_lang("ocaml");
@@ -367,6 +366,26 @@ public:
     /* Set comparison with none for ConstructorToFunction */
     SetNoneComparison( NewString( "$arg != Val_unit" ) );
 
+    /* check if directors are enabled for this module.  note: this 
+     * is a "master" switch, without which no director code will be
+     * emitted.  %feature("director") statements are also required
+     * to enable directors for individual classes or methods.
+     *
+     * use %module(directors="1") modulename at the start of the 
+     * interface file to enable director generation.
+     */
+    {
+      Node *module = Getattr(n, "module");
+      if (module) {
+        Node *options = Getattr(module, "options");
+        if (options) {
+          if (Getattr(options, "directors")) {
+            allow_directors();
+          }
+        }
+      }
+    }
+
     /* Initialize all of the output files */
     String *outfile = Getattr(n,"outfile");
     
@@ -670,12 +689,12 @@ public:
     
     // adds local variables
     Wrapper_add_local(f, "args", "CAMLparam1(args)");
-    Wrapper_add_local(f, "ret", "CAMLlocal2(swig_result,rv)");
+    Wrapper_add_local(f, "ret" , "CAMLlocal2(swig_result,rv)");
     Wrapper_add_local(f, "_len", "int _len");
     Wrapper_add_local(f, "lenv", "int lenv = 1");
     Wrapper_add_local(f, "argc", "int argc = caml_list_length(args)");
     Wrapper_add_local(f, "argv", "value *argv");
-    Wrapper_add_local(f, "i", "int i");
+    Wrapper_add_local(f, "i"   , "int i");
 
     Printv( f->code,
 	    "argv = (value *)malloc( argc * sizeof( value ) );\n"
@@ -818,7 +837,7 @@ public:
     // Now have return value, figure out what to do with it.
     
     if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
-      Replaceall(tm,"$source","result");
+      Replaceall(tm,"$source","swig_result");
       Replaceall(tm,"$target","rv");
       Replaceall(tm,"$result","rv");
       Replaceall(tm,"$ntype",return_type_normalized);
@@ -837,7 +856,7 @@ public:
     
     if (Getattr(n,"feature:new")) {
       if ((tm = Swig_typemap_lookup_new("newfree",n,"result",0))) {
-	Replaceall(tm,"$source","result");
+	Replaceall(tm,"$source","swig_result");
 	Printv(f->code, tm, "\n",NIL);
       }
     }
@@ -1412,7 +1431,9 @@ public:
 
     w = NewWrapper();
     declaration = NewString("");
-    Wrapper_add_local(w,"swig_result","CAMLlocal2(swig_result,args)");
+    Wrapper_add_local(w,"swig_result",
+		      "CAMLparam0();\n"
+		      "CAMLlocal2(swig_result,args)");
 	
     /* determine if the method returns a pointer */
     decl = Getattr(n, "decl");
@@ -1461,7 +1482,7 @@ public:
     wrap_args = NewString("");
     int outputs = 0;
     if (!is_void) outputs++;
-	
+
     /* build argument list and type conversion string */
     for (i=0, idx=0, p = l; i < num_arguments; i++) {
 
@@ -1478,11 +1499,9 @@ public:
       if ((tm = Getattr(p, "tmap:inv")) != 0) {
 	String* parse = Getattr(p, "tmap:inv:parse");
 	if (!parse) {
-	  sprintf(source, "obj%d", idx++);
 	  Replaceall(tm, "$input", source);
 	  Replaceall(tm, "$owner", "0");
 	  Printv(wrap_args, tm, "\n", NIL);
-	  Wrapper_add_localv(w, source, "value", source, "= 0", NIL);
 	  Printv(arglist, source, NIL);
 	} else {
 	  Replaceall(tm, "$input", pname);
@@ -1570,9 +1589,13 @@ public:
     if (!is_void) {
       Wrapper_add_localv(w, "c_result", SwigType_lstr(return_type, "c_result"), NIL);
     }
+
+    Printv(w->code, "swig_result = Val_unit;\n",0);
+    Printf(w->code,"args = Val_unit;\n");
+
     /* direct call to superclass if _up is set */
     Printf(w->code, "if (__get_up()) {\n");
-    Printf(w->code,   "return %s;\n", Swig_method_call(super,l));
+    Printf(w->code,   "CAMLreturn(%s);\n", Swig_method_call(super,l));
     Printf(w->code, "}\n");
     
     /* check that we don't wrap a null... */
@@ -1582,10 +1605,15 @@ public:
     Printv(w->code, wrap_args, NIL);
 
     /* pass the method call on to the Python object */
+    Printv(w->code,
+	   "swig_result = caml_swig_alloc(1,C_list);\n"
+	   "Store_field(swig_result,0,args);\n"
+	   "args = swig_result;\n"
+	   "swig_result = Val_unit;\n",0);
     Printf(w->code, 
-	   "swig_result = caml_list_append(swig_result,"
-	   "callback3(*caml_named_value(\"swig_runmethod\"),"
-	   "__get_self(),copy_string(\"%s\"),args));\n",
+	   "swig_result = "
+	   "callback2(callback(*caml_named_value(\"swig_runmethod\"),"
+	   "__get_self()),copy_string(\"%s\"),args);\n",
 	   Getattr(n,"name"));
     /* exception handling */
 	   tm = Swig_typemap_lookup_new("director:except", n, "result", 0);
@@ -1625,20 +1653,15 @@ public:
 	 * occurs in Language::cDeclaration().
 	 */
       Setattr(n, "type", return_type);
-      tm = Swig_typemap_lookup_new("outv", n, "result", w);
+      tm = Swig_typemap_lookup_new("outv", n, "c_result", w);
       Setattr(n, "type", type);
       if (tm == 0) {
-        String *name = NewString("result");
+        String *name = NewString("c_result");
         tm = Swig_typemap_search("outv", return_type, name, NULL);
 	Delete(name);
       }
       if (tm != 0) {
-	if (outputs > 1) {
-	  Printf(w->code, "output = PyTuple_GetItem(result, %d);\n", idx++);
-	  Replaceall(tm, "$input", "output");
-	} else {
-	  Replaceall(tm, "$input", "result");
-	}
+	Replaceall(tm, "$input", "swig_result");
 	/* TODO check this */
 	if (Getattr(n,"wrap:disown")) {
 	  Replaceall(tm,"$disown","SWIG_POINTER_DISOWN");
@@ -1657,12 +1680,7 @@ public:
     /* marshal outputs */
     for (p = l; p; ) {
       if ((tm = Getattr(p, "tmap:argoutv")) != 0) {
-	if (outputs > 1) {
-	  Printf(w->code, "output = PyTuple_GetItem(result, %d);\n", idx++);
-	  Replaceall(tm, "$input", "output");
-	} else {
-	  Replaceall(tm, "$input", "result");
-	}
+	Replaceall(tm, "$input", "swig_result");
 	Replaceall(tm, "$result", Getattr(p, "name"));
 	Printv(w->code, tm, "\n", NIL);
 	p = Getattr(p, "tmap:argoutv:next");
@@ -1674,9 +1692,9 @@ public:
     /* any existing helper functions to handle this? */
     if (!is_void) {
       if (!SwigType_isreference(return_type)) {
-        Printf(w->code, "return c_result;\n");
+        Printf(w->code, "CAMLreturn(c_result);\n");
       } else {
-        Printf(w->code, "return *c_result;\n");
+        Printf(w->code, "CAMLreturn(*c_result);\n");
       }
     }
 
diff --git a/configure.in b/configure.in
index 9d3432f96..455d8979a 100644
--- a/configure.in
+++ b/configure.in
@@ -916,6 +916,7 @@ AC_ARG_WITH(ocaml,[  --with-ocaml=path	  Set location of ocaml executable],[ OCA
 AC_ARG_WITH(ocamlc,[  --with-ocamlc=path  Set location of ocamlc executable],[ OCAMLC="$withval"], [OCAMLC=])
 AC_ARG_WITH(ocamldlgen,[  --with-ocamldlgen=path  Set location of ocamldlgen],[ OCAMLDLGEN="$withval" ], [OCAMLDLGEN=])
 AC_ARG_WITH(ocamlfind,[  --with-ocamlfind=path  Set location of ocamlfind],[OCAMLFIND="$withval"],[OCAMLFIND=])
+AC_ARG_WITH(ocamlmktop,[  --with-ocamlmktop=path	  Set location of ocamlmktop executable],[ OCAMLMKTOP="$withval"], [OCAMLMKTOP=])
 
 AC_MSG_CHECKING(for Ocaml DL load generator)
 if test -z "$OCAMLDLGEN"; then
@@ -944,6 +945,14 @@ AC_CHECK_PROGS(OCAMLBIN, ocaml, ocaml)
 else
 OCAMLBIN="$OCAMLBIN"
 fi
+
+AC_MSG_CHECKING(for Ocaml toplevel creator)
+if test -z "$OCAMLMKTOP"; then
+AC_CHECK_PROGS(OCAMLMKTOP, ocamlmktop, ocamlmktop)
+else
+OCAMLMKTOP="$OCAMLMKTOP"
+fi
+
 AC_MSG_CHECKING(for Ocaml header files)
 dirs="/usr/lib/ocaml/caml /usr/local/lib/ocaml/caml"
 for i in $dirs; do
@@ -963,12 +972,14 @@ export OCAMLBIN
 export OCAMLC
 export OCAMLDLGEN
 export OCAMLFIND
+export OCAMLMKTOP
 
 AC_SUBST(OCAMLINC)
 AC_SUBST(OCAMLBIN)
 AC_SUBST(OCAMLC)
 AC_SUBST(OCAMLDLGEN)
 AC_SUBST(OCAMLFIND)
+AC_SUBST(OCAMLMKTOP)
 
 #----------------------------------------------------------------
 # Look for Pike