Changeset 34012 in project for release/4


Ignore:
Timestamp:
04/22/17 21:57:07 (3 years ago)
Author:
Kon Lovett
Message:

add missing import in srfi-27-uniform-random.scm, re-flow, add tests

Location:
release/4/srfi-27
Files:
4 deleted
27 edited
17 copied

Legend:

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

    r34008 r34012  
    44(module composite-random-source
    55
    6   (;export
    7     *composite-random-source
    8     composite-random-source)
     6(;export
     7  *composite-random-source
     8  composite-random-source)
    99
    10   (import
    11     scheme
    12     chicken
    13     (only data-structures conc reverse-string-append ->string intersperse)
    14     (only type-errors error-argument-type)
    15     random-source)
     10(import scheme chicken)
    1611
    17   (require-library data-structures type-errors random-source)
     12(import
     13  (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)
    1817
    1918;; *composite-random-source
     
    144143                  (cons (*random-source-maximum-range s) maxrngs)) ) ) ) ) )
    145144
    146 ) ; module composite-random-source
     145) ;module composite-random-source
  • release/4/srfi-27/tags/3.2.2/entropy-clock.scm

    r33848 r34012  
    44(module entropy-clock
    55
    6   (;export
    7     make-entropy-source-system-clock)
     6(;export
     7  make-entropy-source-system-clock)
    88
    9   (import
    10     scheme
    11     chicken
    12     foreign)
     9(import scheme chicken foreign)
    1310
    14   (use entropy-source entropy-support)
     11(use entropy-source entropy-support)
    1512
    1613;;;
  • release/4/srfi-27/tags/3.2.2/entropy-port.scm

    r33848 r34012  
    44(module entropy-port
    55
    6   (;export
    7     ;
    8     entropy-port-lifetime
    9     ;
    10     make-entropy-source/port
    11     make-entropy-source/port-open make-entropy-source/port-open-timed
    12     make-entropy-source/file make-entropy-source/file-timed)
     6(;export
     7  ;
     8  entropy-port-lifetime
     9  ;
     10  make-entropy-source/port
     11  make-entropy-source/port-open make-entropy-source/port-open-timed
     12  make-entropy-source/file make-entropy-source/file-timed)
    1313
    14   (import
    15     scheme
    16     chicken
    17     (only type-checks check-input-port check-procedure check-symbol check-string)
    18     (only type-errors warning-argument-type))
     14(import scheme chicken)
    1915
    20   (require-library
    21     type-checks type-errors)
     16(import
     17  (only type-checks check-input-port check-procedure check-symbol check-string)
     18  (only type-errors warning-argument-type))
     19(require-library type-checks type-errors)
    2220
    2321(use entropy-source entropy-support timed-resource miscmacros)
  • release/4/srfi-27/tags/3.2.2/entropy-procedure.scm

    r19090 r34012  
    44(module entropy-procedure
    55
    6   (;export
    7     make-entropy-source/procedures
    8     make-entropy-source/f64procedure)
     6(;export
     7  make-entropy-source/procedures
     8  make-entropy-source/f64procedure)
    99
    10   (import
    11     scheme
    12     chicken
    13     (only type-checks check-procedure check-symbol check-string)
    14     entropy-source
    15     entropy-support)
     10(import scheme chicken)
    1611
    17   (require-library type-checks entropy-source entropy-support)
     12(import
     13  (only type-checks check-procedure check-symbol check-string)
     14  entropy-source
     15  entropy-support)
     16(require-library type-checks entropy-source entropy-support)
    1817
    1918;;; Entropy from some procedure
  • release/4/srfi-27/tags/3.2.2/entropy-source.scm

    r33848 r34012  
    44(module entropy-source
    55
    6   (;export
    7     *make-entropy-source
    8     entropy-source? check-entropy-source error-entropy-source
    9     *entropy-source-name
    10     *entropy-source-documentation
    11     @entropy-source-constructor
    12     @entropy-source-u8
    13     @entropy-source-f64
    14     @entropy-source-u8vector
    15     @entropy-source-f64vector
    16     ;
    17     entropy-source-integer
    18     entropy-source-f64-integer
    19     ;
    20     registered-entropy-sources
    21     registered-entropy-source
    22     unregister-entropy-source
    23     register-entropy-source!)
     6(;export
     7  *make-entropy-source
     8  entropy-source? check-entropy-source error-entropy-source
     9  *entropy-source-name
     10  *entropy-source-documentation
     11  @entropy-source-constructor
     12  @entropy-source-u8
     13  @entropy-source-f64
     14  @entropy-source-u8vector
     15  @entropy-source-f64vector
     16  ;
     17  entropy-source-integer
     18  entropy-source-f64-integer
     19  ;
     20  registered-entropy-sources
     21  registered-entropy-source
     22  unregister-entropy-source
     23  register-entropy-source!)
    2424
    25   (import
    26     scheme
    27     chicken
    28     (only data-structures alist-ref alist-update!)
    29     (only srfi-1 alist-cons alist-delete!)
    30     (only type-checks define-check+error-type check-procedure check-symbol))
    31   (require-library data-structures srfi-1 type-checks)
     25(import scheme chicken)
    3226
    33   (use registration)
     27(import
     28  (only data-structures alist-ref alist-update!)
     29  (only srfi-1 alist-cons alist-delete!)
     30  (only type-checks define-check+error-type check-procedure check-symbol))
     31(require-library data-structures srfi-1 type-checks)
     32
     33(use registration)
    3434
    3535;;
  • release/4/srfi-27/tags/3.2.2/entropy-support.scm

    r33848 r34012  
    1212(module entropy-support
    1313
    14   (;export
    15     make-entropic-u8/f64
    16     entropic-u8vector-filled/f64
    17     entropic-u8vector-filled
    18     port-entropic-u8
    19     port-entropic-u8vector
    20     make-entropic-f64/u8
    21     entropic-f64vector-filled/u8
    22     entropic-f64vector-filled
    23     port-entropic-f64
    24     port-entropic-f64vector)
     14(;export
     15  make-entropic-u8/f64
     16  entropic-u8vector-filled/f64
     17  entropic-u8vector-filled
     18  port-entropic-u8
     19  port-entropic-u8vector
     20  make-entropic-f64/u8
     21  entropic-f64vector-filled/u8
     22  entropic-f64vector-filled
     23  port-entropic-f64
     24  port-entropic-f64vector)
    2525
    26   (import
    27     scheme
    28     chicken
    29     foreign
    30     (only extras read-byte)
    31     (only srfi-4
    32       u8vector-set! make-u8vector u8vector-length
    33       f64vector-set! make-f64vector f64vector-length
    34       read-u8vector read-u8vector!)
    35     (only lolevel move-memory!)
    36     (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
     26(import scheme chicken foreign)
    3727
    38   (require-library
    39     extras lolevel srfi-4
    40     srfi-27-vector-support)
     28(import
     29   (only extras read-byte)
     30  (only srfi-4
     31    u8vector-set! make-u8vector u8vector-length
     32    f64vector-set! make-f64vector f64vector-length
     33    read-u8vector read-u8vector!)
     34  (only lolevel move-memory!)
     35  (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
     36(require-library
     37  extras lolevel srfi-4
     38  srfi-27-vector-support)
    4139
    4240;; Double stuff
  • release/4/srfi-27/tags/3.2.2/entropy-unix.scm

    r19090 r34012  
    44(module entropy-unix
    55
    6   (;export
    7     make-entropy-source-random-device
    8     make-entropy-source-urandom-device)
     6(;export
     7  make-entropy-source-random-device
     8  make-entropy-source-urandom-device)
    99
    10   (import
    11     scheme
    12     chicken
    13     entropy-source
    14     entropy-port)
     10(import scheme chicken)
    1511
    16   (require-library entropy-source entropy-port)
     12(import
     13  entropy-source
     14  entropy-port)
     15(require-library entropy-source entropy-port)
    1716
    1817;;; Entropy from /dev/random
  • release/4/srfi-27/tags/3.2.2/entropy-windows.scm

    r21253 r34012  
    44(module entropy-windows
    55
    6   (;export
    7     make-entropy-source-crypt)
     6(;export
     7  make-entropy-source-crypt)
    88
    9   (import
    10     scheme
    11     chicken
    12     (only ports make-input-port)
    13     foreign
    14     (only srfi-4 make-u8vector u8vector-ref)
    15     entropy-source
    16     entropy-port)
     9(import scheme chicken foreign)
    1710
    18   (require-library ports srfi-4 entropy-source entropy-port)
     11(import
     12  (only ports make-input-port)
     13  (only srfi-4 make-u8vector u8vector-ref)
     14  entropy-source
     15  entropy-port)
     16(require-library ports srfi-4 entropy-source entropy-port)
    1917
    2018;;; Entropy from CryptContext
  • release/4/srfi-27/tags/3.2.2/moa.scm

    r34008 r34012  
    44(module moa
    55
    6   (;export
    7     make-random-source-moa)
    8 
    9   (import
    10     (except scheme <= inexact->exact exact->inexact number?)
    11     chicken
    12     foreign
    13     srfi-4
    14     (only numbers <= inexact->exact exact->inexact number?)
    15     random-source
    16     entropy-source
    17     (only srfi-27-numbers
    18       check-positive-integer
    19       random-large-integer random-large-real
    20       native-real-precision?))
    21 
    22   (require-library
    23     srfi-4
    24     numbers
    25     random-source entropy-source
    26     srfi-27-numbers)
    27 
    28   (declare (not usual-integrations <= exact->inexact inexact->exact))
     6(;export
     7  make-random-source-moa)
     8
     9(import
     10  (except scheme <= inexact->exact exact->inexact number?)
     11  chicken
     12  foreign)
     13
     14(import
     15  srfi-4
     16  (only numbers <= inexact->exact exact->inexact number?)
     17  random-source
     18  entropy-source
     19  (only srfi-27-numbers
     20    check-positive-integer
     21    random-large-integer random-large-real
     22    native-real-precision?))
     23(require-library
     24  srfi-4
     25  numbers
     26  random-source entropy-source
     27  srfi-27-numbers)
     28
     29(declare
     30  (not usual-integrations
     31    <= exact->inexact inexact->exact))
    2932
    3033#>
     
    273276      #f
    274277      ;
    275       (lambda () (moa-unpack-state state))
    276       ;
    277       (lambda (new-state) (set! state (moa-pack-state new-state)))
    278       ;
    279       (lambda (entropy-source) (set! state (moa-randomize-state state entropy-source)))
    280       ;
    281       (lambda (i j) (set! state (moa-pseudo-randomize-state i j)))
     278      (lambda ()
     279        (moa-unpack-state state) )
     280      ;
     281      (lambda (new-state)
     282        (set! state (moa-pack-state new-state)) )
     283      ;
     284      (lambda (entropy-source)
     285        (set! state (moa-randomize-state state entropy-source)) )
     286      ;
     287      (lambda (i j)
     288        (set! state (moa-pseudo-randomize-state i j)) )
    282289      ;
    283290      (lambda ()
     
    304311        (cond
    305312          ((native-real-precision? prec eMAX)
    306             (lambda () (moa-random-real state)))
     313            (lambda ()
     314              (moa-random-real state) ) )
    307315          (else
    308             (lambda () (moa-random-real-mp state prec)))))) ) )
     316            (lambda ()
     317              (moa-random-real-mp state prec) ) ) ) ) ) ) )
    309318
    310319;;;
  • release/4/srfi-27/tags/3.2.2/mrg32k3a.scm

    r34011 r34012  
    535535          ((native-real-precision? prec eM1)
    536536            (lambda ()
    537               (mrg32k3a-random-real state)))
     537              (mrg32k3a-random-real state) ) )
    538538          (else
    539539            (lambda ()
    540               (mrg32k3a-random-real-mp state prec)))))) ) )
     540              (mrg32k3a-random-real-mp state prec) ) ) ) ) ) ) )
    541541
    542542;;;
  • release/4/srfi-27/tags/3.2.2/mwc.scm

    r34008 r34012  
    44(module mwc
    55
    6   (;export
    7     make-random-source-mwc)
    8 
    9   (import
    10     (except scheme <= inexact->exact exact->inexact number?)
    11     chicken
    12     foreign
    13     srfi-4
    14     (only numbers <= inexact->exact exact->inexact number?)
    15     (only type-errors error-positive-integer)
    16     random-source
    17     entropy-source
    18     (only srfi-27-numbers
    19       check-positive-integer
    20       random-large-integer random-large-real
    21       native-real-precision?))
    22 
    23   (require-library
    24     srfi-4
    25     numbers
    26     type-errors
    27     random-source entropy-source srfi-27-numbers)
    28 
    29   (declare (not usual-integrations <=  exact->inexact inexact->exact))
     6(;export
     7  make-random-source-mwc)
     8
     9(import
     10  (except scheme <= inexact->exact exact->inexact number?)
     11  chicken
     12  foreign)
     13
     14(import
     15  srfi-4
     16  (only numbers <= inexact->exact exact->inexact number?)
     17  (only type-errors error-positive-integer)
     18  random-source
     19  entropy-source
     20  (only srfi-27-numbers
     21    check-positive-integer
     22    random-large-integer random-large-real
     23    native-real-precision?))
     24(require-library
     25  srfi-4
     26  numbers
     27  type-errors
     28  random-source entropy-source srfi-27-numbers)
     29
     30(declare
     31  (not usual-integrations
     32    <=  exact->inexact inexact->exact))
    3033
    3134#>
     
    270273      #f
    271274      ;
    272       (lambda () (mwc-unpack-state state))
    273       ;
    274       (lambda (new-state) (set! state (mwc-pack-state new-state)))
    275       ;
    276       (lambda (entropy-source) (set! state (mwc-randomize-state state entropy-source)))
    277       ;
    278       (lambda (i j) (set! state (mwc-pseudo-randomize-state i j)))
     275      (lambda ()
     276        (mwc-unpack-state state) )
     277      ;
     278      (lambda (new-state)
     279        (set! state (mwc-pack-state new-state)) )
     280      ;
     281      (lambda (entropy-source)
     282        (set! state (mwc-randomize-state state entropy-source)) )
     283      ;
     284      (lambda (i j)
     285        (set! state (mwc-pseudo-randomize-state i j)) )
    279286      ;
    280287      (lambda ()
     
    301308        (cond
    302309          ((native-real-precision? prec eMAX)
    303               (lambda () (mwc-random-real state)))
     310              (lambda ()
     311                (mwc-random-real state) ) )
    304312          (else
    305             (lambda () (mwc-random-real-mp state prec)))))) ) )
     313            (lambda ()
     314              (mwc-random-real-mp state prec) ) ) ) ) ) ) )
    306315
    307316;;;
  • release/4/srfi-27/tags/3.2.2/random-source.scm

    r34011 r34012  
    7575  ((@registration-register! +reg+) name ctor) )
    7676
    77 ) ; module random-source
     77) ;module random-source
  • release/4/srfi-27/tags/3.2.2/registration.scm

    r34011 r34012  
    11;;;; registration.scm
     2;;;; Kon Lovett, Feb '17
    23;;;; Kon Lovett, Oct '09
    34
     
    7071    reg ) )
    7172
    72 ) ;registration
     73) ;module registration
  • release/4/srfi-27/tags/3.2.2/srfi-27-distributions.scm

    r33848 r34012  
    66(module srfi-27-distributions
    77
    8   (;export
    9     make-random-exponentials
    10     make-random-normals
    11     make-random-triangles
    12     make-random-poissons
    13     make-random-bernoullis
    14     make-random-binomials
    15     make-random-geometrics
    16     make-random-lognormals
    17     make-random-cauchys
    18     make-random-gammas
    19     make-random-erlangs
    20     make-random-paretos
    21     make-random-levys
    22     make-random-weibulls)
    23 
    24   (import
    25     scheme
    26     chicken
    27     (only type-errors
    28       error-argument-type)
    29     (only type-checks
    30       check-procedure
    31       check-cardinal-integer
    32       check-real
    33       check-open-interval
    34       check-closed-interval)
    35     (only srfi-27-uniform-random
    36       make-uniform-random-reals))
    37 
    38   (require-library
    39     type-errors type-checks
    40     srfi-27-uniform-random)
     8(;export
     9  make-random-exponentials
     10  make-random-normals
     11  make-random-triangles
     12  make-random-poissons
     13  make-random-bernoullis
     14  make-random-binomials
     15  make-random-geometrics
     16  make-random-lognormals
     17  make-random-cauchys
     18  make-random-gammas
     19  make-random-erlangs
     20  make-random-paretos
     21  make-random-levys
     22  make-random-weibulls)
     23
     24(import scheme chicken)
     25
     26(import
     27  (only type-errors
     28    error-argument-type)
     29  (only type-checks
     30    check-procedure
     31    check-cardinal-integer
     32    check-real
     33    check-open-interval
     34    check-closed-interval)
     35  (only srfi-27-uniform-random
     36    make-uniform-random-reals))
     37(require-library
     38  type-errors type-checks
     39  srfi-27-uniform-random)
    4140
    4241;;; Chicken Generic Arithmetic Argument Checks
  • release/4/srfi-27/tags/3.2.2/srfi-27-uniform-random.scm

    r33848 r34012  
    44(module srfi-27-uniform-random
    55
    6   (;export
    7     *make-uniform-random-integers
    8     make-uniform-random-integers
    9     make-uniform-random-reals)
     6(;export
     7  *make-uniform-random-integers
     8  make-uniform-random-integers
     9  make-uniform-random-reals)
    1010
    11   (import
    12     (except scheme + - * quotient = <)
    13     chicken
    14     data-structures
    15     (only numbers + - * quotient = <)
    16     (only miscmacros exchange!)
    17     random-source
    18     (only srfi-27 current-random-source)
    19     (only srfi-27-numbers
    20       check-integer check-positive-integer
    21       check-real-precision))
     11(import
     12  (except scheme + - * quotient = <)
     13  chicken)
    2214
    23   (require-library
    24     miscmacros
    25     vector-lib numbers
    26     random-source srfi-27 srfi-27-numbers)
     15(import
     16  data-structures
     17  (only numbers + - * quotient = <)
     18  (only miscmacros exchange!)
     19  random-source
     20  (only srfi-27 current-random-source)
     21  (only srfi-27-numbers
     22    check-integer check-positive-integer
     23    check-real-precision)
     24  vector-lib)
     25(require-library
     26  data-structures
     27  numbers
     28  miscmacros
     29  random-source
     30  srfi-27 srfi-27-numbers
     31  vector-lib)
    2732
    28   (declare (not usual-integrations + - * quotient = <))
     33(declare
     34  (not usual-integrations
     35    + - * quotient = <))
    2936
    3037;;; Uniform random integers in [low high] by precision
    3138
    3239(define (*make-uniform-random-integers low high precision rand)
    33   (let ((range (quotient (+ (- high low) 1) precision)))
    34     (cond
    35       ((< (- high low) precision)
    36         (constantly precision))
    37       ((= 0 range)
    38         (constantly 0))
    39       ((and (= 0 low) (= 1 precision))
    40         (lambda () (rand range)))
    41       ((= 0 low)
    42         (lambda () (* (rand range) precision)))
    43       (else
    44         (lambda () (+ low (* (rand range) precision))))) ) )
     40  (let ((dist (- high low)))
     41    (if (< dist precision)
     42      (constantly precision)
     43      (let ((range (quotient (+ dist 1) precision)))
     44        (cond
     45          ((= 0 range)
     46            (constantly 0) )
     47          ((= 0 low)
     48            (if (= 1 precision)
     49              (lambda ()
     50                (rand range)
     51              (lambda ()
     52                (* (rand range) precision) ) ) ) )
     53          (else
     54            (lambda ()
     55              (+ low (* (rand range) precision) ) ) ) ) ) ) ) )
    4556
    4657(define (make-uniform-random-integers
    47           #!key (high #f) (low 0) (precision 1) (source (current-random-source)))
     58          #!key
     59          (high #f) (low 0) (precision 1)
     60          (source (current-random-source)))
    4861  (check-random-source 'make-uniform-random-integers source 'source)
    49   (unless high (set! high (- (*random-source-maximum-range source) 1))) ;(- (*random-source-maximum-range source) 1)
     62  (unless high
     63    (set! high (- (*random-source-maximum-range source) 1)) )
    5064  (check-integer 'make-uniform-random-integers high 'high)
    5165  (check-integer 'make-uniform-random-integers low 'low)
     
    5367  (values
    5468    (*make-uniform-random-integers low high precision ((@random-source-make-integers source)))
    55     (lambda () (values high low precision source)) ) )
     69    (lambda ()
     70      (values high low precision source)) ) )
    5671
    5772;;; Uniform random reals in (0.0 1.0) by precion
    5873
    5974(define (make-uniform-random-reals
    60           #!key (precision #f) (source (current-random-source)))
     75          #!key
     76          (precision #f)
     77          (source (current-random-source)))
    6178  (check-random-source 'make-uniform-random-reals source 'source)
    62   (when precision (check-real-precision 'make-uniform-random-reals precision 'precision))
     79  (when precision
     80    (check-real-precision 'make-uniform-random-reals precision 'precision) )
    6381  (values
    6482    ((@random-source-make-reals source) precision)
    65     (lambda () (values precision source)) ) )
     83    (lambda ()
     84      (values precision source)) ) )
    6685
    6786) ;module srfi-27-uniform-random
  • release/4/srfi-27/tags/3.2.2/srfi-27-vector.scm

    r34008 r34012  
    66(module srfi-27-vector
    77
    8   (;export
    9     ;
    10     make-random-permutations
    11     make-random-vector
    12     make-random-hollow-sphere
    13     make-random-solid-sphere
    14     ;
    15     random-permutation!
    16     random-vector!
    17     random-hollow-sphere!
    18     random-solid-sphere!)
     8(;export
     9  ;
     10  make-random-permutations
     11  make-random-vector
     12  make-random-hollow-sphere
     13  make-random-solid-sphere
     14  ;
     15  random-permutation!
     16  random-vector!
     17  random-hollow-sphere!
     18  random-solid-sphere!)
    1919
    20   (import
    21     scheme
    22     chicken
    23     (only type-checks check-cardinal-integer check-vector)
    24     (only type-errors error-vector)
    25     random-source
    26     srfi-27-uniform-random
    27     srfi-27-distributions
    28     srfi-27-vector-support)
     20(import scheme chicken)
    2921
    30   (require-library
    31     type-checks type-errors
    32     random-source
    33     srfi-27-uniform-random srfi-27-distributions
    34     srfi-27-vector-support)
     22(import
     23  (only type-checks check-cardinal-integer check-vector)
     24  (only type-errors error-vector)
     25  random-source
     26  srfi-27-uniform-random
     27  srfi-27-distributions
     28  srfi-27-vector-support)
     29(require-library
     30  type-checks type-errors
     31  random-source
     32  srfi-27-uniform-random srfi-27-distributions
     33  srfi-27-vector-support)
    3534
    3635;;;
  • release/4/srfi-27/tags/3.2.2/srfi-27.setup

    r34011 r34012  
    77;; Utility Modules
    88
    9 (setup-shared-extension-module 'fp-extn (extension-version "3.2.1")
     9(setup-shared-extension-module 'fp-extn (extension-version "3.2.2")
    1010  #:inline? #t
    1111  #:types? #t
     
    1414    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    1515
    16 (setup-shared-extension-module 'registration (extension-version "3.2.1")
     16(setup-shared-extension-module 'registration (extension-version "3.2.2")
    1717  #:inline? #t
    1818  #:types? #t
     
    2121    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    2222
    23 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.1")
     23(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.2")
    2424  #:inline? #t
    2525  #:types? #t
     
    2828    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    2929
    30 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.1")
     30(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.2")
    3131  #:inline? #t
    3232  #:types? #t
     
    3737;; Entropy Source Modules
    3838
    39 (setup-shared-extension-module 'entropy-source (extension-version "3.2.1")
     39(setup-shared-extension-module 'entropy-source (extension-version "3.2.2")
    4040  #:inline? #t
    4141  #:types? #t
     
    4444    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    4545
    46 (setup-shared-extension-module 'entropy-support (extension-version "3.2.1")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.2")
    4747  #:inline? #t
    4848  #:types? #t
     
    5151    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    5252
    53 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.1")
     53(setup-shared-extension-module 'entropy-clock (extension-version "3.2.2")
    5454  #:inline? #t
    5555  #:types? #t
     
    5858    -no-procedure-checks) )
    5959
    60 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.1")
     60(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.2")
    6161  #:inline? #t
    6262  #:types? #t
     
    6565    -no-procedure-checks) )
    6666
    67 (setup-shared-extension-module 'entropy-port (extension-version "3.2.1")
     67(setup-shared-extension-module 'entropy-port (extension-version "3.2.2")
    6868  #:inline? #t
    6969  #:types? #t
     
    7373
    7474#+unix
    75 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.1")
     75(setup-shared-extension-module 'entropy-unix (extension-version "3.2.2")
    7676  #:inline? #t
    7777  #:types? #t
     
    8181
    8282#+windows
    83 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.1")
     83(setup-shared-extension-module 'entropy-windows (extension-version "3.2.2")
    8484  #:inline? #t
    8585  #:types? #t
     
    9090;; Random Source Modules
    9191
    92 (setup-shared-extension-module 'random-source (extension-version "3.2.1")
     92(setup-shared-extension-module 'random-source (extension-version "3.2.2")
    9393  #:inline? #t
    9494  #:types? #t
     
    9797    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    9898
    99 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.1")
     99(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.2")
    100100  #:inline? #t
    101101  #:types? #t
     
    105105    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    106106
    107 (setup-shared-extension-module 'mwc (extension-version "3.2.1")
     107(setup-shared-extension-module 'mwc (extension-version "3.2.2")
    108108  #:inline? #t
    109109  #:types? #t
     
    112112    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    113113
    114 (setup-shared-extension-module 'moa (extension-version "3.2.1")
     114(setup-shared-extension-module 'moa (extension-version "3.2.2")
    115115  #:inline? #t
    116116  #:types? #t
     
    119119    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    120120
    121 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.1")
     121(setup-shared-extension-module 'composite-random-source (extension-version "3.2.2")
    122122  #:inline? #t
    123123  #:types? #t
     
    128128;; Main Modules
    129129
    130 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.1")
     130(setup-shared-extension-module 'srfi-27 (extension-version "3.2.2")
    131131  #:inline? #t
    132132  #:types? #t
     
    135135    -no-procedure-checks) )
    136136
    137 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.1")
     137(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.2")
     138  #:inline? #t
     139  #:types? #t
     140  #:compile-options '(
     141    -scrutinize ;-optimize-level 3 -debug-level 1
     142    #;-no-procedure-checks) )
     143
     144(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.2")
    138145  #:inline? #t
    139146  #:types? #t
     
    142149    -no-procedure-checks) )
    143150
    144 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.1")
     151(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.2")
    145152  #:inline? #t
    146153  #:types? #t
     
    148155    -scrutinize -optimize-level 3 -debug-level 1
    149156    -no-procedure-checks) )
    150 
    151 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.1")
    152   #:inline? #t
    153   #:types? #t
    154   #:compile-options '(
    155     -scrutinize -optimize-level 3 -debug-level 1
    156     -no-procedure-checks) )
  • release/4/srfi-27/tags/3.2.2/tests/run.scm

    r34011 r34012  
    55
    66(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)))
    107
    11 (let ((v10 (random-u8vector 10)))
    12   (newline)
    13   (print "u8vector: " v10)
    14   (test "random-u8vector ?" #t (u8vector? v10))
    15   (test "random-u8vector 10" 10 (u8vector-length v10)) )
     8(test-begin "SRFI 27")
    169
    17 (let ((v10 (random-f64vector 10)))
    18   (newline)
    19   (print "f64vector: " v10)
    20   (test "random-f64vector ?" #t (f64vector? v10))
    21   (test "random-f64vector 10" 10 (f64vector-length v10)) )
     10(test-group "Testing random SRFI-4 vector"
     11  (print "Random Source: " (random-source-kind (current-random-source)))
     12  (print "Entropy Source: " (entropy-source-kind (current-entropy-source)))
     13
     14  (let ((v10 (random-u8vector 10)))
     15    (newline)
     16    ;(print "u8vector: " v10)
     17    (test "random-u8vector ?" #t (u8vector? v10))
     18    (test "random-u8vector 10" 10 (u8vector-length v10)) )
     19
     20  (let ((v10 (random-f64vector 10)))
     21    (newline)
     22    ;(print "f64vector: " v10)
     23    (test "random-f64vector ?" #t (f64vector? v10))
     24    (test "random-f64vector 10" 10 (f64vector-length v10)) ) )
     25
     26(use srfi-27-uniform-random)
     27
     28(test-group "make-uniform-random-integers"
     29  (let-values (
     30      ((gen init)
     31        (make-uniform-random-integers high: 27 low: 16 precision: 2)))
     32    (let-values (((high low precision source) (init)))
     33      (test-assert (= 27 high))
     34      (test-assert (= 16 low))
     35      (test-assert (= 2 precision))
     36      (do ((i 0 (add1 i))
     37           (rv (gen) (gen)) )
     38          ((= 100 i))
     39        (unless (<= 16 rv) (test-assert (<= 16 rv)))
     40        (unless (<= rv 27) (test-assert (<= rv 27)))
     41        (unless (zero? (modulo rv 2)) (test-assert (zero? (modulo rv 2)))) ) ) ) )
     42
     43;FIXME needs real test
     44(test-group "make-uniform-random-reals"
     45  (let-values (
     46      ((gen init)
     47        (make-uniform-random-reals precision: 0.000000000003)))
     48    (let-values (((precision source) (init)))
     49      (test-assert (= 0.000000000003 precision))
     50      ;(flonum-print-precision 53)
     51      (do ((i 0 (add1 i))
     52           (rv (gen) (gen)) )
     53          ((= 100 i))
     54          ) ) ) )
     55
     56(test-end "SRFI 27")
    2257
    2358(use utils)
     
    2863
    2964(newline)
     65
     66(test-exit)
  • release/4/srfi-27/trunk/composite-random-source.scm

    r34008 r34012  
    44(module composite-random-source
    55
    6   (;export
    7     *composite-random-source
    8     composite-random-source)
     6(;export
     7  *composite-random-source
     8  composite-random-source)
    99
    10   (import
    11     scheme
    12     chicken
    13     (only data-structures conc reverse-string-append ->string intersperse)
    14     (only type-errors error-argument-type)
    15     random-source)
     10(import scheme chicken)
    1611
    17   (require-library data-structures type-errors random-source)
     12(import
     13  (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)
    1817
    1918;; *composite-random-source
     
    144143                  (cons (*random-source-maximum-range s) maxrngs)) ) ) ) ) )
    145144
    146 ) ; module composite-random-source
     145) ;module composite-random-source
  • release/4/srfi-27/trunk/entropy-clock.scm

    r33848 r34012  
    44(module entropy-clock
    55
    6   (;export
    7     make-entropy-source-system-clock)
     6(;export
     7  make-entropy-source-system-clock)
    88
    9   (import
    10     scheme
    11     chicken
    12     foreign)
     9(import scheme chicken foreign)
    1310
    14   (use entropy-source entropy-support)
     11(use entropy-source entropy-support)
    1512
    1613;;;
  • release/4/srfi-27/trunk/entropy-port.scm

    r33848 r34012  
    44(module entropy-port
    55
    6   (;export
    7     ;
    8     entropy-port-lifetime
    9     ;
    10     make-entropy-source/port
    11     make-entropy-source/port-open make-entropy-source/port-open-timed
    12     make-entropy-source/file make-entropy-source/file-timed)
     6(;export
     7  ;
     8  entropy-port-lifetime
     9  ;
     10  make-entropy-source/port
     11  make-entropy-source/port-open make-entropy-source/port-open-timed
     12  make-entropy-source/file make-entropy-source/file-timed)
    1313
    14   (import
    15     scheme
    16     chicken
    17     (only type-checks check-input-port check-procedure check-symbol check-string)
    18     (only type-errors warning-argument-type))
     14(import scheme chicken)
    1915
    20   (require-library
    21     type-checks type-errors)
     16(import
     17  (only type-checks check-input-port check-procedure check-symbol check-string)
     18  (only type-errors warning-argument-type))
     19(require-library type-checks type-errors)
    2220
    2321(use entropy-source entropy-support timed-resource miscmacros)
  • release/4/srfi-27/trunk/entropy-procedure.scm

    r19090 r34012  
    44(module entropy-procedure
    55
    6   (;export
    7     make-entropy-source/procedures
    8     make-entropy-source/f64procedure)
     6(;export
     7  make-entropy-source/procedures
     8  make-entropy-source/f64procedure)
    99
    10   (import
    11     scheme
    12     chicken
    13     (only type-checks check-procedure check-symbol check-string)
    14     entropy-source
    15     entropy-support)
     10(import scheme chicken)
    1611
    17   (require-library type-checks entropy-source entropy-support)
     12(import
     13  (only type-checks check-procedure check-symbol check-string)
     14  entropy-source
     15  entropy-support)
     16(require-library type-checks entropy-source entropy-support)
    1817
    1918;;; Entropy from some procedure
  • release/4/srfi-27/trunk/entropy-source.scm

    r33848 r34012  
    44(module entropy-source
    55
    6   (;export
    7     *make-entropy-source
    8     entropy-source? check-entropy-source error-entropy-source
    9     *entropy-source-name
    10     *entropy-source-documentation
    11     @entropy-source-constructor
    12     @entropy-source-u8
    13     @entropy-source-f64
    14     @entropy-source-u8vector
    15     @entropy-source-f64vector
    16     ;
    17     entropy-source-integer
    18     entropy-source-f64-integer
    19     ;
    20     registered-entropy-sources
    21     registered-entropy-source
    22     unregister-entropy-source
    23     register-entropy-source!)
     6(;export
     7  *make-entropy-source
     8  entropy-source? check-entropy-source error-entropy-source
     9  *entropy-source-name
     10  *entropy-source-documentation
     11  @entropy-source-constructor
     12  @entropy-source-u8
     13  @entropy-source-f64
     14  @entropy-source-u8vector
     15  @entropy-source-f64vector
     16  ;
     17  entropy-source-integer
     18  entropy-source-f64-integer
     19  ;
     20  registered-entropy-sources
     21  registered-entropy-source
     22  unregister-entropy-source
     23  register-entropy-source!)
    2424
    25   (import
    26     scheme
    27     chicken
    28     (only data-structures alist-ref alist-update!)
    29     (only srfi-1 alist-cons alist-delete!)
    30     (only type-checks define-check+error-type check-procedure check-symbol))
    31   (require-library data-structures srfi-1 type-checks)
     25(import scheme chicken)
    3226
    33   (use registration)
     27(import
     28  (only data-structures alist-ref alist-update!)
     29  (only srfi-1 alist-cons alist-delete!)
     30  (only type-checks define-check+error-type check-procedure check-symbol))
     31(require-library data-structures srfi-1 type-checks)
     32
     33(use registration)
    3434
    3535;;
  • release/4/srfi-27/trunk/entropy-support.scm

    r33848 r34012  
    1212(module entropy-support
    1313
    14   (;export
    15     make-entropic-u8/f64
    16     entropic-u8vector-filled/f64
    17     entropic-u8vector-filled
    18     port-entropic-u8
    19     port-entropic-u8vector
    20     make-entropic-f64/u8
    21     entropic-f64vector-filled/u8
    22     entropic-f64vector-filled
    23     port-entropic-f64
    24     port-entropic-f64vector)
     14(;export
     15  make-entropic-u8/f64
     16  entropic-u8vector-filled/f64
     17  entropic-u8vector-filled
     18  port-entropic-u8
     19  port-entropic-u8vector
     20  make-entropic-f64/u8
     21  entropic-f64vector-filled/u8
     22  entropic-f64vector-filled
     23  port-entropic-f64
     24  port-entropic-f64vector)
    2525
    26   (import
    27     scheme
    28     chicken
    29     foreign
    30     (only extras read-byte)
    31     (only srfi-4
    32       u8vector-set! make-u8vector u8vector-length
    33       f64vector-set! make-f64vector f64vector-length
    34       read-u8vector read-u8vector!)
    35     (only lolevel move-memory!)
    36     (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
     26(import scheme chicken foreign)
    3727
    38   (require-library
    39     extras lolevel srfi-4
    40     srfi-27-vector-support)
     28(import
     29   (only extras read-byte)
     30  (only srfi-4
     31    u8vector-set! make-u8vector u8vector-length
     32    f64vector-set! make-f64vector f64vector-length
     33    read-u8vector read-u8vector!)
     34  (only lolevel move-memory!)
     35  (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
     36(require-library
     37  extras lolevel srfi-4
     38  srfi-27-vector-support)
    4139
    4240;; Double stuff
  • release/4/srfi-27/trunk/entropy-unix.scm

    r19090 r34012  
    44(module entropy-unix
    55
    6   (;export
    7     make-entropy-source-random-device
    8     make-entropy-source-urandom-device)
     6(;export
     7  make-entropy-source-random-device
     8  make-entropy-source-urandom-device)
    99
    10   (import
    11     scheme
    12     chicken
    13     entropy-source
    14     entropy-port)
     10(import scheme chicken)
    1511
    16   (require-library entropy-source entropy-port)
     12(import
     13  entropy-source
     14  entropy-port)
     15(require-library entropy-source entropy-port)
    1716
    1817;;; Entropy from /dev/random
  • release/4/srfi-27/trunk/entropy-windows.scm

    r21253 r34012  
    44(module entropy-windows
    55
    6   (;export
    7     make-entropy-source-crypt)
     6(;export
     7  make-entropy-source-crypt)
    88
    9   (import
    10     scheme
    11     chicken
    12     (only ports make-input-port)
    13     foreign
    14     (only srfi-4 make-u8vector u8vector-ref)
    15     entropy-source
    16     entropy-port)
     9(import scheme chicken foreign)
    1710
    18   (require-library ports srfi-4 entropy-source entropy-port)
     11(import
     12  (only ports make-input-port)
     13  (only srfi-4 make-u8vector u8vector-ref)
     14  entropy-source
     15  entropy-port)
     16(require-library ports srfi-4 entropy-source entropy-port)
    1917
    2018;;; Entropy from CryptContext
  • release/4/srfi-27/trunk/moa.scm

    r34008 r34012  
    44(module moa
    55
    6   (;export
    7     make-random-source-moa)
    8 
    9   (import
    10     (except scheme <= inexact->exact exact->inexact number?)
    11     chicken
    12     foreign
    13     srfi-4
    14     (only numbers <= inexact->exact exact->inexact number?)
    15     random-source
    16     entropy-source
    17     (only srfi-27-numbers
    18       check-positive-integer
    19       random-large-integer random-large-real
    20       native-real-precision?))
    21 
    22   (require-library
    23     srfi-4
    24     numbers
    25     random-source entropy-source
    26     srfi-27-numbers)
    27 
    28   (declare (not usual-integrations <= exact->inexact inexact->exact))
     6(;export
     7  make-random-source-moa)
     8
     9(import
     10  (except scheme <= inexact->exact exact->inexact number?)
     11  chicken
     12  foreign)
     13
     14(import
     15  srfi-4
     16  (only numbers <= inexact->exact exact->inexact number?)
     17  random-source
     18  entropy-source
     19  (only srfi-27-numbers
     20    check-positive-integer
     21    random-large-integer random-large-real
     22    native-real-precision?))
     23(require-library
     24  srfi-4
     25  numbers
     26  random-source entropy-source
     27  srfi-27-numbers)
     28
     29(declare
     30  (not usual-integrations
     31    <= exact->inexact inexact->exact))
    2932
    3033#>
     
    273276      #f
    274277      ;
    275       (lambda () (moa-unpack-state state))
    276       ;
    277       (lambda (new-state) (set! state (moa-pack-state new-state)))
    278       ;
    279       (lambda (entropy-source) (set! state (moa-randomize-state state entropy-source)))
    280       ;
    281       (lambda (i j) (set! state (moa-pseudo-randomize-state i j)))
     278      (lambda ()
     279        (moa-unpack-state state) )
     280      ;
     281      (lambda (new-state)
     282        (set! state (moa-pack-state new-state)) )
     283      ;
     284      (lambda (entropy-source)
     285        (set! state (moa-randomize-state state entropy-source)) )
     286      ;
     287      (lambda (i j)
     288        (set! state (moa-pseudo-randomize-state i j)) )
    282289      ;
    283290      (lambda ()
     
    304311        (cond
    305312          ((native-real-precision? prec eMAX)
    306             (lambda () (moa-random-real state)))
     313            (lambda ()
     314              (moa-random-real state) ) )
    307315          (else
    308             (lambda () (moa-random-real-mp state prec)))))) ) )
     316            (lambda ()
     317              (moa-random-real-mp state prec) ) ) ) ) ) ) )
    309318
    310319;;;
  • release/4/srfi-27/trunk/mrg32k3a.scm

    r34011 r34012  
    535535          ((native-real-precision? prec eM1)
    536536            (lambda ()
    537               (mrg32k3a-random-real state)))
     537              (mrg32k3a-random-real state) ) )
    538538          (else
    539539            (lambda ()
    540               (mrg32k3a-random-real-mp state prec)))))) ) )
     540              (mrg32k3a-random-real-mp state prec) ) ) ) ) ) ) )
    541541
    542542;;;
  • release/4/srfi-27/trunk/mwc.scm

    r34008 r34012  
    44(module mwc
    55
    6   (;export
    7     make-random-source-mwc)
    8 
    9   (import
    10     (except scheme <= inexact->exact exact->inexact number?)
    11     chicken
    12     foreign
    13     srfi-4
    14     (only numbers <= inexact->exact exact->inexact number?)
    15     (only type-errors error-positive-integer)
    16     random-source
    17     entropy-source
    18     (only srfi-27-numbers
    19       check-positive-integer
    20       random-large-integer random-large-real
    21       native-real-precision?))
    22 
    23   (require-library
    24     srfi-4
    25     numbers
    26     type-errors
    27     random-source entropy-source srfi-27-numbers)
    28 
    29   (declare (not usual-integrations <=  exact->inexact inexact->exact))
     6(;export
     7  make-random-source-mwc)
     8
     9(import
     10  (except scheme <= inexact->exact exact->inexact number?)
     11  chicken
     12  foreign)
     13
     14(import
     15  srfi-4
     16  (only numbers <= inexact->exact exact->inexact number?)
     17  (only type-errors error-positive-integer)
     18  random-source
     19  entropy-source
     20  (only srfi-27-numbers
     21    check-positive-integer
     22    random-large-integer random-large-real
     23    native-real-precision?))
     24(require-library
     25  srfi-4
     26  numbers
     27  type-errors
     28  random-source entropy-source srfi-27-numbers)
     29
     30(declare
     31  (not usual-integrations
     32    <=  exact->inexact inexact->exact))
    3033
    3134#>
     
    270273      #f
    271274      ;
    272       (lambda () (mwc-unpack-state state))
    273       ;
    274       (lambda (new-state) (set! state (mwc-pack-state new-state)))
    275       ;
    276       (lambda (entropy-source) (set! state (mwc-randomize-state state entropy-source)))
    277       ;
    278       (lambda (i j) (set! state (mwc-pseudo-randomize-state i j)))
     275      (lambda ()
     276        (mwc-unpack-state state) )
     277      ;
     278      (lambda (new-state)
     279        (set! state (mwc-pack-state new-state)) )
     280      ;
     281      (lambda (entropy-source)
     282        (set! state (mwc-randomize-state state entropy-source)) )
     283      ;
     284      (lambda (i j)
     285        (set! state (mwc-pseudo-randomize-state i j)) )
    279286      ;
    280287      (lambda ()
     
    301308        (cond
    302309          ((native-real-precision? prec eMAX)
    303               (lambda () (mwc-random-real state)))
     310              (lambda ()
     311                (mwc-random-real state) ) )
    304312          (else
    305             (lambda () (mwc-random-real-mp state prec)))))) ) )
     313            (lambda ()
     314              (mwc-random-real-mp state prec) ) ) ) ) ) ) )
    306315
    307316;;;
  • release/4/srfi-27/trunk/random-source.scm

    r34011 r34012  
    7575  ((@registration-register! +reg+) name ctor) )
    7676
    77 ) ; module random-source
     77) ;module random-source
  • release/4/srfi-27/trunk/registration.scm

    r34011 r34012  
    11;;;; registration.scm
     2;;;; Kon Lovett, Feb '17
    23;;;; Kon Lovett, Oct '09
    34
     
    7071    reg ) )
    7172
    72 ) ;registration
     73) ;module registration
  • release/4/srfi-27/trunk/srfi-27-distributions.scm

    r33848 r34012  
    66(module srfi-27-distributions
    77
    8   (;export
    9     make-random-exponentials
    10     make-random-normals
    11     make-random-triangles
    12     make-random-poissons
    13     make-random-bernoullis
    14     make-random-binomials
    15     make-random-geometrics
    16     make-random-lognormals
    17     make-random-cauchys
    18     make-random-gammas
    19     make-random-erlangs
    20     make-random-paretos
    21     make-random-levys
    22     make-random-weibulls)
    23 
    24   (import
    25     scheme
    26     chicken
    27     (only type-errors
    28       error-argument-type)
    29     (only type-checks
    30       check-procedure
    31       check-cardinal-integer
    32       check-real
    33       check-open-interval
    34       check-closed-interval)
    35     (only srfi-27-uniform-random
    36       make-uniform-random-reals))
    37 
    38   (require-library
    39     type-errors type-checks
    40     srfi-27-uniform-random)
     8(;export
     9  make-random-exponentials
     10  make-random-normals
     11  make-random-triangles
     12  make-random-poissons
     13  make-random-bernoullis
     14  make-random-binomials
     15  make-random-geometrics
     16  make-random-lognormals
     17  make-random-cauchys
     18  make-random-gammas
     19  make-random-erlangs
     20  make-random-paretos
     21  make-random-levys
     22  make-random-weibulls)
     23
     24(import scheme chicken)
     25
     26(import
     27  (only type-errors
     28    error-argument-type)
     29  (only type-checks
     30    check-procedure
     31    check-cardinal-integer
     32    check-real
     33    check-open-interval
     34    check-closed-interval)
     35  (only srfi-27-uniform-random
     36    make-uniform-random-reals))
     37(require-library
     38  type-errors type-checks
     39  srfi-27-uniform-random)
    4140
    4241;;; Chicken Generic Arithmetic Argument Checks
  • release/4/srfi-27/trunk/srfi-27-uniform-random.scm

    r33848 r34012  
    44(module srfi-27-uniform-random
    55
    6   (;export
    7     *make-uniform-random-integers
    8     make-uniform-random-integers
    9     make-uniform-random-reals)
     6(;export
     7  *make-uniform-random-integers
     8  make-uniform-random-integers
     9  make-uniform-random-reals)
    1010
    11   (import
    12     (except scheme + - * quotient = <)
    13     chicken
    14     data-structures
    15     (only numbers + - * quotient = <)
    16     (only miscmacros exchange!)
    17     random-source
    18     (only srfi-27 current-random-source)
    19     (only srfi-27-numbers
    20       check-integer check-positive-integer
    21       check-real-precision))
     11(import
     12  (except scheme + - * quotient = <)
     13  chicken)
    2214
    23   (require-library
    24     miscmacros
    25     vector-lib numbers
    26     random-source srfi-27 srfi-27-numbers)
     15(import
     16  data-structures
     17  (only numbers + - * quotient = <)
     18  (only miscmacros exchange!)
     19  random-source
     20  (only srfi-27 current-random-source)
     21  (only srfi-27-numbers
     22    check-integer check-positive-integer
     23    check-real-precision)
     24  vector-lib)
     25(require-library
     26  data-structures
     27  numbers
     28  miscmacros
     29  random-source
     30  srfi-27 srfi-27-numbers
     31  vector-lib)
    2732
    28   (declare (not usual-integrations + - * quotient = <))
     33(declare
     34  (not usual-integrations
     35    + - * quotient = <))
    2936
    3037;;; Uniform random integers in [low high] by precision
    3138
    3239(define (*make-uniform-random-integers low high precision rand)
    33   (let ((range (quotient (+ (- high low) 1) precision)))
    34     (cond
    35       ((< (- high low) precision)
    36         (constantly precision))
    37       ((= 0 range)
    38         (constantly 0))
    39       ((and (= 0 low) (= 1 precision))
    40         (lambda () (rand range)))
    41       ((= 0 low)
    42         (lambda () (* (rand range) precision)))
    43       (else
    44         (lambda () (+ low (* (rand range) precision))))) ) )
     40  (let ((dist (- high low)))
     41    (if (< dist precision)
     42      (constantly precision)
     43      (let ((range (quotient (+ dist 1) precision)))
     44        (cond
     45          ((= 0 range)
     46            (constantly 0) )
     47          ((= 0 low)
     48            (if (= 1 precision)
     49              (lambda ()
     50                (rand range)
     51              (lambda ()
     52                (* (rand range) precision) ) ) ) )
     53          (else
     54            (lambda ()
     55              (+ low (* (rand range) precision) ) ) ) ) ) ) ) )
    4556
    4657(define (make-uniform-random-integers
    47           #!key (high #f) (low 0) (precision 1) (source (current-random-source)))
     58          #!key
     59          (high #f) (low 0) (precision 1)
     60          (source (current-random-source)))
    4861  (check-random-source 'make-uniform-random-integers source 'source)
    49   (unless high (set! high (- (*random-source-maximum-range source) 1))) ;(- (*random-source-maximum-range source) 1)
     62  (unless high
     63    (set! high (- (*random-source-maximum-range source) 1)) )
    5064  (check-integer 'make-uniform-random-integers high 'high)
    5165  (check-integer 'make-uniform-random-integers low 'low)
     
    5367  (values
    5468    (*make-uniform-random-integers low high precision ((@random-source-make-integers source)))
    55     (lambda () (values high low precision source)) ) )
     69    (lambda ()
     70      (values high low precision source)) ) )
    5671
    5772;;; Uniform random reals in (0.0 1.0) by precion
    5873
    5974(define (make-uniform-random-reals
    60           #!key (precision #f) (source (current-random-source)))
     75          #!key
     76          (precision #f)
     77          (source (current-random-source)))
    6178  (check-random-source 'make-uniform-random-reals source 'source)
    62   (when precision (check-real-precision 'make-uniform-random-reals precision 'precision))
     79  (when precision
     80    (check-real-precision 'make-uniform-random-reals precision 'precision) )
    6381  (values
    6482    ((@random-source-make-reals source) precision)
    65     (lambda () (values precision source)) ) )
     83    (lambda ()
     84      (values precision source)) ) )
    6685
    6786) ;module srfi-27-uniform-random
  • release/4/srfi-27/trunk/srfi-27-vector.scm

    r34008 r34012  
    66(module srfi-27-vector
    77
    8   (;export
    9     ;
    10     make-random-permutations
    11     make-random-vector
    12     make-random-hollow-sphere
    13     make-random-solid-sphere
    14     ;
    15     random-permutation!
    16     random-vector!
    17     random-hollow-sphere!
    18     random-solid-sphere!)
     8(;export
     9  ;
     10  make-random-permutations
     11  make-random-vector
     12  make-random-hollow-sphere
     13  make-random-solid-sphere
     14  ;
     15  random-permutation!
     16  random-vector!
     17  random-hollow-sphere!
     18  random-solid-sphere!)
    1919
    20   (import
    21     scheme
    22     chicken
    23     (only type-checks check-cardinal-integer check-vector)
    24     (only type-errors error-vector)
    25     random-source
    26     srfi-27-uniform-random
    27     srfi-27-distributions
    28     srfi-27-vector-support)
     20(import scheme chicken)
    2921
    30   (require-library
    31     type-checks type-errors
    32     random-source
    33     srfi-27-uniform-random srfi-27-distributions
    34     srfi-27-vector-support)
     22(import
     23  (only type-checks check-cardinal-integer check-vector)
     24  (only type-errors error-vector)
     25  random-source
     26  srfi-27-uniform-random
     27  srfi-27-distributions
     28  srfi-27-vector-support)
     29(require-library
     30  type-checks type-errors
     31  random-source
     32  srfi-27-uniform-random srfi-27-distributions
     33  srfi-27-vector-support)
    3534
    3635;;;
  • release/4/srfi-27/trunk/srfi-27.setup

    r34011 r34012  
    77;; Utility Modules
    88
    9 (setup-shared-extension-module 'fp-extn (extension-version "3.2.1")
     9(setup-shared-extension-module 'fp-extn (extension-version "3.2.2")
    1010  #:inline? #t
    1111  #:types? #t
     
    1414    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    1515
    16 (setup-shared-extension-module 'registration (extension-version "3.2.1")
     16(setup-shared-extension-module 'registration (extension-version "3.2.2")
    1717  #:inline? #t
    1818  #:types? #t
     
    2121    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    2222
    23 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.1")
     23(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.2")
    2424  #:inline? #t
    2525  #:types? #t
     
    2828    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    2929
    30 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.1")
     30(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.2")
    3131  #:inline? #t
    3232  #:types? #t
     
    3737;; Entropy Source Modules
    3838
    39 (setup-shared-extension-module 'entropy-source (extension-version "3.2.1")
     39(setup-shared-extension-module 'entropy-source (extension-version "3.2.2")
    4040  #:inline? #t
    4141  #:types? #t
     
    4444    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    4545
    46 (setup-shared-extension-module 'entropy-support (extension-version "3.2.1")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.2")
    4747  #:inline? #t
    4848  #:types? #t
     
    5151    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    5252
    53 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.1")
     53(setup-shared-extension-module 'entropy-clock (extension-version "3.2.2")
    5454  #:inline? #t
    5555  #:types? #t
     
    5858    -no-procedure-checks) )
    5959
    60 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.1")
     60(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.2")
    6161  #:inline? #t
    6262  #:types? #t
     
    6565    -no-procedure-checks) )
    6666
    67 (setup-shared-extension-module 'entropy-port (extension-version "3.2.1")
     67(setup-shared-extension-module 'entropy-port (extension-version "3.2.2")
    6868  #:inline? #t
    6969  #:types? #t
     
    7373
    7474#+unix
    75 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.1")
     75(setup-shared-extension-module 'entropy-unix (extension-version "3.2.2")
    7676  #:inline? #t
    7777  #:types? #t
     
    8181
    8282#+windows
    83 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.1")
     83(setup-shared-extension-module 'entropy-windows (extension-version "3.2.2")
    8484  #:inline? #t
    8585  #:types? #t
     
    9090;; Random Source Modules
    9191
    92 (setup-shared-extension-module 'random-source (extension-version "3.2.1")
     92(setup-shared-extension-module 'random-source (extension-version "3.2.2")
    9393  #:inline? #t
    9494  #:types? #t
     
    9797    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    9898
    99 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.1")
     99(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.2")
    100100  #:inline? #t
    101101  #:types? #t
     
    105105    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    106106
    107 (setup-shared-extension-module 'mwc (extension-version "3.2.1")
     107(setup-shared-extension-module 'mwc (extension-version "3.2.2")
    108108  #:inline? #t
    109109  #:types? #t
     
    112112    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    113113
    114 (setup-shared-extension-module 'moa (extension-version "3.2.1")
     114(setup-shared-extension-module 'moa (extension-version "3.2.2")
    115115  #:inline? #t
    116116  #:types? #t
     
    119119    -no-procedure-checks -no-argc-checks -no-bound-checks) )
    120120
    121 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.1")
     121(setup-shared-extension-module 'composite-random-source (extension-version "3.2.2")
    122122  #:inline? #t
    123123  #:types? #t
     
    128128;; Main Modules
    129129
    130 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.1")
     130(setup-shared-extension-module 'srfi-27 (extension-version "3.2.2")
    131131  #:inline? #t
    132132  #:types? #t
     
    135135    -no-procedure-checks) )
    136136
    137 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.1")
     137(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.2")
     138  #:inline? #t
     139  #:types? #t
     140  #:compile-options '(
     141    -scrutinize ;-optimize-level 3 -debug-level 1
     142    #;-no-procedure-checks) )
     143
     144(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.2")
    138145  #:inline? #t
    139146  #:types? #t
     
    142149    -no-procedure-checks) )
    143150
    144 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.1")
     151(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.2")
    145152  #:inline? #t
    146153  #:types? #t
     
    148155    -scrutinize -optimize-level 3 -debug-level 1
    149156    -no-procedure-checks) )
    150 
    151 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.1")
    152   #:inline? #t
    153   #:types? #t
    154   #:compile-options '(
    155     -scrutinize -optimize-level 3 -debug-level 1
    156     -no-procedure-checks) )
  • release/4/srfi-27/trunk/tests/run.scm

    r34011 r34012  
    55
    66(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)))
    107
    11 (let ((v10 (random-u8vector 10)))
    12   (newline)
    13   (print "u8vector: " v10)
    14   (test "random-u8vector ?" #t (u8vector? v10))
    15   (test "random-u8vector 10" 10 (u8vector-length v10)) )
     8(test-begin "SRFI 27")
    169
    17 (let ((v10 (random-f64vector 10)))
    18   (newline)
    19   (print "f64vector: " v10)
    20   (test "random-f64vector ?" #t (f64vector? v10))
    21   (test "random-f64vector 10" 10 (f64vector-length v10)) )
     10(test-group "Testing random SRFI-4 vector"
     11  (print "Random Source: " (random-source-kind (current-random-source)))
     12  (print "Entropy Source: " (entropy-source-kind (current-entropy-source)))
     13
     14  (let ((v10 (random-u8vector 10)))
     15    (newline)
     16    ;(print "u8vector: " v10)
     17    (test "random-u8vector ?" #t (u8vector? v10))
     18    (test "random-u8vector 10" 10 (u8vector-length v10)) )
     19
     20  (let ((v10 (random-f64vector 10)))
     21    (newline)
     22    ;(print "f64vector: " v10)
     23    (test "random-f64vector ?" #t (f64vector? v10))
     24    (test "random-f64vector 10" 10 (f64vector-length v10)) ) )
     25
     26(use srfi-27-uniform-random)
     27
     28(test-group "make-uniform-random-integers"
     29  (let-values (
     30      ((gen init)
     31        (make-uniform-random-integers high: 27 low: 16 precision: 2)))
     32    (let-values (((high low precision source) (init)))
     33      (test-assert (= 27 high))
     34      (test-assert (= 16 low))
     35      (test-assert (= 2 precision))
     36      (do ((i 0 (add1 i))
     37           (rv (gen) (gen)) )
     38          ((= 100 i))
     39        (unless (<= 16 rv) (test-assert (<= 16 rv)))
     40        (unless (<= rv 27) (test-assert (<= rv 27)))
     41        (unless (zero? (modulo rv 2)) (test-assert (zero? (modulo rv 2)))) ) ) ) )
     42
     43;FIXME needs real test
     44(test-group "make-uniform-random-reals"
     45  (let-values (
     46      ((gen init)
     47        (make-uniform-random-reals precision: 0.000000000003)))
     48    (let-values (((precision source) (init)))
     49      (test-assert (= 0.000000000003 precision))
     50      ;(flonum-print-precision 53)
     51      (do ((i 0 (add1 i))
     52           (rv (gen) (gen)) )
     53          ((= 100 i))
     54          ) ) ) )
     55
     56(test-end "SRFI 27")
    2257
    2358(use utils)
     
    2863
    2964(newline)
     65
     66(test-exit)
Note: See TracChangeset for help on using the changeset viewer.