Changeset 34208 in project


Ignore:
Timestamp:
06/26/17 04:31:31 (3 months ago)
Author:
kon
Message:

fix bernoulli rand gen arg

Location:
release/4/srfi-27
Files:
48 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/tags/3.2.9/bsdrnd.scm

    r34021 r34208  
    1111  make-random-source-bsd)
    1212
    13 (import
    14   (except scheme <= inexact->exact exact->inexact number?)
    15   chicken
    16   foreign)
     13(import (except scheme <= inexact->exact exact->inexact number?))
     14
     15(import chicken foreign)
    1716
    1817(import
  • release/4/srfi-27/tags/3.2.9/composite-entropy-source.scm

    r34021 r34208  
    3333  composite-entropy-source)
    3434
    35 (import scheme chicken)
     35(import scheme)
     36
     37(import chicken)
    3638
    3739(import
  • release/4/srfi-27/tags/3.2.9/composite-random-source.scm

    r34021 r34208  
    3333  composite-random-source)
    3434
    35 (import scheme chicken)
     35(import scheme)
     36
     37(import chicken)
    3638
    3739(import
  • release/4/srfi-27/tags/3.2.9/entropy-clock.scm

    r34030 r34208  
    77  make-entropy-source-system-clock)
    88
    9 (import scheme chicken foreign)
     9(import scheme)
     10
     11(import chicken foreign)
    1012
    1113(use entropy-source entropy-support)
  • release/4/srfi-27/tags/3.2.9/entropy-port.scm

    r34015 r34208  
    1212  make-entropy-source/file make-entropy-source/file-timed)
    1313
    14 (import scheme chicken)
     14(import scheme)
     15
     16(import chicken)
    1517
    1618(import
  • release/4/srfi-27/tags/3.2.9/entropy-procedure.scm

    r34012 r34208  
    88  make-entropy-source/f64procedure)
    99
    10 (import scheme chicken)
     10(import scheme)
     11
     12(import chicken)
    1113
    1214(import
  • release/4/srfi-27/tags/3.2.9/entropy-source.scm

    r34021 r34208  
    2323  register-entropy-source!)
    2424
    25 (import scheme chicken)
     25(import scheme)
     26
     27(import chicken)
    2628
    2729(import
  • release/4/srfi-27/tags/3.2.9/entropy-support.scm

    r34015 r34208  
    2424  port-entropic-f64vector)
    2525
    26 (import scheme chicken foreign)
     26(import scheme)
     27
     28(import chicken foreign)
    2729
    2830(import
  • release/4/srfi-27/tags/3.2.9/entropy-unix.scm

    r34012 r34208  
    88  make-entropy-source-urandom-device)
    99
    10 (import scheme chicken)
     10(import scheme)
     11
     12(import chicken)
    1113
    1214(import
  • release/4/srfi-27/tags/3.2.9/entropy-windows.scm

    r34012 r34208  
    77  make-entropy-source-crypt)
    88
    9 (import scheme chicken foreign)
     9(import scheme)
     10
     11(import chicken foreign)
    1012
    1113(import
  • release/4/srfi-27/tags/3.2.9/fp-extn.scm

    r34011 r34208  
    1818  fpfraction)
    1919
    20 (import scheme chicken foreign)
     20(import scheme)
     21
     22(import chicken foreign)
    2123
    2224(declare
  • release/4/srfi-27/tags/3.2.9/moa.scm

    r34021 r34208  
    77  make-random-source-moa)
    88
    9 (import
    10   (except scheme <= inexact->exact exact->inexact number?)
    11   chicken
    12   foreign)
     9(import (except scheme <= inexact->exact exact->inexact number?))
     10
     11(import chicken foreign)
    1312
    1413(import
  • release/4/srfi-27/tags/3.2.9/mrg32k3a.scm

    r34021 r34208  
    1717  make-random-source-mrg32k3a)
    1818
    19 (import
    20   (except scheme <= inexact->exact exact->inexact number?)
    21   chicken
    22   foreign)
     19(import (except scheme <= inexact->exact exact->inexact number?))
     20
     21(import chicken foreign)
    2322
    2423(import
  • release/4/srfi-27/tags/3.2.9/mwc.scm

    r34021 r34208  
    77  make-random-source-mwc)
    88
    9 (import
    10   (except scheme <= inexact->exact exact->inexact number?)
    11   chicken
    12   foreign)
     9(import (except scheme <= inexact->exact exact->inexact number?))
     10
     11(import chicken foreign)
    1312
    1413(import
  • release/4/srfi-27/tags/3.2.9/random-source.scm

    r34015 r34208  
    2222  register-random-source!)
    2323
    24 (import scheme chicken)
     24(import scheme)
     25
     26(import chicken)
    2527
    2628(import
  • release/4/srfi-27/tags/3.2.9/source-registration.scm

    r34017 r34208  
    1010  @source-registration-key @source-registration-ref @source-registration-deref! @source-registration-register!)
    1111
    12 (import scheme chicken)
     12(import scheme)
     13
     14(import chicken)
    1315
    1416(import
  • release/4/srfi-27/tags/3.2.9/srfi-27-distributions.scm

    r34035 r34208  
    11;;;; srfi-27-distributions.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, May '06
    34
     
    2223  make-random-weibulls)
    2324
    24 (import scheme chicken)
     25(import scheme)
     26
     27(import chicken)
     28
     29(import (only type-errors error-argument-type))
     30(require-library type-errors)
    2531
    2632(import
    27   (only type-errors
    28     error-argument-type)
    2933  (only type-checks
     34    define-check+error-type
    3035    check-procedure
    3136    check-cardinal-integer
     
    3338    check-open-interval
    3439    check-closed-interval))
    35 (require-library
    36   type-errors type-checks)
     40(require-library type-checks)
    3741
    3842(use srfi-27)
     
    4044;;; Chicken Generic Arithmetic Argument Checks
    4145
    42 (define (check-nonzero-real loc obj #!optional argnam)
    43   (unless (and (real? obj) (not (zero? obj)))
    44     (error-argument-type loc obj "nonzero-real" argnam))
    45   obj )
    46 
    47 (define (check-nonnegative-real loc obj #!optional argnam)
    48   (unless (and (real? obj) (not (negative? obj)))
    49     (error-argument-type loc obj "nonnegative-real" argnam))
    50   obj )
    51 
    52 (define (check-positive-real loc obj #!optional argnam)
    53   (unless (and (real? obj) (positive? obj))
    54     (error-argument-type loc obj "positive-real" argnam))
    55   obj )
     46(define (nonzero-real? obj)
     47  (and (real? obj) (not (zero? obj))) )
     48
     49(define (nonnegative-real? obj)
     50  (and (real? obj) (not (negative? obj))) )
     51
     52(define (positive-real? obj)
     53  (and (real? obj) (positive? obj)) )
     54
     55(define-check+error-type nonzero-real)
     56(define-check+error-type nonnegative-real)
     57(define-check+error-type positive-real)
    5658
    5759(define (check-real-open-interval loc obj mn mx #!optional argnam)
    5860  (check-real loc obj argnam)
     61  (check-real loc mn argnam)
     62  (check-real loc mx argnam)
    5963  (check-open-interval loc obj mn mx argnam)
    6064  obj )
     
    6266(define (check-real-closed-interval loc obj mn mx #!optional argnam)
    6367  (check-real loc obj argnam)
     68  (check-real loc mn argnam)
     69  (check-real loc mx argnam)
    6470  (check-closed-interval loc obj mn mx argnam)
    6571  obj )
    6672
    67 #;
    68 (define (check-real-precision loc obj #!optional argnam)
    69   (check-real-open-interval loc obj 0 1 argnam)
    70   obj )
    71 
    7273(define (check-real-unit loc obj #!optional argnam)
    73   (check-real-closed-interval loc obj 0 1 argnam)
    74   obj )
     74  (check-real-closed-interval loc obj 0 1 argnam) )
    7575
    7676;;;
     
    184184    (else      (lambda () (<= (randoms) p)))) )
    185185
    186 (define (make-random-bernoullis #!key (p 0.5) randoms)
     186(define (make-random-bernoullis #!key (p 0.5) (randoms (random-real/current)))
    187187  (check-real-unit 'make-random-bernoullis p 'p)
    188188  (check-procedure 'make-random-bernoullis randoms 'randoms)
  • release/4/srfi-27/tags/3.2.9/srfi-27-numbers.scm

    r34011 r34208  
    2929    integer? real?
    3030    exact->inexact inexact->exact
    31     floor)
    32   chicken)
     31    floor))
     32
     33(import chicken)
    3334
    3435(import
  • release/4/srfi-27/tags/3.2.9/srfi-27-uniform-random.scm

    r34035 r34208  
    11;;;; srfi-27-uniform-random.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, Feb '10
    34
     
    910  *make-uniform-random-integers)
    1011
    11 (import
    12   (except scheme + - * quotient = < abs)
    13   chicken)
     12(import (except scheme + - * quotient = < abs))
     13
     14(import chicken)
    1415
    1516(use data-structures)
    1617
    17 (import
    18   (only numbers + - * quotient = < abs)
    19   (only miscmacros exchange!))
    20 (require-library numbers miscmacros)
     18(import (only numbers + - * quotient = < abs))
     19(require-library numbers)
     20
     21(import (only miscmacros exchange!))
     22(require-library miscmacros)
    2123
    2224(use vector-lib)
    2325
     26(import (only srfi-27 current-random-source))
     27(require-library srfi-27)
     28
     29(use random-source)
     30
    2431(import
    25   (only srfi-27 current-random-source)
    2632  (only srfi-27-numbers
    2733    check-integer check-positive-integer
    2834    check-real-precision))
    29 (require-library srfi-27 srfi-27-numbers)
    30 
    31 (use random-source)
     35(require-library srfi-27-numbers)
    3236
    3337(declare
  • release/4/srfi-27/tags/3.2.9/srfi-27-vector-support.scm

    r34021 r34208  
    2323  vector%-sum-squares)
    2424
    25 (import scheme chicken)
     25(import scheme)
     26
     27(import chicken)
    2628
    2729(import
  • release/4/srfi-27/tags/3.2.9/srfi-27-vector.scm

    r34035 r34208  
    1818  random-solid-sphere!)
    1919
    20 (import scheme chicken)
     20(import scheme)
     21
     22(import chicken)
    2123
    2224(import
  • release/4/srfi-27/tags/3.2.9/srfi-27.scm

    r34023 r34208  
    4444  entropy-source-f64vector)
    4545
    46 (import scheme chicken)
     46(import scheme)
     47
     48(import chicken)
    4749
    4850(import
  • release/4/srfi-27/tags/3.2.9/srfi-27.setup

    r34035 r34208  
    1717#;(define publoptn '())
    1818
    19 (setup-shared-extension-module 'fp-extn (extension-version "3.2.8")
     19(setup-shared-extension-module 'fp-extn (extension-version "3.2.9")
    2020  #:inline? #t
    2121  #:types? #t
    2222  #:compile-options `(-scrutinize ,@utiloptn) )
    2323
    24 (setup-shared-extension-module 'source-registration (extension-version "3.2.8")
     24(setup-shared-extension-module 'source-registration (extension-version "3.2.9")
    2525  #:inline? #t
    2626  #:types? #t
    2727  #:compile-options `(-scrutinize ,@utiloptn) )
    2828
    29 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.8")
     29(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.9")
    3030  #:inline? #t
    3131  #:types? #t
    3232  #:compile-options `(-scrutinize ,@utiloptn) )
    3333
    34 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.8")
     34(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.9")
    3535  #:inline? #t
    3636  #:types? #t
     
    3939;; Entropy Source Modules
    4040
    41 (setup-shared-extension-module 'entropy-source (extension-version "3.2.8")
     41(setup-shared-extension-module 'entropy-source (extension-version "3.2.9")
    4242  #:inline? #t
    4343  #:types? #t
    4444  #:compile-options `(-scrutinize ,@utiloptn) )
    4545
    46 (setup-shared-extension-module 'entropy-support (extension-version "3.2.8")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.9")
    4747  #:inline? #t
    4848  #:types? #t
    4949  #:compile-options `(-scrutinize ,@utiloptn) )
    5050
    51 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.8")
     51(setup-shared-extension-module 'entropy-clock (extension-version "3.2.9")
    5252  #:inline? #t
    5353  #:types? #t
    5454  #:compile-options `(-scrutinize ,@publoptn) )
    5555
    56 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.8")
     56(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.9")
    5757  #:inline? #t
    5858  #:types? #t
     
    6161    -no-procedure-checks) )
    6262
    63 (setup-shared-extension-module 'entropy-port (extension-version "3.2.8")
     63(setup-shared-extension-module 'entropy-port (extension-version "3.2.9")
    6464  #:inline? #t
    6565  #:types? #t
     
    6767
    6868#+unix
    69 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.8")
     69(setup-shared-extension-module 'entropy-unix (extension-version "3.2.9")
    7070  #:inline? #t
    7171  #:types? #t
     
    7373
    7474#+windows
    75 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.8")
     75(setup-shared-extension-module 'entropy-windows (extension-version "3.2.9")
    7676  #:inline? #t
    7777  #:types? #t
     
    7979
    8080#;
    81 (setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.8")
     81(setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.9")
    8282  #:inline? #t
    8383  #:types? #t
     
    8686;; Random Source Modules
    8787
    88 (setup-shared-extension-module 'random-source (extension-version "3.2.8")
     88(setup-shared-extension-module 'random-source (extension-version "3.2.9")
    8989  #:inline? #t
    9090  #:types? #t
    9191  #:compile-options `(-scrutinize ,@utiloptn) )
    9292
    93 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.8")
     93(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.9")
    9494  #:inline? #t
    9595  #:types? #t
    9696  #:compile-options `(-scrutinize ,@utiloptn) )
    9797
    98 (setup-shared-extension-module 'mwc (extension-version "3.2.8")
     98(setup-shared-extension-module 'mwc (extension-version "3.2.9")
    9999  #:inline? #t
    100100  #:types? #t
    101101  #:compile-options `(-scrutinize ,@utiloptn) )
    102102
    103 (setup-shared-extension-module 'moa (extension-version "3.2.8")
     103(setup-shared-extension-module 'moa (extension-version "3.2.9")
    104104  #:inline? #t
    105105  #:types? #t
     
    107107
    108108#;
    109 (setup-shared-extension-module 'bsdrnd (extension-version "3.2.8")
     109(setup-shared-extension-module 'bsdrnd (extension-version "3.2.9")
    110110  #:inline? #t
    111111  #:types? #t
     
    113113
    114114#;
    115 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.8")
     115(setup-shared-extension-module 'composite-random-source (extension-version "3.2.9")
    116116  #:inline? #t
    117117  #:types? #t
     
    120120;; Main Modules
    121121
    122 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.8")
     122(setup-shared-extension-module 'srfi-27 (extension-version "3.2.9")
    123123  #:inline? #t
    124124  #:types? #t
    125125  #:compile-options `(-scrutinize ,@publoptn) )
    126126
    127 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.8")
     127(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.9")
    128128  #:inline? #t
    129129  #:types? #t
    130130  #:compile-options `(-scrutinize ,@publoptn) )
    131131
    132 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.8")
     132(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.9")
    133133  #:inline? #t
    134134  #:types? #t
    135135  #:compile-options `(-scrutinize ,@publoptn) )
    136136
    137 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.8")
     137(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.9")
    138138  #:inline? #t
    139139  #:types? #t
  • release/4/srfi-27/tags/3.2.9/tests/run.scm

    r34035 r34208  
    6969|#
    7070
    71 ;;
     71;;;
    7272
    7373(test-begin "SRFI 27")
    7474
    75 ;;
     75;
    7676
    7777(use random-source entropy-source)
     
    8989)
    9090
    91 ;;
     91;
    9292
    9393(use srfi-4)
     
    108108)
    109109
    110 ;;
     110;
    111111
    112112(use srfi-27-uniform-random)
     
    143143)
    144144
    145 ;;
     145;
    146146
    147147(use srfi-27-vector)
     
    178178)
    179179
     180; Distributions
     181
     182(use data-structures)
     183
     184(use srfi-27-distributions)
     185
     186(define +known-distributions+  `(
     187  (,make-random-normals ,real? "normals")
     188  (,make-random-exponentials ,real? "exponentials")
     189  (,make-random-triangles ,real? "triangles")
     190  (,make-random-poissons ,integer? "poissons")
     191  (,make-random-bernoullis ,boolean? "bernoullis")
     192  (,make-random-binomials ,integer? "binomials")
     193  (,make-random-geometrics ,integer? "geometrics")
     194  (,make-random-lognormals ,real? "lognormals")
     195  (,make-random-cauchys ,real? "cauchys")
     196  (,make-random-gammas ,real? "gammas")
     197  (,make-random-erlangs ,real? "erlangs")
     198  (,make-random-paretos ,real? "paretos")
     199  (,make-random-levys ,real? "levys")
     200  (,make-random-weibulls ,real? "weibulls")))
     201
     202(test-group "distributions"
     203  (for-each
     204    (lambda (distr-data)
     205      (let ((distr-ctor (car distr-data))
     206            (distr-pred (cadr distr-data))
     207            (distr-name (caddr distr-data)) )
     208        (test-group distr-name
     209          (receive (genny params) (distr-ctor)
     210            (test-assert "generator" (procedure? genny))
     211            (test-assert "parameters" (procedure? params))
     212            (let ((param-list (call-with-values params list)))
     213              (test-assert (->string param-list) (list? param-list)) )
     214            (do ((i 1 (add1 i)))
     215                ((> i 3))
     216                (let ((res (genny)))
     217                  (test-assert (->string res) (distr-pred res)) ) ) ) ) ) )
     218    +known-distributions+)
     219)
     220
     221;;
     222
    180223(test-end "SRFI 27")
    181224
    182 ;;
     225;;;
    183226
    184227(use utils)
     228
     229(print "*** Original Tests ***")
    185230
    186231(system* "csi -n -s test-mrg32k3a.scm")
     
    188233;(system* "csi -n -s test-diehard") ;errors
    189234
    190 ;;
     235;;;
    191236
    192237(test-exit)
  • release/4/srfi-27/trunk/bsdrnd.scm

    r34021 r34208  
    1111  make-random-source-bsd)
    1212
    13 (import
    14   (except scheme <= inexact->exact exact->inexact number?)
    15   chicken
    16   foreign)
     13(import (except scheme <= inexact->exact exact->inexact number?))
     14
     15(import chicken foreign)
    1716
    1817(import
  • release/4/srfi-27/trunk/composite-entropy-source.scm

    r34021 r34208  
    3333  composite-entropy-source)
    3434
    35 (import scheme chicken)
     35(import scheme)
     36
     37(import chicken)
    3638
    3739(import
  • release/4/srfi-27/trunk/composite-random-source.scm

    r34021 r34208  
    3333  composite-random-source)
    3434
    35 (import scheme chicken)
     35(import scheme)
     36
     37(import chicken)
    3638
    3739(import
  • release/4/srfi-27/trunk/entropy-clock.scm

    r34030 r34208  
    77  make-entropy-source-system-clock)
    88
    9 (import scheme chicken foreign)
     9(import scheme)
     10
     11(import chicken foreign)
    1012
    1113(use entropy-source entropy-support)
  • release/4/srfi-27/trunk/entropy-port.scm

    r34015 r34208  
    1212  make-entropy-source/file make-entropy-source/file-timed)
    1313
    14 (import scheme chicken)
     14(import scheme)
     15
     16(import chicken)
    1517
    1618(import
  • release/4/srfi-27/trunk/entropy-procedure.scm

    r34012 r34208  
    88  make-entropy-source/f64procedure)
    99
    10 (import scheme chicken)
     10(import scheme)
     11
     12(import chicken)
    1113
    1214(import
  • release/4/srfi-27/trunk/entropy-source.scm

    r34021 r34208  
    2323  register-entropy-source!)
    2424
    25 (import scheme chicken)
     25(import scheme)
     26
     27(import chicken)
    2628
    2729(import
  • release/4/srfi-27/trunk/entropy-support.scm

    r34015 r34208  
    2424  port-entropic-f64vector)
    2525
    26 (import scheme chicken foreign)
     26(import scheme)
     27
     28(import chicken foreign)
    2729
    2830(import
  • release/4/srfi-27/trunk/entropy-unix.scm

    r34012 r34208  
    88  make-entropy-source-urandom-device)
    99
    10 (import scheme chicken)
     10(import scheme)
     11
     12(import chicken)
    1113
    1214(import
  • release/4/srfi-27/trunk/entropy-windows.scm

    r34012 r34208  
    77  make-entropy-source-crypt)
    88
    9 (import scheme chicken foreign)
     9(import scheme)
     10
     11(import chicken foreign)
    1012
    1113(import
  • release/4/srfi-27/trunk/fp-extn.scm

    r34011 r34208  
    1818  fpfraction)
    1919
    20 (import scheme chicken foreign)
     20(import scheme)
     21
     22(import chicken foreign)
    2123
    2224(declare
  • release/4/srfi-27/trunk/moa.scm

    r34021 r34208  
    77  make-random-source-moa)
    88
    9 (import
    10   (except scheme <= inexact->exact exact->inexact number?)
    11   chicken
    12   foreign)
     9(import (except scheme <= inexact->exact exact->inexact number?))
     10
     11(import chicken foreign)
    1312
    1413(import
  • release/4/srfi-27/trunk/mrg32k3a.scm

    r34021 r34208  
    1717  make-random-source-mrg32k3a)
    1818
    19 (import
    20   (except scheme <= inexact->exact exact->inexact number?)
    21   chicken
    22   foreign)
     19(import (except scheme <= inexact->exact exact->inexact number?))
     20
     21(import chicken foreign)
    2322
    2423(import
  • release/4/srfi-27/trunk/mwc.scm

    r34021 r34208  
    77  make-random-source-mwc)
    88
    9 (import
    10   (except scheme <= inexact->exact exact->inexact number?)
    11   chicken
    12   foreign)
     9(import (except scheme <= inexact->exact exact->inexact number?))
     10
     11(import chicken foreign)
    1312
    1413(import
  • release/4/srfi-27/trunk/random-source.scm

    r34015 r34208  
    2222  register-random-source!)
    2323
    24 (import scheme chicken)
     24(import scheme)
     25
     26(import chicken)
    2527
    2628(import
  • release/4/srfi-27/trunk/source-registration.scm

    r34017 r34208  
    1010  @source-registration-key @source-registration-ref @source-registration-deref! @source-registration-register!)
    1111
    12 (import scheme chicken)
     12(import scheme)
     13
     14(import chicken)
    1315
    1416(import
  • release/4/srfi-27/trunk/srfi-27-distributions.scm

    r34035 r34208  
    11;;;; srfi-27-distributions.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, May '06
    34
     
    2223  make-random-weibulls)
    2324
    24 (import scheme chicken)
     25(import scheme)
     26
     27(import chicken)
     28
     29(import (only type-errors error-argument-type))
     30(require-library type-errors)
    2531
    2632(import
    27   (only type-errors
    28     error-argument-type)
    2933  (only type-checks
     34    define-check+error-type
    3035    check-procedure
    3136    check-cardinal-integer
     
    3338    check-open-interval
    3439    check-closed-interval))
    35 (require-library
    36   type-errors type-checks)
     40(require-library type-checks)
    3741
    3842(use srfi-27)
     
    4044;;; Chicken Generic Arithmetic Argument Checks
    4145
    42 (define (check-nonzero-real loc obj #!optional argnam)
    43   (unless (and (real? obj) (not (zero? obj)))
    44     (error-argument-type loc obj "nonzero-real" argnam))
    45   obj )
    46 
    47 (define (check-nonnegative-real loc obj #!optional argnam)
    48   (unless (and (real? obj) (not (negative? obj)))
    49     (error-argument-type loc obj "nonnegative-real" argnam))
    50   obj )
    51 
    52 (define (check-positive-real loc obj #!optional argnam)
    53   (unless (and (real? obj) (positive? obj))
    54     (error-argument-type loc obj "positive-real" argnam))
    55   obj )
     46(define (nonzero-real? obj)
     47  (and (real? obj) (not (zero? obj))) )
     48
     49(define (nonnegative-real? obj)
     50  (and (real? obj) (not (negative? obj))) )
     51
     52(define (positive-real? obj)
     53  (and (real? obj) (positive? obj)) )
     54
     55(define-check+error-type nonzero-real)
     56(define-check+error-type nonnegative-real)
     57(define-check+error-type positive-real)
    5658
    5759(define (check-real-open-interval loc obj mn mx #!optional argnam)
    5860  (check-real loc obj argnam)
     61  (check-real loc mn argnam)
     62  (check-real loc mx argnam)
    5963  (check-open-interval loc obj mn mx argnam)
    6064  obj )
     
    6266(define (check-real-closed-interval loc obj mn mx #!optional argnam)
    6367  (check-real loc obj argnam)
     68  (check-real loc mn argnam)
     69  (check-real loc mx argnam)
    6470  (check-closed-interval loc obj mn mx argnam)
    6571  obj )
    6672
    67 #;
    68 (define (check-real-precision loc obj #!optional argnam)
    69   (check-real-open-interval loc obj 0 1 argnam)
    70   obj )
    71 
    7273(define (check-real-unit loc obj #!optional argnam)
    73   (check-real-closed-interval loc obj 0 1 argnam)
    74   obj )
     74  (check-real-closed-interval loc obj 0 1 argnam) )
    7575
    7676;;;
     
    184184    (else      (lambda () (<= (randoms) p)))) )
    185185
    186 (define (make-random-bernoullis #!key (p 0.5) randoms)
     186(define (make-random-bernoullis #!key (p 0.5) (randoms (random-real/current)))
    187187  (check-real-unit 'make-random-bernoullis p 'p)
    188188  (check-procedure 'make-random-bernoullis randoms 'randoms)
  • release/4/srfi-27/trunk/srfi-27-numbers.scm

    r34011 r34208  
    2929    integer? real?
    3030    exact->inexact inexact->exact
    31     floor)
    32   chicken)
     31    floor))
     32
     33(import chicken)
    3334
    3435(import
  • release/4/srfi-27/trunk/srfi-27-uniform-random.scm

    r34035 r34208  
    11;;;; srfi-27-uniform-random.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, Feb '10
    34
     
    910  *make-uniform-random-integers)
    1011
    11 (import
    12   (except scheme + - * quotient = < abs)
    13   chicken)
     12(import (except scheme + - * quotient = < abs))
     13
     14(import chicken)
    1415
    1516(use data-structures)
    1617
    17 (import
    18   (only numbers + - * quotient = < abs)
    19   (only miscmacros exchange!))
    20 (require-library numbers miscmacros)
     18(import (only numbers + - * quotient = < abs))
     19(require-library numbers)
     20
     21(import (only miscmacros exchange!))
     22(require-library miscmacros)
    2123
    2224(use vector-lib)
    2325
     26(import (only srfi-27 current-random-source))
     27(require-library srfi-27)
     28
     29(use random-source)
     30
    2431(import
    25   (only srfi-27 current-random-source)
    2632  (only srfi-27-numbers
    2733    check-integer check-positive-integer
    2834    check-real-precision))
    29 (require-library srfi-27 srfi-27-numbers)
    30 
    31 (use random-source)
     35(require-library srfi-27-numbers)
    3236
    3337(declare
  • release/4/srfi-27/trunk/srfi-27-vector-support.scm

    r34021 r34208  
    2323  vector%-sum-squares)
    2424
    25 (import scheme chicken)
     25(import scheme)
     26
     27(import chicken)
    2628
    2729(import
  • release/4/srfi-27/trunk/srfi-27-vector.scm

    r34035 r34208  
    1818  random-solid-sphere!)
    1919
    20 (import scheme chicken)
     20(import scheme)
     21
     22(import chicken)
    2123
    2224(import
  • release/4/srfi-27/trunk/srfi-27.scm

    r34023 r34208  
    4444  entropy-source-f64vector)
    4545
    46 (import scheme chicken)
     46(import scheme)
     47
     48(import chicken)
    4749
    4850(import
  • release/4/srfi-27/trunk/srfi-27.setup

    r34035 r34208  
    1717#;(define publoptn '())
    1818
    19 (setup-shared-extension-module 'fp-extn (extension-version "3.2.8")
     19(setup-shared-extension-module 'fp-extn (extension-version "3.2.9")
    2020  #:inline? #t
    2121  #:types? #t
    2222  #:compile-options `(-scrutinize ,@utiloptn) )
    2323
    24 (setup-shared-extension-module 'source-registration (extension-version "3.2.8")
     24(setup-shared-extension-module 'source-registration (extension-version "3.2.9")
    2525  #:inline? #t
    2626  #:types? #t
    2727  #:compile-options `(-scrutinize ,@utiloptn) )
    2828
    29 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.8")
     29(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.9")
    3030  #:inline? #t
    3131  #:types? #t
    3232  #:compile-options `(-scrutinize ,@utiloptn) )
    3333
    34 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.8")
     34(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.9")
    3535  #:inline? #t
    3636  #:types? #t
     
    3939;; Entropy Source Modules
    4040
    41 (setup-shared-extension-module 'entropy-source (extension-version "3.2.8")
     41(setup-shared-extension-module 'entropy-source (extension-version "3.2.9")
    4242  #:inline? #t
    4343  #:types? #t
    4444  #:compile-options `(-scrutinize ,@utiloptn) )
    4545
    46 (setup-shared-extension-module 'entropy-support (extension-version "3.2.8")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.9")
    4747  #:inline? #t
    4848  #:types? #t
    4949  #:compile-options `(-scrutinize ,@utiloptn) )
    5050
    51 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.8")
     51(setup-shared-extension-module 'entropy-clock (extension-version "3.2.9")
    5252  #:inline? #t
    5353  #:types? #t
    5454  #:compile-options `(-scrutinize ,@publoptn) )
    5555
    56 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.8")
     56(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.9")
    5757  #:inline? #t
    5858  #:types? #t
     
    6161    -no-procedure-checks) )
    6262
    63 (setup-shared-extension-module 'entropy-port (extension-version "3.2.8")
     63(setup-shared-extension-module 'entropy-port (extension-version "3.2.9")
    6464  #:inline? #t
    6565  #:types? #t
     
    6767
    6868#+unix
    69 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.8")
     69(setup-shared-extension-module 'entropy-unix (extension-version "3.2.9")
    7070  #:inline? #t
    7171  #:types? #t
     
    7373
    7474#+windows
    75 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.8")
     75(setup-shared-extension-module 'entropy-windows (extension-version "3.2.9")
    7676  #:inline? #t
    7777  #:types? #t
     
    7979
    8080#;
    81 (setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.8")
     81(setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.9")
    8282  #:inline? #t
    8383  #:types? #t
     
    8686;; Random Source Modules
    8787
    88 (setup-shared-extension-module 'random-source (extension-version "3.2.8")
     88(setup-shared-extension-module 'random-source (extension-version "3.2.9")
    8989  #:inline? #t
    9090  #:types? #t
    9191  #:compile-options `(-scrutinize ,@utiloptn) )
    9292
    93 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.8")
     93(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.9")
    9494  #:inline? #t
    9595  #:types? #t
    9696  #:compile-options `(-scrutinize ,@utiloptn) )
    9797
    98 (setup-shared-extension-module 'mwc (extension-version "3.2.8")
     98(setup-shared-extension-module 'mwc (extension-version "3.2.9")
    9999  #:inline? #t
    100100  #:types? #t
    101101  #:compile-options `(-scrutinize ,@utiloptn) )
    102102
    103 (setup-shared-extension-module 'moa (extension-version "3.2.8")
     103(setup-shared-extension-module 'moa (extension-version "3.2.9")
    104104  #:inline? #t
    105105  #:types? #t
     
    107107
    108108#;
    109 (setup-shared-extension-module 'bsdrnd (extension-version "3.2.8")
     109(setup-shared-extension-module 'bsdrnd (extension-version "3.2.9")
    110110  #:inline? #t
    111111  #:types? #t
     
    113113
    114114#;
    115 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.8")
     115(setup-shared-extension-module 'composite-random-source (extension-version "3.2.9")
    116116  #:inline? #t
    117117  #:types? #t
     
    120120;; Main Modules
    121121
    122 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.8")
     122(setup-shared-extension-module 'srfi-27 (extension-version "3.2.9")
    123123  #:inline? #t
    124124  #:types? #t
    125125  #:compile-options `(-scrutinize ,@publoptn) )
    126126
    127 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.8")
     127(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.9")
    128128  #:inline? #t
    129129  #:types? #t
    130130  #:compile-options `(-scrutinize ,@publoptn) )
    131131
    132 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.8")
     132(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.9")
    133133  #:inline? #t
    134134  #:types? #t
    135135  #:compile-options `(-scrutinize ,@publoptn) )
    136136
    137 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.8")
     137(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.9")
    138138  #:inline? #t
    139139  #:types? #t
  • release/4/srfi-27/trunk/tests/run.scm

    r34035 r34208  
    6969|#
    7070
    71 ;;
     71;;;
    7272
    7373(test-begin "SRFI 27")
    7474
    75 ;;
     75;
    7676
    7777(use random-source entropy-source)
     
    8989)
    9090
    91 ;;
     91;
    9292
    9393(use srfi-4)
     
    108108)
    109109
    110 ;;
     110;
    111111
    112112(use srfi-27-uniform-random)
     
    143143)
    144144
    145 ;;
     145;
    146146
    147147(use srfi-27-vector)
     
    178178)
    179179
     180; Distributions
     181
     182(use data-structures)
     183
     184(use srfi-27-distributions)
     185
     186(define +known-distributions+  `(
     187  (,make-random-normals ,real? "normals")
     188  (,make-random-exponentials ,real? "exponentials")
     189  (,make-random-triangles ,real? "triangles")
     190  (,make-random-poissons ,integer? "poissons")
     191  (,make-random-bernoullis ,boolean? "bernoullis")
     192  (,make-random-binomials ,integer? "binomials")
     193  (,make-random-geometrics ,integer? "geometrics")
     194  (,make-random-lognormals ,real? "lognormals")
     195  (,make-random-cauchys ,real? "cauchys")
     196  (,make-random-gammas ,real? "gammas")
     197  (,make-random-erlangs ,real? "erlangs")
     198  (,make-random-paretos ,real? "paretos")
     199  (,make-random-levys ,real? "levys")
     200  (,make-random-weibulls ,real? "weibulls")))
     201
     202(test-group "distributions"
     203  (for-each
     204    (lambda (distr-data)
     205      (let ((distr-ctor (car distr-data))
     206            (distr-pred (cadr distr-data))
     207            (distr-name (caddr distr-data)) )
     208        (test-group distr-name
     209          (receive (genny params) (distr-ctor)
     210            (test-assert "generator" (procedure? genny))
     211            (test-assert "parameters" (procedure? params))
     212            (let ((param-list (call-with-values params list)))
     213              (test-assert (->string param-list) (list? param-list)) )
     214            (do ((i 1 (add1 i)))
     215                ((> i 3))
     216                (let ((res (genny)))
     217                  (test-assert (->string res) (distr-pred res)) ) ) ) ) ) )
     218    +known-distributions+)
     219)
     220
     221;;
     222
    180223(test-end "SRFI 27")
    181224
    182 ;;
     225;;;
    183226
    184227(use utils)
     228
     229(print "*** Original Tests ***")
    185230
    186231(system* "csi -n -s test-mrg32k3a.scm")
     
    188233;(system* "csi -n -s test-diehard") ;errors
    189234
    190 ;;
     235;;;
    191236
    192237(test-exit)
Note: See TracChangeset for help on using the changeset viewer.