/* -*- mode: C; mode: fold; -*- */
/* This file was automatically generated. */

<COPYRIGHT>

/* Author: John E. Davis (jed@jedsoft.org) */

#include <stdio.h>
#include <slang.h>

#include <gsl/gsl_errno.h>
#include <gsl/gsl_version.h>

<MODULE_INCLUDES>

#ifdef __cplusplus
extern "C"
{
#endif
/* SLANG_MODULE(<MODULE_NAME>); */
#ifdef __cplusplus
}
#endif

#include "slgsl.h"
#include "version.h"

<MODULE_DEFINES>

#ifdef MODULE_HAS_INTRINSICS
/*{{{ Helper Functions */

#ifdef _GSLSF_MODULE_C_
static gsl_mode_t Default_GSL_Mode = GSL_PREC_SINGLE;

static int get_gsl_precision (void)
{
   return (int) Default_GSL_Mode;
}
static void set_gsl_precision (int *pp)
{
   int p = *pp;

   if ((p == GSL_PREC_SINGLE) || (p == GSL_PREC_DOUBLE) || (p == GSL_PREC_APPROX))
     Default_GSL_Mode = p;
}

static int get_gsl_mode (gsl_mode_t *mp, int from_stack)
{
   if (from_stack)
     {
	int mode;
	if (-1 == SLang_pop_integer (&mode))
	  return -1;
	*mp = (gsl_mode_t) mode;
     }

   *mp = Default_GSL_Mode;
   return 0;
}

static void do_d_dm (double (*f)(double, gsl_mode_t), gsl_mode_t m)
{
   SLGSL_Double_Array_Type a;
   SLang_Array_Type *in, *out;
   unsigned int i, n;
   double *xp, *yp;

   if (-1 == slgsl_pop_d_array (&a, 0))
     return;

   if (NULL == (in = a.at))
     {
	(void) SLang_push_double ((*f)(a.x, m));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, in->dims, in->num_dims)))
     {
	SLang_free_array (in);
	return;
     }

   n = in->num_elements;
   xp = a.xp;
   yp = (double *) out->data;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(xp[i], m);

   (void) SLang_push_array (out, 1);
   SLang_free_array (in);
}

static void do_d_ddm (double (*f)(double, double, gsl_mode_t), gsl_mode_t m)
{
   SLGSL_Double_Array_Type a, b;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *xp, *yp, *zp;
   unsigned int xinc, yinc;

   if (-1 == slgsl_pop_dd_array (&a, &b, 0))
     return;

   if ((NULL == (atz = a.at))
       && (NULL == (atz = b.at)))
     {
	(void) SLang_push_double ((*f)(a.x, b.x, m));
	return;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   xp = a.xp;
   yp = b.xp;
   xinc = a.inc;
   yinc = b.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*xp, *yp, m);
	xp += xinc;
	yp += yinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
}

