Changeset 17347 in project


Ignore:
Timestamp:
02/21/10 22:14:30 (10 years ago)
Author:
Kon Lovett
Message:

Save.

Location:
release/4/srfi-27/trunk
Files:
2 added
1 deleted
8 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/trunk/moa.scm

    r17331 r17347  
    4848
    4949static unsigned char masktab[ 256 ] = {
    50   0 
    51   1 
    52   3 3
    53   7 7 7 7
    54   15 15 15 15 15 15 15 15
    55   31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31
    56   63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63
    57   63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63
    58   127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127
    59   127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127
    60   127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127
    61   127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127
    62   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    63   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    64   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    65   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    66   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    67   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    68   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    69   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
     50  0,
     51  1,
     52  3, 3,
     53  7, 7, 7, 7,
     54  15, 15, 15, 15, 15, 15, 15, 15,
     55  31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31,
     56  63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,
     57  63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,
     58  127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
     59  127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
     60  127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
     61  127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
     62  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     63  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     64  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     65  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     66  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     67  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     68  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     69  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
    7070};
    7171
  • release/4/srfi-27/trunk/mwc.scm

    r17331 r17347  
    5050
    5151static unsigned char masktab[ 256 ] = {
    52   0 
    53   1 
    54   3 3
    55   7 7 7 7
    56   15 15 15 15 15 15 15 15
    57   31 31 31 31 31 31 31 31 31 31 31 31 31 31 31 31
    58   63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63
    59   63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63
    60   127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127
    61   127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127
    62   127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127
    63   127 127 127 127 127 127 127 127 127 127 127 127 127 127 127 127
    64   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    65   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    66   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    67   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    68   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    69   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    70   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
    71   255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
     52  0,
     53  1,
     54  3, 3,
     55  7, 7, 7, 7,
     56  15, 15, 15, 15, 15, 15, 15, 15,
     57  31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31,
     58  63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,
     59  63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,
     60  127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
     61  127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
     62  127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
     63  127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
     64  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     65  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     66  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     67  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     68  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     69  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     70  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
     71  255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
    7272};
    7373
  • release/4/srfi-27/trunk/srfi-27-distributions.scm

    r17332 r17347  
    6060  (check-closed-interval loc obj mn mx argnam) )
    6161
     62#;
    6263(define (check-real-precision loc obj #!optional argnam)
    6364  (check-real-open-interval loc obj 0 1 argnam) )
     
    298299  (values
    299300    (*make-random-erlangs alpha theta randoms)
    300     (lambda () (values alpah theta randoms))) )
     301    (lambda () (values alpha theta randoms))) )
    301302
    302303;;; Pareto distribution
  • release/4/srfi-27/trunk/srfi-27-numbers.scm

    r17334 r17347  
    66  (;export
    77    ;
    8     #;check-integer
     8    check-integer
    99    #;check-cardinal-integer
    10     #;check-positive-integer
     10    check-positive-integer
    1111    #;check-real
    1212    #;check-nonzero-real
     
    5050;;
    5151
    52 #;
    5352(define (check-integer loc obj #!optional argnam)
    5453  (unless (integer? obj)
     
    6059    (error-argument-type loc obj "cardinal-integer" argnam)) )
    6160
    62 #;
    6361(define (check-positive-integer loc obj #!optional argnam)
    6462  (unless (and (integer? obj) (positive? obj))
  • release/4/srfi-27/trunk/srfi-27-vector.scm

    r17332 r17347  
    99    ;
    1010    *random-permutation!
     11    *random-64vector!
    1112    *random-vector!
    1213    *random-normal-vector!
     
    2930  (import scheme
    3031          chicken
     32          (only srfi-4 make-f64vector)
    3133          (only type-checks check-cardinal-integer check-vector)
    3234          (only type-errors error-vector)
    3335          random-source
    3436          srfi-27-uniform-random
     37          srfi-27-distributions
    3538          srfi-27-vector-support)
    3639
    3740  (require-library
     41    srfi-4
    3842    type-checks type-errors
    39     random-source srfi-27-uniform-random srfi-27-vector-support)
     43    random-source
     44    srfi-27-uniform-random srfi-27-distributions
     45    srfi-27-vector-support)
    4046
    4147;;;
     
    97103;and standard normally distributed (i.e., with mean 0 and variance 1).
    98104
     105(define (**random-normal-vector! vec norms)
     106  (*random-vector! vec (lambda (i elm) (norms))) )
     107
    99108(define (*random-normal-vector! vec mu sigma randoms)
    100109  (let ((norms (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
    101     (*random-vector! vec (lambda (i elm) (norms))) ) )
     110    (**random-normal-vector! vec norms) ) )
    102111
    103112(define (make-random-normal-vector #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     
    105114    (lambda (n)
    106115      (check-cardinal-integer 'random-normal-vector n 'length)
    107       (*random-normal-vector! (make-vector n) norms)) ) )
     116      (**random-normal-vector! (make-vector n) norms)) ) )
    108117
    109118(define (random-normal-vector! vec #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     
    118127;uniformly distributed over the surface of the unit n-sphere.
    119128
    120 (define (*random-hollow-sphere! vec mu sigma randoms)
    121   (*random-normal-vector! vec mu sigma randoms)
     129(define (**random-hollow-sphere! vec norms)
     130  (**random-normal-vector! vec norms)
    122131  (vector%-scale! vec (*inverse (sqrt (vector%-sum-squares vec)))) )
    123132
     133(define (*random-hollow-sphere! vec mu sigma randoms)
     134  (**random-hollow-sphere! vec (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)) )
     135
    124136(define (make-random-hollow-sphere #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    125   (lambda (n)
    126     (check-cardinal-integer 'random-hollow-sphere n 'length)
    127     (*random-hollow-sphere! (make-vector n) mu sigma randoms) ) )
     137  (let ((norms (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     138    (lambda (n)
     139      (check-cardinal-integer 'random-hollow-sphere n 'length)
     140      (**random-hollow-sphere! (make-vector n) norms) ) ) )
    128141
    129142(define (random-hollow-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     
    139152;squares of the numbers is returned.
    140153
     154(define (**random-solid-sphere! vec randoms norms)
     155  (**random-hollow-sphere! vec norms)
     156  (vector%-scale! vec (expt (randoms) (*inverse (vector%-length vec)))) )
     157
    141158(define (*random-solid-sphere! vec mu sigma randoms)
    142   (random-hollow-sphere! vec mu sigma randoms)
    143   (vector%-scale! vec (expt (rand) (*inverse (vector%-length vec)))) )
     159  (**random-solid-sphere! vec randoms (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)) )
    144160
    145161(define (make-random-solid-sphere #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    146   (lambda (n)
    147     (check-cardinal-integer 'random-solid-sphere n 'length)
    148     (*random-solid-sphere! (make-vector n) mu sigma randoms) ) )
     162  (let ((norms (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     163    (lambda (n)
     164      (check-cardinal-integer 'random-solid-sphere n 'length)
     165      (**random-solid-sphere! (make-vector n) randoms norms) ) ) )
    149166
    150167(define (random-solid-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
  • release/4/srfi-27/trunk/srfi-27.meta

    r17334 r17347  
    1010 (files
    1111  "tests"
    12         "fp-extn.scm"
     12        "fp-extn-w.scm"
     13        "fp-extn-wo.scm"
    1314        "thread-reaper.scm"
    1415        "thread-support.scm"
  • release/4/srfi-27/trunk/srfi-27.scm

    r17333 r17347  
    4343          chicken
    4444          (only data-structures alist-ref alist-update!)
     45          (only srfi-4 make-u8vector make-f64vector)
    4546          (only miscmacros define-parameter)
    4647          type-checks
    4748          srfi-4-checks
    48           (only type-errors error-argument-type)
     49          (only type-errors error-argument-type warning-argument-type)
    4950          random-source
    5051          entropy-source
    5152          entropy-clock
    5253          mrg32k3a
    53           (only srfi-27-numbers check-real-precision))
     54          (only srfi-27-numbers check-real-precision)
     55          (only srfi-27-vector-support u8vector-filled! f64vector-filled!))
    5456
    5557  (require-library
    56     data-structures
     58    data-structures srfi-4
    5759    miscmacros
    5860    random-source entropy-source
    5961    mrg32k3a entropy-clock
    6062    type-checks type-errors srfi-4-checks
    61     srfi-27-numbers)
     63    srfi-27-numbers srfi-27-vector-support)
    6264
    6365;;;
     
    7577(define-parameter current-entropy-source (make-entropy-source #:entropy-system-clock)
    7678  (lambda (x)
    77     (cond ((*entropy-source? x) x)
     79    (cond ((entropy-source? x) x)
    7880          (else
    7981            (warning-argument-type 'current-entropy-source x 'entropy-source)
     
    204206    (lambda (n)
    205207      (check-cardinal-integer 'make-f64vector n 'length)
    206       (u8vector-filled! (make-f64vector n) rnd) ) ) )
     208      (f64vector-filled! (make-f64vector n) rnd) ) ) )
    207209
    208210(define (random-source-make-u8vectors s)
  • release/4/srfi-27/trunk/srfi-27.setup

    r17334 r17347  
    44
    55(verify-extension-name "srfi-27")
     6
     7(required-extension-version
     8  "miscmacros"          "2.8"
     9  "vector-lib"          "1.2"
     10  "synch"               "2.1.0"
     11  "numbers"             "1.809"
     12  "check-errors"        "1.9.0")
     13
     14(if (version>=? (chicken-version) "4.3.6")
     15    (copy-file '("fp-extn-wo.scm" "fp-extn.scm") "." #t ".")
     16    (copy-file '("fp-extn-w.scm" "fp-extn.scm") "." #t ".") )
    617
    718#;(default-shared-compile-options
     
    1122    #;-no-procedure-checks)))
    1223
    13 #|
    1424(setup-shared-extension-module 'thread-support (extension-version "3.0.0")
    1525  #:compile-options '(
     
    97107    ;-debug-level 0
    98108    #;-no-procedure-checks) )
    99 |#
    100109
    101110(setup-shared-extension-module 'mrg32k3a (extension-version "3.0.0")
Note: See TracChangeset for help on using the changeset viewer.