Changeset 35490 in project


Ignore:
Timestamp:
04/30/18 03:09:02 (4 weeks ago)
Author:
kon
Message:

add types to entropy & composite

Location:
release/4/srfi-27/trunk
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/trunk/composite-entropy-source.scm

    r35486 r35490  
    4444  srfi-27)
    4545
     46;;;
     47
     48(include "srfi-27-common-types")
     49
    4650;;
    4751
     
    6266;FIXME - the combinators are suspect
    6367
     68(: composite-entropy-source (#!rest --> entropy-source))
     69;
    6470(define (composite-entropy-source
    6571          #!rest rest0
    6672          #!key
    67             (comb-int (lambda (ints n) (modulo (reduce fx+ 0 ints) n)))
    68             (comb-real (lambda (reals unit) (reduce fp* 1.0 reals))))
     73          (comb-int (lambda (ints n) (modulo (reduce fx+ 0 ints) n)))
     74          (comb-real (lambda (reals unit) (reduce fp* 1.0 reals))))
    6975  ;scrub keyword arguments
    7076  (let* (
     
    94100;; returns the composite constructor
    95101
     102(: *composite-entropy-source (procedure procedure entropy-source-name string (list-of entropy-source) --> entropy-source))
     103;
    96104(define (*composite-entropy-source comb-int comb-real def-name def-docu srcs)
    97105  (let (
  • release/4/srfi-27/trunk/composite-random-source.scm

    r35484 r35490  
    3131(;export
    3232  *composite-random-source
    33   composite-random-source)
     33  composite-random-source
     34  make-composite-random-state-predicate
     35  composite-random-state?
     36  composite-state-ref composite-state-set!)
    3437
    3538(import scheme chicken)
     
    4346  srfi-27-vector-support
    4447  srfi-27)
     48
     49;;;
     50
     51(include "srfi-27-common-types")
     52
     53(define-type composite-random-source-state (list-of *))
    4554
    4655;;
     
    6978;FIXME - the combinators are suspect
    7079
     80(: composite-random-source (#!rest --> random-source))
     81;
    7182(define (composite-random-source
    7283          #!rest rest0
    7384          #!key
    74             (comb-int (lambda (ints n) (modulo (reduce + 0 ints) n)))
    75             (comb-real (lambda (reals unit) (reduce * 1.0 reals))))
     85          (comb-int (lambda (ints n) (modulo (reduce + 0 ints) n)))
     86          (comb-real (lambda (reals unit) (reduce * 1.0 reals))))
    7687  ;scrub keyword arguments
    7788  (let* (
     
    94105          srcs0)
    95106        ;else collect info
    96         (let ((rs (car srcs)))
     107        (let (
     108          (rs (car srcs)) )
    97109          (loop
    98110            (cdr srcs)
     
    106118;; returns the composite constructor
    107119
     120(: *composite-random-source (procedure procedure random-source-name string number number (list-of random-source) --> random-source))
     121;
    108122(define (*composite-random-source comb-int comb-real def-name def-docu log2-period maxrng srcs)
    109   (let ((srcs-cnt (length srcs))
    110         (composite-make-integers (map random-source-make-integers srcs)) )
     123  (let (
     124    (srcs-cnt (length srcs))
     125    (composite-make-integers (map random-source-make-integers srcs)) )
    111126    (letrec (
    112127        (ctor
     
    152167      ctor ) ) )
    153168
    154 (define (composite-random-state? obj k n)
    155   (and
    156     (pair? obj)
    157     (eq? k (car obj))
    158     (fx= n (fx- (length obj) 1)) ) )
    159 
    160 (define (composite-state-ref s)
    161   ((@random-source-state-ref s)) )
    162 
    163 (define (composite-state-set! s state)
    164   ((@random-source-state-set! s) state) )
     169(: make-composite-random-state-predicate (random-source-name #!optional (or fixnum (list-of random-source)) --> procedure))
     170;
     171(define (make-composite-random-state-predicate name #!optional srcs)
     172  (let (
     173    (*n*
     174      (cond
     175        ((list? srcs)
     176          (length srcs))
     177        ((number? srcs)
     178          srcs)
     179        (else
     180          #f))) )
     181    (lambda (obj)
     182      (and
     183        (pair? obj)
     184        (eq? name (car obj))
     185        (or (not *n*) (fx= *n* (fx- (length (cdr obj)) 1)))) ) ) )
     186
     187(: composite-random-state? (* random-source-name (or fixnum (list-of random-source)) --> boolean))
     188;
     189(define (composite-random-state? obj name srcs)
     190  ((make-composite-random-state-predicate name srcs) obj) )
     191
     192(: composite-state-ref (random-source --> composite-random-source-state))
     193;
     194(define (composite-state-ref rs)
     195  ((@random-source-state-ref rs)) )
     196
     197(: composite-state-set! (random-source composite-random-source-state -> void))
     198;
     199(define (composite-state-set! rs state)
     200  ((@random-source-state-set! rs) state) )
    165201
    166202) ;module composite-random-source
  • release/4/srfi-27/trunk/entropy-port.scm

    r35478 r35490  
    2020  timed-resource miscmacros)
    2121
    22 ;;
     22;;;
    2323
    24 (define (make-open-binary-input-file namstr)
     24(include "srfi-27-common-types")
     25
     26;;;
     27
     28(define (make-open-binary-input-file pn)
    2529  (lambda ()
    26     (open-input-file namstr #:binary)) )
     30    (open-input-file pn #:binary)) )
     31
     32;;;
    2733
    2834;;
     
    9298
    9399(define (*make-entropy-source/port-open opener name docu)
    94   (let ((timeout (entropy-port-lifetime)))
     100  (let (
     101    (timeout (entropy-port-lifetime)) )
    95102    (if timeout
    96103      ;then auto-close on timeout
     
    101108        (*make-entropy-source/port port name docu) ) ) ) )
    102109
    103 ;;; Timeout Seconds
     110;; Timeout Seconds
    104111
    105112(define-constant DEFAULT-ENTROPY-PORT-CLOSE-SECONDS 60.0)
    106113
     114(: entropy-port-lifetime (#!optional (or boolean number) --> number))
     115;
    107116(define-parameter entropy-port-lifetime DEFAULT-ENTROPY-PORT-CLOSE-SECONDS
    108117  (lambda (x)
     
    118127;;; Entropy from some port
    119128
     129(: make-entropy-source/port (input-port #!optional entropy-source-name string --> entropy-source))
     130;
    120131(define (make-entropy-source/port port
    121132          #!optional
     
    129140;;; Entropy from port, timed or fixed (parameterized by entropy-port-lifetime)
    130141
     142(: make-entropy-source/port-open (procedure #!optional entropy-source-name string --> entropy-source))
     143;
    131144(define (make-entropy-source/port-open opener
    132145          #!optional
     
    138151    (check-string 'make-entropy-source/port-open docu 'documentation)) )
    139152
    140 ;;; Make TImed Port Entropy Source
     153;; Make TImed Port Entropy Source
    141154
     155(: make-entropy-source/port-open-timed (procedure number #!optional entropy-source-name string --> entropy-source))
     156;
    142157(define (make-entropy-source/port-open-timed opener timeout
    143158          #!optional
     
    150165    (check-string 'make-entropy-source/port-open-timed docu 'documentation)) )
    151166
    152 ;;;
     167;;
    153168
    154169;binary mode by default (only at the moment)
    155170(define make-entropy-open-file make-open-binary-input-file)
    156171
    157 ;;; Entropy from some file (binary)
     172;; Entropy from some file (binary)
    158173
    159 (define (make-entropy-source/file namstr
     174(: make-entropy-source/file (pathname #!optional entropy-source-name string --> entropy-source))
     175;
     176(define (make-entropy-source/file pn
    160177          #!optional
    161178          (name (gensym 'file-))
    162           (docu (string-append "Entropy from file \"" namstr "\"")))
     179          (docu (string-append "Entropy from file \"" pn "\"")))
    163180  (*make-entropy-source/port-open
    164     (make-entropy-open-file (check-string 'make-entropy-source/file namstr 'filename))
     181    (make-entropy-open-file (check-string 'make-entropy-source/file pn 'filename))
    165182    (check-symbol 'make-entropy-source/file name 'name)
    166183    (check-string 'make-entropy-source/file docu 'documentation)) )
    167184
    168 (define (make-entropy-source/file-timed namstr timeout
     185(: make-entropy-source/file-timed (pathname number #!optional entropy-source-name string --> entropy-source))
     186;
     187(define (make-entropy-source/file-timed pn timeout
    169188          #!optional
    170189          (name (gensym 'file-))
    171           (docu (string-append "Entropy from file \"" namstr "\"")))
     190          (docu (string-append "Entropy from file \"" pn "\"")))
    172191  (*make-entropy-source/port-open-timed
    173     (make-entropy-open-file (check-string 'make-entropy-source/file-timed namstr 'filename))
     192    (make-entropy-open-file (check-string 'make-entropy-source/file-timed pn 'filename))
    174193    (check-number 'make-entropy-source/file-timed timeout 'timeout)
    175194    (check-symbol 'make-entropy-source/file-timed name 'name)
  • release/4/srfi-27/trunk/entropy-procedure.scm

    r35478 r35490  
    1515  entropy-support)
    1616
     17;;;
     18
     19(include "srfi-27-common-types")
     20
    1721;;; Entropy from some procedure
    1822
     23(: make-entropy-source/procedures (procedure procedure #!optional random-source-name string --> entropy-source))
     24;
    1925(define (make-entropy-source/procedures u8proc f64proc
    2026          #!optional
     
    4147    (lambda (f64cnt f64vec) (entropic-f64vector-filled f64cnt f64vec f64proc))) )
    4248
     49(: make-entropy-source/f64procedure (procedure #!optional random-source-name string --> entropy-source))
     50;
    4351(define (make-entropy-source/f64procedure f64proc . args)
    4452  (apply make-entropy-source/procedures (make-entropic-u8/f64 f64proc) f64proc args) )
  • release/4/srfi-27/trunk/entropy-support.scm

    r35478 r35490  
    3636  (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
    3737
    38 ;; Double stuff
     38;;;
     39
     40(include "srfi-27-common-types")
     41
     42;;; Double stuff
    3943
    4044#>
     
    5357    C_return( 0 );"))
    5458
     59(: good_positive_double (u8vector --> float))
     60;
    5561(define good_positive_double
    5662  (foreign-lambda* double ((u8vector u8vec))
     
    6167(define double_peek_byte
    6268  (foreign-lambda* unsigned-byte ((double d) (int idx))
    63     "C_return( ((uint8_t *)&d)[idx] );"))
     69    "C_return( ((uint8_t *) &d)[idx] );"))
    6470
    6571#;(define BYTES/F64 (foreign-value "sizeof( double )" int))
     
    6874;; Entropy from procedure
    6975
     76(: make-entropic-u8/f64 (procedure --> procedure))
     77;
    7078(define (make-entropic-u8/f64 f64gen)
    71   (let ((idx BYTES/F64)
    72         (dbl 0.0) )
     79  (let (
     80    (*idx* BYTES/F64)
     81    (*dbl* 0.0) )
    7382    (lambda ()
    74       (if (fx= idx BYTES/F64)
     83      (if (fx= *idx* BYTES/F64)
    7584        (begin
    76           (set! dbl (f64gen))
    77           (set! idx 0))
    78         (set! idx (fx+ idx 1)) )
    79       (double_peek_byte dbl idx) ) ) )
     85          (set! *dbl* (f64gen))
     86          (set! *idx* 0))
     87        (set! *idx* (fx+ *idx* 1)) )
     88      (double_peek_byte *dbl* *idx*) ) ) )
    8089
    8190#; ;w/ location
    8291(define (make-entropic-f64/u8 u8gen)
    83   (let ((f64buf (make-u8vector BYTES/F64)))
     92  (let ((*f64buf* (make-u8vector BYTES/F64)))
    8493    (lambda ()
    8594      (let-location ((tmpdbl double))
    8695        (let loop ()
    87           (u8vector-filled! f64buf u8gen 0 BYTES/F64)
    88           (if (good_positive_double f64buf #$tmpdbl)
     96          (u8vector-filled! *f64buf* u8gen 0 BYTES/F64)
     97          (if (good_positive_double *f64buf* #$tmpdbl)
    8998            tmpdbl
    9099            (loop) ) ) ) ) ) )
    91100
     101(: make-entropic-f64/u8 (procedure --> procedure))
     102;
    92103(define (make-entropic-f64/u8 u8gen)
    93   (let ((f64buf (make-u8vector BYTES/F64)))
     104  (let (
     105    (*f64buf* (make-u8vector BYTES/F64)) )
    94106    (lambda ()
    95107      (let loop ()
    96         (u8vector-filled! f64buf u8gen 0 BYTES/F64)
    97         (let ((tmpdbl (good_positive_double f64buf)))
     108        (u8vector-filled! *f64buf* u8gen 0 BYTES/F64)
     109        (let ((tmpdbl (good_positive_double *f64buf*)))
    98110          (if (fp= -1.0 tmpdbl)
    99111            (loop)
     
    106118    u8vec ) )
    107119
     120(: entropic-u8vector-filled/f64 (fixnum u8vector procedure --> u8vector))
     121;
    108122(define (entropic-u8vector-filled/f64 u8cnt u8vec f64gen)
    109   (let* ((u8vec (or u8vec (make-u8vector u8cnt)))
    110          (f64cnt (fx/ u8cnt BYTES/F64))
    111          (f64vec (f64vector-filled! (make-f64vector f64cnt) f64gen))
    112          (u8rem (fxmod u8cnt BYTES/F64))
    113          (u8len (fx- u8cnt u8rem)) )
     123  (let* (
     124    (u8vec (or u8vec (make-u8vector u8cnt)))
     125    (f64cnt (fx/ u8cnt BYTES/F64))
     126    (f64vec (f64vector-filled! (make-f64vector f64cnt) f64gen))
     127    (u8rem (fxmod u8cnt BYTES/F64))
     128    (u8len (fx- u8cnt u8rem)) )
    114129    (move-memory! f64vec u8vec u8len)               ;whole
    115130    (when (fx< 0 u8rem)
    116       (let ((u8gen (make-entropic-u8/f64 f64gen)))  ;remaining
     131      (let (
     132        ;remaining
     133        (u8gen (make-entropic-u8/f64 f64gen)) )
    117134        (do ((idx u8len (fx+ idx 1)))
    118135            ((fx>= idx u8cnt))
     
    120137    u8vec )
    121138
     139(: entropic-f64vector-filled/u8 (fixnum f64vector procedure --> f64vector))
     140;
    122141(define (entropic-f64vector-filled/u8 f64cnt f64vec u8gen)
    123   (let ((f64vec (or f64vec (make-f64vector f64cnt))))
     142  (let (
     143    (f64vec (or f64vec (make-f64vector f64cnt))) )
    124144    (f64vector-filled! f64vec (make-entropic-f64/u8 u8gen) 0 f64cnt)
    125145    f64vec ) )
    126146
     147(: entropic-u8vector-filled (fixnum u8vector procedure --> u8vector))
     148;
    127149(define (entropic-u8vector-filled u8cnt u8vec u8gen)
    128   (let ((u8vec (or u8vec (make-u8vector u8cnt))))
     150  (let (
     151    (u8vec (or u8vec (make-u8vector u8cnt))) )
    129152    (u8vector-filled! u8vec u8gen 0 u8cnt)
    130153    u8vec ) )
    131154
     155(: entropic-f64vector-filled (fixnum f64vector procedure --> f64vector))
     156;
    132157(define (entropic-f64vector-filled f64cnt f64vec f64gen)
    133   (let ((f64vec (or f64vec (make-f64vector f64cnt))))
     158  (let (
     159    (f64vec (or f64vec (make-f64vector f64cnt))) )
    134160    (f64vector-filled! f64vec f64gen 0 f64cnt)
    135161    f64vec ) )
     
    141167#; ;w/ location
    142168(define port-entropic-f64
    143   (let ((f64buf (make-u8vector BYTES/F64)))
     169  (let ((*f64buf* (make-u8vector BYTES/F64)))
    144170    (lambda (port)
    145171      (let-location ((tmpdbl double))
    146172        (let loop ()
    147           (let ((len (read-u8vector! BYTES/F64 f64buf port)))
     173          (let ((len (read-u8vector! BYTES/F64 *f64buf* port)))
    148174            (cond
    149175              ((< len BYTES/F64)
    150176                0.0 )
    151               ((good_positive_double f64buf #$tmpdbl)
     177              ((good_positive_double *f64buf* #$tmpdbl)
    152178                tmpdbl )
    153179              (else
    154180                (loop) ) ) ) ) ) ) ) )
    155181
     182(: port-entropic-f64 (input-port --> procedure))
     183;
    156184(define port-entropic-f64
    157   (let ((f64buf (make-u8vector BYTES/F64)))
     185  (let (
     186    (*f64buf* (make-u8vector BYTES/F64)) )
    158187    (lambda (port)
    159188      (let loop ()
    160         (let ((len (read-u8vector! BYTES/F64 f64buf port)))
    161           (if (< len BYTES/F64)
     189        (let (
     190          (len (read-u8vector! BYTES/F64 *f64buf* port)) )
     191          (if (fx< len BYTES/F64)
    162192            0.0
    163             (let ((tmpdbl (good_positive_double f64buf)))
     193            (let ((tmpdbl (good_positive_double *f64buf*)))
    164194              (if (fp= -1.0 tmpdbl)
    165195                (loop)
    166196                tmpdbl ) ) ) ) ) ) ) )
    167197
     198(: port-entropic-u8vector (input-port fixnum u8vector --> u8vector))
     199;
    168200(define (port-entropic-u8vector port u8cnt u8vec)
    169201  (if u8vec
     
    173205    (read-u8vector u8cnt port) ) )
    174206
     207(: port-entropic-f64vector (input-port fixnum f64vector #!optional procedure --> f64vector))
     208;
    175209(define (port-entropic-f64vector port f64cnt f64vec #!optional (f64get port-entropic-f64))
    176210  (entropic-f64vector-filled f64cnt f64vec (lambda () (f64get port))) )
  • release/4/srfi-27/trunk/entropy-unix.scm

    r35478 r35490  
    88  make-entropy-source-urandom-device)
    99
    10 (import scheme)
    11 
    12 (import chicken)
     10(import scheme chicken)
    1311
    1412(use entropy-source entropy-port)
     13
     14;;;
     15
     16(include "srfi-27-common-types")
    1517
    1618;;;
     
    2022;;; Entropy from /dev/random
    2123
     24(: make-entropy-source-random-device (--> entropy-source))
     25;
    2226(define (make-entropy-source-random-device)
    2327  (make-entropy-source/file-timed
     
    3135;;; Entropy from /dev/urandom
    3236
     37(: make-entropy-source-urandom-device (--> entropy-source))
     38;
    3339(define (make-entropy-source-urandom-device)
    3440  (make-entropy-source/file-timed
  • release/4/srfi-27/trunk/srfi-27-common-types.scm

    r35489 r35490  
    99
    1010(define-type alist list)
     11
     12(define-type pathname string)
    1113
    1214;;
  • release/4/srfi-27/trunk/srfi-27-vector.scm

    r35485 r35490  
    5555;
    5656(define (*random-permutation! vec rndint)
    57   (let ((n (vector-length vec)))
     57  (let (
     58    (n (vector-length vec)) )
    5859    (vector-iota! vec n)
    5960    (do ((k n (fx- k 1)))
    60         ((fx= k 1)
    61           vec )
     61        ((fx= k 1) vec )
    6262      ;random-swap
    6363      (let* (
  • release/4/srfi-27/trunk/srfi-27.meta

    r35456 r35490  
    1919 (test-depends test)
    2020 (files
    21  "srfi-27.setup" "srfi-27.meta"
    22  "srfi-27-common-types.scm"
    23  "srfi-27.scm"
    24  "srfi-27-implementation"
    25  "random-source.scm"
    26  ;"bsdrnd.scm"
    27  "composite-random-source.scm"
    28  "mrg32k3a.scm" "mwc.scm" "moa.scm"
    29  "srfi-27-numbers.scm"
    30  "entropy-source.scm"
    31  "composite-entropy-source.scm"
    32  "entropy-unix.scm" "entropy-linux.scm" "entropy-windows.scm"
    33  "entropy-clock.scm" "entropy-procedure.scm" "entropy-port.scm"
    34  "entropy-support.scm"
    35  "srfi-27-uniform-random.scm"
    36  "srfi-27-distributions.scm"
    37  "srfi-27-bernoullis.scm"
    38  "srfi-27-binomials.scm"
    39  "srfi-27-cauchys.scm"
    40  "srfi-27-erlangs.scm"
    41  "srfi-27-exponentials.scm"
    42  "srfi-27-gammas.scm"
    43  "srfi-27-geometrics.scm"
    44  "srfi-27-levys.scm"
    45  "srfi-27-lognormals.scm"
    46  "srfi-27-normals.scm"
    47  "srfi-27-paretos.scm"
    48  "srfi-27-poissons.scm"
    49  "srfi-27-triangles.scm"
    50  "srfi-27-weibulls.scm"
    51  "srfi-27-vector.scm" "srfi-27-vector-support.scm"
    52  "source-registration.scm" "tests/test-diehard.scm" "tests/test-confidence.scm"
    53  "tests/test-mrg32k3a.scm"
    54  "tests/srfi-27-test.scm" "tests/run.scm") )
     21  "srfi-27.setup" "srfi-27.meta"
     22  "source-registration.scm"
     23  "srfi-27-common-types.scm"
     24  "srfi-27.scm"
     25  "random-source.scm"
     26  ;"bsdrnd.scm"
     27  "composite-random-source.scm"
     28  "mrg32k3a.scm" "mwc.scm" "moa.scm" "well512.scm"
     29  "srfi-27-numbers.scm"
     30  "entropy-source.scm"
     31  "composite-entropy-source.scm"
     32  "entropy-unix.scm" "entropy-linux.scm" "entropy-windows.scm"
     33  "entropy-clock.scm" "entropy-procedure.scm" "entropy-port.scm"
     34  "entropy-support.scm"
     35  "srfi-27-uniform-random.scm"
     36  "srfi-27-distributions.scm"
     37  "srfi-27-bernoullis.scm"
     38  "srfi-27-binomials.scm"
     39  "srfi-27-cauchys.scm"
     40  "srfi-27-erlangs.scm"
     41  "srfi-27-exponentials.scm"
     42  "srfi-27-gammas.scm"
     43  "srfi-27-geometrics.scm"
     44  "srfi-27-levys.scm"
     45  "srfi-27-lognormals.scm"
     46  "srfi-27-normals.scm"
     47  "srfi-27-paretos.scm"
     48  "srfi-27-poissons.scm"
     49  "srfi-27-triangles.scm"
     50  "srfi-27-weibulls.scm"
     51  "srfi-27-vector.scm" "srfi-27-vector-support.scm"
     52  "tests/run.scm" "tests/srfi-27-test.scm"
     53  "tests/test-diehard.scm" "tests/test-confidence.scm" "tests/test-mrg32k3a.scm") )
  • release/4/srfi-27/trunk/srfi-27.setup

    r35487 r35490  
    1717  -no-procedure-checks-for-toplevel-bindings))
    1818
    19 (setup-shared-extension-module 'source-registration (extension-version "3.3.2")
     19(setup-shared-extension-module 'source-registration (extension-version "3.4.0")
    2020  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    2121
    22 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.3.2")
     22(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.4.0")
    2323  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    2424
    25 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.3.2")
     25(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.4.0")
    2626  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    2727
    2828;; Entropy Source Modules
    2929
    30 (setup-shared-extension-module 'entropy-source (extension-version "3.3.2")
     30(setup-shared-extension-module 'entropy-source (extension-version "3.4.0")
    3131  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    3232
    33 (setup-shared-extension-module 'entropy-support (extension-version "3.3.2")
     33(setup-shared-extension-module 'entropy-support (extension-version "3.4.0")
    3434  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    3535
    36 (setup-shared-extension-module 'entropy-clock (extension-version "3.3.2")
     36(setup-shared-extension-module 'entropy-clock (extension-version "3.4.0")
    3737  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    3838
    39 (setup-shared-extension-module 'entropy-procedure (extension-version "3.3.2")
     39(setup-shared-extension-module 'entropy-procedure (extension-version "3.4.0")
    4040  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    4141
    42 (setup-shared-extension-module 'entropy-port (extension-version "3.3.2")
     42(setup-shared-extension-module 'entropy-port (extension-version "3.4.0")
    4343  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    4444
    4545#+unix
    46 (setup-shared-extension-module 'entropy-unix (extension-version "3.3.2")
     46(setup-shared-extension-module 'entropy-unix (extension-version "3.4.0")
    4747  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    4848
    4949#|
    5050#+linux
    51 (setup-shared-extension-module 'entropy-linux (extension-version "3.3.2")
     51(setup-shared-extension-module 'entropy-linux (extension-version "3.4.0")
    5252  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    5353|#
    5454
    5555#+windows
    56 (setup-shared-extension-module 'entropy-windows (extension-version "3.3.2")
     56(setup-shared-extension-module 'entropy-windows (extension-version "3.4.0")
    5757  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    5858
     
    6060
    6161#; ;WIP
    62 (setup-shared-extension-module 'well512 (extension-version "3.3.2")
     62(setup-shared-extension-module 'well512 (extension-version "3.4.0")
    6363  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    6464
    65 (setup-shared-extension-module 'random-source (extension-version "3.3.2")
     65(setup-shared-extension-module 'random-source (extension-version "3.4.0")
    6666  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    6767
    6868;-c++ w/ crunch
    69 (setup-shared-extension-module 'mrg32k3a (extension-version "3.3.2")
     69(setup-shared-extension-module 'mrg32k3a (extension-version "3.4.0")
    7070  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    7171
    72 (setup-shared-extension-module 'mwc (extension-version "3.3.2")
     72(setup-shared-extension-module 'mwc (extension-version "3.4.0")
    7373  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    7474
    75 (setup-shared-extension-module 'moa (extension-version "3.3.2")
     75(setup-shared-extension-module 'moa (extension-version "3.4.0")
    7676  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    7777
    7878#;
    79 (setup-shared-extension-module 'bsdrnd (extension-version "3.3.2")
     79(setup-shared-extension-module 'bsdrnd (extension-version "3.4.0")
    8080  #:inline? #t #:types? #t #:compile-options UTILITY-OPTIONS)
    8181
    8282;; Main Modules
    8383
    84 (setup-shared-extension-module 'srfi-27 (extension-version "3.3.2")
     84(setup-shared-extension-module 'srfi-27 (extension-version "3.4.0")
    8585  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    8686
    87 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.3.2")
     87(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.4.0")
    8888  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    8989
    90 (setup-shared-extension-module 'srfi-27-distributions-support (extension-version "3.3.2")
     90(setup-shared-extension-module 'srfi-27-distributions-support (extension-version "3.4.0")
    9191  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    9292
    93 (setup-shared-extension-module 'srfi-27-bernoullis (extension-version "3.3.2")
     93(setup-shared-extension-module 'srfi-27-bernoullis (extension-version "3.4.0")
    9494  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    9595
    96 (setup-shared-extension-module 'srfi-27-binomials (extension-version "3.3.2")
     96(setup-shared-extension-module 'srfi-27-binomials (extension-version "3.4.0")
    9797  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    9898
    99 (setup-shared-extension-module 'srfi-27-cauchys (extension-version "3.3.2")
     99(setup-shared-extension-module 'srfi-27-cauchys (extension-version "3.4.0")
    100100  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    101101
    102 (setup-shared-extension-module 'srfi-27-normals (extension-version "3.3.2")
     102(setup-shared-extension-module 'srfi-27-normals (extension-version "3.4.0")
    103103  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    104104
    105105;needs normals
    106 (setup-shared-extension-module 'srfi-27-gammas (extension-version "3.3.2")
     106(setup-shared-extension-module 'srfi-27-gammas (extension-version "3.4.0")
    107107  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    108108
    109109;needs gammas
    110 (setup-shared-extension-module 'srfi-27-erlangs (extension-version "3.3.2")
     110(setup-shared-extension-module 'srfi-27-erlangs (extension-version "3.4.0")
    111111  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    112112
    113 (setup-shared-extension-module 'srfi-27-exponentials (extension-version "3.3.2")
     113(setup-shared-extension-module 'srfi-27-exponentials (extension-version "3.4.0")
    114114  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    115115
    116 (setup-shared-extension-module 'srfi-27-geometrics (extension-version "3.3.2")
     116(setup-shared-extension-module 'srfi-27-geometrics (extension-version "3.4.0")
    117117  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    118118
    119 (setup-shared-extension-module 'srfi-27-levys (extension-version "3.3.2")
     119(setup-shared-extension-module 'srfi-27-levys (extension-version "3.4.0")
    120120  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    121121
    122 (setup-shared-extension-module 'srfi-27-lognormals (extension-version "3.3.2")
     122(setup-shared-extension-module 'srfi-27-lognormals (extension-version "3.4.0")
    123123  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    124124
    125125;needs gammas exponentials
    126 (setup-shared-extension-module 'srfi-27-paretos (extension-version "3.3.2")
     126(setup-shared-extension-module 'srfi-27-paretos (extension-version "3.4.0")
    127127  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    128128
    129 (setup-shared-extension-module 'srfi-27-poissons (extension-version "3.3.2")
     129(setup-shared-extension-module 'srfi-27-poissons (extension-version "3.4.0")
    130130  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    131131
    132 (setup-shared-extension-module 'srfi-27-triangles (extension-version "3.3.2")
     132(setup-shared-extension-module 'srfi-27-triangles (extension-version "3.4.0")
    133133  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    134134
    135 (setup-shared-extension-module 'srfi-27-weibulls (extension-version "3.3.2")
     135(setup-shared-extension-module 'srfi-27-weibulls (extension-version "3.4.0")
    136136  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    137137
    138 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.3.2")
     138(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.4.0")
    139139  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    140140
    141 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.3.2")
     141(setup-shared-extension-module 'srfi-27-vector (extension-version "3.4.0")
    142142  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    143143
    144144;; Composite Source Modules
    145145
    146 (setup-shared-extension-module 'composite-entropy-source (extension-version "3.3.2")
     146(setup-shared-extension-module 'composite-entropy-source (extension-version "3.4.0")
    147147  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
    148148
    149 (setup-shared-extension-module 'composite-random-source (extension-version "3.3.2")
     149(setup-shared-extension-module 'composite-random-source (extension-version "3.4.0")
    150150  #:inline? #t #:types? #t #:compile-options PUBLIC-OPTIONS)
  • release/4/srfi-27/trunk/well512.scm

    r35488 r35490  
    3838typedef struct {
    3939  unsigned int i;
    40   uint32_t state[R];
    41 } WELL512State;
     40  uint32_t *state; /*[R]*/
     41} WELL512aState;
    4242
    4343void
    44 InitWELLRNG512a( WELL512State *well )
     44InitWELLRNG512a( WELL512aState *well )
    4545{
    4646   well->i = 0;
     
    5050
    5151double
    52 WELLRNG512a( WELL512State *well )
     52WELLRNG512a( WELL512aState *well )
    5353{
    5454# define W 32
     
    116116
    117117static void
    118 init_state(uint32_t *vec, uint_64 seed) {
    119   InitWELLRNG512a( init );
     118init_state( unsigned int *i, uint32_t *state ) {
     119  uint32_t wstate[R];
     120  WELL512aState well;
     121  well.state = wstate;
     122  InitWELLRNG512a( &well );
     123  *i = well.i;
     124  memcpy( state, wstate, sizeof wstate );
    120125}
    121126
    122127static double
    123 uniformf64( uint32_t *state )
    124 {
    125   C_return( WELLRNG512a() );
     128uniformf64( unsigned int *i, uint32_t *state )
     129{
     130  WELL512aState well;
     131  well.i = *i;
     132  well.state = state;
     133  double res = WELLRNG512a( well );
     134  *i = well.i;
     135  C_return( res );
    126136}
    127137
    128138static uint32_t
    129 randomu32( uint32_t *state, uint32_t m )
    130 {
    131   C_return( (uint32_t) WELLRNG512a() );
    132 }
    133 
    134 static void
    135 uniformu64_ith_state( uint32_t *state, uint32_t i )
    136 {
    137   for( ;i > 0; --i )
    138     uniformu32( state );
    139 }
    140 
    141 static void
    142 uniformu64_jth_offset_state( uint32_t *state, uint32_t j )
    143 {
    144   uint64_t x = (uint64_t) pow( A, j ) * state[ W ] + state[ C ];
    145   state[ W ] = low32( x );
    146   state[ C ] = high32( x );
    147 }
    148 
     139randomu32( unsigned int *i, uint32_t *state )
     140{
     141  C_return( (uint32_t) uniformf64( i, state ) );
     142}
    149143<#
    150144
Note: See TracChangeset for help on using the changeset viewer.