static void do_d_dddm (double (*f)(double, double, double, gsl_mode_t), gsl_mode_t m)
{
   SLGSL_Double_Array_Type a, b, c;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *ap, *bp, *cp, *zp;
   unsigned int ainc, binc, cinc;

   if (-1 == slgsl_pop_ddd_array (&a, &b, &c, 0))
     return;

   if ((NULL == (atz = a.at))
       && (NULL == (atz = b.at))
       && (NULL == (atz = c.at)))
     {
	(void) SLang_push_double ((*f)(a.x, b.x, c.x, m));
	return;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	SLang_free_array (c.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   ap = a.xp;
   bp = b.xp;
   cp = c.xp;
   ainc = a.inc;
   binc = b.inc;
   cinc = c.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*ap, *bp, *cp, m);
	ap += ainc;
	bp += binc;
	cp += cinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
   SLang_free_array (c.at);
}

static void do_d_ddddm (double (*f)(double, double, double, double, gsl_mode_t),
			gsl_mode_t m)
{
   SLGSL_Double_Array_Type a, b, c, d;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *ap, *bp, *cp, *dp, *zp;
   unsigned int ainc, binc, cinc, dinc;

   if (-1 == slgsl_pop_dddd_array (&a, &b, &c, &d, 0))
     return;

   if ((NULL == (atz = a.at))
       && (NULL == (atz = b.at))
       && (NULL == (atz = c.at))
       && (NULL == (atz = d.at)))
     {
	(void) SLang_push_double ((*f)(a.x, b.x, c.x, d.x, m));
	return;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	SLang_free_array (c.at);
	SLang_free_array (d.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   ap = a.xp;
   bp = b.xp;
   cp = c.xp;
   dp = d.xp;
   ainc = a.inc;
   binc = b.inc;
   cinc = c.inc;
   dinc = d.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*ap, *bp, *cp, *dp, m);
	ap += ainc;
	bp += binc;
	cp += cinc;
	dp += dinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
   SLang_free_array (c.at);
   SLang_free_array (d.at);
}

static void do_d_dm_fun (const char *fun, double (*f)(double, gsl_mode_t))
{
   gsl_mode_t m;

   if (SLang_Num_Function_Args < 1)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(double[,mode])", fun);
	return;
     }
   if (-1 == get_gsl_mode (&m, SLang_Num_Function_Args-1))
     return;

   slgsl_reset_errors ();
   do_d_dm (f,m);
   slgsl_check_errors (fun);
}

static void do_d_ddm_fun (const char *fun, double (*f)(double, double, gsl_mode_t))
{
   gsl_mode_t m;
   if (SLang_Num_Function_Args < 2)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(double, double [,mode])", fun);
	return;
     }
   if (-1 == get_gsl_mode (&m, SLang_Num_Function_Args-2))
     return;
   slgsl_reset_errors ();
   do_d_ddm (f,m);
   slgsl_check_errors (fun);
}

static void do_d_dddm_fun (const char *fun, double (*f)(double, double, double, gsl_mode_t))
{
   gsl_mode_t m;
   if (SLang_Num_Function_Args < 3)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(double, double, double[,mode])", fun);
	return;
     }
   if (-1 == get_gsl_mode (&m, SLang_Num_Function_Args-3))
     return;
   slgsl_reset_errors ();
   do_d_dddm (f,m);
   slgsl_check_errors (fun);
}

static void do_d_ddddm_fun (const char *fun, double (*f)(double,double,double,double,gsl_mode_t))
{
   gsl_mode_t m;

   if (SLang_Num_Function_Args < 4)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(double, double, double, double [,mode])", fun);
	return;
     }
   if (-1 == get_gsl_mode (&m, SLang_Num_Function_Args-4))
     return;
   slgsl_reset_errors ();
   do_d_ddddm (f,m);
   slgsl_check_errors (fun);
}

static void do_c_c_fun (const char *fun, int (*f)(double, double, gsl_sf_result*, gsl_sf_result*))
{
   SLGSL_Complex_Array_Type a;
   SLang_Array_Type *in, *out;
   unsigned int i, n;
   gsl_sf_result gsl_zr, gsl_zi;
   double *xp, *yp;

   if (SLang_Num_Function_Args < 1)
     {
        SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(complex)", fun);
        return;
     }

   if (-1 == slgsl_pop_c_array (&a, 0))
     return;

   if (NULL == (in = a.at))
     {
        (void) (*f)(a.x[0], a.x[1], &gsl_zr, &gsl_zi);
        (void) SLang_push_complex (gsl_zr.val, gsl_zi.val);
        return;
     }

   if (NULL == (out = SLang_create_array (SLANG_COMPLEX_TYPE, 0, NULL, in->dims, in->num_dims)))
     {
        SLang_free_array (in);
        return;
     }

   n = in->num_elements;
   xp = a.xp;
   yp = (double *) out->data;
   for (i = 0; i < 2*n; i+=2)
     {
        (void) (*f)(xp[i], xp[i+1], &gsl_zr, &gsl_zi);
        yp[i] = gsl_zr.val;
        yp[i+1] = gsl_zi.val;
     }

   (void) SLang_push_array (out, 1);
   SLang_free_array (in);
}


#endif				       /* _GSLSF_MODULE_C_ */

/* Macros to aid in wrapping the functions */
#define SLF(f) f##_intrin

