/* -*- mode: C; mode: fold; -*- */
/*
  Copyright (c) 2004, 2005 Massachusetts Institute of Technology

  This software was developed by the MIT Center for Space Research
  under contract SV1-61010 from the Smithsonian Institution.
  
  Permission to use, copy, modify, distribute, and sell this software
  and its documentation for any purpose is hereby granted without fee,
  provided that the above copyright notice appear in all copies and
  that both that copyright notice and this permission notice appear in
  the supporting documentation, and that the name of the Massachusetts
  Institute of Technology not be used in advertising or publicity
  pertaining to distribution of the software without specific, written
  prior permission.  The Massachusetts Institute of Technology makes
  no representations about the suitability of this software for any
  purpose.  It is provided "as is" without express or implied warranty.
  
  THE MASSACHUSETTS INSTITUTE OF TECHNOLOGY DISCLAIMS ALL WARRANTIES
  WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
  MERCHANTABILITY AND FITNESS.  IN NO EVENT SHALL THE MASSACHUSETTS
  INSTITUTE OF TECHNOLOGY BE LIABLE FOR ANY SPECIAL, INDIRECT OR
  CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
  OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
  NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
  WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*/

/* Author: John E. Davis (davis@space.mit.edu) */

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

#include <gsl/gsl_errno.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

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

#ifdef __cplusplus
extern "C" 
{
#endif
/* SLANG_MODULE(gslrand); */
#ifdef __cplusplus
}
#endif

#if SLANG_VERSION < 20000
# define POP_DOUBLE SLang_pop_double
#else
# define POP_DOUBLE(x,y,z) SLang_pop_double(x)
#endif
static int Rand_Type_Id = -1;

static const gsl_rng_type **Available_Generators;
static const gsl_rng_type **get_available_generators (void)
{
   if (Available_Generators == NULL)
     {
	Available_Generators = gsl_rng_types_setup ();
	
	if (Available_Generators == NULL)
	  {
	     SLang_verror (SL_INTRINSIC_ERROR, "No random number generators are available");
	     return NULL;
	  }
     }
   return Available_Generators;
}

static void rng_get_rng_types (void)
{
   SLang_Array_Type *at;
   const gsl_rng_type **list;
   int i, num;
   char **names;

   list = get_available_generators ();
   if (list == NULL)
     return;
   
   num = 0;
   while (list[num] != NULL)
     num++;
   
   if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 1, NULL, &num, 1)))
     return;

   names = (char **) at->data;
   for (i = 0; i < num; i++)
     {
	char *name = (char *) list[i]->name;
	if (name == NULL)
	  name = "";

	if (NULL == (names[i] = SLang_create_slstring (name)))
	  {
	     SLang_free_array (at);
	     return;
	  }
     }
   (void) SLang_push_array (at, 1);
}

typedef struct
{
   const gsl_rng_type *gen_type;
   const gsl_rng *gen;
}
Rand_Type;

static void free_rand_type (Rand_Type *r)
{
   if (r == NULL)
     return;
   
   if (r->gen != NULL)
     gsl_rng_free ((gsl_rng *) r->gen);
   
   SLfree ((char *)r);
}
	
static Rand_Type *alloc_rand_type (char *name)
{
   const gsl_rng_type **types, *g;
   Rand_Type *r;

   types = get_available_generators ();
   if (types == NULL)
     return NULL;

   if (name == NULL)
     g = gsl_rng_default;
   else while (1)
     {
	g = *types++;
	if (g == NULL)
	  {
	     SLang_verror (SL_NOT_IMPLEMENTED, "Random number generator %s is not supported.  Check spelling\n", name);
	     return NULL;
	  }
	if (0 == strcmp (name, g->name))
	  break;
     }
   
   if (NULL == (r = (Rand_Type *)SLmalloc (sizeof (Rand_Type))))
     return NULL;
   memset ((char *) r, 0, sizeof (Rand_Type));
   
   r->gen_type = g;
   if (NULL == (r->gen = gsl_rng_alloc (g)))
     {
	free_rand_type (r);
	return NULL;
     }
   
   return r;
}

static Rand_Type *Default_Generator;
static Rand_Type *get_default_generator (void)
{
   if (Default_Generator == NULL)
     Default_Generator = alloc_rand_type (NULL);

   return Default_Generator;
}

/* intrinsics here */
static void set_default_generator (char *name)
{
   if (Default_Generator != NULL)
     free_rand_type (Default_Generator);
   Default_Generator = alloc_rand_type (name);
}

static Rand_Type *pop_rand_type (SLang_MMT_Type **mmtp)
{
   SLang_MMT_Type *mmt;
   Rand_Type *r;

   if (NULL == (mmt = SLang_pop_mmt (Rand_Type_Id)))
     {
	*mmtp = NULL;
	return NULL;
     }

   if (NULL == (r = (Rand_Type *) SLang_object_from_mmt (mmt)))
     {
	SLang_free_mmt (mmt);
	*mmtp = NULL;
	return NULL;
     }
   *mmtp = mmt;
   return r;
}

