Changeset 34011 in project for release/4


Ignore:
Timestamp:
04/22/17 20:52:09 (3 years ago)
Author:
Kon Lovett
Message:

fp-extn module, fix mrg32k3a modulo -> remainder (my bad)

Location:
release/4/srfi-27
Files:
2 added
4 deleted
19 edited
8 copied

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/tags/3.2.1/mrg32k3a.scm

    r34008 r34011  
    1414(module mrg32k3a
    1515
    16   (;export
    17     make-random-source-mrg32k3a)
    18 
    19   (import
    20     (except scheme <= inexact->exact exact->inexact number?)
    21     chicken
    22     foreign
    23     srfi-4
    24     (only numbers <= inexact->exact exact->inexact number?)
    25     (only type-errors error-positive-integer)
    26     random-source
    27     entropy-source
    28     (only srfi-27-numbers
    29       check-positive-integer
    30       random-large-integer random-large-real
    31       native-real-precision?))
    32 
    33   (require-library
    34     srfi-4
    35     numbers
    36     type-errors
    37     random-source entropy-source srfi-27-numbers)
    38 
    39   (declare (not usual-integrations <= inexact->exact exact->inexact))
     16(;export
     17  make-random-source-mrg32k3a)
     18
     19(import
     20  (except scheme <= inexact->exact exact->inexact number?)
     21  chicken
     22  foreign)
     23
     24(import
     25  srfi-4
     26  (only numbers <= inexact->exact exact->inexact number?)
     27  (only type-errors error-positive-integer)
     28  random-source
     29  entropy-source
     30  fp-extn
     31  (only srfi-27-numbers
     32    check-positive-integer
     33    random-large-integer random-large-real
     34    native-real-precision?))
     35(require-library
     36  srfi-4
     37  numbers
     38  type-errors
     39  random-source entropy-source
     40  fp-extn
     41  srfi-27-numbers)
     42
     43(declare
     44  (not usual-integrations
     45    <= inexact->exact exact->inexact))
     46
     47;*** DEBUG ***
     48(use extras)
    4049
    4150#>
     
    112121;;; fp stuff
    113122
    114 (include "fp-extn")
    115 
    116123;;;
    117124;;; mrg32k3a specific
     
    259266  (let ((state-M (list fpM1-1 fpM1-1 fpM1-1 fpM2-1 fpM2-1 fpM2-1)))
    260267    (lambda (external-state)
     268      ;
    261269      (define (checked-set! state n i m)
    262         (if (not (number? n)) (error 'mrg32k3a-pack-state "not a number" n)
    263             (let ((x (exact->inexact n)))
    264               (if (and (fpinteger? x) (fp<= 0.0 x) (fp<= x m)) (f64vector-set! state i x)
    265                   (error 'mrg32k3a-pack-state "illegal value" x n) ) ) ) )
    266       ;XXX This is a waste since cannot overflow to zero & or have mixed signs.
     270        (unless (number? n)
     271          (error 'mrg32k3a-pack-state "not a number" n) )
     272        (let ((x (exact->inexact n)))
     273          (unless (and (fpinteger? x) (fp<= 0.0 x) (fp<= x m))
     274            (error 'mrg32k3a-pack-state "illegal value" x n) )
     275          (f64vector-set! state i x) ) )
     276      ;
    267277      (define (check-m-state a b c)
     278        ;XXX This is a waste since cannot overflow to zero & or have mixed signs.
    268279        (when (fpzero? (fp+ a (fp+ b c)))
    269280          (error 'mrg32k3a-pack-state "illegal degenerate state" external-state) ) )
     281      ;
    270282      (unless (and
    271283                (pair? external-state)
     
    273285                (fx= STATE-LENGTH (length (cdr external-state))))
    274286          (error 'mrg32k3a-pack-state "malformed state" external-state) )
     287      ;
    275288      (let ((state (make-state)))
    276289        (do ((i 0 (fx+ i 1))
     
    341354                    0.0       1.0          0.0)) )
    342355    (lambda (i j)
    343 
     356      ;
    344357      (define (product a b) ; A*B in ((Z/m1*Z) x (Z/m2*Z))^(3x3)
    345 
     358        ;Yes, I know at toplevel
    346359        (define-constant fpW      65536.0) ; wordsize to split {0..2^32-1}
    347360        (define-constant fpW-SQR1 209.0)   ; w^2 mod m1
    348361        (define-constant fpW-SQR2 22853.0) ; w^2 mod m2
    349 
     362        ;
    350363        (define (lc i0 i1 i2 j0 j1 j2 m w-sqr) ; linear combination
    351364          (let ((a0h (fpquotient  (f64vector-ref a i0) fpW))
    352                 (a0l (fpremainder (f64vector-ref a i0) fpW))
     365                (a0l (fpmodulo (f64vector-ref a i0) fpW))
    353366                (a1h (fpquotient  (f64vector-ref a i1) fpW))
    354                 (a1l (fpremainder (f64vector-ref a i1) fpW))
     367                (a1l (fpmodulo (f64vector-ref a i1) fpW))
    355368                (a2h (fpquotient  (f64vector-ref a i2) fpW))
    356                 (a2l (fpremainder (f64vector-ref a i2) fpW))
     369                (a2l (fpmodulo (f64vector-ref a i2) fpW))
    357370                (b0h (fpquotient  (f64vector-ref b j0) fpW))
    358                 (b0l (fpremainder (f64vector-ref b j0) fpW))
     371                (b0l (fpmodulo (f64vector-ref b j0) fpW))
    359372                (b1h (fpquotient  (f64vector-ref b j1) fpW))
    360                 (b1l (fpremainder (f64vector-ref b j1) fpW))
     373                (b1l (fpmodulo (f64vector-ref b j1) fpW))
    361374                (b2h (fpquotient  (f64vector-ref b j2) fpW))
    362                 (b2l (fpremainder (f64vector-ref b j2) fpW)))
    363             (fpremainder
    364              (fp+ (fp+ (fp* (fp+ (fp* a0h b0h)
    365                                  (fp+ (fp* a1h b1h)
    366                                       (fp* a2h b2h)))
    367                             w-sqr)
    368                        (fp* fpW
    369                             (fp+ (fp* a0h b0l)
    370                                  (fp+ (fp* a0l b0h)
    371                                       (fp+ (fp* a1h b1l)
    372                                            (fp+ (fp* a1l b1h)
    373                                                 (fp+ (fp* a2h b2l) (fp* a2l b2h))))))))
    374                   (fp+ (fp* a0l b0l) (fp+ (fp* a1l b1l) (fp* a2l b2l))))
    375              m) ) )
    376 
     375                (b2l (fpmodulo (f64vector-ref b j2) fpW)))
     376            (fpmodulo
     377              (fp+ (fp+ (fp* (fp+ (fp* a0h b0h)
     378                                  (fp+ (fp* a1h b1h)
     379                                       (fp* a2h b2h)))
     380                             w-sqr)
     381                        (fp* fpW
     382                             (fp+ (fp* a0h b0l)
     383                                  (fp+ (fp* a0l b0h)
     384                                       (fp+ (fp* a1h b1l)
     385                                            (fp+ (fp* a1l b1h)
     386                                                 (fp+ (fp* a2h b2l) (fp* a2l b2h))))))))
     387                   (fp+ (fp* a0l b0l) (fp+ (fp* a1l b1l) (fp* a2l b2l))))
     388              m) ) )
     389        ;
    377390        (f64vector
    378391          (lc  0  1  2   0  3  6  fpM1 fpW-SQR1) ; (A*B)_00 mod m1
     
    394407          (lc 15 16 17  10 13 16  fpM2 fpW-SQR2)
    395408          (lc 15 16 17  11 14 17  fpM2 fpW-SQR2)) )
    396 
     409      ;
    397410      (define (power a e) ; A^e
    398411        (cond
    399412          ((fpzero? e)  A^0)
    400           ((fp= e 1.0)  a)
     413          ((fp= 1.0 e)  a)
    401414          ((fpeven? e)  (power (product a a) (fpquotient e 2.0)))
    402415          (else         (product (power a (fp- e 1.0)) a)) ) )
    403 
    404416      ; precompute A^(2^127) and A^(2^76)
    405417      ; note that A and A^0 are constant thru computation
    406418      (unless mrg32k3a-gen0
    407         (letrec ((power-power  ; A^(2^b)
    408                   (lambda (a b)
    409                     (if (fpzero? b)
    410                       a
    411                       (power-power (product a a) (fp- b 1.0))))))
     419        (letrec
     420            ((power-power  ; A^(2^b)
     421              (lambda (a b)
     422                (if (fpzero? b)
     423                  a
     424                  (power-power (product a a) (fp- b 1.0))))))
    412425          (set! mrg32k3a-gen0 (power-power A 127.0))
    413426          (set! mrg32k3a-gen1 (power-power A 76.0))
    414427          (set! mrg32k3a-gen2 (power A 16.0)) ) )
    415 
    416428      ; compute M = A^(16 + i*2^127 + j*2^76)
    417429      (let ((M
     
    419431                mrg32k3a-gen2
    420432                (product
    421                   (power mrg32k3a-gen0 (fpremainder i fp2^28))
    422                   (power mrg32k3a-gen1 (fpremainder j fp2^28))))))
     433                  (power mrg32k3a-gen0 (fpmodulo i fp2^28))
     434                  (power mrg32k3a-gen1 (fpmodulo j fp2^28))))))
    423435        ; the new state
    424436        (f64vector
     
    433445(define (make-gms16wc entropy-source)
    434446  (let ((random-m
    435          (let ((x (fpremainder ((@entropy-source-f64 entropy-source)) fp2^16)))
     447         (let ((x (fpmodulo ((@entropy-source-f64 entropy-source)) fp2^16)))
    436448           (lambda ()
    437              (let ((y (fpremainder x fp2^16)))
     449             (let ((y (fpmodulo x fp2^16)))
    438450               (set! x (fp+ (fp* 30903.0 y) (fpquotient x fp2^16)))
    439451               y ) ) ) ) )
    440452    (lambda (n)
    441453      ; m < n < m^2
    442       (fpremainder (fp+ (fp* (random-m) fp2^16) (random-m)) n) ) ) )
     454      (fpmodulo (fp+ (fp* (random-m) fp2^16) (random-m)) n) ) ) )
    443455
    444456; True Randomization
     
    455467    ; the new state
    456468    (f64vector
    457      (fp+ 1.0 (fpremainder (fp+ (f64vector-ref state 0) (random fpM1-1)) fpM1-1))
    458      (fpremainder (fp+ (f64vector-ref state 1) (random fpM1)) fpM1)
    459      (fpremainder (fp+ (f64vector-ref state 2) (random fpM1)) fpM1)
    460      (fp+ 1.0 (fpremainder (fp+ (f64vector-ref state 3) (random fpM2-1)) fpM2-1))
    461      (fpremainder (fp+ (f64vector-ref state 4) (random fpM2)) fpM2)
    462      (fpremainder (fp+ (f64vector-ref state 5) (random fpM2)) fpM2)) ) )
     469      (fp+ 1.0 (fpmodulo (fp+ (f64vector-ref state 0) (random fpM1-1)) fpM1-1))
     470      (fpmodulo (fp+ (f64vector-ref state 1) (random fpM1)) fpM1)
     471      (fpmodulo (fp+ (f64vector-ref state 2) (random fpM1)) fpM1)
     472      (fp+ 1.0 (fpmodulo (fp+ (f64vector-ref state 3) (random fpM2-1)) fpM2-1))
     473      (fpmodulo (fp+ (f64vector-ref state 4) (random fpM2)) fpM2)
     474      (fpmodulo (fp+ (f64vector-ref state 5) (random fpM2)) fpM2)) ) )
    463475
    464476(define (mrg32k3a-random-large state n) ; n > m
     
    486498      #f
    487499      ;
    488       (lambda () (mrg32k3a-unpack-state state) )
    489       ;
    490       (lambda (new-state) (set! state (mrg32k3a-pack-state new-state)))
    491       ;
    492       (lambda (entropy-source) (set! state (mrg32k3a-randomize-state state entropy-source)))
    493       ;
    494       (lambda (i j) (set! state (mrg32k3a-pseudo-randomize-state (exact->inexact i) (exact->inexact j))))
     500      (lambda ()
     501        (mrg32k3a-unpack-state state) )
     502      ;
     503      (lambda (new-state)
     504        (set! state (mrg32k3a-pack-state new-state)) )
     505      ;
     506      (lambda (entropy-source)
     507        (set! state (mrg32k3a-randomize-state state entropy-source)) )
     508      ;
     509      (lambda (i j)
     510        (set! state
     511          (mrg32k3a-pseudo-randomize-state (exact->inexact i) (exact->inexact j))) )
    495512      ;
    496513      (lambda ()
     
    517534        (cond
    518535          ((native-real-precision? prec eM1)
    519             (lambda () (mrg32k3a-random-real state)))
     536            (lambda ()
     537              (mrg32k3a-random-real state)))
    520538          (else
    521             (lambda () (mrg32k3a-random-real-mp state prec)))))) ) )
     539            (lambda ()
     540              (mrg32k3a-random-real-mp state prec)))))) ) )
    522541
    523542;;;
  • release/4/srfi-27/tags/3.2.1/random-source.scm

    r33848 r34011  
    44(module random-source
    55
    6   (;export
    7     *make-random-source
    8     random-source? check-random-source error-random-source
    9     *random-source-name
    10     *random-source-documentation
    11     *random-source-log2-period
    12     *random-source-maximum-range
    13     *random-source-entropy-source *random-source-entropy-source-set!
    14     @random-source-constructor
    15     @random-source-state-ref @random-source-state-set!
    16     @random-source-randomize! @random-source-pseudo-randomize!
    17     @random-source-make-integers @random-source-make-reals
    18     ;
    19     registered-random-sources
    20     registered-random-source
    21     unregister-random-source
    22     register-random-source!)
     6(;export
     7  *make-random-source
     8  random-source? check-random-source error-random-source
     9  *random-source-name
     10  *random-source-documentation
     11  *random-source-log2-period
     12  *random-source-maximum-range
     13  *random-source-entropy-source *random-source-entropy-source-set!
     14  @random-source-constructor
     15  @random-source-state-ref @random-source-state-set!
     16  @random-source-randomize! @random-source-pseudo-randomize!
     17  @random-source-make-integers @random-source-make-reals
     18  ;
     19  registered-random-sources
     20  registered-random-source
     21  unregister-random-source
     22  register-random-source!)
    2323
    24   (import
    25     scheme
    26     chicken
    27     (only data-structures alist-ref alist-update!)
    28     (only srfi-1 alist-cons alist-delete!)
    29     (only type-checks define-check+error-type check-procedure check-symbol))
    30   (require-library data-structures srfi-1 type-checks)
     24(import scheme chicken)
    3125
    32   (use registration)
     26(import
     27  (only data-structures alist-ref alist-update!)
     28  (only srfi-1 alist-cons alist-delete!)
     29  (only type-checks define-check+error-type check-procedure check-symbol))
     30(require-library data-structures srfi-1 type-checks)
     31
     32(use registration)
    3333
    3434;;
  • release/4/srfi-27/tags/3.2.1/registration.scm

    r34008 r34011  
    44(module registration
    55
    6   (;export
    7     make-registration
    8     registration? check-registration error-registration
    9     @registration-key @registration-ref @registration-deref! @registration-register!)
     6(;export
     7  make-registration
     8  registration? check-registration error-registration
     9  @registration-key @registration-ref @registration-deref! @registration-register!)
    1010
    11   (import
    12     scheme
    13     chicken
    14     (only data-structures alist-ref alist-update!)
    15     (only srfi-1 alist-delete!)
    16     (only type-checks define-check+error-type check-procedure check-symbol check-list))
    17   (require-library data-structures srfi-1 type-checks)
     11(import scheme chicken)
     12
     13(import
     14  (only data-structures alist-ref alist-update!)
     15  (only srfi-1 alist-delete!)
     16  (only type-checks define-check+error-type check-procedure check-symbol check-list))
     17(require-library data-structures srfi-1 type-checks)
    1818
    1919;;
  • release/4/srfi-27/tags/3.2.1/srfi-27-numbers.scm

    r33848 r34011  
    44(module srfi-27-numbers
    55
    6   (;export
    7     ;
    8     check-integer
    9     #;check-cardinal-integer
    10     check-positive-integer
    11     #;check-real
    12     #;check-nonzero-real
    13     #;check-nonnegative-real
    14     #;check-positive-real
    15     #;check-real-open-interval
    16     #;check-real-closed-interval
    17     check-real-precision
    18     #;check-real-unit
    19     ;
    20     random-large-integer
    21     random-large-real
    22     ;
    23     native-real-precision?)
     6(;export
     7  ;
     8  check-integer
     9  #;check-cardinal-integer
     10  check-positive-integer
     11  #;check-real
     12  #;check-nonzero-real
     13  #;check-nonnegative-real
     14  #;check-positive-real
     15  #;check-real-open-interval
     16  #;check-real-closed-interval
     17  check-real-precision
     18  #;check-real-unit
     19  ;
     20  random-large-integer
     21  random-large-real
     22  ;
     23  native-real-precision?)
    2424
    25   (import
    26     (except scheme
    27       <= < zero? positive? negative?
    28       + * - / quotient expt
    29       integer? real?
    30       exact->inexact inexact->exact
    31       floor)
    32     chicken
    33     (only numbers
    34       <= < zero? positive? negative?
    35       + * - / quotient expt
    36       integer? real?
    37       exact->inexact inexact->exact
    38       floor)
    39     (only type-checks
    40       check-real)
    41     (only type-errors
    42       error-argument-type error-open-interval error-closed-interval))
     25(import
     26  (except scheme
     27    <= < zero? positive? negative?
     28    + * - / quotient expt
     29    integer? real?
     30    exact->inexact inexact->exact
     31    floor)
     32  chicken)
    4333
    44   (require-library numbers type-errors)
     34(import
     35  (only numbers
     36    <= < zero? positive? negative?
     37    + * - / quotient expt
     38    integer? real?
     39    exact->inexact inexact->exact
     40    floor)
     41  (only type-checks
     42    check-real)
     43  (only type-errors
     44    error-argument-type error-open-interval error-closed-interval))
     45(require-library numbers type-checks type-errors)
    4546
    46   (declare
    47     (not usual-integrations
    48       <= < zero? positive? negative?
    49       + * - / quotient expt
    50       integer? real?
    51       exact->inexact inexact->exact) )
     47(declare
     48  (not usual-integrations
     49    <= < zero? positive? negative?
     50    + * - / quotient expt
     51    integer? real?
     52    exact->inexact inexact->exact) )
    5253
    5354;;;
  • release/4/srfi-27/tags/3.2.1/srfi-27-vector-support.scm

    r33848 r34011  
    1010(module srfi-27-vector-support
    1111
    12   (;export
    13     vector-filled! u8vector-filled! f32vector-filled! f64vector-filled!
    14     f32vector-mapi!/1 f32vector-foldi/1
    15     f64vector-mapi!/1 f64vector-foldi/1
    16     ;
    17     check-vector%
    18     vector%-length
    19     vector%-mapi!/1
    20     vector%-foldi/1
    21     vector%-filled!
    22     vector%-scale!
    23     vector%-sum-squares)
     12(;export
     13  vector-filled! u8vector-filled! f32vector-filled! f64vector-filled!
     14  f32vector-mapi!/1 f32vector-foldi/1
     15  f64vector-mapi!/1 f64vector-foldi/1
     16  ;
     17  check-vector%
     18  vector%-length
     19  vector%-mapi!/1
     20  vector%-foldi/1
     21  vector%-filled!
     22  vector%-scale!
     23  vector%-sum-squares)
    2424
    25   (import
    26     scheme
    27     chicken
    28     (only srfi-4
    29       u8vector-length u8vector-ref u8vector-set!
    30       f32vector? f32vector-length f32vector-ref f32vector-set!
    31       f64vector? f64vector-length f64vector-ref f64vector-set!)
    32     (only vector-lib vector-map! vector-fold)
    33     (only type-errors error-vector))
     25(import scheme chicken)
    3426
    35   (require-library srfi-4 vector-lib type-errors)
     27(import
     28  (only srfi-4
     29    u8vector-length u8vector-ref u8vector-set!
     30    f32vector? f32vector-length f32vector-ref f32vector-set!
     31    f64vector? f64vector-length f64vector-ref f64vector-set!)
     32  (only vector-lib vector-map! vector-fold)
     33  (only type-errors error-vector))
     34(require-library srfi-4 vector-lib type-errors)
    3635
    3736;;;
     
    4039
    4140(define (make-filled! veclenf vecsetf)
    42   (letrec ((self
    43             (case-lambda
    44               ((vec gen)
    45                 (self vec gen 0) )
    46               ((vec gen start)
    47                 (self vec gen start (veclenf vec)) )
    48               ((vec gen start end)
    49                 (do ((idx start (fx+ idx 1)))
    50                     ((fx= end idx) vec)
    51                   (vecsetf vec idx (gen)) ) ) ) ) )
     41  (letrec
     42      ((self
     43        (case-lambda
     44          ((vec gen)
     45            (self vec gen 0) )
     46          ((vec gen start)
     47            (self vec gen start (veclenf vec)) )
     48          ((vec gen start end)
     49            (do ((idx start (fx+ idx 1)))
     50                ((fx= end idx) vec)
     51              (vecsetf vec idx (gen)) ) ) ) ) )
    5252    self ) )
    5353
  • release/4/srfi-27/tags/3.2.1/srfi-27.meta

    r33848 r34011  
    1616        (numbers "2.8")
    1717        (synch "2.1.0"))
    18  (files "mrg32k3a.scm" "srfi-27.meta" "srfi-27-uniform-random.scm" "mwc.scm" "srfi-27.setup" "entropy-procedure.scm" "srfi-27.release-info" "srfi-27-implementation" "srfi-27-numbers.scm" "fp-extn-w.scm" "entropy-unix.scm" "composite-random-source.scm" "entropy-source.scm" "entropy-clock.scm" "random-source.scm" "srfi-27-vector-support.scm" "srfi-27-distributions.scm" "srfi-27-vector.scm" "srfi-27.scm" "entropy-windows.scm" "moa.scm" "fp-extn-wo.scm" "entropy-support.scm" "registration.scm" "tests/test-diehard.scm" "tests/test-confidence.scm" "tests/test-mrg32k3a.scm" "tests/run.scm" "entropy-port.scm") )
     18 (files "mrg32k3a.scm" "srfi-27.meta" "srfi-27-uniform-random.scm" "mwc.scm"
     19 "srfi-27.setup" "entropy-procedure.scm" "srfi-27.release-info"
     20 "srfi-27-implementation" "srfi-27-numbers.scm" "fp-extn.scm"
     21 "entropy-unix.scm" "composite-random-source.scm" "entropy-source.scm"
     22 "entropy-clock.scm" "random-source.scm" "srfi-27-vector-support.scm"
     23 "srfi-27-distributions.scm" "srfi-27-vector.scm" "srfi-27.scm"
     24 "entropy-windows.scm" "moa.scm" "entropy-support.scm"
     25 "registration.scm" "tests/test-diehard.scm" "tests/test-confidence.scm"
     26 "tests/test-mrg32k3a.scm" "tests/run.scm" "entropy-port.scm") )
  • release/4/srfi-27/tags/3.2.1/srfi-27.scm

    r33848 r34011  
    44(module srfi-27
    55
    6   (;export
    7     ;; SRFI 27
    8     default-random-source
    9     random-integer
    10     random-real
    11     make-random-source
    12     random-source? check-random-source error-random-source
    13     random-source-state-ref
    14     random-source-state-set!
    15     random-source-randomize!
    16     random-source-pseudo-randomize!
    17     random-source-make-integers
    18     random-source-make-reals
    19     ;; Extensions
    20     registered-random-sources registered-random-source
    21     current-random-source
    22     new-random-source
    23     random-source-name random-source-kind
    24     random-source-documentation
    25     random-source-log2-period
    26     random-source-maximum-range
    27     random-source-entropy-source random-source-entropy-source-set!
    28     random-source-make-u8vectors
    29     random-source-make-f64vectors
    30     random-u8vector
    31     random-f64vector
    32     registered-entropy-sources registered-entropy-source
    33     current-entropy-source
    34     make-entropy-source new-entropy-source
    35     entropy-source? check-entropy-source error-entropy-source
    36     entropy-source-name entropy-source-kind
    37     entropy-source-documentation
    38     entropy-source-u8
    39     entropy-source-f64
    40     entropy-source-u8vector
    41     entropy-source-f64vector)
    42 
    43   (import
    44     scheme
    45     chicken
    46     (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
    51     (only type-errors error-argument-type warning-argument-type)
    52     random-source
    53     entropy-source
    54     entropy-clock
    55     mrg32k3a
    56     (only srfi-27-numbers check-real-precision)
    57     (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
    58 
    59   (require-library
    60     data-structures srfi-4
    61     miscmacros
    62     random-source entropy-source
    63     mrg32k3a entropy-clock
    64     type-checks type-errors srfi-4-checks
    65     srfi-27-numbers srfi-27-vector-support)
     6(;export
     7  ;; SRFI 27
     8  default-random-source
     9  random-integer
     10  random-real
     11  make-random-source
     12  random-source? check-random-source error-random-source
     13  random-source-state-ref
     14  random-source-state-set!
     15  random-source-randomize!
     16  random-source-pseudo-randomize!
     17  random-source-make-integers
     18  random-source-make-reals
     19  ;; Extensions
     20  registered-random-sources registered-random-source
     21  current-random-source
     22  new-random-source
     23  random-source-name random-source-kind
     24  random-source-documentation
     25  random-source-log2-period
     26  random-source-maximum-range
     27  random-source-entropy-source random-source-entropy-source-set!
     28  random-source-make-u8vectors
     29  random-source-make-f64vectors
     30  random-u8vector
     31  random-f64vector
     32  registered-entropy-sources registered-entropy-source
     33  current-entropy-source
     34  make-entropy-source new-entropy-source
     35  entropy-source? check-entropy-source error-entropy-source
     36  entropy-source-name entropy-source-kind
     37  entropy-source-documentation
     38  entropy-source-u8
     39  entropy-source-f64
     40  entropy-source-u8vector
     41  entropy-source-f64vector)
     42
     43(import scheme chicken)
     44
     45(import
     46  (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
     51  (only type-errors error-argument-type warning-argument-type)
     52  random-source
     53  entropy-source
     54  entropy-clock
     55  mrg32k3a
     56  (only srfi-27-numbers check-real-precision)
     57  (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
     58(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
     64  srfi-27-numbers srfi-27-vector-support)
    6665
    6766;;; Entropy Source
  • release/4/srfi-27/tags/3.2.1/srfi-27.setup

    r34008 r34011  
    55(verify-extension-name "srfi-27")
    66
    7 (if (version>=? (chicken-version) "4.3.6")
    8   (copy-file '("fp-extn-wo.scm" "fp-extn.scm") "." #t ".")
    9   (copy-file '("fp-extn-w.scm" "fp-extn.scm") "." #t ".") )
    10 
    117;; Utility Modules
    128
    13 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.0")
     9(setup-shared-extension-module 'fp-extn (extension-version "3.2.1")
    1410  #:inline? #t
    1511  #:types? #t
     
    1814    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    1915
    20 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.0")
     16(setup-shared-extension-module 'registration (extension-version "3.2.1")
     17  #:inline? #t
     18  #:types? #t
     19  #:compile-options '(
     20    -scrutinize -optimize-level 3 -debug-level 1
     21    -no-procedure-checks -no-argc-checks -no-bound-checks) )
     22
     23(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.1")
    2124  #:inline? #t
    2225  #:types? #t
     
    2528    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    2629
    27 (setup-shared-extension-module 'registration (extension-version "3.2.0")
     30(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.1")
     31  #:inline? #t
     32  #:types? #t
     33  #:compile-options '(
     34    -scrutinize -optimize-level 3 -debug-level 0
     35    -no-procedure-checks -no-argc-checks -no-bound-checks) )
     36
     37;; Entropy Source Modules
     38
     39(setup-shared-extension-module 'entropy-source (extension-version "3.2.1")
    2840  #:inline? #t
    2941  #:types? #t
     
    3244    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    3345
    34 ;; Entropy Source Modules
    35 
    36 (setup-shared-extension-module 'entropy-source (extension-version "3.2.0")
    37   #:inline? #t
    38   #:types? #t
    39   #:compile-options '(
    40     -scrutinize -optimize-level 3 -debug-level 1
    41     -no-procedure-checks -no-argc-checks -no-bound-checks) )
    42 
    43 (setup-shared-extension-module 'entropy-support (extension-version "3.2.0")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.1")
    4447  #:inline? #t
    4548  #:types? #t
     
    4851    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    4952
    50 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.0")
     53(setup-shared-extension-module 'entropy-clock (extension-version "3.2.1")
    5154  #:inline? #t
    5255  #:types? #t
     
    5558    -no-procedure-checks) )
    5659
    57 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.0")
     60(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.1")
    5861  #:inline? #t
    5962  #:types? #t
     
    6265    -no-procedure-checks) )
    6366
    64 (setup-shared-extension-module 'entropy-port (extension-version "3.2.0")
     67(setup-shared-extension-module 'entropy-port (extension-version "3.2.1")
    6568  #:inline? #t
    6669  #:types? #t
     
    7073
    7174#+unix
    72 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.0")
     75(setup-shared-extension-module 'entropy-unix (extension-version "3.2.1")
    7376  #:inline? #t
    7477  #:types? #t
     
    7881
    7982#+windows
    80 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.0")
     83(setup-shared-extension-module 'entropy-windows (extension-version "3.2.1")
    8184  #:inline? #t
    8285  #:types? #t
     
    8790;; Random Source Modules
    8891
    89 (setup-shared-extension-module 'random-source (extension-version "3.2.0")
     92(setup-shared-extension-module 'random-source (extension-version "3.2.1")
    9093  #:inline? #t
    9194  #:types? #t
     
    9497    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    9598
    96 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.0")
     99(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.1")
     100  #:inline? #t
     101  #:types? #t
     102  #:compile-options '(
     103    -scrutinize
     104    ;-optimize-level 3 -debug-level 0
     105    -no-procedure-checks -no-argc-checks -no-bound-checks) )
     106
     107(setup-shared-extension-module 'mwc (extension-version "3.2.1")
    97108  #:inline? #t
    98109  #:types? #t
     
    101112    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    102113
    103 (setup-shared-extension-module 'mwc (extension-version "3.2.0")
     114(setup-shared-extension-module 'moa (extension-version "3.2.1")
    104115  #:inline? #t
    105116  #:types? #t
     
    108119    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    109120
    110 (setup-shared-extension-module 'moa (extension-version "3.2.0")
    111   #:inline? #t
    112   #:types? #t
    113   #:compile-options '(
    114     -scrutinize -optimize-level 3 -debug-level 0
    115     -no-procedure-checks -no-argc-checks -no-bound-checks) )
    116 
    117 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.0")
     121(setup-shared-extension-module 'composite-random-source (extension-version "3.2.1")
    118122  #:inline? #t
    119123  #:types? #t
     
    124128;; Main Modules
    125129
    126 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.0")
     130(setup-shared-extension-module 'srfi-27 (extension-version "3.2.1")
    127131  #:inline? #t
    128132  #:types? #t
     
    131135    -no-procedure-checks) )
    132136
    133 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.0")
     137(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.1")
    134138  #:inline? #t
    135139  #:types? #t
     
    138142    -no-procedure-checks) )
    139143
    140 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.0")
     144(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.1")
    141145  #:inline? #t
    142146  #:types? #t
     
    145149    -no-procedure-checks) )
    146150
    147 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.0")
     151(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.1")
    148152  #:inline? #t
    149153  #:types? #t
  • release/4/srfi-27/tags/3.2.1/tests/run.scm

    r33848 r34011  
    33(use srfi-27)
    44(use srfi-4)
     5
     6(newline)
     7(print "Testing random SRFI-4 vector")
     8(print "Random Source: " (random-source-kind (current-random-source)))
     9(print "Entropy Source: " (entropy-source-kind (current-entropy-source)))
    510
    611(let ((v10 (random-u8vector 10)))
     
    2126(system* "csi -n -s test-confidence")
    2227;(system* "csi -n -s test-diehard") ;errors
     28
     29(newline)
  • release/4/srfi-27/tags/3.2.1/tests/test-confidence.scm

    r19090 r34011  
    1818
    1919(newline)
     20(print "CONFIDENCE TESTS FOR SRFI-27 \"Sources of Random Bits\"")
    2021(print "Entropy Source: " (entropy-source-kind (current-entropy-source)))
    21 (newline)
    2222
    2323
     
    168168(define (check-basics-of s)
    169169  (time
     170    (newline)
    170171    (current-random-source (make-random-source s))
    171172    (print "Random Source: " (random-source-documentation (current-random-source)))
    172     (check-basics) )
    173   (newline) )
     173    (check-basics) ) )
    174174
    175175;;; run some tests
  • release/4/srfi-27/tags/3.2.1/tests/test-mrg32k3a.scm

    r21086 r34011  
    1616
    1717(newline)
     18(print "Testing the MRG32k3a Generator")
    1819(print "Entropy Source: " (entropy-source-kind (current-entropy-source)))
    1920(newline)
     
    7778(check-mrg32k3a)
    7879(print "passed (check-mrg32k3a)")
    79 (newline)
  • release/4/srfi-27/trunk/mrg32k3a.scm

    r34008 r34011  
    1414(module mrg32k3a
    1515
    16   (;export
    17     make-random-source-mrg32k3a)
    18 
    19   (import
    20     (except scheme <= inexact->exact exact->inexact number?)
    21     chicken
    22     foreign
    23     srfi-4
    24     (only numbers <= inexact->exact exact->inexact number?)
    25     (only type-errors error-positive-integer)
    26     random-source
    27     entropy-source
    28     (only srfi-27-numbers
    29       check-positive-integer
    30       random-large-integer random-large-real
    31       native-real-precision?))
    32 
    33   (require-library
    34     srfi-4
    35     numbers
    36     type-errors
    37     random-source entropy-source srfi-27-numbers)
    38 
    39   (declare (not usual-integrations <= inexact->exact exact->inexact))
     16(;export
     17  make-random-source-mrg32k3a)
     18
     19(import
     20  (except scheme <= inexact->exact exact->inexact number?)
     21  chicken
     22  foreign)
     23
     24(import
     25  srfi-4
     26  (only numbers <= inexact->exact exact->inexact number?)
     27  (only type-errors error-positive-integer)
     28  random-source
     29  entropy-source
     30  fp-extn
     31  (only srfi-27-numbers
     32    check-positive-integer
     33    random-large-integer random-large-real
     34    native-real-precision?))
     35(require-library
     36  srfi-4
     37  numbers
     38  type-errors
     39  random-source entropy-source
     40  fp-extn
     41  srfi-27-numbers)
     42
     43(declare
     44  (not usual-integrations
     45    <= inexact->exact exact->inexact))
     46
     47;*** DEBUG ***
     48(use extras)
    4049
    4150#>
     
    112121;;; fp stuff
    113122
    114 (include "fp-extn")
    115 
    116123;;;
    117124;;; mrg32k3a specific
     
    259266  (let ((state-M (list fpM1-1 fpM1-1 fpM1-1 fpM2-1 fpM2-1 fpM2-1)))
    260267    (lambda (external-state)
     268      ;
    261269      (define (checked-set! state n i m)
    262         (if (not (number? n)) (error 'mrg32k3a-pack-state "not a number" n)
    263             (let ((x (exact->inexact n)))
    264               (if (and (fpinteger? x) (fp<= 0.0 x) (fp<= x m)) (f64vector-set! state i x)
    265                   (error 'mrg32k3a-pack-state "illegal value" x n) ) ) ) )
    266       ;XXX This is a waste since cannot overflow to zero & or have mixed signs.
     270        (unless (number? n)
     271          (error 'mrg32k3a-pack-state "not a number" n) )
     272        (let ((x (exact->inexact n)))
     273          (unless (and (fpinteger? x) (fp<= 0.0 x) (fp<= x m))
     274            (error 'mrg32k3a-pack-state "illegal value" x n) )
     275          (f64vector-set! state i x) ) )
     276      ;
    267277      (define (check-m-state a b c)
     278        ;XXX This is a waste since cannot overflow to zero & or have mixed signs.
    268279        (when (fpzero? (fp+ a (fp+ b c)))
    269280          (error 'mrg32k3a-pack-state "illegal degenerate state" external-state) ) )
     281      ;
    270282      (unless (and
    271283                (pair? external-state)
     
    273285                (fx= STATE-LENGTH (length (cdr external-state))))
    274286          (error 'mrg32k3a-pack-state "malformed state" external-state) )
     287      ;
    275288      (let ((state (make-state)))
    276289        (do ((i 0 (fx+ i 1))
     
    341354                    0.0       1.0          0.0)) )
    342355    (lambda (i j)
    343 
     356      ;
    344357      (define (product a b) ; A*B in ((Z/m1*Z) x (Z/m2*Z))^(3x3)
    345 
     358        ;Yes, I know at toplevel
    346359        (define-constant fpW      65536.0) ; wordsize to split {0..2^32-1}
    347360        (define-constant fpW-SQR1 209.0)   ; w^2 mod m1
    348361        (define-constant fpW-SQR2 22853.0) ; w^2 mod m2
    349 
     362        ;
    350363        (define (lc i0 i1 i2 j0 j1 j2 m w-sqr) ; linear combination
    351364          (let ((a0h (fpquotient  (f64vector-ref a i0) fpW))
    352                 (a0l (fpremainder (f64vector-ref a i0) fpW))
     365                (a0l (fpmodulo (f64vector-ref a i0) fpW))
    353366                (a1h (fpquotient  (f64vector-ref a i1) fpW))
    354                 (a1l (fpremainder (f64vector-ref a i1) fpW))
     367                (a1l (fpmodulo (f64vector-ref a i1) fpW))
    355368                (a2h (fpquotient  (f64vector-ref a i2) fpW))
    356                 (a2l (fpremainder (f64vector-ref a i2) fpW))
     369                (a2l (fpmodulo (f64vector-ref a i2) fpW))
    357370                (b0h (fpquotient  (f64vector-ref b j0) fpW))
    358                 (b0l (fpremainder (f64vector-ref b j0) fpW))
     371                (b0l (fpmodulo (f64vector-ref b j0) fpW))
    359372                (b1h (fpquotient  (f64vector-ref b j1) fpW))
    360                 (b1l (fpremainder (f64vector-ref b j1) fpW))
     373                (b1l (fpmodulo (f64vector-ref b j1) fpW))
    361374                (b2h (fpquotient  (f64vector-ref b j2) fpW))
    362                 (b2l (fpremainder (f64vector-ref b j2) fpW)))
    363             (fpremainder
    364              (fp+ (fp+ (fp* (fp+ (fp* a0h b0h)
    365                                  (fp+ (fp* a1h b1h)
    366                                       (fp* a2h b2h)))
    367                             w-sqr)
    368                        (fp* fpW
    369                             (fp+ (fp* a0h b0l)
    370                                  (fp+ (fp* a0l b0h)
    371                                       (fp+ (fp* a1h b1l)
    372                                            (fp+ (fp* a1l b1h)
    373                                                 (fp+ (fp* a2h b2l) (fp* a2l b2h))))))))
    374                   (fp+ (fp* a0l b0l) (fp+ (fp* a1l b1l) (fp* a2l b2l))))
    375              m) ) )
    376 
     375                (b2l (fpmodulo (f64vector-ref b j2) fpW)))
     376            (fpmodulo
     377              (fp+ (fp+ (fp* (fp+ (fp* a0h b0h)
     378                                  (fp+ (fp* a1h b1h)
     379                                       (fp* a2h b2h)))
     380                             w-sqr)
     381                        (fp* fpW
     382                             (fp+ (fp* a0h b0l)
     383                                  (fp+ (fp* a0l b0h)
     384                                       (fp+ (fp* a1h b1l)
     385                                            (fp+ (fp* a1l b1h)
     386                                                 (fp+ (fp* a2h b2l) (fp* a2l b2h))))))))
     387                   (fp+ (fp* a0l b0l) (fp+ (fp* a1l b1l) (fp* a2l b2l))))
     388              m) ) )
     389        ;
    377390        (f64vector
    378391          (lc  0  1  2   0  3  6  fpM1 fpW-SQR1) ; (A*B)_00 mod m1
     
    394407          (lc 15 16 17  10 13 16  fpM2 fpW-SQR2)
    395408          (lc 15 16 17  11 14 17  fpM2 fpW-SQR2)) )
    396 
     409      ;
    397410      (define (power a e) ; A^e
    398411        (cond
    399412          ((fpzero? e)  A^0)
    400           ((fp= e 1.0)  a)
     413          ((fp= 1.0 e)  a)
    401414          ((fpeven? e)  (power (product a a) (fpquotient e 2.0)))
    402415          (else         (product (power a (fp- e 1.0)) a)) ) )
    403 
    404416      ; precompute A^(2^127) and A^(2^76)
    405417      ; note that A and A^0 are constant thru computation
    406418      (unless mrg32k3a-gen0
    407         (letrec ((power-power  ; A^(2^b)
    408                   (lambda (a b)
    409                     (if (fpzero? b)
    410                       a
    411                       (power-power (product a a) (fp- b 1.0))))))
     419        (letrec
     420            ((power-power  ; A^(2^b)
     421              (lambda (a b)
     422                (if (fpzero? b)
     423                  a
     424                  (power-power (product a a) (fp- b 1.0))))))
    412425          (set! mrg32k3a-gen0 (power-power A 127.0))
    413426          (set! mrg32k3a-gen1 (power-power A 76.0))
    414427          (set! mrg32k3a-gen2 (power A 16.0)) ) )
    415 
    416428      ; compute M = A^(16 + i*2^127 + j*2^76)
    417429      (let ((M
     
    419431                mrg32k3a-gen2
    420432                (product
    421                   (power mrg32k3a-gen0 (fpremainder i fp2^28))
    422                   (power mrg32k3a-gen1 (fpremainder j fp2^28))))))
     433                  (power mrg32k3a-gen0 (fpmodulo i fp2^28))
     434                  (power mrg32k3a-gen1 (fpmodulo j fp2^28))))))
    423435        ; the new state
    424436        (f64vector
     
    433445(define (make-gms16wc entropy-source)
    434446  (let ((random-m
    435          (let ((x (fpremainder ((@entropy-source-f64 entropy-source)) fp2^16)))
     447         (let ((x (fpmodulo ((@entropy-source-f64 entropy-source)) fp2^16)))
    436448           (lambda ()
    437              (let ((y (fpremainder x fp2^16)))
     449             (let ((y (fpmodulo x fp2^16)))
    438450               (set! x (fp+ (fp* 30903.0 y) (fpquotient x fp2^16)))
    439451               y ) ) ) ) )
    440452    (lambda (n)
    441453      ; m < n < m^2
    442       (fpremainder (fp+ (fp* (random-m) fp2^16) (random-m)) n) ) ) )
     454      (fpmodulo (fp+ (fp* (random-m) fp2^16) (random-m)) n) ) ) )
    443455
    444456; True Randomization
     
    455467    ; the new state
    456468    (f64vector
    457      (fp+ 1.0 (fpremainder (fp+ (f64vector-ref state 0) (random fpM1-1)) fpM1-1))
    458      (fpremainder (fp+ (f64vector-ref state 1) (random fpM1)) fpM1)
    459      (fpremainder (fp+ (f64vector-ref state 2) (random fpM1)) fpM1)
    460      (fp+ 1.0 (fpremainder (fp+ (f64vector-ref state 3) (random fpM2-1)) fpM2-1))
    461      (fpremainder (fp+ (f64vector-ref state 4) (random fpM2)) fpM2)
    462      (fpremainder (fp+ (f64vector-ref state 5) (random fpM2)) fpM2)) ) )
     469      (fp+ 1.0 (fpmodulo (fp+ (f64vector-ref state 0) (random fpM1-1)) fpM1-1))
     470      (fpmodulo (fp+ (f64vector-ref state 1) (random fpM1)) fpM1)
     471      (fpmodulo (fp+ (f64vector-ref state 2) (random fpM1)) fpM1)
     472      (fp+ 1.0 (fpmodulo (fp+ (f64vector-ref state 3) (random fpM2-1)) fpM2-1))
     473      (fpmodulo (fp+ (f64vector-ref state 4) (random fpM2)) fpM2)
     474      (fpmodulo (fp+ (f64vector-ref state 5) (random fpM2)) fpM2)) ) )
    463475
    464476(define (mrg32k3a-random-large state n) ; n > m
     
    486498      #f
    487499      ;
    488       (lambda () (mrg32k3a-unpack-state state) )
    489       ;
    490       (lambda (new-state) (set! state (mrg32k3a-pack-state new-state)))
    491       ;
    492       (lambda (entropy-source) (set! state (mrg32k3a-randomize-state state entropy-source)))
    493       ;
    494       (lambda (i j) (set! state (mrg32k3a-pseudo-randomize-state (exact->inexact i) (exact->inexact j))))
     500      (lambda ()
     501        (mrg32k3a-unpack-state state) )
     502      ;
     503      (lambda (new-state)
     504        (set! state (mrg32k3a-pack-state new-state)) )
     505      ;
     506      (lambda (entropy-source)
     507        (set! state (mrg32k3a-randomize-state state entropy-source)) )
     508      ;
     509      (lambda (i j)
     510        (set! state
     511          (mrg32k3a-pseudo-randomize-state (exact->inexact i) (exact->inexact j))) )
    495512      ;
    496513      (lambda ()
     
    517534        (cond
    518535          ((native-real-precision? prec eM1)
    519             (lambda () (mrg32k3a-random-real state)))
     536            (lambda ()
     537              (mrg32k3a-random-real state)))
    520538          (else
    521             (lambda () (mrg32k3a-random-real-mp state prec)))))) ) )
     539            (lambda ()
     540              (mrg32k3a-random-real-mp state prec)))))) ) )
    522541
    523542;;;
  • release/4/srfi-27/trunk/random-source.scm

    r33848 r34011  
    44(module random-source
    55
    6   (;export
    7     *make-random-source
    8     random-source? check-random-source error-random-source
    9     *random-source-name
    10     *random-source-documentation
    11     *random-source-log2-period
    12     *random-source-maximum-range
    13     *random-source-entropy-source *random-source-entropy-source-set!
    14     @random-source-constructor
    15     @random-source-state-ref @random-source-state-set!
    16     @random-source-randomize! @random-source-pseudo-randomize!
    17     @random-source-make-integers @random-source-make-reals
    18     ;
    19     registered-random-sources
    20     registered-random-source
    21     unregister-random-source
    22     register-random-source!)
     6(;export
     7  *make-random-source
     8  random-source? check-random-source error-random-source
     9  *random-source-name
     10  *random-source-documentation
     11  *random-source-log2-period
     12  *random-source-maximum-range
     13  *random-source-entropy-source *random-source-entropy-source-set!
     14  @random-source-constructor
     15  @random-source-state-ref @random-source-state-set!
     16  @random-source-randomize! @random-source-pseudo-randomize!
     17  @random-source-make-integers @random-source-make-reals
     18  ;
     19  registered-random-sources
     20  registered-random-source
     21  unregister-random-source
     22  register-random-source!)
    2323
    24   (import
    25     scheme
    26     chicken
    27     (only data-structures alist-ref alist-update!)
    28     (only srfi-1 alist-cons alist-delete!)
    29     (only type-checks define-check+error-type check-procedure check-symbol))
    30   (require-library data-structures srfi-1 type-checks)
     24(import scheme chicken)
    3125
    32   (use registration)
     26(import
     27  (only data-structures alist-ref alist-update!)
     28  (only srfi-1 alist-cons alist-delete!)
     29  (only type-checks define-check+error-type check-procedure check-symbol))
     30(require-library data-structures srfi-1 type-checks)
     31
     32(use registration)
    3333
    3434;;
  • release/4/srfi-27/trunk/registration.scm

    r34008 r34011  
    44(module registration
    55
    6   (;export
    7     make-registration
    8     registration? check-registration error-registration
    9     @registration-key @registration-ref @registration-deref! @registration-register!)
     6(;export
     7  make-registration
     8  registration? check-registration error-registration
     9  @registration-key @registration-ref @registration-deref! @registration-register!)
    1010
    11   (import
    12     scheme
    13     chicken
    14     (only data-structures alist-ref alist-update!)
    15     (only srfi-1 alist-delete!)
    16     (only type-checks define-check+error-type check-procedure check-symbol check-list))
    17   (require-library data-structures srfi-1 type-checks)
     11(import scheme chicken)
     12
     13(import
     14  (only data-structures alist-ref alist-update!)
     15  (only srfi-1 alist-delete!)
     16  (only type-checks define-check+error-type check-procedure check-symbol check-list))
     17(require-library data-structures srfi-1 type-checks)
    1818
    1919;;
  • release/4/srfi-27/trunk/srfi-27-numbers.scm

    r33848 r34011  
    44(module srfi-27-numbers
    55
    6   (;export
    7     ;
    8     check-integer
    9     #;check-cardinal-integer
    10     check-positive-integer
    11     #;check-real
    12     #;check-nonzero-real
    13     #;check-nonnegative-real
    14     #;check-positive-real
    15     #;check-real-open-interval
    16     #;check-real-closed-interval
    17     check-real-precision
    18     #;check-real-unit
    19     ;
    20     random-large-integer
    21     random-large-real
    22     ;
    23     native-real-precision?)
     6(;export
     7  ;
     8  check-integer
     9  #;check-cardinal-integer
     10  check-positive-integer
     11  #;check-real
     12  #;check-nonzero-real
     13  #;check-nonnegative-real
     14  #;check-positive-real
     15  #;check-real-open-interval
     16  #;check-real-closed-interval
     17  check-real-precision
     18  #;check-real-unit
     19  ;
     20  random-large-integer
     21  random-large-real
     22  ;
     23  native-real-precision?)
    2424
    25   (import
    26     (except scheme
    27       <= < zero? positive? negative?
    28       + * - / quotient expt
    29       integer? real?
    30       exact->inexact inexact->exact
    31       floor)
    32     chicken
    33     (only numbers
    34       <= < zero? positive? negative?
    35       + * - / quotient expt
    36       integer? real?
    37       exact->inexact inexact->exact
    38       floor)
    39     (only type-checks
    40       check-real)
    41     (only type-errors
    42       error-argument-type error-open-interval error-closed-interval))
     25(import
     26  (except scheme
     27    <= < zero? positive? negative?
     28    + * - / quotient expt
     29    integer? real?
     30    exact->inexact inexact->exact
     31    floor)
     32  chicken)
    4333
    44   (require-library numbers type-errors)
     34(import
     35  (only numbers
     36    <= < zero? positive? negative?
     37    + * - / quotient expt
     38    integer? real?
     39    exact->inexact inexact->exact
     40    floor)
     41  (only type-checks
     42    check-real)
     43  (only type-errors
     44    error-argument-type error-open-interval error-closed-interval))
     45(require-library numbers type-checks type-errors)
    4546
    46   (declare
    47     (not usual-integrations
    48       <= < zero? positive? negative?
    49       + * - / quotient expt
    50       integer? real?
    51       exact->inexact inexact->exact) )
     47(declare
     48  (not usual-integrations
     49    <= < zero? positive? negative?
     50    + * - / quotient expt
     51    integer? real?
     52    exact->inexact inexact->exact) )
    5253
    5354;;;
  • release/4/srfi-27/trunk/srfi-27-vector-support.scm

    r33848 r34011  
    1010(module srfi-27-vector-support
    1111
    12   (;export
    13     vector-filled! u8vector-filled! f32vector-filled! f64vector-filled!
    14     f32vector-mapi!/1 f32vector-foldi/1
    15     f64vector-mapi!/1 f64vector-foldi/1
    16     ;
    17     check-vector%
    18     vector%-length
    19     vector%-mapi!/1
    20     vector%-foldi/1
    21     vector%-filled!
    22     vector%-scale!
    23     vector%-sum-squares)
     12(;export
     13  vector-filled! u8vector-filled! f32vector-filled! f64vector-filled!
     14  f32vector-mapi!/1 f32vector-foldi/1
     15  f64vector-mapi!/1 f64vector-foldi/1
     16  ;
     17  check-vector%
     18  vector%-length
     19  vector%-mapi!/1
     20  vector%-foldi/1
     21  vector%-filled!
     22  vector%-scale!
     23  vector%-sum-squares)
    2424
    25   (import
    26     scheme
    27     chicken
    28     (only srfi-4
    29       u8vector-length u8vector-ref u8vector-set!
    30       f32vector? f32vector-length f32vector-ref f32vector-set!
    31       f64vector? f64vector-length f64vector-ref f64vector-set!)
    32     (only vector-lib vector-map! vector-fold)
    33     (only type-errors error-vector))
     25(import scheme chicken)
    3426
    35   (require-library srfi-4 vector-lib type-errors)
     27(import
     28  (only srfi-4
     29    u8vector-length u8vector-ref u8vector-set!
     30    f32vector? f32vector-length f32vector-ref f32vector-set!
     31    f64vector? f64vector-length f64vector-ref f64vector-set!)
     32  (only vector-lib vector-map! vector-fold)
     33  (only type-errors error-vector))
     34(require-library srfi-4 vector-lib type-errors)
    3635
    3736;;;
     
    4039
    4140(define (make-filled! veclenf vecsetf)
    42   (letrec ((self
    43             (case-lambda
    44               ((vec gen)
    45                 (self vec gen 0) )
    46               ((vec gen start)
    47                 (self vec gen start (veclenf vec)) )
    48               ((vec gen start end)
    49                 (do ((idx start (fx+ idx 1)))
    50                     ((fx= end idx) vec)
    51                   (vecsetf vec idx (gen)) ) ) ) ) )
     41  (letrec
     42      ((self
     43        (case-lambda
     44          ((vec gen)
     45            (self vec gen 0) )
     46          ((vec gen start)
     47            (self vec gen start (veclenf vec)) )
     48          ((vec gen start end)
     49            (do ((idx start (fx+ idx 1)))
     50                ((fx= end idx) vec)
     51              (vecsetf vec idx (gen)) ) ) ) ) )
    5252    self ) )
    5353
  • release/4/srfi-27/trunk/srfi-27.meta

    r33848 r34011  
    1616        (numbers "2.8")
    1717        (synch "2.1.0"))
    18  (files "mrg32k3a.scm" "srfi-27.meta" "srfi-27-uniform-random.scm" "mwc.scm" "srfi-27.setup" "entropy-procedure.scm" "srfi-27.release-info" "srfi-27-implementation" "srfi-27-numbers.scm" "fp-extn-w.scm" "entropy-unix.scm" "composite-random-source.scm" "entropy-source.scm" "entropy-clock.scm" "random-source.scm" "srfi-27-vector-support.scm" "srfi-27-distributions.scm" "srfi-27-vector.scm" "srfi-27.scm" "entropy-windows.scm" "moa.scm" "fp-extn-wo.scm" "entropy-support.scm" "registration.scm" "tests/test-diehard.scm" "tests/test-confidence.scm" "tests/test-mrg32k3a.scm" "tests/run.scm" "entropy-port.scm") )
     18 (files "mrg32k3a.scm" "srfi-27.meta" "srfi-27-uniform-random.scm" "mwc.scm"
     19 "srfi-27.setup" "entropy-procedure.scm" "srfi-27.release-info"
     20 "srfi-27-implementation" "srfi-27-numbers.scm" "fp-extn.scm"
     21 "entropy-unix.scm" "composite-random-source.scm" "entropy-source.scm"
     22 "entropy-clock.scm" "random-source.scm" "srfi-27-vector-support.scm"
     23 "srfi-27-distributions.scm" "srfi-27-vector.scm" "srfi-27.scm"
     24 "entropy-windows.scm" "moa.scm" "entropy-support.scm"
     25 "registration.scm" "tests/test-diehard.scm" "tests/test-confidence.scm"
     26 "tests/test-mrg32k3a.scm" "tests/run.scm" "entropy-port.scm") )
  • release/4/srfi-27/trunk/srfi-27.scm

    r33848 r34011  
    44(module srfi-27
    55
    6   (;export
    7     ;; SRFI 27
    8     default-random-source
    9     random-integer
    10     random-real
    11     make-random-source
    12     random-source? check-random-source error-random-source
    13     random-source-state-ref
    14     random-source-state-set!
    15     random-source-randomize!
    16     random-source-pseudo-randomize!
    17     random-source-make-integers
    18     random-source-make-reals
    19     ;; Extensions
    20     registered-random-sources registered-random-source
    21     current-random-source
    22     new-random-source
    23     random-source-name random-source-kind
    24     random-source-documentation
    25     random-source-log2-period
    26     random-source-maximum-range
    27     random-source-entropy-source random-source-entropy-source-set!
    28     random-source-make-u8vectors
    29     random-source-make-f64vectors
    30     random-u8vector
    31     random-f64vector
    32     registered-entropy-sources registered-entropy-source
    33     current-entropy-source
    34     make-entropy-source new-entropy-source
    35     entropy-source? check-entropy-source error-entropy-source
    36     entropy-source-name entropy-source-kind
    37     entropy-source-documentation
    38     entropy-source-u8
    39     entropy-source-f64
    40     entropy-source-u8vector
    41     entropy-source-f64vector)
    42 
    43   (import
    44     scheme
    45     chicken
    46     (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
    51     (only type-errors error-argument-type warning-argument-type)
    52     random-source
    53     entropy-source
    54     entropy-clock
    55     mrg32k3a
    56     (only srfi-27-numbers check-real-precision)
    57     (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
    58 
    59   (require-library
    60     data-structures srfi-4
    61     miscmacros
    62     random-source entropy-source
    63     mrg32k3a entropy-clock
    64     type-checks type-errors srfi-4-checks
    65     srfi-27-numbers srfi-27-vector-support)
     6(;export
     7  ;; SRFI 27
     8  default-random-source
     9  random-integer
     10  random-real
     11  make-random-source
     12  random-source? check-random-source error-random-source
     13  random-source-state-ref
     14  random-source-state-set!
     15  random-source-randomize!
     16  random-source-pseudo-randomize!
     17  random-source-make-integers
     18  random-source-make-reals
     19  ;; Extensions
     20  registered-random-sources registered-random-source
     21  current-random-source
     22  new-random-source
     23  random-source-name random-source-kind
     24  random-source-documentation
     25  random-source-log2-period
     26  random-source-maximum-range
     27  random-source-entropy-source random-source-entropy-source-set!
     28  random-source-make-u8vectors
     29  random-source-make-f64vectors
     30  random-u8vector
     31  random-f64vector
     32  registered-entropy-sources registered-entropy-source
     33  current-entropy-source
     34  make-entropy-source new-entropy-source
     35  entropy-source? check-entropy-source error-entropy-source
     36  entropy-source-name entropy-source-kind
     37  entropy-source-documentation
     38  entropy-source-u8
     39  entropy-source-f64
     40  entropy-source-u8vector
     41  entropy-source-f64vector)
     42
     43(import scheme chicken)
     44
     45(import
     46  (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
     51  (only type-errors error-argument-type warning-argument-type)
     52  random-source
     53  entropy-source
     54  entropy-clock
     55  mrg32k3a
     56  (only srfi-27-numbers check-real-precision)
     57  (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
     58(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
     64  srfi-27-numbers srfi-27-vector-support)
    6665
    6766;;; Entropy Source
  • release/4/srfi-27/trunk/srfi-27.setup

    r34008 r34011  
    55(verify-extension-name "srfi-27")
    66
    7 (if (version>=? (chicken-version) "4.3.6")
    8   (copy-file '("fp-extn-wo.scm" "fp-extn.scm") "." #t ".")
    9   (copy-file '("fp-extn-w.scm" "fp-extn.scm") "." #t ".") )
    10 
    117;; Utility Modules
    128
    13 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.0")
     9(setup-shared-extension-module 'fp-extn (extension-version "3.2.1")
    1410  #:inline? #t
    1511  #:types? #t
     
    1814    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    1915
    20 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.0")
     16(setup-shared-extension-module 'registration (extension-version "3.2.1")
     17  #:inline? #t
     18  #:types? #t
     19  #:compile-options '(
     20    -scrutinize -optimize-level 3 -debug-level 1
     21    -no-procedure-checks -no-argc-checks -no-bound-checks) )
     22
     23(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.1")
    2124  #:inline? #t
    2225  #:types? #t
     
    2528    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    2629
    27 (setup-shared-extension-module 'registration (extension-version "3.2.0")
     30(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.1")
     31  #:inline? #t
     32  #:types? #t
     33  #:compile-options '(
     34    -scrutinize -optimize-level 3 -debug-level 0
     35    -no-procedure-checks -no-argc-checks -no-bound-checks) )
     36
     37;; Entropy Source Modules
     38
     39(setup-shared-extension-module 'entropy-source (extension-version "3.2.1")
    2840  #:inline? #t
    2941  #:types? #t
     
    3244    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    3345
    34 ;; Entropy Source Modules
    35 
    36 (setup-shared-extension-module 'entropy-source (extension-version "3.2.0")
    37   #:inline? #t
    38   #:types? #t
    39   #:compile-options '(
    40     -scrutinize -optimize-level 3 -debug-level 1
    41     -no-procedure-checks -no-argc-checks -no-bound-checks) )
    42 
    43 (setup-shared-extension-module 'entropy-support (extension-version "3.2.0")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.1")
    4447  #:inline? #t
    4548  #:types? #t
     
    4851    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    4952
    50 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.0")
     53(setup-shared-extension-module 'entropy-clock (extension-version "3.2.1")
    5154  #:inline? #t
    5255  #:types? #t
     
    5558    -no-procedure-checks) )
    5659
    57 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.0")
     60(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.1")
    5861  #:inline? #t
    5962  #:types? #t
     
    6265    -no-procedure-checks) )
    6366
    64 (setup-shared-extension-module 'entropy-port (extension-version "3.2.0")
     67(setup-shared-extension-module 'entropy-port (extension-version "3.2.1")
    6568  #:inline? #t
    6669  #:types? #t
     
    7073
    7174#+unix
    72 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.0")
     75(setup-shared-extension-module 'entropy-unix (extension-version "3.2.1")
    7376  #:inline? #t
    7477  #:types? #t
     
    7881
    7982#+windows
    80 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.0")
     83(setup-shared-extension-module 'entropy-windows (extension-version "3.2.1")
    8184  #:inline? #t
    8285  #:types? #t
     
    8790;; Random Source Modules
    8891
    89 (setup-shared-extension-module 'random-source (extension-version "3.2.0")
     92(setup-shared-extension-module 'random-source (extension-version "3.2.1")
    9093  #:inline? #t
    9194  #:types? #t
     
    9497    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    9598
    96 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.0")
     99(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.1")
     100  #:inline? #t
     101  #:types? #t
     102  #:compile-options '(
     103    -scrutinize
     104    ;-optimize-level 3 -debug-level 0
     105    -no-procedure-checks -no-argc-checks -no-bound-checks) )
     106
     107(setup-shared-extension-module 'mwc (extension-version "3.2.1")
    97108  #:inline? #t
    98109  #:types? #t
     
    101112    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    102113
    103 (setup-shared-extension-module 'mwc (extension-version "3.2.0")
     114(setup-shared-extension-module 'moa (extension-version "3.2.1")
    104115  #:inline? #t
    105116  #:types? #t
     
    108119    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    109120
    110 (setup-shared-extension-module 'moa (extension-version "3.2.0")
    111   #:inline? #t
    112   #:types? #t
    113   #:compile-options '(
    114     -scrutinize -optimize-level 3 -debug-level 0
    115     -no-procedure-checks -no-argc-checks -no-bound-checks) )
    116 
    117 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.0")
     121(setup-shared-extension-module 'composite-random-source (extension-version "3.2.1")
    118122  #:inline? #t
    119123  #:types? #t
     
    124128;; Main Modules
    125129
    126 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.0")
     130(setup-shared-extension-module 'srfi-27 (extension-version "3.2.1")
    127131  #:inline? #t
    128132  #:types? #t
     
    131135    -no-procedure-checks) )
    132136
    133 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.0")
     137(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.1")
    134138  #:inline? #t
    135139  #:types? #t
     
    138142    -no-procedure-checks) )
    139143
    140 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.0")
     144(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.1")
    141145  #:inline? #t
    142146  #:types? #t
     
    145149    -no-procedure-checks) )
    146150
    147 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.0")
     151(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.1")
    148152  #:inline? #t
    149153  #:types? #t
  • release/4/srfi-27/trunk/tests/run.scm

    r33848 r34011  
    33(use srfi-27)
    44(use srfi-4)
     5
     6(newline)
     7(print "Testing random SRFI-4 vector")
     8(print "Random Source: " (random-source-kind (current-random-source)))
     9(print "Entropy Source: " (entropy-source-kind (current-entropy-source)))
    510
    611(let ((v10 (random-u8vector 10)))
     
    2126(system* "csi -n -s test-confidence")
    2227;(system* "csi -n -s test-diehard") ;errors
     28
     29(newline)
  • release/4/srfi-27/trunk/tests/test-confidence.scm

    r19090 r34011  
    1818
    1919(newline)
     20(print "CONFIDENCE TESTS FOR SRFI-27 \"Sources of Random Bits\"")
    2021(print "Entropy Source: " (entropy-source-kind (current-entropy-source)))
    21 (newline)
    2222
    2323
     
    168168(define (check-basics-of s)
    169169  (time
     170    (newline)
    170171    (current-random-source (make-random-source s))
    171172    (print "Random Source: " (random-source-documentation (current-random-source)))
    172     (check-basics) )
    173   (newline) )
     173    (check-basics) ) )
    174174
    175175;;; run some tests
  • release/4/srfi-27/trunk/tests/test-mrg32k3a.scm

    r21086 r34011  
    1616
    1717(newline)
     18(print "Testing the MRG32k3a Generator")
    1819(print "Entropy Source: " (entropy-source-kind (current-entropy-source)))
    1920(newline)
     
    7778(check-mrg32k3a)
    7879(print "passed (check-mrg32k3a)")
    79 (newline)
Note: See TracChangeset for help on using the changeset viewer.