From 5d1ce10ec8f041d7b25c27363620b7db63dff19b Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Sat, 22 Oct 2022 08:26:16 -0500
Subject: Add: utility modules

---
 definition-macros.lisp | 19 ++++++++++++++++++
 utilities.lisp         | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+)
 create mode 100644 definition-macros.lisp
 create mode 100644 utilities.lisp

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))
-- 
cgit v1.2.3