static int pop_n_doubles (int n, double *d)
{
   double *dmax = d + n;
   while (dmax > d)
     {
	dmax--;
	if (-1 == POP_DOUBLE (dmax, NULL, NULL))
	  return -1;
     }
   return 0;
}

/* This function will is used in situations where both the integer and the
 * generator are optional, but the N doubles are required, e.g.,
 * 
 *     x = f ({d});                       nargs = nds
 *   x[] = ran_ugaussian ({d},n);         nargs = nds+1
 *     x = ran_ugaussian (gen,{d});       nargs = nds+1
 *   x[] = ran_ugaussian (gen, {d}, n);   nargs = nds+2
 * 
 * If the generator was not given, then the default will be used.
 * It is up to the caller to ensure that nds <= nargs <= nds+2
 */ 
static Rand_Type *pop_rand_nds_and_int (int nargs, int nds, SLang_MMT_Type **mmtp, double *ds, int *ip)
{
   SLang_MMT_Type *mmt;
   Rand_Type *r;

   *mmtp = NULL;
   *ip = -1;

   if (nargs == nds + 2)
     {
	if (-1 == SLang_pop_integer (ip))
	  return NULL;
	
	if (-1 == pop_n_doubles (nds, ds))
	  return NULL;

	if (NULL != (r = pop_rand_type (&mmt)))
	  *mmtp = mmt;
	return r;
     }

   if (nargs == nds)
     {
	if (-1 == pop_n_doubles (nds, ds))
	  return NULL;

	return get_default_generator ();
     }
   
   /* nargs = nds + 1 :
    * There are two possibilities: 
    *   case 1: rng d1 d2 ... dn
    *   case 2: d1 d2 ... dn i
    */
   if (-1 == SLroll_stack (-nargs))
     return NULL;

   r = NULL; mmt = NULL;
   if (Rand_Type_Id == SLang_peek_at_stack ())
     {
	/* case 1 */
	if (NULL == (r = pop_rand_type (&mmt)))
	  return NULL;
	*mmtp = mmt;

	if (-1 == pop_n_doubles (nds, ds))
	  {
	     SLang_free_mmt (mmt);
	     *mmtp = NULL;
	     return NULL;
	  }
	return r;
     }

   /* case 2 */
   *mmtp = NULL;

   if (-1 == SLroll_stack (nargs))
     return NULL;

   if (-1 == SLang_pop_integer (ip))
     return NULL;
   
   if (-1 == pop_n_doubles (nds, ds))
     {
	SLang_free_mmt (mmt);
	return NULL;
     }
   
   return get_default_generator ();
}

static void rng_alloc (void)
{
   Rand_Type *r;
   SLang_MMT_Type *mmt;
   char *name;

   if (SLang_Num_Function_Args == 1)
     {
	if (-1 == SLang_pop_slstring (&name))
	  return;
     }
   else name = NULL;
   r = alloc_rand_type (name);
   SLang_free_slstring (name);	       /* NULL ok */

   if (r == NULL)
     return;
   
   if (NULL == (mmt = SLang_create_mmt (Rand_Type_Id, (VOID_STAR) r)))
     {
	free_rand_type (r);
	return;
     }

   /* Unfortunately, SLang_create_mmt sets the ref_count to 0, which means 
    * that no free is necessary if the push is successful.  This is an
    * _undesirable_ slang feature that I ought to correct for slang 2.
    */
   if (0 == SLang_push_mmt (mmt))
     return;

   SLang_free_mmt (mmt);
}

static void rng_set (void)
{
   unsigned long seed;
   SLang_MMT_Type *mmt = NULL;
   Rand_Type *r;

   if ((SLang_Num_Function_Args < 1) || (SLang_Num_Function_Args > 2))
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y = rng_set ([GSL_Rng_Type gen,] ULong_Type seed)");
	return;
     }

   if (-1 == SLang_pop_ulong (&seed))
     return;

   if (SLang_Num_Function_Args == 1)
     r = get_default_generator ();
   else
     r = pop_rand_type (&mmt);
	
   if (r == NULL)
     return;
   
   gsl_rng_set (r->gen, seed);
   if (mmt != NULL) SLang_free_mmt (mmt);
}

static void do_rng_d (double (*f)(const gsl_rng *), const gsl_rng *r, int num)
{
   SLang_Array_Type *out;
   unsigned int i, n;
   double *yp;

   if (num < 0)
     {
	(void) SLang_push_double ((*f)(r));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &num, 1)))
     return;

   yp = (double *) out->data;
   n = (unsigned int) num;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(r);

   (void) SLang_push_array (out, 1);
}

