[PATCH] Allow exposing of random number generator state

[Andreas Rottmann]

Hi!

Here is a first version of the patch to add an external representation
for the RNG state (needed for implementing SRFI 27 "Sources of random
bits" in terms of Guile's RNG). I'm not quite sure about the naming of
procedures, both one the C and the Scheme side of things -- suggestions
highly appreciated!

From: Andreas Rottmann <address@hidden>
Subject: Allow exposing of random number generator state

Now the random number generator state can be obtained in external
(i.e. `read'/`write'-able) form via the new procedure
`random-state->external'.  An externalized state can be reinstantiated by
calling `external->random-state'.

* libguile/random.c (scm_i_init_rstate_scm, scm_i_expose_rstate): New
  internal functions.
* libguile/random.c (scm_c_make_rstate_scm, scm_external_to_random_state,
  scm_random_state_to_external): New public functions.
* libguile/random.h: Add prototypes for the above functions.

* libguile/random.h (scm_t_rng): Add new fields `init_rstate_scm' and
  `expose_rstate'.
* libguile/random.c (scm_init_random): Initialize the new fields in
  `scm_the_rng'.

---
 NEWS                  |   10 +++++++
 doc/ref/api-data.texi |   26 +++++++++++++++--
 libguile/random.c     |   72 ++++++++++++++++++++++++++++++++++++++++++++++---
 libguile/random.h     |    7 ++++-
 4 files changed, 107 insertions(+), 8 deletions(-)

diff --git a/NEWS b/NEWS
index 1939a2b..80e295d 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,16 @@ Please send Guile bug reports to address@hidden
 (During the 1.9 series, we will keep an incremental NEWS for the latest
 prerelease, and a full NEWS corresponding to 1.8 -> 2.0.)
 
+Changes in 1.9.12 (since the 1.9.11 prerelease):
+
+** Random generator state has an external form
+
+Now the random number generator state can be obtained in external
+(i.e. `read'/`write'-able) form via the new procedure
+`random-state->external'.  An externalized state can be reinstantiated by
+calling `external->random-state'.
+
+
 Changes in 1.9.11 (since the 1.9.10 prerelease):
 
 ** Renamed module: (rnrs bytevectors)
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 40bd969..184c4d3 100755
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -1511,9 +1511,13 @@ through @var{end} (exclusive) bits of @var{n}.  The
 @subsubsection Random Number Generation
 
 Pseudo-random numbers are generated from a random state object, which
-can be created with @code{seed->random-state}.  The @var{state}
-parameter to the various functions below is optional, it defaults to
-the state object in the @code{*random-state*} variable.
+can be created with @code{seed->random-state} or
address@hidden>random-state}.  An external representation (i.e. one
+which can written with @code{write} and read with @code{read}) of a
+random state object can be obtained via
address@hidden>external}.  The @var{state} parameter to the
+various functions below is optional, it defaults to the state object
+in the @code{*random-state*} variable.
 
 @deffn {Scheme Procedure} copy-random-state [state]
 @deffnx {C Function} scm_copy_random_state (state)
@@ -1582,6 +1586,22 @@ Return a uniformly distributed inexact real random 
number in
 Return a new random state using @var{seed}.
 @end deffn
 
address@hidden {Scheme Procedure} external->random-state external
address@hidden {C Function} scm_external_to_random_state (external)
+Return a new random state from the external representation
address@hidden, which must have been obtained by
address@hidden>external}.
address@hidden deffn
+
address@hidden {Scheme Procedure} random-state->external state
address@hidden {C Function} scm_random_state_to_external (state)
+Return an external representation of @var{state}.  You cannot make
+any assumtions on the structure of the returned object besides that
+it will be an acceptable argument to @code{external->random-state}
+and that it will be able to be written and read back by the Scheme
+reader.
address@hidden deffn
+
 @defvar *random-state*
 The global random state used by the above functions when the
 @var{state} parameter is not given.
diff --git a/libguile/random.c b/libguile/random.c
index 281d43a..c8ad64e 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006, 2009 Free Software 
Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006, 2009, 2010 Free Software 
Foundation, Inc.
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
  * as published by the Free Software Foundation; either version 3 of
@@ -151,6 +151,35 @@ scm_i_copy_rstate (scm_t_i_rstate *state)
   return memcpy (new_state, state, scm_the_rng.rstate_size);
 }
 
