d997d6e268a3

Add `cl-variates` to test script (it's bad)
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 08 Sep 2017 19:42:27 -0400
parents 1915a3dcf410
children f4d8d363a9dc
branches/tags (none)
files build/pcg.ros vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

--- a/build/pcg.ros	Thu Apr 06 20:07:56 2017 +0000
+++ b/build/pcg.ros	Fri Sep 08 19:42:27 2017 -0400
@@ -8,54 +8,58 @@
 (unless (find-package :pcg)
   (ql:quickload '(:cl-pcg) :silent t))
 
+(unless (find-package :cl-variates)
+  (ql:quickload '(:cl-variates) :silent t))
+
 (require 'sb-rotate-byte)
 
 (declaim (optimize (debug 0) (safety 0) (speed 3)))
 
 (let ((*standard-output* (make-broadcast-stream)) ; shut
       (*error-output* (make-broadcast-stream))) ; up
-  (asdf:load-system 'cl-pcg :force t))
+  (asdf:load-system 'cl-pcg :force t)
+  (asdf:load-system 'cl-variates :force t))
 
 
 (deftype u32 () '(unsigned-byte 32))
 (defconstant +buffer-size+ (* 1 1024))
 
-(defun pcg-dump-data ()
-  (with-open-file (out "/dev/stdout"
-                       :direction :output
-                       :if-exists :append
-                       :element-type 'u32)
-    (loop
-      :with pcg = (pcg::make-pcg :seed (random (expt 2 32)) :stream-id 0)
-      :with buffer = (make-array +buffer-size+
-                       :element-type t
-                       :initial-element 0)
-      :do (loop :for i :from 0 :below +buffer-size+
-                :for n = (pcg::pcg-random% pcg)
-                :do (setf (aref buffer i) n))
-      (write-sequence buffer out))))
+(defmacro define-dumper (name (generator-name make-generator-form) generate-form)
+  (pcg.quickutils:with-gensyms
+    (output-stream buffer i)
+    `(defun ,name ()
+       (with-open-file (,output-stream "/dev/stdout"
+                                       :direction :output
+                                       :if-exists :append
+                                       :element-type 'u32)
+         (loop
+           :with ,generator-name = ,make-generator-form
+           :with ,buffer = (make-array +buffer-size+
+                                       :element-type t
+                                       :initial-element 0)
+           :do (loop :for ,i :from 0 :below +buffer-size+
+                     :do (setf (aref ,buffer ,i) ,generate-form))
+           (write-sequence ,buffer ,output-stream))))))
 
-(defun random-dump-data ()
-  (with-open-file (out "/dev/stdout"
-                       :direction :output
-                       :if-exists :append
-                       :element-type 'u32)
-    (loop
-      :with rs = (make-random-state t)
-      :with buffer = (make-array +buffer-size+
-                       :element-type 'u32
-                       :initial-element 0)
-      :do (loop :for i :from 0 :below +buffer-size+
-                :for n = (random (expt 2 32) rs)
-                :do (setf (aref buffer i) n))
-      (write-sequence buffer out))))
+(define-dumper variates-dump-data
+    (gen (cl-variates:make-random-number-generator (random (expt 2 32))))
+  (cl-variates:integer-random gen 0 (expt 2 32)) )
+
+(define-dumper pcg-dump-data
+    (pcg (pcg::make-pcg :seed (random (expt 2 32)) :stream-id 0))
+  (pcg::pcg-random% pcg))
+
+(define-dumper random-dump-data
+    (rs (make-random-state t))
+  (random (expt 2 32) rs))
 
 (defun main (&optional generator &rest argv)
   (declare (ignore argv))
   (setf *random-state* (make-random-state t))
   (handler-case
-      (if (string= generator "random")
-        (random-dump-data)
-        (pcg-dump-data))
+      (cond
+        ((string= generator "random") (random-dump-data))
+        ((string= generator "variates") (variates-dump-data))
+        (t (pcg-dump-data)))
     (stream-error () t))
   t)
--- a/vendor/make-quickutils.lisp	Thu Apr 06 20:07:56 2017 +0000
+++ b/vendor/make-quickutils.lisp	Fri Sep 08 19:42:27 2017 -0400
@@ -5,6 +5,7 @@
   :utilities '(
 
                :symb
+               :with-gensyms
 
                )
   :package "PCG.QUICKUTILS")
--- a/vendor/quickutils.lisp	Thu Apr 06 20:07:56 2017 +0000
+++ b/vendor/quickutils.lisp	Fri Sep 08 19:42:27 2017 -0400
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:SYMB) :ensure-package T :package "PCG.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:SYMB :WITH-GENSYMS) :ensure-package T :package "PCG.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "PCG.QUICKUTILS")
@@ -13,7 +13,8 @@
 (in-package "PCG.QUICKUTILS")
 
 (when (boundp '*utilities*)
-  (setf *utilities* (union *utilities* '(:MKSTR :SYMB))))
+  (setf *utilities* (union *utilities* '(:MKSTR :SYMB :STRING-DESIGNATOR
+                                         :WITH-GENSYMS))))
 
   (defun mkstr (&rest args)
     "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
@@ -31,7 +32,51 @@
 See also: `symbolicate`"
     (values (intern (apply #'mkstr args))))
   
+
+  (deftype string-designator ()
+    "A string designator type. A string designator is either a string, a symbol,
+or a character."
+    `(or symbol string character))
+  
+
+  (defmacro with-gensyms (names &body forms)
+    "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+    (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+    (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+    `(let ,(mapcar (lambda (name)
+                     (multiple-value-bind (symbol string)
+                         (etypecase name
+                           (symbol
+                            (values name (symbol-name name)))
+                           ((cons symbol (cons string-designator null))
+                            (values (first name) (string (second name)))))
+                       `(,symbol (gensym ,string))))
+            names)
+       ,@forms))
+
+  (defmacro with-unique-names (names &body forms)
+    "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+    (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+    (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+    `(with-gensyms ,names ,@forms))
+  
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(symb)))
+  (export '(symb with-gensyms with-unique-names)))
 
 ;;;; END OF quickutils.lisp ;;;;