static void do_rng_d_fun (char *fun, double (*f)(const gsl_rng *))
{
   SLang_MMT_Type *mmt;
   Rand_Type *r;
   int n = -1;

   if (SLang_Num_Function_Args > 2)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s([GSL_Rng_Type] [,num])", fun);
	return;
     }
   
   if (NULL == (r = pop_rand_nds_and_int (SLang_Num_Function_Args, 0, &mmt, NULL, &n)))
     return;

   slgsl_reset_errors ();
   do_rng_d (f, r->gen, n);
   slgsl_check_errors (fun);
   if (mmt != NULL) SLang_free_mmt (mmt);
}

static void do_rng_ul (unsigned long (*f)(const gsl_rng *), const gsl_rng *r, int num)
{
   SLang_Array_Type *out;
   unsigned int i, n;
   unsigned long *yp;

   if (num < 0)
     {
	(void) SLang_push_ulong ((*f)(r));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_ULONG_TYPE, 0, NULL, &num, 1)))
     return;

   yp = (unsigned long *) out->data;
   n = (unsigned int) num;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(r);

   (void) SLang_push_array (out, 1);
}


static void do_rng_ulong_fun (char *fun,  unsigned long (*f)(const gsl_rng *))
{
   SLang_MMT_Type *mmt;
   Rand_Type *r;
   int n;

   if (SLang_Num_Function_Args > 2)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s([GSL_Rng_Type] [,num])", fun);
	return;
     }

   if (NULL == (r = pop_rand_nds_and_int (SLang_Num_Function_Args, 0, &mmt, NULL, &n)))
     return;

   slgsl_reset_errors ();
   do_rng_ul (f, r->gen, n);
   slgsl_check_errors (fun);
   if (mmt != NULL) SLang_free_mmt (mmt);
}

static void do_simple_rng_ulong_fun (char *fun,  unsigned long (*f)(const gsl_rng *))
{
   SLang_MMT_Type *mmt = NULL;
   Rand_Type *r;

   if ((SLang_Num_Function_Args > 1) || (SLang_Num_Function_Args < 0))
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s([GSL_Rng_Type])", fun);
	return;
     }
   if (SLang_Num_Function_Args == 1)
     r = pop_rand_type (&mmt);
   else
     r = get_default_generator ();
   
   slgsl_reset_errors ();
   (void) SLang_push_ulong ((*f) (r->gen));
   slgsl_check_errors (fun);
   if (mmt != NULL) SLang_free_mmt (mmt);
}

static void rng_max (void)
{
   do_simple_rng_ulong_fun ("rng_max", &gsl_rng_max);
}

static void rng_min (void)
{
   do_simple_rng_ulong_fun ("rng_min", &gsl_rng_min);
}

static void rng_get (void)
{
   do_rng_ulong_fun ("rng_get", &gsl_rng_get);
}

static void do_ran_dist_d (double (*f)(const gsl_rng *, double), 
			   const gsl_rng *r, double a, int num)
{
   SLang_Array_Type *out;
   unsigned int i, n;
   double *yp;

   if (num < 0)
     {
	(void) SLang_push_double ((*f)(r, a));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &num, 1)))
     return;

   yp = (double *) out->data;
   n = (unsigned int) num;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(r,a);

   (void) SLang_push_array (out, 1);
}

static void do_ran_dist_dd (double (*f)(const gsl_rng *, double, double),
			    const gsl_rng *r, double a, double b, 
			    int num)
{
   SLang_Array_Type *out;
   unsigned int i, n;
   double *yp;

   if (num < 0)
     {
	(void) SLang_push_double ((*f)(r, a, b));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &num, 1)))
     return;

   yp = (double *) out->data;
   n = (unsigned int) num;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(r,a,b);

   (void) SLang_push_array (out, 1);
}

static void do_ran_dist_d_fun (char *fun, double (*f)(const gsl_rng *,double))
{
   SLang_MMT_Type *mmt;
   Rand_Type *r;
   double a;
   int n;

   if ((SLang_Num_Function_Args < 1) || (SLang_Num_Function_Args > 3))
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s([GSL_Rng_Type,] double [,num])", fun);
	return;
     }

   if (NULL == (r = pop_rand_nds_and_int (SLang_Num_Function_Args, 1, &mmt, &a, &n)))
     return;

   slgsl_reset_errors ();
   do_ran_dist_d (f, r->gen, a, n);
   slgsl_check_errors (fun);
   if (mmt != NULL) SLang_free_mmt (mmt);
}

