# HG changeset patch # User Steve Losh # Date 1504914147 14400 # Node ID d997d6e268a3e497c3bec35127aa2f0af23703e6 # Parent 1915a3dcf4107b0e5743e772c6a1cff0812ee65d Add `cl-variates` to test script (it's bad) diff -r 1915a3dcf410 -r d997d6e268a3 build/pcg.ros --- 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) diff -r 1915a3dcf410 -r d997d6e268a3 vendor/make-quickutils.lisp --- 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") diff -r 1915a3dcf410 -r d997d6e268a3 vendor/quickutils.lisp --- 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 ;;;;