add types, fix vector-copy! shadowing

1 files changed, 63 insertions, 10 deletions

diff --git a/194-impl.scm b/194-impl.scm
index ae98046..0d95073 100644
--- a/194-impl.scm
+++ b/194-impl.scm
@@ -2,6 +2,13 @@
 ; SPDX-FileCopyrightText: 2020 Bradley Lucier
 ; SPDX-License-Identifier: MIT
 
+(define-syntax proj1
+  ;; Return the first returned value after evaluating `expr`.
+  (syntax-rules ()
+    ((proj1 expr)
+     (let-values (((returned second) expr))
+       returned))))
+
 ;;
 ;; This parameter is defined by the srfi-27 egg.
 ;;
@@ -23,6 +30,7 @@
 ;; https://doi.org/10.1287/opre.50.6.1073.358
 ;;
 
+(: make-random-source-generator (integer -> (-> *)))
 (define (make-random-source-generator s)
   (if (not (and (exact? s)
                 (integer? s)
@@ -39,29 +47,48 @@
 ;; Primitive randoms
 ;;
 
+(: make-random-integer-generator (integer integer -> (-> integer)))
 (define (make-random-integer-generator low-bound up-bound)
-  (make-uniform-random-integers high: (- up-bound 1)
-                                low: low-bound))
+  (proj1 (make-uniform-random-integers high: (- up-bound 1)
+                                       low: low-bound)))
 
+(: make-random-u1-generator (-> (-> integer)))
 (define (make-random-u1-generator)
   (make-random-integer-generator 0 2))
+
+(: make-random-u8-generator (-> (-> integer)))
 (define (make-random-u8-generator)
   (make-random-integer-generator 0 256))
+
+(: make-random-s8-generator (-> (-> integer)))
 (define (make-random-s8-generator)
   (make-random-integer-generator -128 128))
+
+(: make-random-u16-generator (-> (-> integer)))
 (define (make-random-u16-generator)
   (make-random-integer-generator 0 65536))
+
+(: make-random-s16-generator (-> (-> integer)))
 (define (make-random-s16-generator)
   (make-random-integer-generator -32768 32768))
+
+(: make-random-u32-generator (-> (-> integer)))
 (define (make-random-u32-generator)
   (make-random-integer-generator 0 (expt 2 32)))
+
+(: make-random-s32-generator (-> (-> integer)))
 (define (make-random-s32-generator)
   (make-random-integer-generator (- (expt 2 31)) (expt 2 31)))
+
+(: make-random-u64-generator (-> (-> integer)))
 (define (make-random-u64-generator)
   (make-random-integer-generator 0 (expt 2 64)))
+
+(: make-random-s64-generator (-> (-> integer)))
 (define (make-random-s64-generator)
   (make-random-integer-generator (- (expt 2 63)) (expt 2 63)))
 
+(: clamp-real-number (number number number --> number))
 (define (clamp-real-number lower-bound upper-bound value)
   (cond ((not (real? lower-bound))
          (error "expected real number for lower bound"))
@@ -73,6 +100,8 @@
         ((> value upper-bound) upper-bound)
         (else value)))
 
+(: make-random-real-generator
+   (number number -> (-> float)))
 (define (make-random-real-generator low-bound up-bound)
   (unless (and (real? low-bound)
                (finite? low-bound))
@@ -91,6 +120,8 @@
      (+ (* t low-bound)
         (* (- 1.0 t) up-bound)))))
 
+(: make-random-rectangular-generator
+   (number number number number -> (-> cplxnum)))
 (define (make-random-rectangular-generator
           real-lower-bound real-upper-bound
           imag-lower-bound imag-upper-bound)
@@ -99,6 +130,8 @@
     (lambda ()
       (make-rectangular (real-gen) (imag-gen)))))
 
+;;; TODO: How to type optional arguments that appear in the front in
+;;; CHICKEN?
 (define make-random-polar-generator
   (case-lambda
     ((magnitude-lower-bound magnitude-upper-bound)
@@ -132,8 +165,11 @@
                 (r (sqrt (+ (* m t) b))))
           (+ origin (make-polar r phi))))))))
 
-(define (make-random-boolean-generator) (make-random-bernoullis))
+(: make-random-boolean-generator (-> (-> boolean)))
+(define (make-random-boolean-generator)
+  (proj1 (make-random-bernoullis)))
 
+(: make-random-char-generator (string -> (-> char)))
 (define (make-random-char-generator str)
   (when (not (string? str))
     (error "expected string"))
@@ -143,6 +179,7 @@
    (lambda ()
      (string-ref str (int-gen)))))
 
+(: make-random-string-generator (integer string -> (-> string)))
 (define (make-random-string-generator k str)
   (let ((char-gen (make-random-char-generator str))
         (int-gen (make-random-integer-generator 0 k)))
@@ -153,20 +190,25 @@
 ;; Non-uniform distributions
 ;;
 
+(: PI float)
 (define PI (* 4 (atan 1.0)))
 
+(: make-bernoulli-generator (#!optional number * -> (-> fixnum)))
 (define make-bernoulli-generator
   (case-lambda
     (() (make-bernoulli-generator 1/2 (current-random-real)))
     ((p) (make-bernoulli-generator p (current-random-real)))
     ((p source)
      (gmap (lambda (x) (if x 1 0))
-           (make-random-bernoullis p: p randoms: source)))))
+           (proj1 (make-random-bernoullis p: p randoms: source))))))
 
+(: make-binomial-generator (number number -> (-> number)))
 (define (make-binomial-generator n p)
-  ;; Already in CHICKEN's SRFI-27
-  (make-random-binomials t: n p: p randoms: (current-random-real)))
+  (proj1
+   (make-random-binomials t: n p: p randoms: (current-random-real))))
 
+(: make-categorical-generator
+   ((vector-of number) -> (-> integer)))
 (define (make-categorical-generator weights-vec)
   (define weight-sum
     (vector-fold
@@ -191,14 +233,20 @@
            (it newsum
                (+ i 1)))))))
 
+(: make-normal-generator
+   (#!optional number number -> (-> number)))
 (define make-normal-generator
   (case-lambda
     (() (make-normal-generator #i0 #i1))
     ((mean) (make-normal-generator mean #i1))
     ((mean deviation)
-     (make-random-normals mu: mean sigma: deviation
-                          randoms: (current-random-real)))))
+     (proj1
+      (make-random-normals mu: mean sigma: deviation
+                           randoms: (current-random-real))))))
 
+;;; NOTE: Chicken's SRFI-27 has an exponential generator, but for
+;;; some reason it is limited to means between 0 and 1.
+(: make-exponential-generator (number -> (-> number)))
 (define (make-exponential-generator mean)
   (unless (and (real? mean)
                (finite? mean)
@@ -208,12 +256,17 @@
    (lambda ()
      (- (* mean (log (rand-real-proc)))))))
 
+(: make-geometric-generator (number -> (-> number )))
 (define (make-geometric-generator p)
-  (make-random-geometrics p: p randoms: (current-random-real)))
+  (proj1
+   (make-random-geometrics p: p randoms: (current-random-real))))
 
+(: make-poisson-generator (number -> (-> number)))
 (define (make-poisson-generator L)
-  (make-random-poissons mu: L random: (current-random-real)))
+  (proj1
+   (make-random-poissons mu: L random: (current-random-real))))
 
+(: gsampling (#!rest (-> *) -> (-> *)))
 (define (gsampling . generators-lst)
   (let ((gen-vec (list->vector generators-lst))
         (rand-int-proc (random-source-make-integers (current-random-source))))