static void do_ran_dist_dd_fun (char *fun, double (*f)(const gsl_rng *,double, double))
{
   SLang_MMT_Type *mmt;
   Rand_Type *r;
   double ds[2];
   int n;

   if ((SLang_Num_Function_Args < 2) || (SLang_Num_Function_Args > 4))
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s([GSL_Rng_Type,] double, double [,num])", fun);
	return;
     }

   if (NULL == (r = pop_rand_nds_and_int (SLang_Num_Function_Args, 2, &mmt, ds, &n)))
     return;
   
   slgsl_reset_errors ();
   do_ran_dist_dd (f, r->gen, ds[0], ds[1], n);
   slgsl_check_errors (fun);
   if (mmt != NULL) SLang_free_mmt (mmt);
}

static void do_u_ran_dist_d (unsigned int (*f)(const gsl_rng *, double),
			     const gsl_rng *r, double a, int num)
{
   SLang_Array_Type *out;
   unsigned int i, n;
   unsigned int *yp;

   if (num < 0)
     {
	(void) SLang_push_uinteger ((*f)(r, a));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_UINT_TYPE, 0, NULL, &num, 1)))
     return;

   yp = (unsigned int *) out->data;
   n = (unsigned int) num;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(r,a);

   (void) SLang_push_array (out, 1);
}

static void do_u_ran_dist_dd (unsigned int (*f)(const gsl_rng *, double, double),
			      const gsl_rng *r, double a, double b, int num)
{
   SLang_Array_Type *out;
   unsigned int i, n;
   unsigned int *yp;

   if (num < 0)
     {
	(void) SLang_push_uinteger ((*f)(r, a, b));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_UINT_TYPE, 0, NULL, &num, 1)))
     return;

   yp = (unsigned int *) out->data;
   n = (unsigned int) num;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(r,a,b);

   (void) SLang_push_array (out, 1);
}

static void do_u_ran_dist_d_fun (char *fun, unsigned int (*f)(const gsl_rng *,double))
{
   SLang_MMT_Type *mmt;
   Rand_Type *r;
   double a;
   int n;

   if ((SLang_Num_Function_Args < 1) || (SLang_Num_Function_Args > 3))
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s([GSL_Rng_Type,] double [,num])", fun);
	return;
     }

   if (NULL == (r = pop_rand_nds_and_int (SLang_Num_Function_Args, 1, &mmt, &a, &n)))
     return;
   
   slgsl_reset_errors ();
   do_u_ran_dist_d (f, r->gen, a, n);
   slgsl_check_errors (fun);
   if (mmt != NULL) SLang_free_mmt (mmt);
}

static void do_u_ran_dist_dd_fun (char *fun, unsigned int (*f)(const gsl_rng *,double,double))
{
   SLang_MMT_Type *mmt;
   Rand_Type *r;
   double ds[2];
   int n;

   if ((SLang_Num_Function_Args < 2) || (SLang_Num_Function_Args > 4))
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s([GSL_Rng_Type,] double [,num])", fun);
	return;
     }

   if (NULL == (r = pop_rand_nds_and_int (SLang_Num_Function_Args, 2, &mmt, ds, &n)))
     return;

   slgsl_reset_errors ();
   do_u_ran_dist_dd (f, r->gen, ds[0], ds[1], n);
   slgsl_check_errors (fun);
   if (mmt != NULL) SLang_free_mmt (mmt);
}

#if 0
static unsigned int u_dd_gsl_ran_binomial (const gsl_rng *r, double p, double n)
{
   return gsl_ran_binomial (r, p, (unsigned int) n);
}
static double d_d_gsl_ran_gamma_int (const gsl_rng *r, double a)
{
   return gsl_ran_gamma_int (r, (unsigned int) a);
}
static double d_dd_gsl_ran_pascal (const gsl_rng *r, double p, double n)
{
   return gsl_ran_pascal (r, p, (unsigned int) n);
}
#endif

#define SLF(f) f##_intrin
#define D_F(f,n) \
   static void SLF(f) (void) { do_rng_d_fun (n,f); }
#define D_FD(f,n) \
   static void SLF(f) (void) { do_ran_dist_d_fun (n,f); }
#define D_FDD(f,n) \
   static void SLF(f) (void) { do_ran_dist_dd_fun (n,f); }
#define U_FD(f,n) \
   static void SLF(f) (void) { do_u_ran_dist_d_fun (n,f); }
#define U_FDD(f,n) \
   static void SLF(f) (void) { do_u_ran_dist_dd_fun (n,f); }

D_F(gsl_rng_uniform, "rng_uniform")
D_F(gsl_rng_uniform_pos, "rng_uniform_pos")
D_F(gsl_ran_ugaussian, "ran_ugaussian")
D_F(gsl_ran_ugaussian_ratio_method, "ran_ugaussian_ratio_method")
D_F(gsl_ran_landau, "ran_landau")

