;;;; "random.scm" Pseudo-Random number generator for scheme.
;;; Copyright (C) 1991, 1993 Aubrey Jaffer.
;
;Permission to copy this software, to redistribute it, and to use it
;for any purpose is granted, subject to the following restrictions and
;understandings.
;
;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
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3.  In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.

(require 'byte)
(require 'logical)

(define (make-rng seed)
  (define mutex #f)
  (define idx 0)
  (define idy 0)
  (define sta (make-bytes 256))
					; initialize state
  (do ((idx #xff (+ -1 idx)))
      ((negative? idx))
    (byte-set! sta idx idx))

  (if (number? seed)
      (set! seed (number->string seed)))

					; merge seed into state
  (do ((idx 0 (+ 1 idx))
       (kdx 0 (modulo (+ 1 kdx) seed-len))
       (seed-len (bytes-length seed)))
      ((>= idx 256) (set! idy 0))
    (let ((swp (byte-ref sta idx)))
      (set! idy (logand #xff (+ idy (byte-ref seed kdx) swp)))
      (byte-set! sta idx (byte-ref sta idy))
      (byte-set! sta idy swp)))
					; spew
  (lambda ()
    (if mutex (slib:error "random state called reentrantly"))
    (set! mutex #t)
    (set! idx (logand #xff (+ 1 idx)))
    (let ((xtm (byte-ref sta idx)))
      (set! idy (logand #xff (+ idy xtm)))
      (let ((ytm (byte-ref sta idy)))
	(byte-set! sta idy xtm)
	(byte-set! sta idx ytm)
	(let ((ans (byte-ref sta (logand #xff (+ ytm xtm)))))
	  (set! mutex #f)
	  ans)))))

(define *random-state*
  (make-rng "http://swissnet.ai.mit.edu/~jaffer/SLIB.html"))

;;; random:chunk returns an integer in the range of 0 to 255.
(define (random:chunk v) (v))

(define (random:random modu . args)
  (let ((state (if (null? args) *random-state* (car args))))
    (if (exact? modu)
	(let ((bitlen (integer-length (+ -1 modu))))
	  (do ((bln bitlen (+ -8 bln))
	       (rbs 0 (+ (ash rbs 8) (random:chunk state))))
	      ((<= bln 7)
	       (modulo
		(if (zero? bln) rbs
		    (+ (ash rbs bln)
		       (logand (bit-field (random:chunk state) 0 bln))))
		modu))))

	(* (random:uniform state) modu))))
;;;random:uniform is in randinex.scm.  It is needed only if inexact is
;;;supported.

(define (make-random-state . args)
  (let ((seed (if (null? args)
		  (do ((bts (make-bytes 10))
		       (idx 0 (+ 1 idx)))
		      ((>= idx 10) bts)
		    (byte-set! bts idx (random:random 256)))
		  (let ()
		    (require 'object->string)
		    (object->limited-string (car args) 20)))))
    (make-rng seed)))

(define random random:random)

(provide 'random)			;to prevent loops
(if (provided? 'inexact) (require 'random-inexact))