Changeset 34015 in project for release/4/srfi-27/trunk/srfi-27.scm


Ignore:
Timestamp:
04/23/17 09:05:00 (2 years ago)
Author:
Kon Lovett
Message:

Rename registration -> source-registration. Fix {{random-source-entropy-source-set!}}, must accept {{#f}} {{entropy-source}}. Fix broken srfi-27-vector.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • release/4/srfi-27/trunk/srfi-27.scm

    r34011 r34015  
    7676    (cond
    7777      ((entropy-source? x)
    78         x)
     78        x )
    7979      (else
    8080        (warning-argument-type 'current-entropy-source x 'entropy-source)
    8181        (current-entropy-source) ) ) ) )
    8282
    83 (define make-entropy-source
    84   (case-lambda
    85     (()
    86       ((@entropy-source-constructor (current-entropy-source))) )
    87     ((es)
    88       (let ((ctor
    89               (cond
    90                 ((entropy-source? es)
    91                   (@entropy-source-constructor es) )
    92                 ((symbol? es)
    93                   (let ((ctor (registered-entropy-source es)))
    94                     (or
    95                       ctor
    96                       (error 'make-entropy-source "unregistered entropy-source name" es) ) ) )
    97                 (else
    98                   (error-argument-type
    99                     'make-entropy-source es
    100                     "valid entropy-source or registered entropy-source name") ) ) ) )
    101         (ctor) ) ) ) )
    102 
    103 #;
    10483(define (make-entropy-source #!optional (es (current-entropy-source)))
    10584  (let ((ctor
    … …  
    11695
    11796(define (new-entropy-source es)
    118   (check-entropy-source 'new-entropy-source es)
    119   ((@entropy-source-constructor es)) )
     97  ((@entropy-source-constructor (check-entropy-source 'new-entropy-source es))) )
    12098
    12199(define (entropy-source-name es)
    122   (check-entropy-source 'entropy-source-name es)
    123   (*entropy-source-name es) )
     100  (*entropy-source-name (check-entropy-source 'entropy-source-name es)) )
    124101
    125102(define entropy-source-kind entropy-source-name)
    126103
    127104(define (entropy-source-documentation es)
    128   (check-entropy-source 'entropy-source-documentation es)
    129   (*entropy-source-documentation es) )
     105  (*entropy-source-documentation
     106    (check-entropy-source 'entropy-source-documentation es)) )
    130107
    131108(define (entropy-source-u8vector es n #!optional vec)
    132   (check-entropy-source 'entropy-source-u8vector es)
    133   (check-positive-fixnum 'entropy-source-u8vector n)
    134   (when vec (check-u8vector 'entropy-source-u8vector vec))
    135   ((@entropy-source-u8vector es) n vec) )
     109  ((@entropy-source-u8vector (check-entropy-source 'entropy-source-u8vector es))
     110    (check-positive-fixnum 'entropy-source-u8vector n)
     111    (and vec (check-u8vector 'entropy-source-u8vector vec))) )
    136112
    137113(define (entropy-source-f64vector es n #!optional vec)
    138   (check-entropy-source 'entropy-source-f64vector es)
    139   (check-positive-fixnum 'entropy-source-f64vector n)
    140   (when vec (check-f64vector 'entropy-source-f64vector vec))
    141   ((@entropy-source-f64vector es) n vec) )
     114  ((@entropy-source-f64vector (check-entropy-source 'entropy-source-f64vector es))
     115    (check-positive-fixnum 'entropy-source-f64vector n)
     116    (and vec (check-f64vector 'entropy-source-f64vector vec))) )
    142117
    143118(define (entropy-source-u8 es)
    144   (check-entropy-source 'entropy-source-u8 es)
    145   (@entropy-source-u8 es) )
     119  (@entropy-source-u8 (check-entropy-source 'entropy-source-u8 es)) )
    146120
    147121(define (entropy-source-f64 es)
    148   (check-entropy-source 'entropy-source-f64 es)
    149   (@entropy-source-f64 es) )
     122  (@entropy-source-f64 (check-entropy-source 'entropy-source-f64 es)) )
    150123
    151124;;; Random Source
    … …  
    154127  (let ((rndint ((@random-source-make-integers rs))))
    155128    (lambda (n)
    156       (check-cardinal-integer 'make-u8vector n 'length)
    157       (u8vector-filled! (make-u8vector n) (lambda () (rndint 256))) ) ) )
     129      (u8vector-filled!
     130        (make-u8vector (check-cardinal-integer 'random-source-make-u8vector n 'length))
     131        (lambda () (rndint 256))) ) ) )
    158132
    159133(define (*random-source-make-f64vectors rs prec)
    160134  (let ((rnd ((@random-source-make-reals rs) prec)))
    161135    (lambda (n)
    162       (check-cardinal-integer 'make-f64vector n 'length)
    163       (f64vector-filled! (make-f64vector n) rnd) ) ) )
     136      (f64vector-filled!
     137        (make-f64vector (check-cardinal-integer 'random-source-make-f64vector n 'length))
     138        rnd) ) ) )
    164139
    165140;;
    … …  
    185160    (cond
    186161      ((random-source? x)
    187         x)
     162        x )
    188163      (else
    189164        (warning-argument-type 'current-random-source x 'random-source)
    190165        (current-random-source) ) ) ) )
    191166
    192 (define make-random-source
    193   (case-lambda
    194     (()
    195       ((@random-source-constructor (current-random-source))) )
    196     ((es)
    197       (let ((ctor
    198               (cond
    199                 ((random-source? es)
    200                   (@random-source-constructor es) )
    201                 ((symbol? es)
    202                   (registered-random-source es) )
    203                 (else
    204                   (error-argument-type
    205                     'make-random-source es
    206                     "valid random-source or registered random-source name") ) ) ) )
    207         (ctor) ) ) ) )
    208 
    209 #;
    210 (define (make-random-source #!optional (es (current-random-source)))
     167(define (make-random-source #!optional (rs (current-random-source)))
    211168  (let ((ctor
    212169          (cond
    213             ((random-source? es)
    214               (@random-source-constructor es) )
    215             ((symbol? es)
    216               (registered-random-source es) )
     170            ((random-source? rs)
     171              (@random-source-constructor rs) )
     172            ((symbol? rs)
     173              (registered-random-source rs) )
    217174            (else
    218175              (error-argument-type
    219                 'make-random-source es
     176                'make-random-source rs
    220177                "valid random-source or registered random-source name") ) ) ) )
    221178    (ctor) ) )
    222179
    223 (define (new-random-source es)
    224   (check-random-source 'new-random-source es)
    225   ((@random-source-constructor es)) )
     180(define (new-random-source rs)
     181  ((@random-source-constructor (check-random-source 'new-random-source rs))) )
    226182
    227183(define (random-source-name rs)
    228   (check-random-source 'random-source-name rs)
    229   (*random-source-name rs) )
     184  (*random-source-name
     185    (check-random-source 'random-source-name rs)) )
    230186
    231187(define random-source-kind random-source-name)
    232188
    233189(define (random-source-documentation rs)
    234   (check-random-source 'random-source-documentation rs)
    235   (*random-source-documentation rs) )
     190  (*random-source-documentation
     191    (check-random-source 'random-source-documentation rs)) )
    236192
    237193(define (random-source-log2-period rs)
    238   (check-random-source 'random-source-log2-period rs)
    239   (*random-source-log2-period rs) )
     194  (*random-source-log2-period
     195    (check-random-source 'random-source-log2-period rs)) )
    240196
    241197(define (random-source-maximum-range rs)
    242   (check-random-source 'random-source-maximum-range rs)
    243   (*random-source-maximum-range rs) )
     198  (*random-source-maximum-range
     199    (check-random-source 'random-source-maximum-range rs)) )
    244200
    245201(define (random-source-entropy-source rs)
    246   (check-random-source 'random-source-entropy-source rs)
    247   (*random-source-entropy-source rs) )
     202  (*random-source-entropy-source
     203    (check-random-source 'random-source-entropy-source rs)) )
    248204
    249205(define (random-source-entropy-source-set! rs es)
    250   (check-random-source 'random-source-entropy-source-set! rs)
    251   (check-entropy-source 'random-source-entropy-source-set! es)
    252   (*random-source-entropy-source-set! rs es) )
     206  (*random-source-entropy-source-set!
     207    (check-random-source 'random-source-entropy-source-set! rs)
     208    ;#f indicates no set entropy-source
     209    (and es (check-entropy-source 'random-source-entropy-source-set! es))) )
    253210
    254211(define (random-source-state-ref rs)
    255   (check-random-source 'random-source-state-ref rs)
    256   ((@random-source-state-ref rs)) )
     212  ((@random-source-state-ref (check-random-source 'random-source-state-ref rs))) )
    257213
    258214(define (random-source-state-set! rs state)
    259   (check-random-source 'random-source-state-set! rs)
    260   ((@random-source-state-set! rs) state) )
     215  ((@random-source-state-set! (check-random-source 'random-source-state-set! rs))
     216    state) )
    261217
    262218(define (random-source-randomize! rs #!optional es)
    263219  (check-random-source 'random-source-randomize! rs)
    264   (when es (check-entropy-source 'random-source-randomize! es))
    265220  ((@random-source-randomize! rs)
    266     (or es (*random-source-entropy-source rs) (current-entropy-source))) )
     221    (or
     222      (and es (check-entropy-source 'random-source-randomize! es))
     223      (*random-source-entropy-source rs)
     224      (current-entropy-source))) )
    267225
    268226(define (random-source-pseudo-randomize! rs i j)
    269   (check-random-source 'random-source-pseudo-randomize! rs)
    270   (check-cardinal-integer 'random-source-pseudo-randomize! i)
    271   (check-cardinal-integer 'random-source-pseudo-randomize! j)
    272   ((@random-source-pseudo-randomize! rs) i j) )
     227  ((@random-source-pseudo-randomize! (check-random-source 'random-source-pseudo-randomize! rs))
     228    (check-cardinal-integer 'random-source-pseudo-randomize! i)
     229    (check-cardinal-integer 'random-source-pseudo-randomize! j)) )
    273230
    274231(define (random-source-make-integers rs)
    275   (check-random-source 'random-source-make-integers rs)
    276   ((@random-source-make-integers rs)) )
     232  ((@random-source-make-integers (check-random-source 'random-source-make-integers rs))) )
    277233
    278234(define (random-source-make-reals rs #!optional prec)
    279   (check-random-source 'random-source-make-reals rs)
    280   (when prec (check-real-precision 'random-source-make-reals prec 'precision))
    281   ((@random-source-make-reals rs) prec) )
     235  ((@random-source-make-reals (check-random-source 'random-source-make-reals rs))
     236    (and prec (check-real-precision 'random-source-make-reals prec 'precision))) )
    282237
    283238(define (random-source-make-u8vectors rs)
    284   (check-random-source 'random-source-make-u8vectors rs)
    285   (*random-source-make-u8vectors rs) )
     239  (*random-source-make-u8vectors
     240    (check-random-source 'random-source-make-u8vectors rs)) )
    286241
    287242(define (random-source-make-f64vectors rs #!optional prec)
    288   (check-random-source 'random-source-make-f64vectors rs)
    289   (when prec (check-real-precision 'random-source-make-f64vectors prec 'precision))
    290   (*random-source-make-f64vectors rs prec) )
     243  (*random-source-make-f64vectors
     244    (check-random-source 'random-source-make-f64vectors rs)
     245    (and prec (check-real-precision 'random-source-make-f64vectors prec 'precision))) )
    291246
    292247) ;module srfi-27
Note: See TracChangeset for help on using the changeset viewer.