Changeset 34015 in project for release/4/srfi-27/trunk/srfi-27.scm
- Timestamp:
- 04/23/17 09:05:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/srfi-27/trunk/srfi-27.scm
r34011 r34015 76 76 (cond 77 77 ((entropy-source? x) 78 x )78 x ) 79 79 (else 80 80 (warning-argument-type 'current-entropy-source x 'entropy-source) 81 81 (current-entropy-source) ) ) ) ) 82 82 83 (define make-entropy-source84 (case-lambda85 (()86 ((@entropy-source-constructor (current-entropy-source))) )87 ((es)88 (let ((ctor89 (cond90 ((entropy-source? es)91 (@entropy-source-constructor es) )92 ((symbol? es)93 (let ((ctor (registered-entropy-source es)))94 (or95 ctor96 (error 'make-entropy-source "unregistered entropy-source name" es) ) ) )97 (else98 (error-argument-type99 'make-entropy-source es100 "valid entropy-source or registered entropy-source name") ) ) ) )101 (ctor) ) ) ) )102 103 #;104 83 (define (make-entropy-source #!optional (es (current-entropy-source))) 105 84 (let ((ctor … … 116 95 117 96 (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))) ) 120 98 121 99 (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)) ) 124 101 125 102 (define entropy-source-kind entropy-source-name) 126 103 127 104 (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)) ) 130 107 131 108 (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))) ) 136 112 137 113 (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))) ) 142 117 143 118 (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)) ) 146 120 147 121 (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)) ) 150 123 151 124 ;;; Random Source … … 154 127 (let ((rndint ((@random-source-make-integers rs)))) 155 128 (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))) ) ) ) 158 132 159 133 (define (*random-source-make-f64vectors rs prec) 160 134 (let ((rnd ((@random-source-make-reals rs) prec))) 161 135 (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) ) ) ) 164 139 165 140 ;; … … 185 160 (cond 186 161 ((random-source? x) 187 x )162 x ) 188 163 (else 189 164 (warning-argument-type 'current-random-source x 'random-source) 190 165 (current-random-source) ) ) ) ) 191 166 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))) 211 168 (let ((ctor 212 169 (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) ) 217 174 (else 218 175 (error-argument-type 219 'make-random-source es176 'make-random-source rs 220 177 "valid random-source or registered random-source name") ) ) ) ) 221 178 (ctor) ) ) 222 179 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))) ) 226 182 227 183 (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)) ) 230 186 231 187 (define random-source-kind random-source-name) 232 188 233 189 (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)) ) 236 192 237 193 (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)) ) 240 196 241 197 (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)) ) 244 200 245 201 (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)) ) 248 204 249 205 (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))) ) 253 210 254 211 (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))) ) 257 213 258 214 (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) ) 261 217 262 218 (define (random-source-randomize! rs #!optional es) 263 219 (check-random-source 'random-source-randomize! rs) 264 (when es (check-entropy-source 'random-source-randomize! es))265 220 ((@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))) ) 267 225 268 226 (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)) ) 273 230 274 231 (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))) ) 277 233 278 234 (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))) ) 282 237 283 238 (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)) ) 286 241 287 242 (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))) ) 291 246 292 247 ) ;module srfi-27
Note: See TracChangeset
for help on using the changeset viewer.