chiark / gitweb /
Guile wrapper seems mostly functional, sans exceptions (needed wrapper around opt...
authorstevenj <stevenj@alum.mit.edu>
Thu, 3 Jun 2010 02:58:24 +0000 (22:58 -0400)
committerstevenj <stevenj@alum.mit.edu>
Thu, 3 Jun 2010 02:58:24 +0000 (22:58 -0400)
darcs-hash:20100603025824-c8de0-bfd2efa65d9993029b48081e35b7fb28fb331a22.gz

swig/Makefile.am
swig/nlopt-guile.i

index deeaf5740e31e08f33c750bc282d4288dfe0b0c8..53036a1179c5e3e549b4ba23cacd0f3f596211aa 100644 (file)
@@ -8,6 +8,7 @@ HDR = $(top_builddir)/api/nlopt.hpp
 # Guile wrapper
 
 libnlopt@NLOPT_SUFFIX@_guile_la_SOURCES = nlopt-guile.cpp
+libnlopt@NLOPT_SUFFIX@_guile_la_LIBADD = ../libnlopt@NLOPT_SUFFIX@.la
 libnlopt@NLOPT_SUFFIX@_guile_la_LDFLAGS = -version-info @SHARED_VERSION_INFO@
 libnlopt@NLOPT_SUFFIX@_guile_la_CPPFLAGS = $(GUILE_CPPFLAGS) -I$(top_builddir)/api
 
index faf23f82d72965f5be4c3153bea1c80afc29fdcb..4e6ea022a47b558b3226bcd0fff3075a56b22ae9 100644 (file)
@@ -1,6 +1,7 @@
 // -*- C++ -*-
 
 %{
+// vfunc wrapper around Guile function (val . grad) = f(x)
 static double vfunc_guile(const std::vector<double> &x,
                           std::vector<double> &grad, void *f) {
   SCM xscm = scm_c_make_vector(x.size(), SCM_UNSPECIFIED);
@@ -25,17 +26,37 @@ static double vfunc_guile(const std::vector<double> &x,
   }
   throw std::invalid_argument("invalid result passed to nlopt");
 }
+
+extern SCM nlopt_do_optimize(nlopt::opt &opt, const std::vector<double> &x);
+
+// wrapper around opt::optimize that returns a triplet (result . (x . optf))
+SCM nlopt_do_optimize(nlopt::opt &opt, const std::vector<double> &x0)
+{
+  std::vector<double> x(x0);
+  double optf;
+  nlopt::result res = opt.optimize(x, optf);
+  SCM xscm = scm_c_make_vector(x.size(), SCM_UNSPECIFIED);
+  for (unsigned i = 0; i < x.size(); ++i)
+    scm_c_vector_set_x(xscm, i, scm_make_real(x[i]));
+  return scm_cons(scm_from_int(int(res)),
+                 scm_cons(xscm, scm_make_real(optf)));
+}
+
 %}
 
+extern SCM nlopt_do_optimize(nlopt::opt &opt, const std::vector<double> &x);
+
 %typemap(in)(nlopt::vfunc vf, void *f_data) {
   $1 = vfunc_guile;
   $2 = (void*) $input; // input is SCM pointer to Scheme function
 }
+%typecheck(SWIG_TYPECHECK_POINTER)(nlopt::vfunc vf, void *f_data) {
+  $1 = SCM_NFALSEP(scm_procedure_p($input));
+}
 
 // export constants as variables, rather than as functions returning the value
 %feature("constasvar", "1");
 
 %scheme %{ 
-(dynamic-link "libnlopt@NLOPT_SUFFIX@.so")
 (load-extension "libnlopt@NLOPT_SUFFIX@_guile.so" "SWIG_init")
 %}