diff options
author | Steve Langasek <vorlon@debian.org> | 2005-01-10 08:53:33 +0000 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:30 -0800 |
commit | e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch) | |
tree | abbf06041619e445f9d0b772b0d58132009d8234 /random.scm | |
parent | f559c149c83da84d0b1c285f0298c84aec564af9 (diff) | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip |
Import Debian changes 3a1-4.2debian/3a1-4.2
slib (3a1-4.2) unstable; urgency=low
* Non-maintainer upload.
* Add guile.init.local for use within the build dir, since otherwise we
have an (earlier unnoticed) circular build-dep due to a difference
between scm and guile.
slib (3a1-4.1) unstable; urgency=low
* Non-maintainer upload.
* Build-depend on guile-1.6 instead of scm, since the new version of
scm is wedged in unstable (closes: #281809).
slib (3a1-4) unstable; urgency=low
* Also check for expected creation on slibcat. (Closes: #240096)
slib (3a1-3) unstable; urgency=low
* Also check for /usr/share/guile/1.6/slib before installing for guile
1.6. (Closes: #239267)
slib (3a1-2) unstable; urgency=low
* Add format.scm back into slib until gnucash stops using it.
* Call guile-1.6 new-catalog (Closes: #238231)
slib (3a1-1) unstable; urgency=low
* New upstream release
* Remove Info section from doc-base file (Closes: #186950)
* Remove period from end of description (linda, lintian)
* html gen fixed upstream (Closes: #111778)
slib (2d4-2) unstable; urgency=low
* Fix url for upstream source (Closes: #144981)
* Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
* Add build depends.
slib (2d4-1) unstable; urgency=low
* New upstream.
slib (2d3-1) unstable; urgency=low
* New upstream.
* Remove texi2html call in debian/rules. Now done upstream. Add make
html instead.
* Changes to rules and doc-base to conform to upstream html gen
* Clean up upstream makefile to make sure it cleans up after itself.
Diffstat (limited to 'random.scm')
-rw-r--r-- | random.scm | 69 |
1 files changed, 35 insertions, 34 deletions
@@ -1,5 +1,5 @@ ;;;; "random.scm" Pseudo-Random number generator for scheme. -;;; Copyright (C) 1991, 1993, 1998, 1999 Aubrey Jaffer +;;; Copyright (C) 1991, 1993, 1998, 1999, 2002, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; @@ -19,8 +19,14 @@ (require 'byte) (require 'logical) +(require-if 'compiling 'object->string) ; for make-random-state + +;;@code{(require 'random)} +;;@ftindex random ;;; random:chunk returns an integer in the range of 0 to 255. +;;; export for random-inexact: +;;@ (define (random:chunk sta) (cond ((positive? (byte-ref sta 258)) (byte-set! sta 258 0) @@ -39,34 +45,30 @@ ans)))) -;;@args n ;;@args n state -;;Accepts a positive integer or real @1 and returns a number of the -;;same type between zero (inclusive) and @1 (exclusive). The values -;;returned by @0 are uniformly distributed from 0 to @1. +;;@args n +;; +;;@1 must be an exact positive integer. @0 returns an exact integer +;;between zero (inclusive) and @1 (exclusive). The values returned by +;;@0 are uniformly distributed from 0 to @1. ;; -;;The optional argument @var{state} must be of the type returned by -;;@code{(seed->random-state)} or @code{(make-random-state)}. It defaults -;;to the value of the variable @code{*random-state*}. This object is used -;;to maintain the state of the pseudo-random-number generator and is -;;altered as a side effect of calls to @code{random}. +;;The optional argument @2 must be of the type returned by +;;@code{(seed->random-state)} or @code{(make-random-state)}. It +;;defaults to the value of the variable @code{*random-state*}. This +;;object is used to maintain the state of the pseudo-random-number +;;generator and is altered as a side effect of calls to @code{random}. (define (random modu . args) - (let ((state (if (null? args) *random-state* (car args)))) - (if (exact? modu) - (letrec ((bitlen (integer-length (+ -1 modu))) - (rnd (lambda () - (do ((bln bitlen (+ -8 bln)) - (rbs 0 (+ (ash rbs 8) (random:chunk state)))) - ((<= bln 7) - (set! rbs (+ (ash rbs bln) - (bit-field (random:chunk state) 0 bln))) - (and (< rbs modu) rbs)))))) - (do ((ans (rnd) (rnd))) (ans ans))) - (* (random:uniform1 state) modu)))) - -(define random:random random) -;;;random:uniform is in randinex.scm. It is needed only if inexact is -;;;supported. + (define state (if (null? args) *random-state* (car args))) + (define bitlen (integer-length (+ -1 modu))) + (define (rnd) + (do ((bln bitlen (+ -8 bln)) + (rbs 0 (+ (ash rbs 8) (random:chunk state)))) + ((<= bln 7) + (if (positive? bln) + (set! rbs (logxor (ash rbs bln) + (random:chunk state)))) + (if (< rbs modu) rbs (rnd))))) + (rnd)) ;;@defvar *random-state* @@ -84,7 +86,7 @@ ;;@args ;;Returns a new copy of @code{*random-state*}. (define (copy-random-state . sta) - (string-copy (if (null? sta) *random-state* (car sta)))) + (bytes-copy (if (null? sta) *random-state* (car sta)))) ;;@body @@ -105,11 +107,13 @@ ; merge seed into state (do ((i 0 (+ 1 i)) (j 0 (modulo (+ 1 j) seed-len)) - (seed-len (bytes-length seed)) + (seed-len (string-length seed)) (k 0)) ((>= i 256)) (let ((swp (byte-ref sta i))) - (set! k (logand #xff (+ k (byte-ref seed j) swp))) + (set! k (logand #xff (+ k + (modulo (char->integer (string-ref seed j)) 255) + swp))) (byte-set! sta i (byte-ref sta k)) (byte-set! sta k swp))) sta) @@ -131,9 +135,6 @@ (require 'object->string) (set! seed (object->limited-string seed 50))))) (seed->random-state seed))) - +;@ (define *random-state* (make-random-state "http://swissnet.ai.mit.edu/~jaffer/SLIB.html")) - -(provide 'random) ;to prevent loops -(if (provided? 'inexact) (require 'random-inexact)) |