# HG changeset patch # User Steve Losh # Date 1474912966 0 # Node ID 8f9411271fd7a224f4a8de73eec57a7b1f4600aa # Parent 66e02df8c0b36a5879999f89d86d92b2e68d0606 Add license-finding utilities diff -r 66e02df8c0b3 -r 8f9411271fd7 DOCUMENTATION.markdown --- 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. diff -r 66e02df8c0b3 -r 8f9411271fd7 losh.lisp --- 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. diff -r 66e02df8c0b3 -r 8f9411271fd7 make-docs.lisp --- 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" diff -r 66e02df8c0b3 -r 8f9411271fd7 package.lisp --- 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 diff -r 66e02df8c0b3 -r 8f9411271fd7 vendor/make-quickutils.lisp --- 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 ) diff -r 66e02df8c0b3 -r 8f9411271fd7 vendor/quickutils.lisp --- 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 ;;;;