Changeset 34021 in project for release/4


Ignore:
Timestamp:
04/23/17 23:56:47 (3 years ago)
Author:
Kon Lovett
Message:

Revert to own clock entropy implementation; no seed access. Fix vector map/fill; wrong args. Use EXTERNAL-ID for name so avail.

Location:
release/4/srfi-27
Files:
4 added
3 deleted
11 edited
26 copied

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/tags/3.2.5/composite-random-source.scm

    r34012 r34021  
    11;;;; composite-random-source.scm
    22;;;; Kon Lovett, Oct '09
     3
     4#|
     5=== Composite Random Source
     6
     7==== Usage
     8
     9<enscript language=scheme>
     10(use composite-random-source)
     11</enscript>
     12
     13==== composite-random-source
     14
     15<procedure>(composite-random-source [RANDOM-SOURCE ...] [#:comb-int (COMB-INT INTEGER-COMBINE)] [#:comb-real (COMB-REAL REAL-COMBINE)]) => random-source</procedure>
     16
     17Returns a new {{random-source}} that combines the behaviors of the supplied
     18{{RANDOM-SOURCE ...}}.
     19
     20{{INTEGER-COMBINE}} default is {{(lambda (ints bnd) (modulo (apply + ints) bnd))}}.
     21
     22{{REAL-COMBINE}} default is {{(lambda (reals prec) (apply * reals))}}.
     23
     24Does not register the constructed {{random-source}}.
     25
     26Experimental at best.
     27|#
    328
    429(module composite-random-source
     
    1237(import
    1338  (only data-structures conc reverse-string-append ->string intersperse)
    14   (only type-errors error-argument-type)
    15   random-source)
    16 (require-library data-structures type-errors random-source)
     39  (only type-errors error-argument-type))
     40(require-library data-structures type-errors)
    1741
    18 ;; *composite-random-source
     42(use srfi-1)
     43(use numbers)
     44(use random-source srfi-27-vector-support srfi-27)
     45
    1946;;
    20 ;; returns the composite constructor
    2147
    22 (define *composite-random-source
    23   (let ((random-states?
    24           (lambda (obj k n)
    25             (and
    26               (pair? obj)
    27               (eq? k (car obj))
    28               (list? obj)
    29               (= n (- (length obj) 1)))))
    30         (state-ref
    31           (lambda (s)
    32             ((@random-source-state-ref s))))
    33         (state-set!
    34           (lambda (s state)
    35             ((@random-source-state-ref s) state)))
    36         (make-integers
    37           (lambda (s)
    38             ((@random-source-make-integers s)))) )
    39     (lambda (comb-int comb-real name docu log2-period maxrng srcs)
    40       (let ((srcs-cnt (length srcs))
    41             (make-integers (map make-integers srcs)) )
    42         (letrec ((ctor
    43                   (lambda (#!optional (name name) (docu docu))
    44                     (*make-random-source
    45                       ;
    46                       ctor
    47                       ;
    48                       name
    49                       ;
    50                       docu
    51                       ;
    52                       log2-period
    53                       ;
    54                       maxrng
    55                       ;entropy-source
    56                       ;FIXME provide combine entropy-source
    57                       #f
    58                       ;state-ref
    59                       (lambda ()
    60                         (cons name (map state-ref srcs)))
    61                       ;state-set!
    62                       (lambda (state)
    63                         (if (random-states? state name srcs-cnt)
    64                           (for-each state-set! srcs (cdr state))
    65                           (error-argument-type
    66                             (string->symbol (conc name #\- 'state-set!))
    67                             state
    68                             'composite-random-state) ) )
    69                       ;randomize!
    70                       (lambda (e)
    71                         (for-each
    72                           (lambda (s)
    73                             ((@random-source-randomize! s) e))
    74                           srcs) )
    75                       ;pseudo-randomize!
    76                       (lambda (i j)
    77                         (for-each
    78                           (lambda (s)
    79                             ((@random-source-pseudo-randomize! s) i j) )
    80                           srcs) )
    81                       ;make-integers
    82                       (lambda ()
    83                         (lambda (n)
    84                           (comb-int (map (cut <> n) make-integers) n)))
    85                       ;make-reals
    86                       (lambda (unit)
    87                         (let ((makrels
    88                                 (map
    89                                   (lambda (s)
    90                                     ((@random-source-make-reals s) unit) )
    91                                   srcs)))
    92                           (lambda ()
    93                             (comb-real (map (cut <>) makrels) unit) ) ) ) ) ) ) )
    94           ctor ) ) ) ) )
     48(define (pull-rest-argument rest0)
     49  (let loop ((irest rest0) (orest '()))
     50    (cond
     51      ((null? irest)
     52        (reverse! orest) )
     53      ((keyword? (car irest))
     54        (loop (cddr irest) orest) )
     55      (else
     56        (loop (cdr irest) (cons (car irest) orest)) ) ) ) )
    9557
    9658;; composite-random-source
     
    10870
    10971(define (composite-random-source
    110           #!rest srcs0
     72          #!rest rest0
    11173          #!key
    112             (comb-int (lambda (ints n) (modulo (apply + ints) n)))
    113             (comb-real (lambda (reals unit) (apply * reals))))
    114   ; scrub keyword arguments
    115   (let ((srcs
    116           (let loop ((isrcs srcs0) (osrcs '()))
    117             (if (null? isrcs)
    118               (if (null? osrcs)
    119                 (error 'composite-random-source "no random-sources to combine")
    120                 (reverse osrcs) ) )
    121               (if (keyword? (car isrcs)) (loop (cddr isrcs) osrcs)
    122                 (begin
    123                   (check-random-source 'composite-random-source (car isrcs))
    124                   (loop (cdr isrcs) (cons (car isrcs) osrcs)) ) ) ) ) )
     74            (comb-int (lambda (ints n) (modulo (reduce + 0 ints) n)))
     75            (comb-real (lambda (reals unit) (reduce * 1.0 reals))))
     76  ;scrub keyword arguments
     77  (let* (
     78      (rest (pull-rest-argument rest0) )
     79      (srcs0
     80        (if (null? rest)
     81          (error 'composite-random-source "no random-sources to combine")
     82          (map (cut check-random-source 'composite-random-source <>) rest) ) ) )
    12583    ; collect features
    126     (let loop ((srcs srcs) (names '()) (docus '()) (log2-periods '()) (maxrngs '()))
     84    (let loop ((srcs srcs0) (names '()) (docus '()) (log2-periods '()) (maxrngs '()))
    12785      (if (null? srcs)
    128           ;then make composed random-source
    129           (*composite-random-source
    130             comb-int comb-real
    131             (string->symbol (reverse-string-append (intersperse names "+")))
    132             (reverse-string-append (intersperse docus " & "))
    133             ;FIXME minimum? (if this is good then apply along the way)
    134             (apply min log2-periods)
    135             (apply min maxrngs)
    136             srcs)
    137           ;else collect info
    138           (let ((s (car srcs)))
    139             (loop (cdr srcs)
    140                   (cons (->string (*random-source-name s)) names)
    141                   (cons (*random-source-documentation s) docus)
    142                   (cons (*random-source-log2-period s) log2-periods)
    143                   (cons (*random-source-maximum-range s) maxrngs)) ) ) ) ) )
     86        ;then make composed random-source
     87        (*composite-random-source
     88          comb-int comb-real
     89          (string->symbol (reverse-string-append (intersperse names "+")))
     90          (reverse-string-append (intersperse docus " & "))
     91          ;FIXME minimum? (if this is good then apply along the way)
     92          (apply min log2-periods)
     93          (apply min maxrngs)
     94          srcs0)
     95        ;else collect info
     96        (let ((rs (car srcs)))
     97          (loop
     98            (cdr srcs)
     99            (cons (->string (*random-source-name rs)) names)
     100            (cons (*random-source-documentation rs) docus)
     101            (cons (*random-source-log2-period rs) log2-periods)
     102            (cons (*random-source-maximum-range rs) maxrngs)) ) ) ) ) )
     103
     104;; *composite-random-source
     105;;
     106;; returns the composite constructor
     107
     108(define (*composite-random-source comb-int comb-real def-name def-docu log2-period maxrng srcs)
     109  (let ((srcs-cnt (length srcs))
     110        (composite-make-integers (map random-source-make-integers srcs)) )
     111    (letrec (
     112        (ctor
     113          (lambda (#!optional (name def-name) (docu def-docu))
     114            (let ((name-state-set!-id (string->symbol (conc name #\- 'state-set!))))
     115              (*make-random-source
     116                ;
     117                ctor
     118                ;
     119                name
     120                ;
     121                docu
     122                ;
     123                log2-period
     124                ;
     125                maxrng
     126                ;entropy-source
     127                #f
     128                ;state-ref
     129                (lambda ()
     130                  (cons name (map composite-state-ref srcs)))
     131                ;state-set!
     132                (lambda (state)
     133                  (if (composite-random-state? state name srcs-cnt)
     134                    (for-each composite-state-set! srcs (cdr state))
     135                    (error-argument-type name-state-set!-id state 'composite-random-state) ) )
     136                ;randomize!
     137                (lambda (es)
     138                  (for-each
     139                    (lambda (rs)
     140                      ((@random-source-randomize! rs) es) )
     141                    srcs) )
     142                ;pseudo-randomize!
     143                (lambda (i j)
     144                  (for-each
     145                    (lambda (rs)
     146                      ((@random-source-pseudo-randomize! rs) i j) )
     147                    srcs) )
     148                ;make-integers
     149                (lambda ()
     150                  (lambda (n)
     151                    (comb-int (map (cut <> n) composite-make-integers) n)))
     152                ;make-reals
     153                (lambda (unit)
     154                  (let (
     155                      (makrels
     156                        (map
     157                          (lambda (rs)
     158                            ((@random-source-make-reals rs) unit) )
     159                          srcs)))
     160                    (lambda ()
     161                      (comb-real (map (cut <>) makrels) unit) ) ) ) ) ) ) ) )
     162      ctor ) ) )
     163
     164(define (composite-random-state? obj k n)
     165  (and
     166    (pair? obj)
     167    (eq? k (car obj))
     168    (fx= n (fx- (length obj) 1)) ) )
     169
     170(define (composite-state-ref s)
     171  ((@random-source-state-ref s)) )
     172
     173(define (composite-state-set! s state)
     174  ((@random-source-state-set! s) state) )
    144175
    145176) ;module composite-random-source
  • release/4/srfi-27/tags/3.2.5/entropy-clock.scm

    r34012 r34021  
    1313;;;
    1414
    15 #|
    1615#>
    1716#include <time.h>
     
    3433(define f64init (foreign-lambda double "f64init"))
    3534(define f64rand (foreign-lambda double "f64rand" double))
    36 |#
    37 
    38 (import extras)
    39 
    40 (define (f64init) (randomize))
    41 (define (f64rand n) (random n))
    4235
    4336;;; Entropy from system clock
  • release/4/srfi-27/tags/3.2.5/entropy-source.scm

    r34015 r34021  
    5050;;
    5151
    52 (define (entropy-source-integer entropy-source)
     52(define (entropy-source-integer es)
    5353  ;ugly but ...
    54   (let ((get-f64 (@entropy-source-f64 entropy-source)))
    55     (let loop ((x (get-f64)))
     54  (let ((genf64 (@entropy-source-f64 es)))
     55    (let loop ((x (genf64)))
    5656      (if (integer? x)
    5757        x
    58         (loop (get-f64)) ) ) ) )
     58        (loop (genf64)) ) ) ) )
    5959
    6060(define entropy-source-f64-integer entropy-source-integer)
  • release/4/srfi-27/tags/3.2.5/moa.scm

    r34012 r34021  
    244244      (modulo
    245245        (fpabs (entropy-source-f64-integer entropy-source))
    246         (expt 2 64))))
     246        fpMAX)))
    247247  state )
    248248
     
    266266      make-random-source-moa
    267267      ;
    268       INTERNAL-ID
     268      EXTERNAL-ID
    269269      ;
    270270      "George Marsaglia's Mother-Of-All Generator"
  • release/4/srfi-27/tags/3.2.5/mrg32k3a.scm

    r34012 r34021  
    488488      make-random-source-mrg32k3a
    489489      ;
    490       INTERNAL-ID
     490      EXTERNAL-ID
    491491      ;
    492492      "Pierre L'Ecuyer's Combined Multiple Recursive Generator"
  • release/4/srfi-27/tags/3.2.5/mwc.scm

    r34012 r34021  
    239239      (modulo
    240240        (fpabs (entropy-source-f64-integer entropy-source))
    241         (expt 2 64))))
     241        fpMAX)))
    242242  state )
    243243
     
    263263      make-random-source-mwc
    264264      ;
    265       INTERNAL-ID
     265      EXTERNAL-ID
    266266      ;
    267267      "George Marsaglia's Multiply With Carry Generator"
  • release/4/srfi-27/tags/3.2.5/srfi-27-vector-support.scm

    r34015 r34021  
    102102
    103103(define (vector-fold/1 vec proc seed)
    104   (vector-fold (cut proc #f <> <>) seed vec) )
     104  (vector-fold proc seed vec) )
    105105
    106106(define (vector-map!/1 vec proc)
    107   (vector-map! (cut proc #f <>) vec) )
     107  (vector-map! proc vec) )
    108108
    109109#; ;NOT YET
  • release/4/srfi-27/tags/3.2.5/srfi-27.meta

    r34017 r34021  
    1717        (synch "2.1.0")
    1818        #;(random-bsd "0.2"))
    19  (files "mrg32k3a.scm" "srfi-27.meta" "srfi-27-uniform-random.scm" "mwc.scm"
     19 (files
     20 ;"bsdrnd.scm" "composite-random-source.scm" "composite-entropy-source.scm"
     21 "mrg32k3a.scm" "srfi-27.meta" "srfi-27-uniform-random.scm" "mwc.scm"
    2022 "srfi-27.setup" "entropy-procedure.scm" "srfi-27.release-info"
    2123 "srfi-27-implementation" "srfi-27-numbers.scm" "fp-extn.scm"
    22  "entropy-unix.scm" "composite-random-source.scm" "entropy-source.scm"
     24 "entropy-unix.scm" "entropy-source.scm"
    2325 "entropy-clock.scm" "random-source.scm" "srfi-27-vector-support.scm"
    2426 "srfi-27-distributions.scm" "srfi-27-vector.scm" "srfi-27.scm"
    2527 "entropy-windows.scm" "moa.scm" "entropy-support.scm"
    26  #;"bsdrnd.scm"
    2728 "source-registration.scm" "tests/test-diehard.scm" "tests/test-confidence.scm"
    2829 "tests/test-mrg32k3a.scm" "tests/run.scm" "entropy-port.scm") )
  • release/4/srfi-27/tags/3.2.5/srfi-27.scm

    r34017 r34021  
    4545(import
    4646  (only data-structures alist-ref alist-update!)
    47   (only srfi-4 make-u8vector make-f64vector)
    48   (only miscmacros define-parameter)
    49   type-checks
    50   srfi-4-checks
     47  (only srfi-4 make-u8vector make-f64vector))
     48(require-library data-structures srfi-4)
     49
     50(import (only miscmacros define-parameter))
     51(require-library miscmacros)
     52
     53(import
    5154  (only type-errors error-argument-type warning-argument-type)
    52   random-source
    53   entropy-source
    54   entropy-clock
    55   mrg32k3a
    5655  (only srfi-27-numbers check-real-precision)
    5756  (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
    5857(require-library
    59   data-structures srfi-4
    60   miscmacros
    61   random-source entropy-source
    62   mrg32k3a entropy-clock
    63   type-checks type-errors srfi-4-checks
     58  type-errors
    6459  srfi-27-numbers srfi-27-vector-support)
     60
     61(use
     62  type-checks srfi-4-checks
     63  random-source mrg32k3a
     64  entropy-source entropy-clock)
    6565
    6666;;; Entropy Source
  • release/4/srfi-27/tags/3.2.5/srfi-27.setup

    r34017 r34021  
    77;; Utility Modules
    88
    9 (setup-shared-extension-module 'fp-extn (extension-version "3.2.4")
     9(define utiloptn '(
     10  -optimize-level 3 -debug-level 0
     11  -no-procedure-checks -no-argc-checks -no-bound-checks))
     12#;(define utiloptn '())
     13
     14(define publoptn '(
     15  -optimize-level 3 -debug-level 1
     16  -no-procedure-checks))
     17#;(define publoptn '())
     18
     19(setup-shared-extension-module 'fp-extn (extension-version "3.2.5")
    1020  #:inline? #t
    1121  #:types? #t
    12   #:compile-options '(
    13     -scrutinize -optimize-level 3 -debug-level 0
    14     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     22  #:compile-options `(-scrutinize ,@utiloptn) )
    1523
    16 (setup-shared-extension-module 'source-registration (extension-version "3.2.4")
     24(setup-shared-extension-module 'source-registration (extension-version "3.2.5")
    1725  #:inline? #t
    1826  #:types? #t
    19   #:compile-options '(
    20     -scrutinize -optimize-level 3 -debug-level 1
    21     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     27  #:compile-options `(-scrutinize ,@utiloptn) )
    2228
    23 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.4")
     29(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.5")
    2430  #:inline? #t
    2531  #:types? #t
    26   #:compile-options '(
    27     -scrutinize -optimize-level 3 -debug-level 0
    28     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     32  #:compile-options `(-scrutinize ,@utiloptn) )
    2933
    30 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.4")
     34(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.5")
    3135  #:inline? #t
    3236  #:types? #t
    33   #:compile-options '(
    34     -scrutinize -optimize-level 3 -debug-level 0
    35     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     37  #:compile-options `(-scrutinize ,@utiloptn) )
    3638
    3739;; Entropy Source Modules
    3840
    39 (setup-shared-extension-module 'entropy-source (extension-version "3.2.4")
     41(setup-shared-extension-module 'entropy-source (extension-version "3.2.5")
    4042  #:inline? #t
    4143  #:types? #t
    42   #:compile-options '(
    43     -scrutinize -optimize-level 3 -debug-level 1
    44     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     44  #:compile-options `(-scrutinize ,@utiloptn) )
    4545
    46 (setup-shared-extension-module 'entropy-support (extension-version "3.2.4")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.5")
    4747  #:inline? #t
    4848  #:types? #t
    49   #:compile-options '(
    50     -scrutinize -optimize-level 3 -debug-level 0
    51     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     49  #:compile-options `(-scrutinize ,@utiloptn) )
    5250
    53 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.4")
     51(setup-shared-extension-module 'entropy-clock (extension-version "3.2.5")
     52  #:inline? #t
     53  #:types? #t
     54  #:compile-options `(-scrutinize ,@publoptn) )
     55
     56(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.5")
    5457  #:inline? #t
    5558  #:types? #t
     
    5861    -no-procedure-checks) )
    5962
    60 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.4")
     63(setup-shared-extension-module 'entropy-port (extension-version "3.2.5")
    6164  #:inline? #t
    6265  #:types? #t
    63   #:compile-options '(
    64     -scrutinize -optimize-level 3 -debug-level 1
    65     -no-procedure-checks) )
     66  #:compile-options `(-scrutinize ,@publoptn) )
    6667
    67 (setup-shared-extension-module 'entropy-port (extension-version "3.2.4")
     68#+unix
     69(setup-shared-extension-module 'entropy-unix (extension-version "3.2.5")
    6870  #:inline? #t
    6971  #:types? #t
    70   #:compile-options '(
    71     -scrutinize -optimize-level 3 -debug-level 1
    72     -no-procedure-checks) )
     72  #:compile-options `(-scrutinize ,@publoptn) )
    7373
    74 #+unix
    75 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.4")
     74#+windows
     75(setup-shared-extension-module 'entropy-windows (extension-version "3.2.5")
    7676  #:inline? #t
    7777  #:types? #t
    78   #:compile-options '(
    79     -scrutinize -optimize-level 3 -debug-level 1
    80     -no-procedure-checks) )
     78  #:compile-options `(-scrutinize ,@publoptn) )
    8179
    82 #+windows
    83 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.4")
     80#;
     81(setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.5")
    8482  #:inline? #t
    8583  #:types? #t
    86   #:compile-options '(
    87     -scrutinize -optimize-level 3 -debug-level 1
    88     -no-procedure-checks) )
     84  #:compile-options `(-scrutinize ,@publoptn) )
    8985
    9086;; Random Source Modules
    9187
    92 (setup-shared-extension-module 'random-source (extension-version "3.2.4")
     88(setup-shared-extension-module 'random-source (extension-version "3.2.5")
    9389  #:inline? #t
    9490  #:types? #t
    95   #:compile-options '(
    96     -scrutinize -optimize-level 3 -debug-level 1
    97     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     91  #:compile-options `(-scrutinize ,@utiloptn) )
    9892
    99 #;(setup-shared-extension-module 'bsdrnd (extension-version "3.2.4")
     93(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.5")
    10094  #:inline? #t
    10195  #:types? #t
    102   #:compile-options '(
    103     -scrutinize -optimize-level 3 -debug-level 0
    104     -no-procedure-checks -no-argc-checks -no-bound-checks ) )
     96  #:compile-options `(-scrutinize ,@utiloptn) )
    10597
    106 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.4")
     98(setup-shared-extension-module 'mwc (extension-version "3.2.5")
    10799  #:inline? #t
    108100  #:types? #t
    109   #:compile-options '(
    110     -scrutinize
    111     ;-optimize-level 3 -debug-level 0
    112     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     101  #:compile-options `(-scrutinize ,@utiloptn) )
    113102
    114 (setup-shared-extension-module 'mwc (extension-version "3.2.4")
     103(setup-shared-extension-module 'moa (extension-version "3.2.5")
    115104  #:inline? #t
    116105  #:types? #t
    117   #:compile-options '(
    118     -scrutinize -optimize-level 3 -debug-level 0
    119     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     106  #:compile-options `(-scrutinize ,@utiloptn) )
    120107
    121 (setup-shared-extension-module 'moa (extension-version "3.2.4")
     108#;
     109(setup-shared-extension-module 'bsdrnd (extension-version "3.2.5")
    122110  #:inline? #t
    123111  #:types? #t
    124   #:compile-options '(
    125     -scrutinize -optimize-level 3 -debug-level 0
    126     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     112  #:compile-options `(-scrutinize ,@utiloptn) )
    127113
    128 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.4")
     114#;
     115(setup-shared-extension-module 'composite-random-source (extension-version "3.2.5")
    129116  #:inline? #t
    130117  #:types? #t
    131   #:compile-options '(
    132     -scrutinize -optimize-level 3 -debug-level 1
    133     -no-procedure-checks) )
     118  #:compile-options `(-scrutinize ,@publoptn) )
    134119
    135120;; Main Modules
    136121
    137 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.4")
     122(setup-shared-extension-module 'srfi-27 (extension-version "3.2.5")
    138123  #:inline? #t
    139124  #:types? #t
    140   #:compile-options '(
    141     -scrutinize -optimize-level 3 -debug-level 1
    142     -no-procedure-checks) )
     125  #:compile-options `(-scrutinize ,@publoptn) )
    143126
    144 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.4")
     127(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.5")
    145128  #:inline? #t
    146129  #:types? #t
    147   #:compile-options '(
    148     -scrutinize ;-optimize-level 3 -debug-level 1
    149     #;-no-procedure-checks) )
     130  #:compile-options `(-scrutinize ,@publoptn) )
    150131
    151 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.4")
     132(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.5")
    152133  #:inline? #t
    153134  #:types? #t
    154   #:compile-options '(
    155     -scrutinize -optimize-level 3 -debug-level 1
    156     -no-procedure-checks) )
     135  #:compile-options `(-scrutinize ,@publoptn) )
    157136
    158 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.4")
     137(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.5")
    159138  #:inline? #t
    160139  #:types? #t
    161   #:compile-options '(
    162     -scrutinize -optimize-level 3 -debug-level 1
    163     -no-procedure-checks) )
     140  #:compile-options `(-scrutinize ,@publoptn) )
  • release/4/srfi-27/tags/3.2.5/tests/run.scm

    r34017 r34021  
    1010;(newline)
    1111
    12 (test-begin "SRFI 27")
     12#|
     13(use bsdrnd)
     14
     15(make-random-source 'bsd)
     16|#
    1317
    1418#|
    15 (use bsdrnd)
    16 (make-random-source 'bsd)
     19(use composite-random-source)
     20(use mwc mrg32k3a moa)
     21
     22(test-group "composite random"
     23  (let* (
     24      (crs-ctor
     25        (composite-random-source
     26          (make-random-source-mwc)
     27          (make-random-source-mrg32k3a)
     28          (make-random-source-moa)) )
     29      (crs (crs-ctor) )
     30      (rndint (random-source-make-integers crs) )
     31      (rnd (random-source-make-reals crs) ) )
     32    (test-assert (procedure? rndint))
     33    (test-assert (procedure? rnd))
     34    (test-assert (integer? (rndint 10)))
     35    (test-assert (<= 0 (rndint 10)))
     36    (test-assert (<= (rndint 10) 10))
     37    (test-assert (inexact? (rnd)))
     38    (test-assert (random-source-randomize! crs))
     39    (test-assert (random-source-pseudo-randomize! crs 1 2))
     40  )
     41)
    1742|#
     43
     44#|
     45(use composite-entropy-source)
     46(use entropy-clock entropy-unix)
     47(use srfi-4)
     48
     49(test-group "composite entropy"
     50  (let* (
     51      (ces-ctor
     52        (composite-entropy-source
     53          (make-entropy-source-system-clock)
     54          (make-entropy-source-random-device)
     55          (make-entropy-source-urandom-device)) )
     56      (ces (ces-ctor) )
     57      (genu8 (entropy-source-u8 ces) )
     58      (genf64 (entropy-source-f64 ces) ) )
     59    (test-assert (integer? (genu8)))
     60    (test-assert (<= 0 (genu8)))
     61    (test-assert (<= (genu8) 255))
     62    (test-assert (flonum? (genf64)))
     63    (test-assert (u8vector? (entropy-source-u8vector ces 2)))
     64    (test-assert (= 2 (u8vector-length (entropy-source-u8vector ces 2))))
     65    (test-assert (f64vector? (entropy-source-f64vector ces 2)))
     66    (test-assert (= 2 (f64vector-length (entropy-source-f64vector ces 2))))
     67  )
     68)
     69|#
     70
     71;;
     72
     73(test-begin "SRFI 27")
    1874
    1975;;
     
    2177(use random-source entropy-source)
    2278
    23 (test-group "basics"
     79(test-group "basics entropy"
     80  (test-assert (entropy-source? (current-entropy-source)))
     81)
     82
     83(test-group "basics random"
    2484  (test-assert (random-source? default-random-source))
    2585  (test-assert (random-source? (current-random-source)))
    26   (test-assert (entropy-source? (current-entropy-source)))
    2786
    2887  (test-assert (procedure? random-integer))
  • release/4/srfi-27/trunk/composite-random-source.scm

    r34012 r34021  
    11;;;; composite-random-source.scm
    22;;;; Kon Lovett, Oct '09
     3
     4#|
     5=== Composite Random Source
     6
     7==== Usage
     8
     9<enscript language=scheme>
     10(use composite-random-source)
     11</enscript>
     12
     13==== composite-random-source
     14
     15<procedure>(composite-random-source [RANDOM-SOURCE ...] [#:comb-int (COMB-INT INTEGER-COMBINE)] [#:comb-real (COMB-REAL REAL-COMBINE)]) => random-source</procedure>
     16
     17Returns a new {{random-source}} that combines the behaviors of the supplied
     18{{RANDOM-SOURCE ...}}.
     19
     20{{INTEGER-COMBINE}} default is {{(lambda (ints bnd) (modulo (apply + ints) bnd))}}.
     21
     22{{REAL-COMBINE}} default is {{(lambda (reals prec) (apply * reals))}}.
     23
     24Does not register the constructed {{random-source}}.
     25
     26Experimental at best.
     27|#
    328
    429(module composite-random-source
     
    1237(import
    1338  (only data-structures conc reverse-string-append ->string intersperse)
    14   (only type-errors error-argument-type)
    15   random-source)
    16 (require-library data-structures type-errors random-source)
     39  (only type-errors error-argument-type))
     40(require-library data-structures type-errors)
    1741
    18 ;; *composite-random-source
     42(use srfi-1)
     43(use numbers)
     44(use random-source srfi-27-vector-support srfi-27)
     45
    1946;;
    20 ;; returns the composite constructor
    2147
    22 (define *composite-random-source
    23   (let ((random-states?
    24           (lambda (obj k n)
    25             (and
    26               (pair? obj)
    27               (eq? k (car obj))
    28               (list? obj)
    29               (= n (- (length obj) 1)))))
    30         (state-ref
    31           (lambda (s)
    32             ((@random-source-state-ref s))))
    33         (state-set!
    34           (lambda (s state)
    35             ((@random-source-state-ref s) state)))
    36         (make-integers
    37           (lambda (s)
    38             ((@random-source-make-integers s)))) )
    39     (lambda (comb-int comb-real name docu log2-period maxrng srcs)
    40       (let ((srcs-cnt (length srcs))
    41             (make-integers (map make-integers srcs)) )
    42         (letrec ((ctor
    43                   (lambda (#!optional (name name) (docu docu))
    44                     (*make-random-source
    45                       ;
    46                       ctor
    47                       ;
    48                       name
    49                       ;
    50                       docu
    51                       ;
    52                       log2-period
    53                       ;
    54                       maxrng
    55                       ;entropy-source
    56                       ;FIXME provide combine entropy-source
    57                       #f
    58                       ;state-ref
    59                       (lambda ()
    60                         (cons name (map state-ref srcs)))
    61                       ;state-set!
    62                       (lambda (state)
    63                         (if (random-states? state name srcs-cnt)
    64                           (for-each state-set! srcs (cdr state))
    65                           (error-argument-type
    66                             (string->symbol (conc name #\- 'state-set!))
    67                             state
    68                             'composite-random-state) ) )
    69                       ;randomize!
    70                       (lambda (e)
    71                         (for-each
    72                           (lambda (s)
    73                             ((@random-source-randomize! s) e))
    74                           srcs) )
    75                       ;pseudo-randomize!
    76                       (lambda (i j)
    77                         (for-each
    78                           (lambda (s)
    79                             ((@random-source-pseudo-randomize! s) i j) )
    80                           srcs) )
    81                       ;make-integers
    82                       (lambda ()
    83                         (lambda (n)
    84                           (comb-int (map (cut <> n) make-integers) n)))
    85                       ;make-reals
    86                       (lambda (unit)
    87                         (let ((makrels
    88                                 (map
    89                                   (lambda (s)
    90                                     ((@random-source-make-reals s) unit) )
    91                                   srcs)))
    92                           (lambda ()
    93                             (comb-real (map (cut <>) makrels) unit) ) ) ) ) ) ) )
    94           ctor ) ) ) ) )
     48(define (pull-rest-argument rest0)
     49  (let loop ((irest rest0) (orest '()))
     50    (cond
     51      ((null? irest)
     52        (reverse! orest) )
     53      ((keyword? (car irest))
     54        (loop (cddr irest) orest) )
     55      (else
     56        (loop (cdr irest) (cons (car irest) orest)) ) ) ) )
    9557
    9658;; composite-random-source
     
    10870
    10971(define (composite-random-source
    110           #!rest srcs0
     72          #!rest rest0
    11173          #!key
    112             (comb-int (lambda (ints n) (modulo (apply + ints) n)))
    113             (comb-real (lambda (reals unit) (apply * reals))))
    114   ; scrub keyword arguments
    115   (let ((srcs
    116           (let loop ((isrcs srcs0) (osrcs '()))
    117             (if (null? isrcs)
    118               (if (null? osrcs)
    119                 (error 'composite-random-source "no random-sources to combine")
    120                 (reverse osrcs) ) )
    121               (if (keyword? (car isrcs)) (loop (cddr isrcs) osrcs)
    122                 (begin
    123                   (check-random-source 'composite-random-source (car isrcs))
    124                   (loop (cdr isrcs) (cons (car isrcs) osrcs)) ) ) ) ) )
     74            (comb-int (lambda (ints n) (modulo (reduce + 0 ints) n)))
     75            (comb-real (lambda (reals unit) (reduce * 1.0 reals))))
     76  ;scrub keyword arguments
     77  (let* (
     78      (rest (pull-rest-argument rest0) )
     79      (srcs0
     80        (if (null? rest)
     81          (error 'composite-random-source "no random-sources to combine")
     82          (map (cut check-random-source 'composite-random-source <>) rest) ) ) )
    12583    ; collect features
    126     (let loop ((srcs srcs) (names '()) (docus '()) (log2-periods '()) (maxrngs '()))
     84    (let loop ((srcs srcs0) (names '()) (docus '()) (log2-periods '()) (maxrngs '()))
    12785      (if (null? srcs)
    128           ;then make composed random-source
    129           (*composite-random-source
    130             comb-int comb-real
    131             (string->symbol (reverse-string-append (intersperse names "+")))
    132             (reverse-string-append (intersperse docus " & "))
    133             ;FIXME minimum? (if this is good then apply along the way)
    134             (apply min log2-periods)
    135             (apply min maxrngs)
    136             srcs)
    137           ;else collect info
    138           (let ((s (car srcs)))
    139             (loop (cdr srcs)
    140                   (cons (->string (*random-source-name s)) names)
    141                   (cons (*random-source-documentation s) docus)
    142                   (cons (*random-source-log2-period s) log2-periods)
    143                   (cons (*random-source-maximum-range s) maxrngs)) ) ) ) ) )
     86        ;then make composed random-source
     87        (*composite-random-source
     88          comb-int comb-real
     89          (string->symbol (reverse-string-append (intersperse names "+")))
     90          (reverse-string-append (intersperse docus " & "))
     91          ;FIXME minimum? (if this is good then apply along the way)
     92          (apply min log2-periods)
     93          (apply min maxrngs)
     94          srcs0)
     95        ;else collect info
     96        (let ((rs (car srcs)))
     97          (loop
     98            (cdr srcs)
     99            (cons (->string (*random-source-name rs)) names)
     100            (cons (*random-source-documentation rs) docus)
     101            (cons (*random-source-log2-period rs) log2-periods)
     102            (cons (*random-source-maximum-range rs) maxrngs)) ) ) ) ) )
     103
     104;; *composite-random-source
     105;;
     106;; returns the composite constructor
     107
     108(define (*composite-random-source comb-int comb-real def-name def-docu log2-period maxrng srcs)
     109  (let ((srcs-cnt (length srcs))
     110        (composite-make-integers (map random-source-make-integers srcs)) )
     111    (letrec (
     112        (ctor
     113          (lambda (#!optional (name def-name) (docu def-docu))
     114            (let ((name-state-set!-id (string->symbol (conc name #\- 'state-set!))))
     115              (*make-random-source
     116                ;
     117                ctor
     118                ;
     119                name
     120                ;
     121                docu
     122                ;
     123                log2-period
     124                ;
     125                maxrng
     126                ;entropy-source
     127                #f
     128                ;state-ref
     129                (lambda ()
     130                  (cons name (map composite-state-ref srcs)))
     131                ;state-set!
     132                (lambda (state)
     133                  (if (composite-random-state? state name srcs-cnt)
     134                    (for-each composite-state-set! srcs (cdr state))
     135                    (error-argument-type name-state-set!-id state 'composite-random-state) ) )
     136                ;randomize!
     137                (lambda (es)
     138                  (for-each
     139                    (lambda (rs)
     140                      ((@random-source-randomize! rs) es) )
     141                    srcs) )
     142                ;pseudo-randomize!
     143                (lambda (i j)
     144                  (for-each
     145                    (lambda (rs)
     146                      ((@random-source-pseudo-randomize! rs) i j) )
     147                    srcs) )
     148                ;make-integers
     149                (lambda ()
     150                  (lambda (n)
     151                    (comb-int (map (cut <> n) composite-make-integers) n)))
     152                ;make-reals
     153                (lambda (unit)
     154                  (let (
     155                      (makrels
     156                        (map
     157                          (lambda (rs)
     158                            ((@random-source-make-reals rs) unit) )
     159                          srcs)))
     160                    (lambda ()
     161                      (comb-real (map (cut <>) makrels) unit) ) ) ) ) ) ) ) )
     162      ctor ) ) )
     163
     164(define (composite-random-state? obj k n)
     165  (and
     166    (pair? obj)
     167    (eq? k (car obj))
     168    (fx= n (fx- (length obj) 1)) ) )
     169
     170(define (composite-state-ref s)
     171  ((@random-source-state-ref s)) )
     172
     173(define (composite-state-set! s state)
     174  ((@random-source-state-set! s) state) )
    144175
    145176) ;module composite-random-source
  • release/4/srfi-27/trunk/entropy-clock.scm

    r34012 r34021  
    1313;;;
    1414
    15 #|
    1615#>
    1716#include <time.h>
     
    3433(define f64init (foreign-lambda double "f64init"))
    3534(define f64rand (foreign-lambda double "f64rand" double))
    36 |#
    37 
    38 (import extras)
    39 
    40 (define (f64init) (randomize))
    41 (define (f64rand n) (random n))
    4235
    4336;;; Entropy from system clock
  • release/4/srfi-27/trunk/entropy-source.scm

    r34015 r34021  
    5050;;
    5151
    52 (define (entropy-source-integer entropy-source)
     52(define (entropy-source-integer es)
    5353  ;ugly but ...
    54   (let ((get-f64 (@entropy-source-f64 entropy-source)))
    55     (let loop ((x (get-f64)))
     54  (let ((genf64 (@entropy-source-f64 es)))
     55    (let loop ((x (genf64)))
    5656      (if (integer? x)
    5757        x
    58         (loop (get-f64)) ) ) ) )
     58        (loop (genf64)) ) ) ) )
    5959
    6060(define entropy-source-f64-integer entropy-source-integer)
  • release/4/srfi-27/trunk/moa.scm

    r34012 r34021  
    244244      (modulo
    245245        (fpabs (entropy-source-f64-integer entropy-source))
    246         (expt 2 64))))
     246        fpMAX)))
    247247  state )
    248248
     
    266266      make-random-source-moa
    267267      ;
    268       INTERNAL-ID
     268      EXTERNAL-ID
    269269      ;
    270270      "George Marsaglia's Mother-Of-All Generator"
  • release/4/srfi-27/trunk/mrg32k3a.scm

    r34012 r34021  
    488488      make-random-source-mrg32k3a
    489489      ;
    490       INTERNAL-ID
     490      EXTERNAL-ID
    491491      ;
    492492      "Pierre L'Ecuyer's Combined Multiple Recursive Generator"
  • release/4/srfi-27/trunk/mwc.scm

    r34012 r34021  
    239239      (modulo
    240240        (fpabs (entropy-source-f64-integer entropy-source))
    241         (expt 2 64))))
     241        fpMAX)))
    242242  state )
    243243
     
    263263      make-random-source-mwc
    264264      ;
    265       INTERNAL-ID
     265      EXTERNAL-ID
    266266      ;
    267267      "George Marsaglia's Multiply With Carry Generator"
  • release/4/srfi-27/trunk/srfi-27-vector-support.scm

    r34015 r34021  
    102102
    103103(define (vector-fold/1 vec proc seed)
    104   (vector-fold (cut proc #f <> <>) seed vec) )
     104  (vector-fold proc seed vec) )
    105105
    106106(define (vector-map!/1 vec proc)
    107   (vector-map! (cut proc #f <>) vec) )
     107  (vector-map! proc vec) )
    108108
    109109#; ;NOT YET
  • release/4/srfi-27/trunk/srfi-27.meta

    r34017 r34021  
    1717        (synch "2.1.0")
    1818        #;(random-bsd "0.2"))
    19  (files "mrg32k3a.scm" "srfi-27.meta" "srfi-27-uniform-random.scm" "mwc.scm"
     19 (files
     20 ;"bsdrnd.scm" "composite-random-source.scm" "composite-entropy-source.scm"
     21 "mrg32k3a.scm" "srfi-27.meta" "srfi-27-uniform-random.scm" "mwc.scm"
    2022 "srfi-27.setup" "entropy-procedure.scm" "srfi-27.release-info"
    2123 "srfi-27-implementation" "srfi-27-numbers.scm" "fp-extn.scm"
    22  "entropy-unix.scm" "composite-random-source.scm" "entropy-source.scm"
     24 "entropy-unix.scm" "entropy-source.scm"
    2325 "entropy-clock.scm" "random-source.scm" "srfi-27-vector-support.scm"
    2426 "srfi-27-distributions.scm" "srfi-27-vector.scm" "srfi-27.scm"
    2527 "entropy-windows.scm" "moa.scm" "entropy-support.scm"
    26  #;"bsdrnd.scm"
    2728 "source-registration.scm" "tests/test-diehard.scm" "tests/test-confidence.scm"
    2829 "tests/test-mrg32k3a.scm" "tests/run.scm" "entropy-port.scm") )
  • release/4/srfi-27/trunk/srfi-27.scm

    r34017 r34021  
    4545(import
    4646  (only data-structures alist-ref alist-update!)
    47   (only srfi-4 make-u8vector make-f64vector)
    48   (only miscmacros define-parameter)
    49   type-checks
    50   srfi-4-checks
     47  (only srfi-4 make-u8vector make-f64vector))
     48(require-library data-structures srfi-4)
     49
     50(import (only miscmacros define-parameter))
     51(require-library miscmacros)
     52
     53(import
    5154  (only type-errors error-argument-type warning-argument-type)
    52   random-source
    53   entropy-source
    54   entropy-clock
    55   mrg32k3a
    5655  (only srfi-27-numbers check-real-precision)
    5756  (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
    5857(require-library
    59   data-structures srfi-4
    60   miscmacros
    61   random-source entropy-source
    62   mrg32k3a entropy-clock
    63   type-checks type-errors srfi-4-checks
     58  type-errors
    6459  srfi-27-numbers srfi-27-vector-support)
     60
     61(use
     62  type-checks srfi-4-checks
     63  random-source mrg32k3a
     64  entropy-source entropy-clock)
    6565
    6666;;; Entropy Source
  • release/4/srfi-27/trunk/srfi-27.setup

    r34017 r34021  
    77;; Utility Modules
    88
    9 (setup-shared-extension-module 'fp-extn (extension-version "3.2.4")
     9(define utiloptn '(
     10  -optimize-level 3 -debug-level 0
     11  -no-procedure-checks -no-argc-checks -no-bound-checks))
     12#;(define utiloptn '())
     13
     14(define publoptn '(
     15  -optimize-level 3 -debug-level 1
     16  -no-procedure-checks))
     17#;(define publoptn '())
     18
     19(setup-shared-extension-module 'fp-extn (extension-version "3.2.5")
    1020  #:inline? #t
    1121  #:types? #t
    12   #:compile-options '(
    13     -scrutinize -optimize-level 3 -debug-level 0
    14     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     22  #:compile-options `(-scrutinize ,@utiloptn) )
    1523
    16 (setup-shared-extension-module 'source-registration (extension-version "3.2.4")
     24(setup-shared-extension-module 'source-registration (extension-version "3.2.5")
    1725  #:inline? #t
    1826  #:types? #t
    19   #:compile-options '(
    20     -scrutinize -optimize-level 3 -debug-level 1
    21     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     27  #:compile-options `(-scrutinize ,@utiloptn) )
    2228
    23 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.4")
     29(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.5")
    2430  #:inline? #t
    2531  #:types? #t
    26   #:compile-options '(
    27     -scrutinize -optimize-level 3 -debug-level 0
    28     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     32  #:compile-options `(-scrutinize ,@utiloptn) )
    2933
    30 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.4")
     34(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.5")
    3135  #:inline? #t
    3236  #:types? #t
    33   #:compile-options '(
    34     -scrutinize -optimize-level 3 -debug-level 0
    35     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     37  #:compile-options `(-scrutinize ,@utiloptn) )
    3638
    3739;; Entropy Source Modules
    3840
    39 (setup-shared-extension-module 'entropy-source (extension-version "3.2.4")
     41(setup-shared-extension-module 'entropy-source (extension-version "3.2.5")
    4042  #:inline? #t
    4143  #:types? #t
    42   #:compile-options '(
    43     -scrutinize -optimize-level 3 -debug-level 1
    44     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     44  #:compile-options `(-scrutinize ,@utiloptn) )
    4545
    46 (setup-shared-extension-module 'entropy-support (extension-version "3.2.4")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.5")
    4747  #:inline? #t
    4848  #:types? #t
    49   #:compile-options '(
    50     -scrutinize -optimize-level 3 -debug-level 0
    51     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     49  #:compile-options `(-scrutinize ,@utiloptn) )
    5250
    53 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.4")
     51(setup-shared-extension-module 'entropy-clock (extension-version "3.2.5")
     52  #:inline? #t
     53  #:types? #t
     54  #:compile-options `(-scrutinize ,@publoptn) )
     55
     56(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.5")
    5457  #:inline? #t
    5558  #:types? #t
     
    5861    -no-procedure-checks) )
    5962
    60 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.4")
     63(setup-shared-extension-module 'entropy-port (extension-version "3.2.5")
    6164  #:inline? #t
    6265  #:types? #t
    63   #:compile-options '(
    64     -scrutinize -optimize-level 3 -debug-level 1
    65     -no-procedure-checks) )
     66  #:compile-options `(-scrutinize ,@publoptn) )
    6667
    67 (setup-shared-extension-module 'entropy-port (extension-version "3.2.4")
     68#+unix
     69(setup-shared-extension-module 'entropy-unix (extension-version "3.2.5")
    6870  #:inline? #t
    6971  #:types? #t
    70   #:compile-options '(
    71     -scrutinize -optimize-level 3 -debug-level 1
    72     -no-procedure-checks) )
     72  #:compile-options `(-scrutinize ,@publoptn) )
    7373
    74 #+unix
    75 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.4")
     74#+windows
     75(setup-shared-extension-module 'entropy-windows (extension-version "3.2.5")
    7676  #:inline? #t
    7777  #:types? #t
    78   #:compile-options '(
    79     -scrutinize -optimize-level 3 -debug-level 1
    80     -no-procedure-checks) )
     78  #:compile-options `(-scrutinize ,@publoptn) )
    8179
    82 #+windows
    83 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.4")
     80#;
     81(setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.5")
    8482  #:inline? #t
    8583  #:types? #t
    86   #:compile-options '(
    87     -scrutinize -optimize-level 3 -debug-level 1
    88     -no-procedure-checks) )
     84  #:compile-options `(-scrutinize ,@publoptn) )
    8985
    9086;; Random Source Modules
    9187
    92 (setup-shared-extension-module 'random-source (extension-version "3.2.4")
     88(setup-shared-extension-module 'random-source (extension-version "3.2.5")
    9389  #:inline? #t
    9490  #:types? #t
    95   #:compile-options '(
    96     -scrutinize -optimize-level 3 -debug-level 1
    97     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     91  #:compile-options `(-scrutinize ,@utiloptn) )
    9892
    99 #;(setup-shared-extension-module 'bsdrnd (extension-version "3.2.4")
     93(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.5")
    10094  #:inline? #t
    10195  #:types? #t
    102   #:compile-options '(
    103     -scrutinize -optimize-level 3 -debug-level 0
    104     -no-procedure-checks -no-argc-checks -no-bound-checks ) )
     96  #:compile-options `(-scrutinize ,@utiloptn) )
    10597
    106 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.4")
     98(setup-shared-extension-module 'mwc (extension-version "3.2.5")
    10799  #:inline? #t
    108100  #:types? #t
    109   #:compile-options '(
    110     -scrutinize
    111     ;-optimize-level 3 -debug-level 0
    112     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     101  #:compile-options `(-scrutinize ,@utiloptn) )
    113102
    114 (setup-shared-extension-module 'mwc (extension-version "3.2.4")
     103(setup-shared-extension-module 'moa (extension-version "3.2.5")
    115104  #:inline? #t
    116105  #:types? #t
    117   #:compile-options '(
    118     -scrutinize -optimize-level 3 -debug-level 0
    119     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     106  #:compile-options `(-scrutinize ,@utiloptn) )
    120107
    121 (setup-shared-extension-module 'moa (extension-version "3.2.4")
     108#;
     109(setup-shared-extension-module 'bsdrnd (extension-version "3.2.5")
    122110  #:inline? #t
    123111  #:types? #t
    124   #:compile-options '(
    125     -scrutinize -optimize-level 3 -debug-level 0
    126     -no-procedure-checks -no-argc-checks -no-bound-checks) )
     112  #:compile-options `(-scrutinize ,@utiloptn) )
    127113
    128 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.4")
     114#;
     115(setup-shared-extension-module 'composite-random-source (extension-version "3.2.5")
    129116  #:inline? #t
    130117  #:types? #t
    131   #:compile-options '(
    132     -scrutinize -optimize-level 3 -debug-level 1
    133     -no-procedure-checks) )
     118  #:compile-options `(-scrutinize ,@publoptn) )
    134119
    135120;; Main Modules
    136121
    137 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.4")
     122(setup-shared-extension-module 'srfi-27 (extension-version "3.2.5")
    138123  #:inline? #t
    139124  #:types? #t
    140   #:compile-options '(
    141     -scrutinize -optimize-level 3 -debug-level 1
    142     -no-procedure-checks) )
     125  #:compile-options `(-scrutinize ,@publoptn) )
    143126
    144 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.4")
     127(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.5")
    145128  #:inline? #t
    146129  #:types? #t
    147   #:compile-options '(
    148     -scrutinize ;-optimize-level 3 -debug-level 1
    149     #;-no-procedure-checks) )
     130  #:compile-options `(-scrutinize ,@publoptn) )
    150131
    151 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.4")
     132(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.5")
    152133  #:inline? #t
    153134  #:types? #t
    154   #:compile-options '(
    155     -scrutinize -optimize-level 3 -debug-level 1
    156     -no-procedure-checks) )
     135  #:compile-options `(-scrutinize ,@publoptn) )
    157136
    158 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.4")
     137(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.5")
    159138  #:inline? #t
    160139  #:types? #t
    161   #:compile-options '(
    162     -scrutinize -optimize-level 3 -debug-level 1
    163     -no-procedure-checks) )
     140  #:compile-options `(-scrutinize ,@publoptn) )
  • release/4/srfi-27/trunk/tests/run.scm

    r34017 r34021  
    1010;(newline)
    1111
    12 (test-begin "SRFI 27")
     12#|
     13(use bsdrnd)
     14
     15(make-random-source 'bsd)
     16|#
    1317
    1418#|
    15 (use bsdrnd)
    16 (make-random-source 'bsd)
     19(use composite-random-source)
     20(use mwc mrg32k3a moa)
     21
     22(test-group "composite random"
     23  (let* (
     24      (crs-ctor
     25        (composite-random-source
     26          (make-random-source-mwc)
     27          (make-random-source-mrg32k3a)
     28          (make-random-source-moa)) )
     29      (crs (crs-ctor) )
     30      (rndint (random-source-make-integers crs) )
     31      (rnd (random-source-make-reals crs) ) )
     32    (test-assert (procedure? rndint))
     33    (test-assert (procedure? rnd))
     34    (test-assert (integer? (rndint 10)))
     35    (test-assert (<= 0 (rndint 10)))
     36    (test-assert (<= (rndint 10) 10))
     37    (test-assert (inexact? (rnd)))
     38    (test-assert (random-source-randomize! crs))
     39    (test-assert (random-source-pseudo-randomize! crs 1 2))
     40  )
     41)
    1742|#
     43
     44#|
     45(use composite-entropy-source)
     46(use entropy-clock entropy-unix)
     47(use srfi-4)
     48
     49(test-group "composite entropy"
     50  (let* (
     51      (ces-ctor
     52        (composite-entropy-source
     53          (make-entropy-source-system-clock)
     54          (make-entropy-source-random-device)
     55          (make-entropy-source-urandom-device)) )
     56      (ces (ces-ctor) )
     57      (genu8 (entropy-source-u8 ces) )
     58      (genf64 (entropy-source-f64 ces) ) )
     59    (test-assert (integer? (genu8)))
     60    (test-assert (<= 0 (genu8)))
     61    (test-assert (<= (genu8) 255))
     62    (test-assert (flonum? (genf64)))
     63    (test-assert (u8vector? (entropy-source-u8vector ces 2)))
     64    (test-assert (= 2 (u8vector-length (entropy-source-u8vector ces 2))))
     65    (test-assert (f64vector? (entropy-source-f64vector ces 2)))
     66    (test-assert (= 2 (f64vector-length (entropy-source-f64vector ces 2))))
     67  )
     68)
     69|#
     70
     71;;
     72
     73(test-begin "SRFI 27")
    1874
    1975;;
     
    2177(use random-source entropy-source)
    2278
    23 (test-group "basics"
     79(test-group "basics entropy"
     80  (test-assert (entropy-source? (current-entropy-source)))
     81)
     82
     83(test-group "basics random"
    2484  (test-assert (random-source? default-random-source))
    2585  (test-assert (random-source? (current-random-source)))
    26   (test-assert (entropy-source? (current-entropy-source)))
    2786
    2887  (test-assert (procedure? random-integer))
Note: See TracChangeset for help on using the changeset viewer.