+SCM_SYMBOL(scm_i_rstate_tag, "multiply-with-carry");
+
+void
+scm_i_init_rstate_scm (scm_t_i_rstate *state, SCM value)
+#define FUNC_NAME "scm_i_init_rstate_scm"
+{
+  unsigned long w, c;
+  long length;
+  
+  SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, value, length);
+  SCM_ASSERT (length == 3, value, SCM_ARG1, FUNC_NAME);
+  SCM_ASSERT (scm_is_eq (SCM_CAR (value), scm_i_rstate_tag),
+              value, SCM_ARG1, FUNC_NAME);
+  SCM_VALIDATE_ULONG_COPY (SCM_ARG1, SCM_CADR (value), w);
+  SCM_VALIDATE_ULONG_COPY (SCM_ARG1, SCM_CADDR (value), c);
+
+  state->w = w;
+  state->c = c;
+}
+#undef FUNC_NAME
+
+SCM
+scm_i_expose_rstate (scm_t_i_rstate *state)
+{
+  return scm_list_3 (scm_i_rstate_tag,
+                     scm_from_ulong (state->w),
+                     scm_from_ulong (state->c));
+}
+
 
 /*
  * Random number library functions
@@ -168,6 +197,17 @@ scm_c_make_rstate (const char *seed, int n)
   return state;
 }
 
+scm_t_rstate *
+scm_c_make_rstate_scm (SCM external)
+{
+  scm_t_rstate *state;
+
+  state = scm_gc_malloc_pointerless (scm_the_rng.rstate_size,
+                                    "random-state");
+  state->reserved0 = 0;
+  scm_the_rng.init_rstate_scm (state, external);
+  return state;
+}
 
 scm_t_rstate *
 scm_c_default_rstate ()
@@ -394,6 +434,28 @@ SCM_DEFINE (scm_seed_to_random_state, 
"seed->random-state", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_external_to_random_state, "external->random-state", 1, 0, 0, 
+            (SCM external),
+            "Return a new random state using @var{external}.\n"
+            "\n"
+            "@var{external} must be an external state representation 
obtained\n"
+            "from @code{random-state->external}.")
+#define FUNC_NAME s_scm_external_to_random_state
+{
+  return make_rstate (scm_c_make_rstate_scm (external));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_random_state_to_external, "random-state->external", 1, 0, 0, 
+            (SCM state),
+            "Return an external representation of @var{state}.")
+#define FUNC_NAME s_scm_random_state_to_external
+{
+  SCM_VALIDATE_RSTATE (1, state);
+  return scm_the_rng.expose_rstate (SCM_RSTATE (state));
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_random_uniform, "random:uniform", 0, 1, 0, 
             (SCM state),
            "Return a uniformly distributed inexact real random number in\n"
@@ -590,9 +652,11 @@ scm_init_random ()
   scm_t_rng rng =
   {
     sizeof (scm_t_i_rstate),
-    (unsigned long (*)()) scm_i_uniform32,
-    (void (*)())          scm_i_init_rstate,
-    (scm_t_rstate *(*)())    scm_i_copy_rstate
+    (unsigned long (*)())           scm_i_uniform32,
+    (void (*)())                    scm_i_init_rstate,
+    (scm_t_rstate *(*)())           scm_i_copy_rstate,
+    (void (*)(scm_t_rstate *, SCM)) scm_i_init_rstate_scm,
+    (SCM (*)(scm_t_rstate *))       scm_i_expose_rstate
   };
   scm_the_rng = rng;
   
diff --git a/libguile/random.h b/libguile/random.h
index 6cf404f..402c3f1 100644
--- a/libguile/random.h
+++ b/libguile/random.h
@@ -3,7 +3,7 @@
 #ifndef SCM_RANDOM_H
 #define SCM_RANDOM_H
 
-/* Copyright (C) 1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2006, 2008, 2010 Free Software Foundation, 
Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -49,6 +49,8 @@ typedef struct scm_t_rng {
   unsigned long (*random_bits) (scm_t_rstate *state); /* gives 32 random bits 
*/
   void (*init_rstate) (scm_t_rstate *state, const char *seed, int n);
   scm_t_rstate *(*copy_rstate) (scm_t_rstate *state);
+  void (*init_rstate_scm) (scm_t_rstate *state, SCM exposed);
+  SCM (*expose_rstate) (scm_t_rstate *state);
 } scm_t_rng;
 
 SCM_API scm_t_rng scm_the_rng;
@@ -66,12 +68,15 @@ typedef struct scm_t_i_rstate {
 SCM_INTERNAL unsigned long scm_i_uniform32 (scm_t_i_rstate *);
 SCM_INTERNAL void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int 
n);
 SCM_INTERNAL scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
+SCM_INTERNAL void scm_i_init_rstate_scm (scm_t_i_rstate *state, SCM value);
+SCM_INTERNAL SCM scm_i_expose_rstate (scm_t_i_rstate *state);
 
 
 /*
  * Random number library functions
  */
 SCM_API scm_t_rstate *scm_c_make_rstate (const char *, int);
+SCM_API scm_t_rstate *scm_c_make_rstate_scm (SCM external);
 SCM_API scm_t_rstate *scm_c_default_rstate (void);
 #define scm_c_uniform32(RSTATE) scm_the_rng.random_bits (RSTATE)
 SCM_API double scm_c_uniform01 (scm_t_rstate *);
-- 
tg: (3fdc1d0..) t/random-external (depends on: master)

Regards, Rotty
-- 
Andreas Rottmann -- <http://rotty.yi.org/>