1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
;;;; 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 default-name (kind)
(format nil "~a" (gensym kind)))
(defun take (n list &optional 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 &optional share-tail)
"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, the element is inserted from the back of
the list. If the abslute value of -N is greater than the lenght of
the list, a list just containing X is returned."
(when (minusp n)
(setf n (+ 1 n (length list))))
(multiple-value-bind (front back) (take n list share-tail)
(nconc front (cons x back))))
(defun remove-nth (n list &optional share-tail)
"Removes Nth member of list. Returns two values.
The first value is the new list with the Nth member removed. The
second value is the removed item.
See insert-nth for a description of the behavior of negative values
of N, and for documentation on SHARE-TAIL."
(when (minusp n)
(setf n (+ n (length list))))
(multiple-value-bind (front back) (take n list share-tail)
(values
(nconc front (cdr back))
(car 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))
(defmacro alambda (&body body)
"Anaphoric lambda of one argument"
`(lambda (it)
(declare (ignorable it))
,@body))
(defun tmp-dir-name ()
(merge-pathnames
(format nil "~a/" (gensym "tmpdir"))
(uiop:temporary-directory)))
(defmacro with-temp-dir ((dir) &body body)
"Create temporary directory and bind its full path name to the variable DIR"
`(let ((,dir (tmp-dir-name)))
(ensure-directories-exist ,dir)
(unwind-protect
(progn ,@body)
(uiop:delete-directory-tree ,dir :validate t))))
(defun read-from-file (path)
(read-from-string
(alexandria:read-file-into-string path)))
|
