From 8466d8cfa486fb30d1755c4261b781135083787b Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:29 -0800
Subject: Import Upstream version 3a1

---
 random.scm | 69 +++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 35 insertions(+), 34 deletions(-)

(limited to 'random.scm')

diff --git a/random.scm b/random.scm
index 9f9ee98..ac66357 100644
--- a/random.scm
+++ b/random.scm
@@ -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))
-- 
cgit v1.2.3