D_FD(gsl_ran_cauchy,"ran_cauchy")
D_FD(gsl_ran_chisq,"ran_chisq")
D_FD(gsl_ran_exponential,"ran_exponential")
D_FD(gsl_ran_gaussian,"ran_gaussian")
D_FD(gsl_ran_gaussian_ratio_method,"ran_gaussian_ratio_method")
D_FD(gsl_ran_laplace,"ran_laplace")
D_FD(gsl_ran_logistic,"ran_logistic")
D_FD(gsl_ran_rayleigh,"ran_rayleigh")
D_FD(gsl_ran_tdist,"ran_tdist")
D_FD(gsl_ran_ugaussian_tail,"ran_ugaussian_tail")
/* D_FD(d_d_gsl_ran_gamma_int, "ran_gamma_int") */

D_FDD(gsl_ran_beta,"ran_beta")
D_FDD(gsl_ran_erlang,"ran_erlang")
D_FDD(gsl_ran_exppow,"ran_exppow")
D_FDD(gsl_ran_fdist,"ran_fdist")
D_FDD(gsl_ran_flat,"ran_flat")
D_FDD(gsl_ran_gamma,"ran_gamma")
D_FDD(gsl_ran_gaussian_tail,"ran_gaussian_tail")
D_FDD(gsl_ran_gumbel1,"ran_gumbel1")
D_FDD(gsl_ran_gumbel2,"ran_gumbel2")
D_FDD(gsl_ran_levy,"ran_levy")
D_FDD(gsl_ran_lognormal,"ran_lognormal")
D_FDD(gsl_ran_pareto,"ran_pareto")
D_FDD(gsl_ran_rayleigh_tail,"ran_rayleigh_tail")
D_FDD(gsl_ran_weibull,"ran_weibull")
/* D_FDD(d_dd_gsl_ran_pascal, "ran_pascal") */

U_FD(gsl_ran_bernoulli, "ran_bernoulli")
U_FD(gsl_ran_geometric, "ran_geometric")
U_FD(gsl_ran_logarithmic, "ran_logarithmic")
U_FD(gsl_ran_poisson, "ran_poisson")

U_FDD(gsl_ran_negative_binomial,"ran_negative_binomial")
/* U_FDD(u_dd_gsl_ran_binomial,"ran_binomial") */

#if 0
;				       /* make indentation work again */
#endif

/* The pdf functions */

#define PDF_D_FD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_d_fun (n,f); }
#define PDF_D_FDD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_dd_fun (n,f); }
#define PDF_D_FDDD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_ddd_fun (n,f); }
#define PDF_D_FDDDD(f,n) \
     static void SLF(f) (void) { slgsl_do_d_dddd_fun (n,f); }

#define PDF_D_UD(f,n) \
   static void SLF(f) (void) { not_implemented (n); }
#define PDF_D_UDD(f) \
   static void SLF(f) (void) { not_implemented (n); }
#define PDF_D_UDU(f) \
   static void SLF(f) (void) { not_implemented (n); }
#define PDF_D_UUUU(f) \
   static void SLF(f) (void) { not_implemented (n); }