#define D_FD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_d_fun (n,f); }
#define D_FDD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_dd_fun (n,f); }
#define D_FDDD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_ddd_fun (n,f); }
#define D_FDDDD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_dddd_fun (n,f); }
#define D_FDM(f,n) \
     static void SLF(f) (void) { do_d_dm_fun (n,f); }
#define D_FDDM(f,n) \
     static void SLF(f) (void) { do_d_ddm_fun (n,f); }
#define D_FDDDM(f,n) \
     static void SLF(f) (void) { do_d_dddm_fun (n,f); }
#define D_FDDDDM(f,n) \
     static void SLF(f) (void) { do_d_ddddm_fun (n,f); }
#define D_FI(f,n) \
     static void SLF(f) (void) { slgsl_do_d_i_fun (n,f); }
#define D_FID(f,n) \
     static void SLF(f) (void) { slgsl_do_d_id_fun (n,f); }
#define D_FIDD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_idd_fun (n,f); }
#define D_FIID(f,n) \
     static void SLF(f) (void) { slgsl_do_d_iid_fun (n,f); }
#define D_FIIDD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_iidd_fun (n,f); }
#define I_FD(f,n) \
     static void SLF(f) (void) { slgsl_do_i_d_fun (n,f); }
/* Complex wrappers */
#define C_FC(f,n) \
     static void SLF(f) (void) { do_c_c_fun (n,f); }

/*}}}*/

<INTRINSIC_DEFINITIONS>

#define V SLANG_VOID_TYPE
static SLang_Intrin_Fun_Type Module_Intrinsics [] =
{
<MODULE_INTRINSICS>
#ifdef _GSLSF_MODULE_C_
   MAKE_INTRINSIC_0("gslsf_get_precision", get_gsl_precision, SLANG_INT_TYPE),
   MAKE_INTRINSIC_I("gslsf_set_precision", set_gsl_precision, SLANG_VOID_TYPE),
#endif
   SLANG_END_INTRIN_FUN_TABLE
};
#undef V
#endif				       /* MODULE_HAS_INTRINSICS */

static SLang_Intrin_Var_Type Module_Variables [] =
{
<MODULE_VARIABLES>
   MAKE_VARIABLE("_<MODULE_NAME>_module_version_string", &Module_Version_String, SLANG_STRING_TYPE, 1),
   MAKE_VARIABLE("GSL_VERSION", &gsl_version, SLANG_STRING_TYPE, 1),
   SLANG_END_INTRIN_VAR_TABLE
};

static SLang_IConstant_Type Module_IConstants [] =
{
<MODULE_ICONSTANTS>
   MAKE_ICONSTANT("_<MODULE_NAME>_module_version", MODULE_VERSION_NUMBER),
#ifdef _GSLSF_MODULE_C_
   MAKE_ICONSTANT("GSL_PREC_SINGLE", GSL_PREC_SINGLE),
   MAKE_ICONSTANT("GSL_PREC_DOUBLE", GSL_PREC_DOUBLE),
   MAKE_ICONSTANT("GSL_PREC_APPROX", GSL_PREC_APPROX),
#endif
   SLANG_END_ICONST_TABLE
};

#ifdef MODULE_HAS_DCONSTANTS
static SLang_DConstant_Type Module_DConstants [] =
{
<MODULE_DCONSTANTS>
   SLANG_END_DCONST_TABLE
};
#endif

int init_<MODULE_NAME>_module_ns (char *ns_name)
{
   SLang_NameSpace_Type *ns = SLns_create_namespace (ns_name);
   if (ns == NULL)
     return -1;

   if (
       (-1 == SLns_add_intrin_var_table (ns, Module_Variables, NULL))
#ifdef MODULE_HAS_INTRINSICS
       || (-1 == SLns_add_intrin_fun_table (ns, Module_Intrinsics, NULL))
#endif
       || (-1 == SLns_add_iconstant_table (ns, Module_IConstants, NULL))
#ifdef MODULE_HAS_DCONSTANTS
       || (-1 == SLns_add_dconstant_table (ns, Module_DConstants, NULL))
#endif
       )
     return -1;

   return 0;
}

/* This function is optional */
void deinit_<MODULE_NAME>_module (void)
{
}
