From 59c0f5d621d665a2ab48cc760b561a7b610ab5fd Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 23 Feb 2021 16:21:51 +0530
Subject: Redefine integrand_t as a struct.

This change will make it easier for the scheme wrapper to curry
integrands.

* include/extent-sampling.h (integrand_t): Redefine type as struct.
(integral): Pass pointer to integrand_t.
* src/extent-sampling.sc (integral-per-direction, integral): Handle
new integrand-t type.
(invoke-integrand): New sc macro.
---
 include/extent-sampling.h | 7 +++++--
 src/extent-sampling.sc    | 9 ++++++---
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/include/extent-sampling.h b/include/extent-sampling.h
index 27314a3..ef64fe3 100644
--- a/include/extent-sampling.h
+++ b/include/extent-sampling.h
@@ -10,7 +10,10 @@ typedef struct {
   void *params;
 } extent_oracle_t;
 
-typedef double (*integrand_t) (double, const gsl_vector*);
+typedef struct {
+  double (*integrand) (double, const gsl_vector*, void*);
+  void *params;
+} integrand_t;
 
 void init_random (void);
 
@@ -25,7 +28,7 @@ double volume_window
  unsigned int* number_of_samples);
 
 double integral
-(integrand_t integrand, extent_oracle_t *extent_oracle, double true_integral,
+(integrand_t *integrand, extent_oracle_t *extent_oracle, double true_integral,
  const gsl_rng* r, unsigned int dimension, double rtol,
  gsl_rstat_workspace* stats);
 
diff --git a/src/extent-sampling.sc b/src/extent-sampling.sc
index c91c46c..69ea0a7 100644
--- a/src/extent-sampling.sc
+++ b/src/extent-sampling.sc
@@ -71,13 +71,16 @@
            (gsl-rstat-n stats))))
   (return volume))
 
+(sc-define-syntax (invoke-integrand integrand r x)
+  ((: integrand integrand) r x (: integrand params)))
+
 (pre-let* (INTEGRATION-INTERVALS 1000)
   (define (integral-per-direction integrand direction r n radius rtol neval)
-    (double integrand-t (const gsl-vector*) (const gsl-rng*) (unsigned int) double double int*)
+    (double integrand-t* (const gsl-vector*) (const gsl-rng*) (unsigned int) double double int*)
     (define (f r params) (double double void*)
       (set+ (pointer-get neval) 1)
       (return (* (gsl-pow-uint r (- n 1))
-                 (integrand r direction))))
+                 (invoke-integrand integrand r direction))))
     (declare gsl-f (struct-variable gsl-function (function (address-of f)))
              result double
              error double)
@@ -97,7 +100,7 @@
 
 (pre-let* (INTEGRAL-MINIMUM-SAMPLES 100)
   (define (integral integrand extent-oracle true-integral r dimension rtol stats)
-    (double integrand-t extent-oracle-t* double (const gsl-rng*) (unsigned int) double gsl-rstat-workspace*)
+    (double integrand-t* extent-oracle-t* double (const gsl-rng*) (unsigned int) double gsl-rstat-workspace*)
     (declare integral double
              error double)
     (with-vector x dimension
-- 
cgit v1.2.3