;;;; random-system.scm ;;;; Kon Lovett, Oct '21 (module random-system (;export make-random-source-system) (import scheme (chicken base) (chicken foreign) (only (chicken flonum) maximum-flonum) (chicken random) (only (srfi 4) make-u8vector u8vector? u8vector-length u8vector->blob blob->u8vector u8vector->blob/shared blob->u8vector/shared) (type-checks-numbers integer) random-source entropy-source) ;;; #; ;UNUSED (define (blob-copy old) (import (only (chicken blob) make-blob blob-size)) (import (only (chicken memory) move-memory!)) (let ((new (make-blob (blob-size old)))) (move-memory! old new ) new ) ) #; ;UNUSED (define (entropy-source-blob es n blb) (u8vector->blob/shared (entropy-source-u8vector es n (blob->u8vector/shared blb))) ) (define (u8vector-copy vec) (blob->u8vector/shared (u8vector->blob vec)) ) (define (entropy-source-u8vector es n vec) ((@entropy-source-u8vector es) n vec) ) ;;; (define fpMAX maximum-flonum) (define-constant LOG2-PERIOD 512) #; ;UNUSED (define eMAX (inexact->exact fpMAX)) ;Create a "bignum" if necessary (define STATE-LENGTH (foreign-value "C_RANDOM_STATE_SIZE" unsigned-int)) (define-constant INTERNAL-ID 'system) (define-constant EXTERNAL-ID 'system) ;;; (define (set-seed! state) (set-pseudo-random-seed! (u8vector->blob/shared state)) state ) (define (init-state state) (random-bytes (u8vector->blob/shared state))) (define (make-state) (make-u8vector STATE-LENGTH)) (define (system-initial-state) (let ((state (make-state))) (init-state state) state ) ) #; ;internal state unavailable (define (external-state? obj) (and (pair? obj) (eq? EXTERNAL-ID (car obj)) (u8vector? (cdr obj)) ;lenient input (<= STATE-LENGTH (u8vector-length (cdr obj))) ) ) #; ;internal state unavailable (define (system-unpack-state state) (cons EXTERNAL-ID (u8vector-copy state)) ) #; ;internal state unavailable (define (system-pack-state external-state) (unless (external-state? external-state) (error 'system-pack-state "malformed state" external-state) ) (u8vector-copy (cdr external-state)) ) (define (system-randomize-state state entropy-source) (entropy-source-u8vector entropy-source STATE-LENGTH state) ) (define (system-pseudo-randomize-state i j) (system-initial-state) #; ;FIXME incorporate pseudo-randomize (let ((state (make-state))) (init-state state (+ i j)) state ) ) ;;; (define (make-random-source-system) (let ((state (set-seed! (system-initial-state)))) (*make-random-source ; make-random-source-system ; EXTERNAL-ID ; "Random from system" ; LOG2-PERIOD ; fpMAX ; #f ; #; ;internal state unavailable (lambda () (system-unpack-state state)) #f ; #; ;internal state unavailable (lambda (new-state) (set! state (set-seed! (system-pack-state new-state)))) #f ; (lambda (entropy-source) (set! state (set-seed! (system-randomize-state state entropy-source))) ) ; (lambda (i j) (set! state (set-seed! (system-pseudo-randomize-state i j))) ) ; (lambda () (lambda (n) (pseudo-random-integer (check-positive-integer INTERNAL-ID n 'range)) ) ) ; (lambda (prec) #; ;always true, eMAX = integer(fpMAX) (assert (native-real-precision? prec eMAX)) pseudo-random-real ) ) ) ) ;;; ;;; Module Init ;;; (register-random-source! INTERNAL-ID make-random-source-system) ) ;module random-system