cmwc.rkt
#lang racket
(require data/queue)
(provide 
 (contract-out
  (make-cmwc-gen (-> (listof integer?) integer? integer? integer? (-> integer?)))
  (make-default-cmwc-gen (-> integer? (-> integer?)))
  (make-cmwc-gen-raw (-> queue? integer? integer? integer? (-> integer?)))
  (init-cmwc-seed (-> integer? integer? queue?))))

(define PHI 2654435769)

(define (cmwc x a b c)
  (let* ((x0 (dequeue! x))
         (x-new (modulo (- (sub1 b) (+ (* a x0) c)) b))
         (c-new (quotient (+ (* a x0) c) b)))
    (enqueue! x x-new)
    (values x-new c-new)))

(define (make-cmwc-gen seed a b c)
  (let ((x-reg (make-queue)))
    (for-each (λ (x)
                (enqueue! x-reg x))
              seed)
    (make-cmwc-gen-raw x-reg a b c)))

(define (make-cmwc-gen-raw seed a b c)
  (let ((c-reg (box c)))
    (λ () 
      (let-values (((x-new c-new) (cmwc seed a b (unbox c-reg))))
        (set-box! c-reg c-new)
        x-new))))

(define (init-cmwc-seed init lag)
  (let ((seed (make-queue))
        (q1 (box init))
        (q2 (box (+ init PHI)))
        (q3 (box (+ init PHI PHI)))
        (q4 (box #f)))
    (begin
      (enqueue! seed (unbox q1))
      (enqueue! seed (unbox q2))
      (enqueue! seed (unbox q3)))
    (for ((i (in-range 3 lag)))
      (begin
        (set-box! q4 (bitwise-xor (unbox q2) (unbox q1) PHI i))
        (set-box! q1 (unbox q2))
        (set-box! q2 (unbox q3))
        (set-box! q3 (unbox q4))
        (enqueue! seed (unbox q4))))
    seed))

(define (make-default-cmwc-gen seed) (make-cmwc-gen-raw (init-cmwc-seed seed 4096) 18782 (expt 2 32) 362436))