/* PDF_D_FUD(gsl_ran_bernoulli_pdf, "bernoulli_pdf") */
PDF_D_FDDD(gsl_ran_beta_pdf, "beta_pdf")
/* PDF_D_FUDU(gsl_ran_binomial_pdf, "binomial_pdf") */
PDF_D_FDD(gsl_ran_exponential_pdf, "exponential_pdf")
PDF_D_FDDD(gsl_ran_exppow_pdf, "exppow_pdf")
PDF_D_FDD(gsl_ran_cauchy_pdf, "cauchy_pdf")
PDF_D_FDD(gsl_ran_chisq_pdf, "chisq_pdf")
/* dirichlet_pdf */
PDF_D_FDDD(gsl_ran_erlang_pdf, "erlang_pdf")
PDF_D_FDDD(gsl_ran_fdist_pdf, "fdist_pdf")
PDF_D_FDDD(gsl_ran_flat_pdf, "flat_pdf")
PDF_D_FDDD(gsl_ran_gamma_pdf, "gamma_pdf")
PDF_D_FDD(gsl_ran_gaussian_pdf, "gaussian_pdf")
PDF_D_FD(gsl_ran_ugaussian_pdf, "ugaussian_pdf")
PDF_D_FDDD(gsl_ran_gaussian_tail_pdf, "gaussian_tail_pdf")
PDF_D_FDD(gsl_ran_ugaussian_tail_pdf, "ugaussian_tail_pdf")
/* PDF_D_FDDDDD(gsl_ran_bivariate_gaussian_pdf, "bivariate_gaussian_pdf") */
PDF_D_FD(gsl_ran_landau_pdf, "landau_pdf")
/* PDF_D_UD(gsl_ran_geometric_pdf, "geometric_pdf") */
/* PDF_D_UUUU(gsl_ran_hypergeometric_pdf, "hypergeometric_pdf") */
PDF_D_FDDD(gsl_ran_gumbel1_pdf, "gumbel1_pdf")
PDF_D_FDDD(gsl_ran_gumbel2_pdf, "gumbel2_pdf")
PDF_D_FDD(gsl_ran_logistic_pdf, "logistic_pdf")
PDF_D_FDDD(gsl_ran_lognormal_pdf, "lognormal_pdf")
/* PDF_D_UD(gsl_ran_logarithmic_pdf, "logarithmic_pdf") */
/* multinomial_pdf */
/* PDF_D_UDD(gsl_ran_negative_binomial_pdf, "negative_binomial_pdf") */
/* PDF_D_UDU(gsl_ran_pascal_pdf, "pascal_pdf") */
PDF_D_FDDD(gsl_ran_pareto_pdf, "pareto_pdf")
/* PDF_D_FUD(gsl_ran_poisson_pdf, "poisson_pdf") */
PDF_D_FDD(gsl_ran_rayleigh_pdf, "rayleigh_pdf")
PDF_D_FDDD(gsl_ran_rayleigh_tail_pdf, "rayleigh_tail_pdf")
PDF_D_FDD(gsl_ran_tdist_pdf, "tdist_pdf")
PDF_D_FDD(gsl_ran_laplace_pdf, "laplace_pdf")
PDF_D_FDDD(gsl_ran_weibull_pdf, "weibull_pdf")
/* discrete_pdf */

						
/* static void bivariate_gaussian_pdf (){} */
static void ran_bivariate_gaussian (void)
{
   SLang_MMT_Type *mmt;
   Rand_Type *r;
   double ds[3];
   SLang_Array_Type *at_x = NULL, *at_y = NULL;
   double *xp, *yp;
   SLindex_Type i, num;
   double sx, sy, rho;
   const gsl_rng *rng;
   char *fun = "ran_bivariate_gaussian";

   if ((SLang_Num_Function_Args < 3) || (SLang_Num_Function_Args > 5))
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: (x,y)=%s([GSL_Rng_Type,] sx, sy, rho, [,num])", fun);
	return;
     }
   if (NULL == (r = pop_rand_nds_and_int (SLang_Num_Function_Args, 3, &mmt, ds, &num)))
     return;

   sx = ds[0]; sy = ds[1]; rho = ds[2];
   rng = r->gen;

   if (num < 0)
     {
	double x, y;
	slgsl_reset_errors ();
	gsl_ran_bivariate_gaussian (rng, sx, sy, rho, &x, &y);
	slgsl_check_errors (fun);
	(void) SLang_push_double (x);
	(void) SLang_push_double (y);
	goto free_return;
     }
   
   if ((NULL == (at_x = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &num, 1)))
       || (NULL == (at_y = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &num, 1))))
     goto free_return;

   xp = (double *) at_x->data;
   yp = (double *) at_y->data;

   slgsl_reset_errors ();
   for (i = 0; i < num; i++)
     gsl_ran_bivariate_gaussian (rng, sx, sy, rho, xp+i, yp+i);
   slgsl_check_errors (fun);

   (void) SLang_push_array (at_x, 0);
   (void) SLang_push_array (at_y, 0);
   /* drop */

   free_return:
   if (mmt != NULL) SLang_free_mmt (mmt);
   if (at_x != NULL) SLang_free_array (at_x);
   if (at_y != NULL) SLang_free_array (at_y);
}

