Deriv.i

   1 %module "Math::GSL::Deriv"
   2 // Danger Will Robinson, for realz!
   3 /*
   4 struct gsl_function_struct
   5 {
   6   double (* function) (double x, void * params);
   7   void * params;
   8 };
   9
  10 typedef struct gsl_function_struct gsl_function ;
  11 #define GSL_FN_EVAL(F,x) (*((F)->function))(x,(F)->params)
  12 */
  13
  14 %include "typemaps.i"
  15 //%include "gsl_typemaps.i"
  16 %{
  17     static HV * Callbacks = (HV*)NULL;
  18     typedef struct callback_t
  19     {
  20         SV * obj;
  21     };
  22     double xsquared(double x,void *params){
  23         fprintf(stderr,"static xsquared!!\n");
  24         return x * x;
  25     }
  26 %}
  27 %apply double * OUTPUT { double *abserr, double *result };
  28 /*
  29 int gsl_deriv_central (const gsl_function *f,
  30                        double x, double h,
  31                        double *result, double *abserr);
  32 */
  33 /*
  34 %typemap(in) (const gsl_function *f,
  35                        double x, double h,
  36                        double *result, double *abserr ) {
  37     fprintf(stderr,"XXXX\n");
  38 }
  39 */
  40 %typemap(in) gsl_function const * {
  41     fprintf(stderr,"typemap in!\n");
  42     gsl_function F;
  43     int count;
  44     F.params = 0;
  45     F.function = &xsquared;
  46     SV * callback;
  47
  48     if (!SvROK($input)) {
  49         croak("Math::GSL : not a reference value!");
  50     }
  51     if (Callbacks == (HV*)NULL)
  52         Callbacks = newHV();
  53     fprintf(stderr,"input =%d\n", (int)$input);
  54     hv_store( Callbacks, (char*)&$input, sizeof($input), newSVsv($input), 0 );
  55
  56     //Perl_sv_dump( $input );
  57     //call_sv((SV*)$input, G_SCALAR);
  58     // how to register callback ?
  59     $1 = &F;
  60 };
  61 %typemap(argout) gsl_function const * {
  62     fprintf(stderr,"typemap argout!\n");
  63     SV ** sv;
  64     double x;
  65
  66     sv = hv_fetch(Callbacks, (char*)&$input, sizeof($input), FALSE );
  67     if (sv == (SV**)NULL)
  68         croak("Math::GSL : Missing callback!\n");
  69     dSP;
  70     ENTER;
  71     SAVETMPS;
  72
  73     PUSHMARK(SP);
  74     // these are the arguments passed to the callback
  75     // this is currently passing in the memory address of the callback
  76     XPUSHs(sv_2mortal(newSViv((int)$input)));
  77     //XPUSHs(sv_2mortal($input));
  78     //XPUSHs(newSVsv($input));
  79     //XPUSHs(sv_2mortal(newSViv(42)));
  80     //XPUSHs(sv_2mortal(newSVnv((double) (*($input)->function)()    )));
  81     PUTBACK;
  82
  83     fprintf(stderr, "\nCALLBACK!\n");
  84
  85     /* This actually calls the perl subroutine */
  86     call_sv(*sv, G_SCALAR);
  87
  88     //x = POPn;
  89     //$result =  &x;
  90     //fprintf(stderr, "argout:x = %.8f\n", x);
  91     if (argvi >= items) {
  92         EXTEND(SP,1);
  93     }
  94     argvi++;
  95     //XPUSHs(sv_2mortal(newSVnv(x)));
  96
  97     FREETMPS;
  98     LEAVE;
  99 }
 100
 101 %typemap(in) void * {
 102     $1 = (double *) $input;
 103 };
 104 %{
 105     #include "gsl/gsl_math.h"
 106     #include "gsl/gsl_deriv.h"
 107 %}
 108
 109 %include "gsl/gsl_math.h"
 110 %include "gsl/gsl_deriv.h"
 111
 112 %perlcode %{
 113 @EXPORT_OK = qw/
 114                gsl_deriv_central
 115                gsl_deriv_backward
 116                gsl_deriv_forward
 117              /;
 118 %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
 119
 120 __END__
 121
 122 =head1 NAME
 123
 124 Math::GSL::Deriv - Functions to compute numerical derivatives by finite differencing
 125
 126 =head1 SYNOPSIS
 127
 128 This module is not yet implemented. Patches Welcome!
 129
 130 use Math::GSL::Deriv qw /:all/;
 131
 132 =head1 DESCRIPTION
 133
 134 Here is a list of all the functions in this module :
 135
 136 =over
 137
 138 =item * C<gsl_deriv_central>
 139
 140 =item * C<gsl_deriv_backward>
 141
 142 =item * C<gsl_deriv_forward>
 143
 144 =back
 145
 146 For more informations on the functions, we refer you to the GSL offcial
 147 documentation: L<http://www.gnu.org/software/gsl/manual/html_node/>
 148
 149 Tip : search on google: site:http://www.gnu.org/software/gsl/manual/html_node/ name_of_the_function_you_want
 150
 151
 152 =head1 AUTHORS
 153
 154 Jonathan Leto <jonathan@leto.net> and Thierry Moisan <thierry.moisan@gmail.com>
 155
 156 =head1 COPYRIGHT AND LICENSE
 157
 158 Copyright (C) 2008 Jonathan Leto and Thierry Moisan
 159
 160 This program is free software; you can redistribute it and/or modify it
 161 under the same terms as Perl itself.
 162
 163 =cut
 164
 165 %}
 166