[PATCH] Add implementation of SRFI 27

[Andreas Rottmann <a.rottmann@gmx.at>]

[-- Attachment #1: Type: text/plain, Size: 76 bytes --]

Hi!

Here's an updated version of the patch, this time with documentation:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: srfi-27-new.diff --]
[-- Type: text/x-diff, Size: 16857 bytes --]

From: Andreas Rottmann <a.rottmann@gmx.at>
Subject: Add implementation of SRFI 27

* module/srfi/srfi-27.scm: New file; implementation of SRFI 27 in terms
  of the existing random number generator.
* module/Makefile.am (SRFI_SOURCES): Add srfi/srfi-27.scm.

* test-suite/tests/srfi-27.test: New file; minimal test suite for SRFI 27.
* test-suite/Makefile.am (SCM_TESTS): Add tests/srfi-27.test.

* doc/ref/srfi-modules.texi: Add subsection on SRFI-27 based
  on the specification.

---
 NEWS                          |    4 +
 doc/ref/srfi-modules.texi     |  155 +++++++++++++++++++++++++++++++++++++++++
 module/Makefile.am            |    1 +
 module/srfi/srfi-27.scm       |   94 +++++++++++++++++++++++++
 test-suite/Makefile.am        |    1 +
 test-suite/tests/srfi-27.test |   91 ++++++++++++++++++++++++
 6 files changed, 346 insertions(+), 0 deletions(-)

diff --git a/NEWS b/NEWS
index 85f81e5..0449b1d 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,10 @@ latest prerelease, and a full NEWS corresponding to 1.8 -> 2.0.
 
 Changes in 1.9.12 (since the 1.9.11 prerelease):
 
+** Support for SRFI-27
+
+SRFI-27 "Sources of Random Bits" is now available.
+
 ** Many R6RS bugfixes
 
 `(rnrs bytevectors)' and `(rnrs io ports)' now have version information,
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 0d74202..188a71c 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -36,6 +36,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-18::                     Multithreading support
 * SRFI-19::                     Time/Date library.
 * SRFI-26::                     Specializing parameters
+* SRFI-27::                     Sources of Random Bits
 * SRFI-30::                     Nested multi-line block comments
 * SRFI-31::                     A special form `rec' for recursive evaluation
 * SRFI-34::                     Exception handling.
@@ -3226,6 +3227,160 @@ or similar is typical.
 @end example
 @end deffn
 
+@node SRFI-27
+@subsection SRFI-27 - Sources of Random Bits
+@cindex SRFI-27
+
+@c This subsection is based on the specification of SRFI-27, which has
+@c the following license:
+
+@c Copyright (C) Sebastian Egner (2002). All Rights Reserved.
+
+@c Permission is hereby granted, free of charge, to any person obtaining a
+@c copy of this software and associated documentation files (the
+@c "Software"), to deal in the Software without restriction, including
+@c without limitation the rights to use, copy, modify, merge, publish,
+@c distribute, sublicense, and/or sell copies of the Software, and to
+@c permit persons to whom the Software is furnished to do so, subject to
+@c the following conditions:
+
+@c The above copyright notice and this permission notice shall be included
+@c in all copies or substantial portions of the Software.
+
+@c THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+@c OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+@c MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+@c NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+@c LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+@c OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+@c WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+
+This SRFI provides access to a (pseudo) random number generator; for
+Guile's built-in random number facilities, which SRFI-27 is implemented
+upon, @xref{Random}.  With SRFI-27, random numbers are obtained from a
+@emph{random source}, which encapsulates a random number generation
+algorithm and its state.
+
+@menu
+* SRFI-27 Default Random Source::    Obtaining random numbers
+* SRFI-27 Random Sources::           Creating and manipulating random sources
+* SRFI-27 Random Number Generators:: Obtaining random number generators
+@end menu
+
+@node SRFI-27 Default Random Source
+@subsubsection The Default Random Source
+@cindex SRFI-27
+
+@defun random-integer n
+Return a random number between zero (inclusive) and @var{n} (exclusive),
+using the default random source.  The numbers returned have a uniform
+distribution.
+@end defun
+
+@defun random-real
+Return a random number in (0,1), using the default random source.  The
+numbers returned have a uniform distribution.
+@end defun
+
+@defun default-random-source
+A random source from which @code{random-integer} and @code{random-real}
+have been derived using @code{random-source-make-integers} and
+@code{random-source-make-reals} (@pxref{SRFI-27 Random Number Generators}
+for those procedures).  Note that an assignment to
+@code{default-random-source} does not change @code{random-integer} or
+@code{random-real}; it is also strongly recommended not to assign a new
+value.
+@end defun
+
+@node SRFI-27 Random Sources
+@subsubsection Random Sources
+@cindex SRFI-27
+
+@defun make-random-source
+Create a new random source.  The stream of random numbers obtained from
+each random source created by this procedure will be identical, unless
+its state is changed by one of the procedures below.
+@end defun
+
+@defun random-source? object
+Tests whether @var{object} is a random source.  Random sources are a
+disjoint type.
+@end defun
+
+@defun random-source-randomize! source
+Attempt to set the state of the random source to a truly random value.
+The current implementation uses a seed based on the current system time.
+@end defun
+
+@defun random-source-pseudo-randomize! source i j
+Changes the state of the random source s into the initial state of the
+(@var{i}, @var{j})-th independent random source, where @var{i} and
+@var{j} are non-negative integers.  This procedure provides a mechanism
+to obtain a large number of independent random sources (usually all
+derived from the same backbone generator), indexed by two integers. In
+contrast to @code{random-source-randomize!}, this procedure is entirely
+deterministic.
+@end defun
+
+The state associated with a random state can be obtained an reinstated
+with the following procedures:
+
+@defun random-source-state-ref source
+@defunx random-source-state-set! source state
+Get and set the state of a random source.  No assumptions should be made
+about the nature of the state object, besides it having an external
+representation (i.e. it can be passed to @code{write} and subsequently
+@code{read} back).
+@end defun
+
+@node SRFI-27 Random Number Generators
+@subsubsection Obtaining random number generator procedures
+@cindex SRFI-27
+
+@defun random-source-make-integers source
+Obtains a procedure to generate random integers using the random source
+@var{source}.  The returned procedure takes a single argument @var{n},
+which must be a positive integer, and returns the next uniformly
+distributed random integer from the interval @{0, ..., @var{n}-1@} by
+advancing the state of @var{source}.
+
+If an application obtains and uses several generators for the same
+random source @var{source}, a call to any of these generators advances
+the state of @var{source}.  Hence, the generators do not produce the
+same sequence of random integers each but rather share a state. This
+also holds for all other types of generators derived from a fixed random
+sources.  
+
+While the SRFI text specifies that ``Implementations that support
+concurrency make sure that the state of a generator is properly
+advanced'', this is currently not the case in Guile's implementation of
+SRFI-27, as it would cause a severe performance penalty.  So in
+multi-threaded programs, you either must perform locking on random
+sources shared between threads yourself, or use different random sources
+for multiple threads.
+@end defun
+
+@defun random-source-make-reals source
+@defunx random-source-make-reals source unit
+Obtains a procedure to generate random real numbers @math{0 < x < 1}
+using the random source @var{source}.  The procedure rand is called
+without arguments.
+
+The optional parameter @var{unit} determines the type of numbers being
+produced by the returned procedure and the quantization of the output.
+@var{unit} must be a number such that @math{0 < @var{unit} < 1}.  The
+numbers created by the returned procedure are of the same numerical type
+as @var{unit} and the potential output values are spaced by at most
+@var{unit}.  One can imagine rand to create numbers as @var{x} *
+@var{unit} where @var{x} is a random integer in @{1, ...,
+floor(1/unit)-1@}.  Note, however, that this need not be the way the
+values are actually created and that the actual resolution of rand can
+be much higher than unit. In case @var{unit} is absent it defaults to a
+reasonably small value (related to the width of the mantissa of an
+efficient number format).
+@end defun
+
 @node SRFI-30
 @subsection SRFI-30 - Nested Multi-line Comments
 @cindex SRFI-30
diff --git a/module/Makefile.am b/module/Makefile.am
index 1202e20..bcceb9c 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -250,6 +250,7 @@ SRFI_SOURCES = \
   srfi/srfi-18.scm \
   srfi/srfi-19.scm \
   srfi/srfi-26.scm \
+  srfi/srfi-27.scm \
   srfi/srfi-31.scm \
   srfi/srfi-34.scm \
   srfi/srfi-35.scm \
diff --git a/module/srfi/srfi-27.scm b/module/srfi/srfi-27.scm
new file mode 100644
index 0000000..9777ace
--- /dev/null
+++ b/module/srfi/srfi-27.scm
@@ -0,0 +1,94 @@
+;;; srfi-27.scm --- Sources of Random Bits
+
+;; Copyright (C) 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 the License, or (at your option) any later version.
+
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library. If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This module is fully documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-27)
+  #:export (random-integer
+            random-real
+            default-random-source
+            make-random-source
+            random-source?
+            random-source-state-ref
+            random-source-state-set!
+            random-source-randomize!
+            random-source-pseudo-randomize!
+            random-source-make-integers
+            random-source-make-reals)
+  #:use-module (srfi srfi-9))
+
+(define-record-type :random-source
+  (%make-random-source state)
+  random-source?
+  (state random-source-state set-random-source-state!))
+
+(define (make-random-source)
+  (%make-random-source (seed->random-state 0)))
+
+(define (random-source-state-ref s)
+  (random-state->datum (random-source-state s)))
+
+(define (random-source-state-set! s state)
+  (set-random-source-state! s (datum->random-state state)))
+
+(define (random-source-randomize! s)
+  (let ((time (gettimeofday)))
+    (set-random-source-state! s (seed->random-state
+                                 (+ (* (car time) 1e6) (cdr time))))))
+
+(define (random-source-pseudo-randomize! s i j)
+  (set-random-source-state! s (seed->random-state (i+j->seed i j))))
+
+(define (i+j->seed i j)
+  (logior (ash (spread i 2) 1)
+          (spread j 2)))
+
+(define (spread n amount)
+  (let loop ((result 0) (n n) (shift 0))
+    (if (zero? n)
+        result
+        (loop (logior result
+                      (ash (logand n 1) shift))
+              (ash n -1)
+              (+ shift amount)))))
+
+(define (random-source-make-integers s)
+  (lambda (n)
+    (random n (random-source-state s))))
+
+(define random-source-make-reals
+  (case-lambda
+    ((s)
+     (lambda ()
+       (let loop ()
+         (let ((x (random:uniform (random-source-state s))))
+           (if (zero? x)
+               (loop)
+               x)))))
+    ((s unit)
+     (or (and (real? unit) (< 0 unit 1))
+         (error "unit must be real between 0 and 1" unit))
+     (random-source-make-reals s))))
+
+(define default-random-source (make-random-source))
+(define random-integer (random-source-make-integers default-random-source))
+(define random-real (random-source-make-reals default-random-source))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index c504587..22f31d9 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -113,6 +113,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/srfi-14.test			\
 	    tests/srfi-19.test			\
 	    tests/srfi-26.test			\
+	    tests/srfi-27.test			\
 	    tests/srfi-31.test			\
 	    tests/srfi-34.test			\
 	    tests/srfi-35.test			\
diff --git a/test-suite/tests/srfi-27.test b/test-suite/tests/srfi-27.test
new file mode 100644
index 0000000..4b153d2
--- /dev/null
+++ b/test-suite/tests/srfi-27.test
@@ -0,0 +1,91 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;;
+;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2002 Sebastian Egner
+;;;
+;;; This code is based on the file conftest.scm in the reference
+;;; implementation of SRFI-27, provided under the following license:
+;;;
+;;; Permission is hereby granted, free of charge, to any person obtaining
+;;; a copy of this software and associated documentation files (the
+;;; "Software"), to deal in the Software without restriction, including
+;;; without limitation the rights to use, copy, modify, merge, publish,
+;;; distribute, sublicense, and/or sell copies of the Software, and to
+;;; permit persons to whom the Software is furnished to do so, subject to
+;;; the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;;; SOFTWARE.
+
+(define-module (test-srfi-27)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-27))
+
+(with-test-prefix "large integers"
+  (pass-if "in range"
+    (let loop ((k 0) (n 1))
+      (cond ((> k 1024)
+             #t)
+            ((<= 0 (random-integer n) (- n 1))
+             (loop (+ k 1) (* n 2)))
+            (else
+             #f)))))
+
+(with-test-prefix "reals"
+  (pass-if "in range"
+    (let loop ((k 0) (n 1))
+      (if (> k 1000)
+          #t
+          (let ((x (random-real)))
+            (if (< 0 x 1)
+                (loop (+ k 1) (* n 2))
+                #f))))))
+
+(with-test-prefix "get/set state"
+  (let* ((state1 (random-source-state-ref default-random-source))
+         (x1 (random-integer (expt 2 32)))
+         (state2 (random-source-state-ref default-random-source))
+         (x2 (random-integer (expt 2 32))))
+    (random-source-state-set! default-random-source state1)
+    (pass-if "state1"
+      (= x1 (random-integer (expt 2 32))))
+    (random-source-state-set! default-random-source state2)
+    (pass-if "state2"
+      (= x2 (random-integer (expt 2 32))))))
+
+;; These tests throw 'unresolved instead of failing since it /could/
+;; happen that `random-source-randomize!' (or
+;; `random-source-pseudo-randomize!')  puts the RNG into a state where
+;; it generates the same number as before. They should have a very high
+;; chance of passing, though.
+
+(with-test-prefix "randomize!"
+  (let* ((state1 (random-source-state-ref default-random-source))
+         (x1 (random-integer (expt 2 32))))
+    (random-source-state-set! default-random-source state1)
+    (random-source-randomize! default-random-source)
+    (if (= x1 (random-integer (expt 2 32)))
+        (throw 'unresolved))))
+
+(with-test-prefix "pseudo-randomize!"
+  (let* ((state1 (random-source-state-ref default-random-source))
+         (x1 (random-integer (expt 2 32))))
+    (random-source-state-set! default-random-source state1)
+    (random-source-pseudo-randomize! default-random-source 0 1)
+    (let ((y1 (random-integer (expt 2 32))))
+      (if (= x1 y1)
+          (throw 'unresolved)))
+    (random-source-state-set! default-random-source state1)
+    (random-source-pseudo-randomize! default-random-source 1 0)
+    (let ((y1 (random-integer (expt 2 32))))
+      (if (= x1 y1)
+          (throw 'unresolved)))))
-- 
tg: (e850dfc..) t/srfi-27-new (depends on: t/random-external t/fix-random-64bit)

[-- Attachment #3: Type: text/plain, Size: 63 bytes --]


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