--- a/DOCUMENTATION.markdown Tue Sep 20 15:34:32 2016 +0000
+++ b/DOCUMENTATION.markdown Mon Sep 26 18:02:46 2016 +0000
@@ -218,6 +218,12 @@
Utilities for figuring out what the hell is going on.
+### `AESTHETIC-STRING` (function)
+
+ (AESTHETIC-STRING THING)
+
+Return the string used to represent `thing` when printing aesthetically.
+
### `BITS` (function)
(BITS N SIZE &OPTIONAL (STREAM T))
@@ -260,6 +266,26 @@
+### `PRINT-TABLE` (function)
+
+ (PRINT-TABLE ROWS)
+
+Print `rows` as a nicely-formatted table.
+
+ Each row should have the same number of colums.
+
+ Columns will be justified properly to fit the longest item in each one.
+
+ Example:
+
+ (print-table '((1 :red something)
+ (2 :green more)))
+ =>
+ 1 | RED | SOMETHING
+ 2 | GREEN | MORE
+
+
+
### `SHUT-UP` (macro)
(SHUT-UP
@@ -268,6 +294,12 @@
Run `body` with stdout and stderr redirected to the void.
+### `STRUCTURAL-STRING` (function)
+
+ (STRUCTURAL-STRING THING)
+
+Return the string used to represent `thing` when printing structurally.
+
## Package `LOSH.DISTRIBUTIONS`
Utilities for calculating statistical... things.
@@ -453,7 +485,7 @@
### `MACROEXPAND-ITERATE` (function)
- (MACROEXPAND-ITERATE CLAUSE &OPTIONAL (COCKS :FOO))
+ (MACROEXPAND-ITERATE CLAUSE)
Macroexpand the given iterate clause/driver.
@@ -462,9 +494,44 @@
(macroexpand-iterate '(averaging (+ x 10) :into avg))
=>
(PROGN
- (FOR #:COUNT665 :FROM 0)
- (FOR AVG :FIRST (+ X 10) :THEN
- (/ (+ (* AVG #:COUNT665) (+ X 10)) (1+ #:COUNT665))))
+ (FOR #:COUNT630 :FROM 1)
+ (SUM (+ X 10) :INTO #:TOTAL631)
+ (FOR AVG = (/ #:TOTAL631 #:COUNT630)))
+
+
+
+## Package `LOSH.LICENSING`
+
+Utilities related to open source licenses.
+
+### `PRINT-LICENSES` (function)
+
+ (PRINT-LICENSES QUICKLISP-PROJECT-DESIGNATOR)
+
+Print the licenses used by the given project and its dependencies.
+
+ Note that in order to do this the project must be `quickload`ed, so you might
+ want to do this in a separate Lisp image if you don't want to clutter your
+ current one.
+
+ If the project does not specify its license in its ASDF system definition it
+ will be listed as 'Unspecified'. You should manually figure out what license
+ it uses (and maybe send a pull request).
+
+ Example:
+
+ (print-licenses 'fast-io)
+ =>
+ alexandria | Public Domain / 0-clause MIT
+ babel | MIT
+ cffi | MIT
+ cffi-grovel | MIT
+ cffi-toolchain | MIT
+ fast-io | NewBSD
+ static-vectors | MIT
+ trivial-features | MIT
+ trivial-gray-streams | MIT
+ uiop | Unspecified
@@ -494,12 +561,44 @@
Utilities related to math and numbers.
+### `1/2TAU` (variable)
+
+### `1/4TAU` (variable)
+
+### `1/8TAU` (variable)
+
+### `2/4TAU` (variable)
+
+### `2/8TAU` (variable)
+
+### `3/4TAU` (variable)
+
+### `3/8TAU` (variable)
+
+### `4/8TAU` (variable)
+
+### `5/8TAU` (variable)
+
+### `6/8TAU` (variable)
+
+### `7/8TAU` (variable)
+
### `CLAMP` (function)
(CLAMP FROM TO VALUE)
Clamp `value` between `from` and `to`.
+### `DEGREES` (function)
+
+ (DEGREES RADIANS)
+
+Convert `radians` into degrees.
+
+ The result will be the same type as `tau` and `pi`.
+
+
+
### `DIVIDESP` (function)
(DIVIDESP N DIVISOR)
@@ -556,12 +655,28 @@
+### `RADIANS` (function)
+
+ (RADIANS DEGREES)
+
+Convert `degrees` into radians.
+
+ The result will be the same type as `tau` and `pi`.
+
+
+
### `SQUARE` (function)
(SQUARE X)
### `TAU` (variable)
+### `TAU/2` (variable)
+
+### `TAU/4` (variable)
+
+### `TAU/8` (variable)
+
## Package `LOSH.MUTATION`
Utilities for mutating places in-place.
--- a/losh.lisp Tue Sep 20 15:34:32 2016 +0000
+++ b/losh.lisp Mon Sep 26 18:02:46 2016 +0000
@@ -1295,6 +1295,41 @@
,@body)))))
+(defun aesthetic-string (thing)
+ "Return the string used to represent `thing` when printing aesthetically."
+ (format nil "~A" thing))
+
+(defun structural-string (thing)
+ "Return the string used to represent `thing` when printing structurally."
+ (format nil "~S" thing))
+
+(defun print-table (rows)
+ "Print `rows` as a nicely-formatted table.
+
+ Each row should have the same number of colums.
+
+ Columns will be justified properly to fit the longest item in each one.
+
+ Example:
+
+ (print-table '((1 :red something)
+ (2 :green more)))
+ =>
+ 1 | RED | SOMETHING
+ 2 | GREEN | MORE
+
+ "
+ (when rows
+ (iterate
+ (with column-sizes =
+ (reduce (curry #'mapcar #'max)
+ (mapcar (curry #'mapcar (compose #'length #'aesthetic-string))
+ rows))) ; lol
+ (for row :in rows)
+ (format t "~{~vA~^ | ~}~%" (weave column-sizes row))))
+ (values))
+
+
;;;; Weightlists
(defstruct (weightlist (:constructor %make-weightlist))
weights sums items total)
@@ -1321,6 +1356,63 @@
(finding item :such-that (< n weight))))
+;;;; Licensing
+;;; Original code from @dk_jackdaniel:
+;;; http://paste.lisp.org/display/327154
+(defun license-tree (quicklisp-project-designator)
+ (let ((sys (ql-dist:dependency-tree quicklisp-project-designator)))
+ (assert (not (null sys)) ()
+ "Cannot find Quicklisp project for designator ~S"
+ quicklisp-project-designator)
+ (shut-up
+ (ql:quickload quicklisp-project-designator))
+ (map-tree
+ (lambda (s)
+ (vector (slot-value s 'ql-dist:name)
+ (or (asdf:system-license
+ (asdf:find-system
+ (ql-dist:system-file-name s)))
+ "Unspecified")))
+ sys)))
+
+(defun license-list (quicklisp-project-designator)
+ (remove-duplicates
+ (mapcar (rcurry #'coerce 'list)
+ (flatten (license-tree quicklisp-project-designator)))
+ :key #'car :test #'string=))
+
+(defun print-licenses (quicklisp-project-designator)
+ "Print the licenses used by the given project and its dependencies.
+
+ Note that in order to do this the project must be `quickload`ed, so you might
+ want to do this in a separate Lisp image if you don't want to clutter your
+ current one.
+
+ If the project does not specify its license in its ASDF system definition it
+ will be listed as 'Unspecified'. You should manually figure out what license
+ it uses (and maybe send a pull request).
+
+ Example:
+
+ (print-licenses 'fast-io)
+ =>
+ alexandria | Public Domain / 0-clause MIT
+ babel | MIT
+ cffi | MIT
+ cffi-grovel | MIT
+ cffi-toolchain | MIT
+ fast-io | NewBSD
+ static-vectors | MIT
+ trivial-features | MIT
+ trivial-gray-streams | MIT
+ uiop | Unspecified
+
+ "
+ (print-table (sort (license-list quicklisp-project-designator)
+ #'string<
+ :key #'car)))
+
+
;;;; Eldritch Horrors
(defmacro dlambda (&rest clauses)
;;; From Let Over Lambda.
--- a/make-docs.lisp Tue Sep 20 15:34:32 2016 +0000
+++ b/make-docs.lisp Mon Sep 26 18:02:46 2016 +0000
@@ -11,6 +11,7 @@
"LOSH.FUNCTIONS"
"LOSH.HASH-SETS"
"LOSH.ITERATE"
+ "LOSH.LICENSING"
"LOSH.LISTS"
"LOSH.MATH"
"LOSH.MUTATION"
--- a/package.lisp Tue Sep 20 15:34:32 2016 +0000
+++ b/package.lisp Mon Sep 26 18:02:46 2016 +0000
@@ -167,7 +167,10 @@
#:pr
#:bits
#:shut-up
- #:dis))
+ #:dis
+ #:aesthetic-string
+ #:structural-string
+ #:print-table))
(defpackage #:losh.weightlists
(:documentation
@@ -179,6 +182,11 @@
#:make-weightlist
#:weightlist-random))
+(defpackage #:losh.licensing
+ (:documentation "Utilities related to open source licenses.")
+ (:export
+ #:print-licenses))
+
(defpackage #:losh.eldritch-horrors
(:documentation "Abandon all hope, ye who enter here.")
(:export
@@ -200,7 +208,8 @@
#:losh.mutation
#:losh.queues
#:losh.random
- #:losh.weightlists)
+ #:losh.weightlists
+ #:losh.licensing)
(:use
#:cl
#:iterate
--- a/vendor/make-quickutils.lisp Tue Sep 20 15:34:32 2016 +0000
+++ b/vendor/make-quickutils.lisp Mon Sep 26 18:02:46 2016 +0000
@@ -4,14 +4,18 @@
"quickutils.lisp"
:utilities '(
+ :compose
:curry
:emptyp
:ensure-keyword
:ensure-list
+ :flatten
+ :map-tree
:mkstr
:once-only
:rcurry
:symb
+ :weave
:with-gensyms
)
--- a/vendor/quickutils.lisp Tue Sep 20 15:34:32 2016 +0000
+++ b/vendor/quickutils.lisp Mon Sep 26 18:02:46 2016 +0000
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :EMPTYP :ENSURE-KEYWORD :ENSURE-LIST :MKSTR :ONCE-ONLY :RCURRY :SYMB :WITH-GENSYMS) :ensure-package T :package "LOSH.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :EMPTYP :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN :MAP-TREE :MKSTR :ONCE-ONLY :RCURRY :SYMB :WEAVE :WITH-GENSYMS) :ensure-package T :package "LOSH.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "LOSH.QUICKUTILS")
@@ -14,10 +14,11 @@
(when (boundp '*utilities*)
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :CURRY :NON-ZERO-P :EMPTYP
- :ENSURE-KEYWORD :ENSURE-LIST :MKSTR
- :ONCE-ONLY :RCURRY :SYMB
- :STRING-DESIGNATOR :WITH-GENSYMS))))
+ :COMPOSE :CURRY :NON-ZERO-P :EMPTYP
+ :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN
+ :MAP-TREE :MKSTR :ONCE-ONLY :RCURRY
+ :SYMB :WEAVE :STRING-DESIGNATOR
+ :WITH-GENSYMS))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-gensym-list (length &optional (x "G"))
"Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -42,6 +43,35 @@
(fdefinition function-designator)))
) ; eval-when
+ (defun compose (function &rest more-functions)
+ "Returns a function composed of `function` and `more-functions` that applies its ;
+arguments to to each in turn, starting from the rightmost of `more-functions`,
+and then calling the next one with the primary value of the last."
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (reduce (lambda (f g)
+ (let ((f (ensure-function f))
+ (g (ensure-function g)))
+ (lambda (&rest arguments)
+ (declare (dynamic-extent arguments))
+ (funcall f (apply g arguments)))))
+ more-functions
+ :initial-value function))
+
+ (define-compiler-macro compose (function &rest more-functions)
+ (labels ((compose-1 (funs)
+ (if (cdr funs)
+ `(funcall ,(car funs) ,(compose-1 (cdr funs)))
+ `(apply ,(car funs) arguments))))
+ (let* ((args (cons function more-functions))
+ (funs (make-gensym-list (length args) "COMPOSE")))
+ `(let ,(loop for f in funs for arg in args
+ collect `(,f (ensure-function ,arg)))
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (lambda (&rest arguments)
+ (declare (dynamic-extent arguments))
+ ,(compose-1 funs))))))
+
+
(defun curry (function &rest arguments)
"Returns a function that applies `arguments` and the arguments
it is called with to `function`."
@@ -88,6 +118,28 @@
(list list)))
+ (defun flatten (&rest xs)
+ "Flatten (and append) all lists `xs` completely."
+ (labels ((rec (xs acc)
+ (cond ((null xs) acc)
+ ((consp xs) (rec (car xs) (rec (cdr xs) acc)))
+ (t (cons xs acc)))))
+ (rec xs nil)))
+
+
+ (defun map-tree (function tree)
+ "Map `function` to each of the leave of `tree`."
+ (check-type tree cons)
+ (labels ((rec (tree)
+ (cond
+ ((null tree) nil)
+ ((atom tree) (funcall function tree))
+ ((consp tree)
+ (cons (rec (car tree))
+ (rec (cdr tree)))))))
+ (rec tree)))
+
+
(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.
@@ -154,6 +206,12 @@
(values (intern (apply #'mkstr args))))
+ (defun weave (&rest lists)
+ "Return a list whose elements alternate between each of the lists
+`lists`. Weaving stops when any of the lists has been exhausted."
+ (apply #'mapcan #'list lists))
+
+
(deftype string-designator ()
"A string designator type. A string designator is either a string, a symbol,
or a character."
@@ -198,7 +256,7 @@
`(with-gensyms ,names ,@forms))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(curry emptyp ensure-keyword ensure-list mkstr once-only rcurry symb
- with-gensyms with-unique-names)))
+ (export '(compose curry emptyp ensure-keyword ensure-list flatten map-tree
+ mkstr once-only rcurry symb weave with-gensyms with-unique-names)))
;;;; END OF quickutils.lisp ;;;;