Changeset 35485 in project


Ignore:
Timestamp:
04/29/18 21:57:35 (6 months ago)
Author:
kon
Message:

add vector & registration types

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

Legend:

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

    r34867 r35485  
    1212  @source-registration-register!)
    1313
    14 (import scheme)
     14(import scheme chicken)
    1515
    16 (import chicken)
    17 
    18 (import
     16(use
    1917  (only data-structures alist-ref alist-update!)
    2018  (only srfi-1 alist-delete!)
    2119  (only type-checks define-check+error-type check-procedure check-symbol check-list))
    22 (require-library data-structures srfi-1 type-checks)
    2320
    24 ;;
     21;;;
     22
     23(include "srfi-27-common-types")
     24
     25;;; Utilities
    2526
    2627(define (alist-keys alist)
     
    3031  (map cdr alist) )
    3132
    32 ;;
     33;;; Public
    3334
     35(: *make-source-registration (source-registration-name alist procedure procedure procedure procedure --> source-registration))
     36(: source-registration? (* -> boolean : source-registration))
     37(: *source-registration-name (source-registration --> source-registration-name))
     38(: *source-registration-sources (source-registration --> alist))
     39(: *source-registration-sources-set! (source-registration alist -> void))
     40(: @source-registration-key (source-registration --> procedure))
     41(: @source-registration-ref (source-registration --> procedure))
     42(: @source-registration-deref! (source-registration --> procedure))
     43(: @source-registration-register! (source-registration --> procedure))
     44;
    3445(define-record-type source-registration
    3546  (*make-source-registration nam srcs keys ref deref! reg!)
  • release/4/srfi-27/trunk/srfi-27-common-types.scm

    r35484 r35485  
    44;; Issues
    55;;
     6
     7(define-type alist list)
    68
    79(define-type entropy-source (struct entropy-source))
     
    3638
    3739(define-type random-source-entropy-source (or boolean entropy-source))
     40
     41(define-type source-registration (struct source-registration))
     42
     43(define-type source-registration-name (or entropy-source-name random-source-name))
     44
     45(define-type srfi-27-vector (or vector f32vector f64vector))
     46
     47(define-type random-vector-function (fixnum --> vector))
  • release/4/srfi-27/trunk/srfi-27-vector-support.scm

    r35477 r35485  
    3535;;;
    3636
     37(include "srfi-27-common-types")
     38
     39;;;
     40
    3741;;
    3842
     43#;
    3944(define (make-filled! veclenf vecsetf)
    4045  (letrec (
     
    5156    self ) )
    5257
    53 #;
    5458(define (make-filled! veclenf vecsetf)
    5559  (lambda (vec gen #!optional (start 0) (end (veclenf vec)))
     
    141145;;
    142146
     147(: vector%-length (srfi-27-vector --> fixnum))
     148;
    143149(define vector%-length
    144150  (make-oper vector-length f32vector-length f64vector-length) )
    145151
     152(: vector%-mapi!/1 (srfi-27-vector procedure -> void))
     153;
    146154(define vector%-mapi!/1
    147155  ;(lambda (vec proc) (array-map! vec (cut proc #f <>)))
    148156  (make-oper vector-map!/1 f32vector-mapi!/1 f64vector-mapi!/1) )
    149157
     158(: vector%-foldi/1 (srfi-27-vector procedure * --> *))
     159;
    150160(define vector%-foldi/1
    151161  ;(lambda (vec proc seed) (array-fold (cut proc #f <> <>) seed vec))
    152162  (make-oper vector-fold/1 f32vector-foldi/1 f64vector-foldi/1) )
    153163
     164(: vector%-filled! (srfi-27-vector random-real-function #!optional fixnum fixnum -> void))
     165;
    154166(define vector%-filled!
    155167  ;(lambda (vec func) (array-fold (lambda (x y) (func)) #f vec))
    156168  (make-oper vector-filled! f32vector-filled! f64vector-filled!) )
    157169
     170(: vector%--scale! (srfi-27-vector number -> void))
     171;
    158172(define (vector%-scale! vec factor)
    159173  (vector%-mapi!/1 vec (lambda (i elt) (* elt factor))) )
    160174
     175(: vector%-sum-squares (srfi-27-vector --> number))
     176;
    161177(define (vector%-sum-squares vec)
    162178  (vector%-foldi/1 vec (lambda (i sum elt) (+ sum (* elt elt))) 0) )
  • release/4/srfi-27/trunk/srfi-27-vector.scm

    r35477 r35485  
    3131;;;
    3232
     33(include "srfi-27-common-types")
     34
     35;;;
     36
    3337#;
    34 (define (vector-iota n)
     38(define:-type (vector-iota (n fixnum)) --> (vector-of fixnum)
    3539  (import (only vector-lib vector-unfold))
    3640  (vector-unfold values n) )
    3741
     42(: vector-iota! (vector fixnum -> void))
     43;
    3844(define (vector-iota! vec n)
    3945  (do ((i 0 (fx+ i 1)))
     
    6369        (vector-set! vec j xi) ) ) ) )
    6470
     71(: make-random-permutations (#!rest --> random-vector-function))
     72;
    6573(define (make-random-permutations #!key (randoms (current-random-integer)))
    6674  (lambda (n)
     
    7179      (check-procedure 'make-random-permutations randoms 'randoms))) )
    7280
     81(: random-permutation! (srfi-27-vector #!rest -> void))
     82;
    7383(define (random-permutation! vec #!key (randoms (current-random-integer)))
    7484  (*random-permutation!
     
    7888;;
    7989
     90(: make-random-vector (#!rest --> random-vector-function))
     91;
    8092(define (make-random-vector #!key (randoms (current-random-real)))
    8193  (lambda (n)
     
    8597      (check-procedure 'make-random-vector randoms 'randoms))) )
    8698
     99(: random-vector! (srfi-27-vector #!rest -> void))
     100;
    87101(define (random-vector! vec #!key (randoms (current-random-real)))
    88102  (vector%-filled!
     
    106120(define (*random-hollow-sphere! vec mu sigma randoms)
    107121  (let-values (
    108       ((norms pl)
    109         (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     122    ((norms pl) (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)) )
    110123    (**random-hollow-sphere! vec norms) ) )
    111124
     125(: make-random-hollow-sphere (#!rest --> vector))
     126;
    112127(define (make-random-hollow-sphere #!key (mu 0.0) (sigma 1.0) (randoms (current-random-real)))
    113128  (let-values (
    114       ((norms pl)
    115         (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     129    ((norms pl) (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)) )
    116130    (lambda (n)
    117131      (**random-hollow-sphere!
     
    119133        norms) ) ) )
    120134
     135(: random-hollow-sphere! (srfi-27-vector #!rest -> void))
     136;
    121137(define (random-hollow-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (current-random-real)))
    122138  (*random-hollow-sphere!
     
    138154(define (*random-solid-sphere! vec mu sigma randoms)
    139155  (let-values (
    140       ((norms pl)
    141         (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     156    ((norms pl) (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)) )
    142157    (**random-solid-sphere! vec randoms norms) ) )
    143158
     159(: make-random-solid-sphere (#!rest --> vector))
     160;
    144161(define (make-random-solid-sphere #!key (mu 0.0) (sigma 1.0) (randoms (current-random-real)))
    145162  (let-values (
    146       ((norms pl)
    147         (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     163    ((norms pl) (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)) )
    148164    (lambda (n)
    149165      (**random-solid-sphere!
     
    151167        randoms norms) ) ) )
    152168
     169(: random-solid-sphere! (srfi-27-vector #!rest -> void))
     170;
    153171(define (random-solid-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (current-random-real)))
    154172  (*random-solid-sphere!
Note: See TracChangeset for help on using the changeset viewer.