diff options
| -rw-r--r-- | definition-macros.lisp | 19 | ||||
| -rw-r--r-- | utilities.lisp | 53 |
2 files changed, 72 insertions, 0 deletions
diff --git a/definition-macros.lisp b/definition-macros.lisp new file mode 100644 index 0000000..6ecda6d --- /dev/null +++ b/definition-macros.lisp @@ -0,0 +1,19 @@ +;;;; definition-macros.lisp + +(in-package :vampire) + +(defmacro defclass/bknr (name supers slotdefs &rest options) + "Defines a class using defclass/std syntax. Ensures that the class + is a sublcas of STORE-OBJECT with metaclass PERSISTENT-CLASS." + (let* ((include-store-object-p + (notany (lambda (c) (closer-mop:subclassp c 'store-object)) + supers)) + (supers + (if include-store-object-p + `(store-object ,@supers) + supers))) + `(eval-when (:compile-toplevel) + (defclass/std ,name ,supers + ,slotdefs + (:metaclass persistent-class) + ,@options)))) diff --git a/utilities.lisp b/utilities.lisp new file mode 100644 index 0000000..972df8a --- /dev/null +++ b/utilities.lisp @@ -0,0 +1,53 @@ +;;;; utilities.lisp + +(in-package #:vampire) + +(let ((host (uiop:hostname)) + (count 0)) + (defun nuid () + "Generates a Nearly Universal ID" + (format nil "~36r" + (sxhash + (list + (incf count) + host + (get-universal-time)))))) + +(defun take (n list &key share-tail) + "Returns two values. The first value returned is a list of the first + N members of LIST. The second value is a list of the remaining + values of list. + + If N is negative, NIL is returned for both values. If N is greater + than the length of LIST then the entire list is returned. + + If SHARE-TAIL is non-nil, the second value will + share memory with LIST, otherwise a copy is returned." + (if (zerop n) + (values nil (if share-tail list (copy-seq list))) + (loop repeat n + for (h . tail) on list + collect h into front + finally + (return (values front + (if share-tail + tail + (copy-seq tail))))))) + +(defun insert-nth (x n list) + "Creates a new list, the result of inserting X into the Nth position + of LIST, displacing the rest of the elements by one position. If N + is greater than the length of LIST, X becomes the last element of + LIST. If N is negative, a list containing just X is returned." + (multiple-value-bind (front back) (take n list) + ;; NCONC ok b/c this call to TAKE returns values that do not shre + ;; memory with LIST + (nconc front (cons x back)))) + +(defun nswap (list n m) + "Swap Nth and Mth members of LIST. Mutates LIST. Assumes both N and + M are less than the length of LIST." + (let ((tmp (nth n list))) + (setf (nth n list) (nth m list) + (nth m list) tmp) + list)) |