Changeset 34015 in project for release/4/srfi27/trunk/srfi27.scm
 Timestamp:
 04/23/17 09:05:00 (2 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

release/4/srfi27/trunk/srfi27.scm
r34011 r34015 76 76 (cond 77 77 ((entropysource? x) 78 x )78 x ) 79 79 (else 80 80 (warningargumenttype 'currententropysource x 'entropysource) 81 81 (currententropysource) ) ) ) ) 82 82 83 (define makeentropysource84 (caselambda85 (()86 ((@entropysourceconstructor (currententropysource))) )87 ((es)88 (let ((ctor89 (cond90 ((entropysource? es)91 (@entropysourceconstructor es) )92 ((symbol? es)93 (let ((ctor (registeredentropysource es)))94 (or95 ctor96 (error 'makeentropysource "unregistered entropysource name" es) ) ) )97 (else98 (errorargumenttype99 'makeentropysource es100 "valid entropysource or registered entropysource name") ) ) ) )101 (ctor) ) ) ) )102 103 #;104 83 (define (makeentropysource #!optional (es (currententropysource))) 105 84 (let ((ctor … … 116 95 117 96 (define (newentropysource es) 118 (checkentropysource 'newentropysource es) 119 ((@entropysourceconstructor es)) ) 97 ((@entropysourceconstructor (checkentropysource 'newentropysource es))) ) 120 98 121 99 (define (entropysourcename es) 122 (checkentropysource 'entropysourcename es) 123 (*entropysourcename es) ) 100 (*entropysourcename (checkentropysource 'entropysourcename es)) ) 124 101 125 102 (define entropysourcekind entropysourcename) 126 103 127 104 (define (entropysourcedocumentation es) 128 ( checkentropysource 'entropysourcedocumentation es)129 (*entropysourcedocumentation es) )105 (*entropysourcedocumentation 106 (checkentropysource 'entropysourcedocumentation es)) ) 130 107 131 108 (define (entropysourceu8vector es n #!optional vec) 132 (checkentropysource 'entropysourceu8vector es) 133 (checkpositivefixnum 'entropysourceu8vector n) 134 (when vec (checku8vector 'entropysourceu8vector vec)) 135 ((@entropysourceu8vector es) n vec) ) 109 ((@entropysourceu8vector (checkentropysource 'entropysourceu8vector es)) 110 (checkpositivefixnum 'entropysourceu8vector n) 111 (and vec (checku8vector 'entropysourceu8vector vec))) ) 136 112 137 113 (define (entropysourcef64vector es n #!optional vec) 138 (checkentropysource 'entropysourcef64vector es) 139 (checkpositivefixnum 'entropysourcef64vector n) 140 (when vec (checkf64vector 'entropysourcef64vector vec)) 141 ((@entropysourcef64vector es) n vec) ) 114 ((@entropysourcef64vector (checkentropysource 'entropysourcef64vector es)) 115 (checkpositivefixnum 'entropysourcef64vector n) 116 (and vec (checkf64vector 'entropysourcef64vector vec))) ) 142 117 143 118 (define (entropysourceu8 es) 144 (checkentropysource 'entropysourceu8 es) 145 (@entropysourceu8 es) ) 119 (@entropysourceu8 (checkentropysource 'entropysourceu8 es)) ) 146 120 147 121 (define (entropysourcef64 es) 148 (checkentropysource 'entropysourcef64 es) 149 (@entropysourcef64 es) ) 122 (@entropysourcef64 (checkentropysource 'entropysourcef64 es)) ) 150 123 151 124 ;;; Random Source … … 154 127 (let ((rndint ((@randomsourcemakeintegers rs)))) 155 128 (lambda (n) 156 (checkcardinalinteger 'makeu8vector n 'length) 157 (u8vectorfilled! (makeu8vector n) (lambda () (rndint 256))) ) ) ) 129 (u8vectorfilled! 130 (makeu8vector (checkcardinalinteger 'randomsourcemakeu8vector n 'length)) 131 (lambda () (rndint 256))) ) ) ) 158 132 159 133 (define (*randomsourcemakef64vectors rs prec) 160 134 (let ((rnd ((@randomsourcemakereals rs) prec))) 161 135 (lambda (n) 162 (checkcardinalinteger 'makef64vector n 'length) 163 (f64vectorfilled! (makef64vector n) rnd) ) ) ) 136 (f64vectorfilled! 137 (makef64vector (checkcardinalinteger 'randomsourcemakef64vector n 'length)) 138 rnd) ) ) ) 164 139 165 140 ;; … … 185 160 (cond 186 161 ((randomsource? x) 187 x )162 x ) 188 163 (else 189 164 (warningargumenttype 'currentrandomsource x 'randomsource) 190 165 (currentrandomsource) ) ) ) ) 191 166 192 (define makerandomsource 193 (caselambda 194 (() 195 ((@randomsourceconstructor (currentrandomsource))) ) 196 ((es) 197 (let ((ctor 198 (cond 199 ((randomsource? es) 200 (@randomsourceconstructor es) ) 201 ((symbol? es) 202 (registeredrandomsource es) ) 203 (else 204 (errorargumenttype 205 'makerandomsource es 206 "valid randomsource or registered randomsource name") ) ) ) ) 207 (ctor) ) ) ) ) 208 209 #; 210 (define (makerandomsource #!optional (es (currentrandomsource))) 167 (define (makerandomsource #!optional (rs (currentrandomsource))) 211 168 (let ((ctor 212 169 (cond 213 ((randomsource? es)214 (@randomsourceconstructor es) )215 ((symbol? es)216 (registeredrandomsource es) )170 ((randomsource? rs) 171 (@randomsourceconstructor rs) ) 172 ((symbol? rs) 173 (registeredrandomsource rs) ) 217 174 (else 218 175 (errorargumenttype 219 'makerandomsource es176 'makerandomsource rs 220 177 "valid randomsource or registered randomsource name") ) ) ) ) 221 178 (ctor) ) ) 222 179 223 (define (newrandomsource es) 224 (checkrandomsource 'newrandomsource es) 225 ((@randomsourceconstructor es)) ) 180 (define (newrandomsource rs) 181 ((@randomsourceconstructor (checkrandomsource 'newrandomsource rs))) ) 226 182 227 183 (define (randomsourcename rs) 228 ( checkrandomsource 'randomsourcename rs)229 (*randomsourcename rs) )184 (*randomsourcename 185 (checkrandomsource 'randomsourcename rs)) ) 230 186 231 187 (define randomsourcekind randomsourcename) 232 188 233 189 (define (randomsourcedocumentation rs) 234 ( checkrandomsource 'randomsourcedocumentation rs)235 (*randomsourcedocumentation rs) )190 (*randomsourcedocumentation 191 (checkrandomsource 'randomsourcedocumentation rs)) ) 236 192 237 193 (define (randomsourcelog2period rs) 238 ( checkrandomsource 'randomsourcelog2period rs)239 (*randomsourcelog2period rs) )194 (*randomsourcelog2period 195 (checkrandomsource 'randomsourcelog2period rs)) ) 240 196 241 197 (define (randomsourcemaximumrange rs) 242 ( checkrandomsource 'randomsourcemaximumrange rs)243 (*randomsourcemaximumrange rs) )198 (*randomsourcemaximumrange 199 (checkrandomsource 'randomsourcemaximumrange rs)) ) 244 200 245 201 (define (randomsourceentropysource rs) 246 ( checkrandomsource 'randomsourceentropysource rs)247 (*randomsourceentropysource rs) )202 (*randomsourceentropysource 203 (checkrandomsource 'randomsourceentropysource rs)) ) 248 204 249 205 (define (randomsourceentropysourceset! rs es) 250 (checkrandomsource 'randomsourceentropysourceset! rs) 251 (checkentropysource 'randomsourceentropysourceset! es) 252 (*randomsourceentropysourceset! rs es) ) 206 (*randomsourceentropysourceset! 207 (checkrandomsource 'randomsourceentropysourceset! rs) 208 ;#f indicates no set entropysource 209 (and es (checkentropysource 'randomsourceentropysourceset! es))) ) 253 210 254 211 (define (randomsourcestateref rs) 255 (checkrandomsource 'randomsourcestateref rs) 256 ((@randomsourcestateref rs)) ) 212 ((@randomsourcestateref (checkrandomsource 'randomsourcestateref rs))) ) 257 213 258 214 (define (randomsourcestateset! rs state) 259 ( checkrandomsource 'randomsourcestateset! rs)260 ((@randomsourcestateset! rs)state) )215 ((@randomsourcestateset! (checkrandomsource 'randomsourcestateset! rs)) 216 state) ) 261 217 262 218 (define (randomsourcerandomize! rs #!optional es) 263 219 (checkrandomsource 'randomsourcerandomize! rs) 264 (when es (checkentropysource 'randomsourcerandomize! es))265 220 ((@randomsourcerandomize! rs) 266 (or es (*randomsourceentropysource rs) (currententropysource))) ) 221 (or 222 (and es (checkentropysource 'randomsourcerandomize! es)) 223 (*randomsourceentropysource rs) 224 (currententropysource))) ) 267 225 268 226 (define (randomsourcepseudorandomize! rs i j) 269 (checkrandomsource 'randomsourcepseudorandomize! rs) 270 (checkcardinalinteger 'randomsourcepseudorandomize! i) 271 (checkcardinalinteger 'randomsourcepseudorandomize! j) 272 ((@randomsourcepseudorandomize! rs) i j) ) 227 ((@randomsourcepseudorandomize! (checkrandomsource 'randomsourcepseudorandomize! rs)) 228 (checkcardinalinteger 'randomsourcepseudorandomize! i) 229 (checkcardinalinteger 'randomsourcepseudorandomize! j)) ) 273 230 274 231 (define (randomsourcemakeintegers rs) 275 (checkrandomsource 'randomsourcemakeintegers rs) 276 ((@randomsourcemakeintegers rs)) ) 232 ((@randomsourcemakeintegers (checkrandomsource 'randomsourcemakeintegers rs))) ) 277 233 278 234 (define (randomsourcemakereals rs #!optional prec) 279 (checkrandomsource 'randomsourcemakereals rs) 280 (when prec (checkrealprecision 'randomsourcemakereals prec 'precision)) 281 ((@randomsourcemakereals rs) prec) ) 235 ((@randomsourcemakereals (checkrandomsource 'randomsourcemakereals rs)) 236 (and prec (checkrealprecision 'randomsourcemakereals prec 'precision))) ) 282 237 283 238 (define (randomsourcemakeu8vectors rs) 284 ( checkrandomsource 'randomsourcemakeu8vectors rs)285 (*randomsourcemakeu8vectors rs) )239 (*randomsourcemakeu8vectors 240 (checkrandomsource 'randomsourcemakeu8vectors rs)) ) 286 241 287 242 (define (randomsourcemakef64vectors rs #!optional prec) 288 ( checkrandomsource 'randomsourcemakef64vectors rs)289 (when prec (checkrealprecision 'randomsourcemakef64vectors prec 'precision))290 (*randomsourcemakef64vectors rs prec) )243 (*randomsourcemakef64vectors 244 (checkrandomsource 'randomsourcemakef64vectors rs) 245 (and prec (checkrealprecision 'randomsourcemakef64vectors prec 'precision))) ) 291 246 292 247 ) ;module srfi27
Note: See TracChangeset
for help on using the changeset viewer.