Browse Source

First commit

master
Michael Fiano 4 years ago
commit
6ec8ff3f6d
  1. 21
      LICENSE
  2. 27
      README.md
  3. 59
      src/filesystem.lisp
  4. 51
      src/list-alist.lisp
  5. 49
      src/list-plist.lisp
  6. 1
      src/list.lisp
  7. 11
      src/macro.lisp
  8. 48
      src/package.lisp
  9. 22
      src/sequence.lisp
  10. 7
      src/string.lisp
  11. 6
      src/symbol.lisp
  12. 13
      src/type.lisp

21
LICENSE

@ -0,0 +1,21 @@
MIT License
Copyright (c) Michael Fiano
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

27
README.md

@ -0,0 +1,27 @@
# Golden
Auxiliary Utilities (AU).
## Overview
TODO
## Install
This system is not yet available to be installed automatically with Quicklisp. To manually install
using Quicklisp, clone this repository into your local-projects directory and issue the following in
your REPL:
```lisp
(ql:quickload :golden)
```
## Usage
TODO
## License
Copyright © 2017-2018 Michael Fiano <mail@michaelfiano.com>
Licensed under the MIT License.

59
src/filesystem.lisp

@ -0,0 +1,59 @@
(in-package :au)
(deftype octet () '(unsigned-byte 8))
(defmacro with-binary-input ((stream file) &body body)
`(with-open-file (,stream ,file :direction :input
:if-does-not-exist :error
:element-type 'octet)
,@body))
(defmacro with-binary-output ((stream file) &body body)
`(with-open-file (,stream ,file :direction :output
:if-exists :supersede
:if-does-not-exist :create
:element-type 'octet)
,@body))
(defun resolve-path (system &optional path)
"Resolve the absolute path of the filesystem where `PATH` is located, relative to the ASDF system,
`SYSTEM`, or relative to the program location in the case of running a dumped Lisp image from the
command line.
Note: A dumped image must have either been created with UIOP:DUMP-IMAGE, or have manually set
UIOP/IMAGE:*IMAGE-DUMPED-P* prior to dumping."
(if uiop/image:*image-dumped-p*
(truename (uiop/pathname:merge-pathnames*
path
(uiop:pathname-directory-pathname (uiop:argv0))))
(asdf/system:system-relative-pathname (asdf:find-system system) path)))
(defun map-files (path function &key (test (constantly t)) (recursive? t))
"Map over all files located in the directory of `PATH`, applying `FUNCTION` to each file's path.
`TEST` is a function that takes a file path and decides if `FUNCTION` should be applied to it.
`RECURSIVE?`, when non-NIL will descend into sub-directories of `PATH` recursively."
(labels ((process-files (dir)
(map nil
(lambda (x)
(when (funcall test x)
(funcall function x)))
(uiop/filesystem:directory-files dir))))
(uiop/filesystem:collect-sub*directories
(uiop/pathname:ensure-directory-pathname path) t recursive? #'process-files)))
(defun safe-read-file-form (path &key (package :cl))
"Read the first form of the file located at `PATH`, with *PACKAGE* bound to `PACKAGE`."
(with-standard-io-syntax
(let ((*package* (find-package package))
(*read-eval* nil))
(with-open-file (in path)
(read in)))))
(defun safe-read-file (path &key (package :cl))
"Read all forms of the file located at `PATH`, with *PACKAGE* bound to `PACKAGE`."
(with-standard-io-syntax
(let ((*package* (find-package package))
(*read-eval* nil))
(with-open-file (in path)
(loop :for form = (read in nil in)
:until (eq form in)
:collect form)))))

51
src/list-alist.lisp

@ -0,0 +1,51 @@
;;;; Association lists.
;;;; Various functions dealing with association lists.
(in-package :au)
(deftype alist () '(satisfies alistp))
(defun alist-get (alist key &rest args)
"Get the value associated with `KEY` in `ALIST`."
(let ((cell (apply #'assoc key alist args)))
(values (cdr cell) cell)))
(defun alist-rget (alist value &rest args)
"Get the key associated with `VALUE` in `ALIST`."
(let ((cell (apply #'rassoc value alist args)))
(values (car cell) cell)))
(defun alist-remove (alist &rest keys &key test &allow-other-keys)
"Remove all `KEYS` and their associated values from `ALIST`. Non-destructive."
(remove-if
(lambda (x)
(find (car x) keys :test test))
alist))
(defun alist-keys (alist)
"Get a list of all keys in `ALIST`."
(mapcar #'car alist))
(defun alist-values (alist)
"Get a list of all values in `ALIST`."
(mapcar #'cdr alist))
(defun alist->plist (alist)
"Convert `ALIST` to a property list. A property list in this context has keyword symbols for its odd
elements."
(mapcan
(lambda (x)
(list (make-keyword (car x)) (cdr x)))
alist))
(defun alist->hash (alist &rest args)
"Convert `ALIST` to a hash table."
(let ((table (apply #'make-hash-table args)))
(dolist (cell alist)
(setf (gethash (car cell) table) (cdr cell)))
table))
(defun alist? (item)
"Check whether or not `ITEM` is an association list."
(and (listp item)
(every #'consp item)))

49
src/list-plist.lisp

@ -0,0 +1,49 @@
;;;; Property lists
;;;; Various functions dealing with property lists.
;;;; Note: Property lists in the context of this library are defined as a list of an even number of
;;;; elements, where even indices hold keyword symbols.
(in-package :au)
(deftype plist () '(satisfies plist?))
(defun plist-get (plist key)
"Get the value associated with `KEY` in `PLIST`."
(getf plist key))
(defun plist-remove (plist &rest keys)
"Remove all `KEYS` and their associated values from `PLIST`. Non-destructive."
(loop :for (key value) :on plist :by #'cddr
:unless (member key keys :test #'eq)
:append (list key value)))
(defun plist-keys (plist)
"Get a list of all keys in `PLIST`."
(loop :for (key value) :on plist :by #'cddr
:collect key))
(defun plist-values (plist)
"Get a list of all values in `PLIST`."
(loop :for (key value) :on plist :by #'cddr
:collect value))
(defun plist->alist (plist)
"Convert `PLIST` to an association list."
(loop :for (key value) :on plist :by #'cddr
:collect (cons key value)))
(defun plist->hash (plist &rest args)
"Convert `PLIST` to a hash table."
(let ((table (apply #'make-hash-table args)))
(loop :for (key value) :on plist :by #'cddr
:do (setf (gethash key table) value))
table))
(defun plist? (item)
"Check whether or not `ITEM` is a property list."
(and (listp item)
(evenp (length item))
(every
#'keywordp
(loop :for element :in item :by #'cddr
:collect element))))

1
src/list.lisp

@ -0,0 +1 @@
(in-package :au)

11
src/macro.lisp

@ -0,0 +1,11 @@
(in-package :au)
(defmacro define-printer ((object stream &key (type t) identity) &body body)
(alexandria:with-gensyms (object-symbol)
`(defmethod print-object ((,object-symbol ,object) ,stream)
(print-unreadable-object (,object-symbol ,stream :type ,type :identity ,identity)
,@body))))
(defmacro eval-always (&body body)
"Evaluate `BODY` always."
`(eval-when (:compile-toplevel :load-toplevel :execute) ,@body))

48
src/package.lisp

@ -0,0 +1,48 @@
(in-package :cl-user)
(defpackage+-1:defpackage+ #:au
(:use #:cl)
(:export-only
;; macros
#:define-printer
#:eval-always
;; sequences
#:flatten
#:flatten-numbers
;; lists
;; association lists
#:alist
#:alist-get
#:alist-rget
#:alist-remove
#:alist-keys
#:alist-values
#:alist->plist
#:alist->hash
#:alist?
;; property lists
#:plist
#:plist-get
#:plist-remove
#:plist-keys
#:plist-values
#:plist->alist
#:plist->hash
#:plist?
;; strings
#:split-string
;; types
#:b8
#:ub8
#:b16
#:ub16
#:b32
#:ub32
;; filesystem
#:octet
#:with-binary-input
#:with-binary-output
#:resolve-path
#:map-files
#:safe-read-file-form
#:safe-read-file))

22
src/sequence.lisp

@ -0,0 +1,22 @@
(in-package :au)
(defun flatten (sequence)
(let ((list))
(labels ((traverse (sub-tree)
(when sub-tree
(typecase sub-tree
(cons
(traverse (car sub-tree))
(traverse (cdr sub-tree)))
(vector
(map nil #'traverse sub-tree))
(t (push sub-tree list))))))
(traverse sequence))
(nreverse list)))
(defun flatten-numbers (sequence &key (type 'single-float))
(flet ((%coerce (sequence)
(mapcar (lambda (x) (coerce x type))
(remove-if (complement #'realp) (flatten sequence)))))
(let ((sequence (%coerce sequence)))
(make-array (length sequence) :element-type type :initial-contents sequence))))

7
src/string.lisp

@ -0,0 +1,7 @@
(in-package :au)
(defun split-string (string delimiter)
"Split `STRING` into 2 values on the boundary `DELIMITER`."
(let ((pos (position delimiter string)))
(values (subseq string 0 pos)
(subseq string (1+ pos)))))

6
src/symbol.lisp

@ -0,0 +1,6 @@
(in-package :au)
(defun make-keyword (name)
(etypecase name
((or symbol string number)
(alexandria:format-symbol :keyword "~:@(~a~)" name))))

13
src/type.lisp

@ -0,0 +1,13 @@
(in-package :au)
(deftype b8 () '(signed-byte 8))
(deftype ub8 () '(unsigned-byte 8))
(deftype b16 () '(signed-byte 16))
(deftype ub16 () '(unsigned-byte 16))
(deftype b32 () '(signed-byte 32))
(deftype ub32 () '(unsigned-byte 32))
Loading…
Cancel
Save