Changeset 33848 in project for release/4/srfi-27/trunk/srfi-27.scm

Timestamp:

02/11/17 16:41:38 (3 years ago)

Author:

Kon Lovett

Message:

re-flow, add "catalog" supp

File:

• release/4/srfi-27/trunk/srfi-27.scm (modified) (5 diffs)

release/4/srfi-27/trunk/srfi-27.scm

@@ -75 +75 @@
 (define-parameter current-entropy-source default-entropy-source
   (lambda (x)
-    (cond ((entropy-source? x) x)
-          (else
-            (warning-argument-type 'current-entropy-source x 'entropy-source)
-            (current-entropy-source) ) ) ) )
-
+    (cond
+      ((entropy-source? x)
+        x)
+      (else
+        (warning-argument-type 'current-entropy-source x 'entropy-source)
+        (current-entropy-source) ) ) ) )
+
+(define make-entropy-source
+  (case-lambda
+    (()
+      ((@entropy-source-constructor (current-entropy-source))) )
+    ((es)
+      (let ((ctor
+              (cond
+                ((entropy-source? es)
+                  (@entropy-source-constructor es) )
+                ((symbol? es)
+                  (let ((ctor (registered-entropy-source es)))
+                    (or
+                      ctor
+                      (error 'make-entropy-source "unregistered entropy-source name" es) ) ) )
+                (else
+                  (error-argument-type
+                    'make-entropy-source es
+                    "valid entropy-source or registered entropy-source name") ) ) ) )
+        (ctor) ) ) ) )
+
+#;
 (define (make-entropy-source #!optional (es (current-entropy-source)))
   (let ((ctor
           (cond
-            ((entropy-source? es) (@entropy-source-construtor es) )
-            ((symbol? es)         (registered-entropy-source es) )
+            ((entropy-source? es)
+              (@entropy-source-constructor es) )
+            ((symbol? es)
+              (registered-entropy-source es) )
             (else
               (error-argument-type
@@ -93 +118 @@
 (define (new-entropy-source es)
   (check-entropy-source 'new-entropy-source es)
-  ((@entropy-source-construtor es)) )
+  ((@entropy-source-constructor es)) )
 
 (define (entropy-source-name es)
@@ -131 +156 @@
     (lambda (n)
       (check-cardinal-integer 'make-u8vector n 'length)
-      (u8vector-filled! (make-u8vector n) (lambda () (modulo (rndint) 256))) ) ) )
+      (u8vector-filled! (make-u8vector n) (lambda () (rndint 256))) ) ) )
 
 (define (*random-source-make-f64vectors rs prec)
@@ -159 +184 @@
 (define-parameter current-random-source default-random-source
   (lambda (x)
-    (cond ((random-source? x) x)
-          (else
-            (warning-argument-type 'current-random-source x 'random-source)
-            (current-random-source) ) ) ) )
-
+    (cond
+      ((random-source? x)
+        x)
+      (else
+        (warning-argument-type 'current-random-source x 'random-source)
+        (current-random-source) ) ) ) )
+
+(define make-random-source
+  (case-lambda
+    (()
+      ((@random-source-constructor (current-random-source))) )
+    ((es)
+      (let ((ctor
+              (cond
+                ((random-source? es)
+                  (@random-source-constructor es) )
+                ((symbol? es)
+                  (registered-random-source es) )
+                (else
+                  (error-argument-type
+                    'make-random-source es
+                    "valid random-source or registered random-source name") ) ) ) )
+        (ctor) ) ) ) )
+
+#;
 (define (make-random-source #!optional (es (current-random-source)))
   (let ((ctor
           (cond
-            ((random-source? es)  (@random-source-construtor es) )
-            ((symbol? es)         (registered-random-source es) )
+            ((random-source? es)
+              (@random-source-constructor es) )
+            ((symbol? es)
+              (registered-random-source es) )
             (else
               (error-argument-type
@@ -177 +224 @@
 (define (new-random-source es)
   (check-random-source 'new-random-source es)
-  ((@random-source-construtor es)) )
+  ((@random-source-constructor es)) )
 
 (define (random-source-name rs)