Changeset 35473 in project
 Timestamp:
 04/29/18 16:18:57 (11 months ago)
 Location:
 release/4/srfi27/trunk
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

release/4/srfi27/trunk/entropyclock.scm
r34208 r35473 7 7 makeentropysourcesystemclock) 8 8 9 (import scheme) 10 11 (import chicken foreign) 9 (import scheme chicken foreign) 12 10 13 11 (use entropysource entropysupport) … … 18 16 #include <time.h> 19 17 #include <math.h> 20 21 static double 22 f64init() 23 { 24 return (double) time( NULL ); 25 } 26 27 static double 28 f64rand( double f64seed ) 29 { 30 double x = 11.0 + (25214903917.0 * f64seed); 31 return fmod( x, 281474976711000.0 ); /* actually remainder */ 32 } 18 /* linear congruential generator */ 19 #define MULTIPLIER 25214903917.0 20 #define LIMITER 81474976711000.0 33 21 <# 34 22 35 (define f64init (foreignlambda double "f64init")) 36 (define f64rand (foreignlambda double "f64rand" double)) 23 (define f64init (foreignlambda* double () 24 "C_return( (double) time( NULL ) );")) 25 26 (define f64rand (foreignlambda* double ((double f64seed)) 27 "double x = 11.0 + (MULTIPLIER * f64seed); 28 C_return( fmod( x, LIMITER ) );")) 29 30 ;;; 31 32 (include "srfi27commontypes") 37 33 38 34 ;;; Entropy from system clock 39 35 36 (: makeentropysourcesystemclock (> entropysource)) 37 ; 40 38 (define (makeentropysourcesystemclock) 41 (let* ((f64seed (f64init) ) 42 (_f64rand 43 (lambda () 44 (set! f64seed (f64rand f64seed)) 45 f64seed ) ) ) 39 (let* ( 40 (*f64seed* (f64init)) 41 (*f64rand* 42 (lambda () 43 (set! *f64seed* (f64rand *f64seed*)) 44 *f64seed*)) ) 46 45 (*makeentropysource 47 46 ; … … 53 52 ; 54 53 (lambda () 55 (makeentropicu8/f64 _f64rand) )54 (makeentropicu8/f64 *f64rand*) ) 56 55 ; 57 _f64rand56 *f64rand* 58 57 ; 59 58 (lambda (u8cnt u8vec) 60 (entropicu8vectorfilled/f64 u8cnt u8vec _f64rand) )59 (entropicu8vectorfilled/f64 u8cnt u8vec *f64rand*) ) 61 60 ; 62 61 (lambda (f64cnt f64vec) 63 (entropicf64vectorfilled f64cnt f64vec _f64rand) ) ) ) )62 (entropicf64vectorfilled f64cnt f64vec *f64rand*) ) ) ) ) 64 63 65 64 (registerentropysource! 'systemclock makeentropysourcesystemclock) 
release/4/srfi27/trunk/srfi27.scm
r35456 r35473 46 46 entropysourcef64vector 47 47 ;; 48 currentrandominteger49 currentrandomreal)48 randominteger/current 49 randomreal/current) 50 50 51 51 (import scheme chicken) … … 216 216 ((@randomsourcemakeintegers (currentrandomsource))) ) 217 217 218 (: currentrandominteger (deprecated currentrandominteger))219 (define currentrandominteger currentrandominteger)220 221 218 (: currentrandomreal (> float)) 222 219 ; 223 220 (define (currentrandomreal) 224 221 ((@randomsourcemakereals (currentrandomsource)) #f) ) 225 226 (: currentrandomreal (deprecated currentrandomreal))227 (define currentrandomreal currentrandomreal)228 222 229 223 (: makerandomsource (#!optional randomsource > randomsource)) … … 323 317 ((@randomsourcemakeintegers (checkrandomsource 'randomsourcemakeintegers rs))) ) 324 318 325 (: randomsourcemake integers (randomsource #!optional fixnum > randomrealfunction))319 (: randomsourcemakereals (randomsource #!optional fixnum > randomrealfunction)) 326 320 ; 327 321 (define (randomsourcemakereals rs #!optional prec) … … 342 336 (and prec (checkrealprecision 'randomsourcemakef64vectors prec 'precision))) ) 343 337 338 ;;; 339 340 (: randominteger/current (deprecated currentrandominteger)) 341 (define randominteger/current currentrandominteger) 342 343 (: randomreal/current (deprecated currentrandomreal)) 344 (define randomreal/current currentrandomreal) 345 344 346 ) ;module srfi27 
release/4/srfi27/trunk/tests/srfi27test.scm
r34967 r35473 48 48 (testassert (>string (randomsourcekind (currentrandomsource))) #t) 49 49 (testassert (procedure? randominteger)) 50 (testassert (randominteger 5)) 50 51 (testassert (procedure? randomreal)) 52 (testassert (randomreal)) 51 53 ) 52 54
Note: See TracChangeset
for help on using the changeset viewer.