#define V SLANG_VOID_TYPE
static SLang_Intrin_Fun_Type Module_Intrinsics [] =
{
   MAKE_INTRINSIC_0("rng_get_rng_types", rng_get_rng_types, V),
   MAKE_INTRINSIC_0("rng_alloc", rng_alloc, V),
   MAKE_INTRINSIC_0("rng_set", rng_set, V),
   MAKE_INTRINSIC_0("rng_get", rng_get, V),
   MAKE_INTRINSIC_0("rng_uniform", SLF(gsl_rng_uniform), V),
   MAKE_INTRINSIC_0("rng_uniform_pos", SLF(gsl_rng_uniform_pos), V),

   MAKE_INTRINSIC_S("rng_set_default", set_default_generator, V),
   
   MAKE_INTRINSIC_0("rng_max", rng_max, V),
   MAKE_INTRINSIC_0("rng_min", rng_min, V),

   MAKE_INTRINSIC_0("ran_bernoulli", SLF(gsl_ran_bernoulli), V),
   MAKE_INTRINSIC_0("ran_beta", SLF(gsl_ran_beta), V),
   /* MAKE_INTRINSIC_0("ran_binomial", SLF(u_dd_gsl_ran_binomial), V), */
   MAKE_INTRINSIC_0("ran_bivariate_gaussian", ran_bivariate_gaussian, V),
   MAKE_INTRINSIC_0("ran_cauchy", SLF(gsl_ran_cauchy), V),
   MAKE_INTRINSIC_0("ran_chisq", SLF(gsl_ran_chisq), V),
   MAKE_INTRINSIC_0("ran_erlang", SLF(gsl_ran_erlang), V),
   MAKE_INTRINSIC_0("ran_exponential", SLF(gsl_ran_exponential), V),
   MAKE_INTRINSIC_0("ran_exppow", SLF(gsl_ran_exppow), V),
   MAKE_INTRINSIC_0("ran_fdist", SLF(gsl_ran_fdist), V),
   MAKE_INTRINSIC_0("ran_flat", SLF(gsl_ran_flat), V),
   MAKE_INTRINSIC_0("ran_gamma", SLF(gsl_ran_gamma), V),
   /* MAKE_INTRINSIC_0("ran_gamma_int", SLF(d_d_gsl_ran_gamma_int), V), */
   MAKE_INTRINSIC_0("ran_gaussian", SLF(gsl_ran_gaussian), V),
   MAKE_INTRINSIC_0("ran_gaussian_ratio_method", SLF(gsl_ran_gaussian_ratio_method), V),
   MAKE_INTRINSIC_0("ran_gaussian_tail", SLF(gsl_ran_gaussian_tail), V),
   MAKE_INTRINSIC_0("ran_geometric", SLF(gsl_ran_geometric), V),
   MAKE_INTRINSIC_0("ran_gumbel1", SLF(gsl_ran_gumbel1), V),
   MAKE_INTRINSIC_0("ran_gumbel2", SLF(gsl_ran_gumbel2), V),
   MAKE_INTRINSIC_0("ran_landau", SLF(gsl_ran_landau), V),
   MAKE_INTRINSIC_0("ran_laplace", SLF(gsl_ran_laplace), V),
   MAKE_INTRINSIC_0("ran_levy", SLF(gsl_ran_levy), V),
   MAKE_INTRINSIC_0("ran_logarithmic", SLF(gsl_ran_logarithmic), V),
   MAKE_INTRINSIC_0("ran_logistic", SLF(gsl_ran_logistic), V),
   MAKE_INTRINSIC_0("ran_lognormal", SLF(gsl_ran_lognormal), V),
   MAKE_INTRINSIC_0("ran_negative_binomial", SLF(gsl_ran_negative_binomial), V),
   MAKE_INTRINSIC_0("ran_pareto", SLF(gsl_ran_pareto), V),
   /* MAKE_INTRINSIC_0("ran_pascal", SLF(d_dd_gsl_ran_pascal), V), */
   MAKE_INTRINSIC_0("ran_poisson", SLF(gsl_ran_poisson), V),
   MAKE_INTRINSIC_0("ran_rayleigh", SLF(gsl_ran_rayleigh), V),
   MAKE_INTRINSIC_0("ran_rayleigh_tail", SLF(gsl_ran_rayleigh_tail), V),
   MAKE_INTRINSIC_0("ran_tdist", SLF(gsl_ran_tdist), V),
   MAKE_INTRINSIC_0("ran_ugaussian", SLF(gsl_ran_ugaussian), V),
   MAKE_INTRINSIC_0("ran_ugaussian_ratio_method", SLF(gsl_ran_ugaussian_ratio_method), V),
   MAKE_INTRINSIC_0("ran_ugaussian_tail", SLF(gsl_ran_ugaussian_tail), V),
   MAKE_INTRINSIC_0("ran_weibull", SLF(gsl_ran_weibull), V),
   
   /* The pdfs */
   /* MAKE_INTRINSIC_0("bernoulli_pdf", SLF(gsl_ran_bernoulli_pdf), V), */
   MAKE_INTRINSIC_0("beta_pdf", SLF(gsl_ran_beta_pdf), V),
   /* MAKE_INTRINSIC_0("binomial_pdf", SLF(gsl_ran_binomial_pdf), V), */
   MAKE_INTRINSIC_0("exponential_pdf", SLF(gsl_ran_exponential_pdf), V),
   MAKE_INTRINSIC_0("exppow_pdf", SLF(gsl_ran_exppow_pdf), V),
   MAKE_INTRINSIC_0("cauchy_pdf", SLF(gsl_ran_cauchy_pdf), V),
   MAKE_INTRINSIC_0("chisq_pdf", SLF(gsl_ran_chisq_pdf), V),
   /* dirichlet_pdf */
   MAKE_INTRINSIC_0("erlang_pdf", SLF(gsl_ran_erlang_pdf), V),
   MAKE_INTRINSIC_0("fdist_pdf", SLF(gsl_ran_fdist_pdf), V),
   MAKE_INTRINSIC_0("flat_pdf", SLF(gsl_ran_flat_pdf), V),
   MAKE_INTRINSIC_0("gamma_pdf", SLF(gsl_ran_gamma_pdf), V),
   MAKE_INTRINSIC_0("gaussian_pdf", SLF(gsl_ran_gaussian_pdf), V),
   MAKE_INTRINSIC_0("ugaussian_pdf", SLF(gsl_ran_ugaussian_pdf), V),
   MAKE_INTRINSIC_0("gaussian_tail_pdf", SLF(gsl_ran_gaussian_tail_pdf), V),
   MAKE_INTRINSIC_0("ugaussian_tail_pdf", SLF(gsl_ran_ugaussian_tail_pdf), V),
   /* MAKE_INTRINSIC_0("bivariate_gaussian_pdf", SLF(gsl_ran_bivariate_gaussian_pdf), V), */
   MAKE_INTRINSIC_0("landau_pdf", SLF(gsl_ran_landau_pdf), V),
   /* MAKE_INTRINSIC_0("geometric_pdf", SLF(gsl_ran_geometric_pdf), V), */
   /* MAKE_INTRINSIC_0("hypergeometric_pdf", SLF(gsl_ran_hypergeometric_pdf), V), */
   MAKE_INTRINSIC_0("gumbel1_pdf", SLF(gsl_ran_gumbel1_pdf), V),
   MAKE_INTRINSIC_0("gumbel2_pdf", SLF(gsl_ran_gumbel2_pdf), V),
   MAKE_INTRINSIC_0("logistic_pdf", SLF(gsl_ran_logistic_pdf), V),
   MAKE_INTRINSIC_0("lognormal_pdf", SLF(gsl_ran_lognormal_pdf), V),
   /* MAKE_INTRINSIC_0("logarithmic_pdf", SLF(gsl_ran_logarithmic_pdf), V), */
   /* multinomial_pdf */
   /* MAKE_INTRINSIC_0("negative_binomial_pdf", SLF(gsl_ran_negative_binomial_pdf), V), */
   /* MAKE_INTRINSIC_0("pascal_pdf", SLF(gsl_ran_pascal_pdf), V), */
   MAKE_INTRINSIC_0("pareto_pdf", SLF(gsl_ran_pareto_pdf), V),
   /* MAKE_INTRINSIC_0("poisson_pdf", SLF(gsl_ran_poisson_pdf), V), */
   MAKE_INTRINSIC_0("rayleigh_pdf", SLF(gsl_ran_rayleigh_pdf), V),
   MAKE_INTRINSIC_0("rayleigh_tail_pdf", SLF(gsl_ran_rayleigh_tail_pdf), V),
   MAKE_INTRINSIC_0("tdist_pdf", SLF(gsl_ran_tdist_pdf), V),
   MAKE_INTRINSIC_0("laplace_pdf", SLF(gsl_ran_laplace_pdf), V),
   MAKE_INTRINSIC_0("weibull_pdf", SLF(gsl_ran_weibull_pdf), V),
   /* discrete_pdf */
   SLANG_END_INTRIN_FUN_TABLE
};
#undef V

