commit 2434170e506182dd40680072c67ce2c48c48d86f Author: Avril Date: Sun Apr 19 02:29:09 2020 +0100 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b25c15b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/cl-rng.asd b/cl-rng.asd new file mode 100644 index 0000000..3764a68 --- /dev/null +++ b/cl-rng.asd @@ -0,0 +1,10 @@ +;;;; cl-rng.asd + +(asdf:defsystem #:cl-rng + :description "urandom for CL" + :author "Avril (flanchan@cumallover.me)" + :license "None" + :version "0.0.1" + :serial t + :components ((:file "package") + (:file "cl-rng"))) diff --git a/cl-rng.lisp b/cl-rng.lisp new file mode 100644 index 0000000..93d2323 --- /dev/null +++ b/cl-rng.lisp @@ -0,0 +1,32 @@ +;;;; cl-rng.lisp + +(in-package #:cl-rng) + +(defun urandom (&key (limit 1.0) (precision 1) (transform nil)) + (let ((transform (or transform (lambda (x) x)))) + (with-open-file (rng "/dev/urandom" :element-type 'unsigned-byte) + (assert (> precision 0)) + (if (= precision 1) + (funcall transform (* limit (/ (read-byte rng) 255))) + (let* ((val (apply '+ (loop for i from 0 below precision collect (read-byte rng)))) + (max (* precision 255)) + (frac (/ val max))) + (values (* limit frac) frac)))))) + +(defun %urandom-vector (range &rest params) + (loop for x from 0 below (length range) collect + (setf (aref range x) (apply 'urandom params)))) + +(defun %urandom-list (range &rest params) + (setf (car range) (apply 'urandom params)) + (when (not (null (cdr range))) + (apply '%urandom-list (cons (cdr range) params)))) + +(defun urandom-range (range &rest params) + (if (listp range) + (apply '%urandom-list (cons range params)) + (apply '%urandom-vector (cons range params)))) + +(export 'urandom) +(export 'urandom-range) + diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..00fcf6f --- /dev/null +++ b/package.lisp @@ -0,0 +1,4 @@ +;;;; package.lisp + +(defpackage #:cl-rng + (:use #:cl))