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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
;;;; 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 hash-string (plaintext salt)
"Hash plaintext using SALT"
(flexi-streams:octets-to-string
(ironclad:digest-sequence
:sha3
(flexi-streams:string-to-octets (concatenate 'string salt plaintext)
:external-format :utf-8))
:external-format :latin1))
(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 thunk* (&body body)
"Returns a lambda of any number of arguments where those arguments
are ignored."
(let ((args (gensym)) )
`(lambda (&rest ,args)
(declare (ignorable ,args))
,@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)))
(defun secs-to-hms (secs)
(setf secs (round secs))
(let ((hours (floor (/ secs (* 60 60))))
(mins (floor (/ (mod secs (* 60 60))
60)))
(secs (mod secs 60)))
(if (plusp hours)
(format nil "~a:~2,'0d:~2,'0d"
hours mins secs)
(format nil "~a:~2,'0d"
mins secs))))
(defun <?> (pred then else)
(lambda (&rest args)
(if (apply pred args)
(apply then args)
(apply else args))))
(defun clean-filename (str)
(let ((non-safe-chars (cl-ppcre:create-scanner "[^a-zA-Z0-9_\\-.]")))
(cl-ppcre:regex-replace-all non-safe-chars str "-")))
|