static SLang_Intrin_Var_Type Module_Variables [] =
{
   MAKE_VARIABLE("_gslrand_module_version_string", &Module_Version_String, SLANG_STRING_TYPE, 1),
   SLANG_END_INTRIN_VAR_TABLE
};

static SLang_IConstant_Type Module_IConstants [] =
{
   MAKE_ICONSTANT("_gslrand_module_version", MODULE_VERSION_NUMBER),
   SLANG_END_ICONST_TABLE
};

static void destroy_rand_type (SLtype type, VOID_STAR vr)
{	  
   (void) type;
   free_rand_type ((Rand_Type *)vr);
}

int init_gslrand_module_ns (char *ns_name)
{
   SLang_Class_Type *cl;

   SLang_NameSpace_Type *ns = SLns_create_namespace (ns_name);
   if (ns == NULL)
     return -1;

   if (Rand_Type_Id == -1)
     {
	if (NULL == (cl = SLclass_allocate_class ("GSL_Rand_Type")))
	  return -1;

	(void) SLclass_set_destroy_function (cl, destroy_rand_type);

	if (-1 == SLclass_register_class (cl, SLANG_VOID_TYPE,
					  sizeof (Rand_Type), 
					  SLANG_CLASS_TYPE_MMT))
	  return -1;

	(void) gsl_rng_env_setup ();
	Rand_Type_Id = SLclass_get_class_id (cl);
     }

   if (
       (-1 == SLns_add_intrin_var_table (ns, Module_Variables, NULL))
       || (-1 == SLns_add_intrin_fun_table (ns, Module_Intrinsics, NULL))
       || (-1 == SLns_add_iconstant_table (ns, Module_IConstants, NULL))
       )
     return -1;

   return 0;
}

/* This function is optional */
void deinit_gslrand_module (void)
{
}
