136 lines
3.7 KiB
Common Lisp
136 lines
3.7 KiB
Common Lisp
;;;; kutils.lisp
|
|
|
|
(in-package #:kutils)
|
|
|
|
;;; "kutils" goes here. Hacks and glory await!
|
|
|
|
;;; This file contains various utilities I've written.
|
|
|
|
(defun take (n lst)
|
|
"Take n elements from lst."
|
|
(labels ((rec (n lst acc)
|
|
(if (or (zerop n) (null lst))
|
|
(nreverse acc)
|
|
(rec (- n 1) (cdr lst) (cons (car lst) acc)))))
|
|
(when (> n 0)
|
|
(rec n lst nil))))
|
|
|
|
(defun drop (n lst)
|
|
"Drop n elements from the list."
|
|
(if (or (<= n 0) (null lst))
|
|
lst
|
|
(drop (- n 1) (cdr lst))))
|
|
|
|
(defun interpose (x sep)
|
|
"Takes a list and a separator, and places separator between element
|
|
of the list."
|
|
(let ((x (coerce x 'list)))
|
|
(apply #'append
|
|
(mapcar (lambda (y)
|
|
(list y sep))
|
|
x))))
|
|
|
|
(defun build-list (arg)
|
|
"If arg is an atom, return it as a list. If it's a list, return the
|
|
arg. If it's a vector, coerce it to a list. Otherwise, return nil."
|
|
(cond
|
|
((listp arg) (copy-list arg))
|
|
((vectorp arg) (coerce arg 'list))
|
|
((atom arg) (list arg))
|
|
(t nil)))
|
|
|
|
(defun partial (fn &rest initial-args)
|
|
"partial provides partial function application. It returns a lambda
|
|
that will call the function given with the intial args and any
|
|
additional args provided to the lambda."
|
|
(lambda (&rest args)
|
|
(apply fn (append initial-args args))))
|
|
|
|
(defun macroexpand-n (n form)
|
|
"Expand the macro n times."
|
|
(let ((new-form form))
|
|
(dotimes (i n)
|
|
(multiple-value-bind
|
|
(expansion expanded)
|
|
(macroexpand-1 new-form)
|
|
(if expanded
|
|
(setf new-form expansion)
|
|
(return))))
|
|
new-form))
|
|
|
|
(defun mksymb (&rest args)
|
|
"Create a symbol from arguments, upcasing strings as required."
|
|
(let ((args (mapcar (lambda (arg)
|
|
(if (stringp arg)
|
|
(string-upcase arg)
|
|
arg))
|
|
args)))
|
|
(apply #'symb args)))
|
|
|
|
(defun mkkw (&rest args)
|
|
"Create a keyword from its arguments."
|
|
(intern (string (apply #'mksymb args)) "KEYWORD"))
|
|
|
|
(defun zip (&rest lsts)
|
|
"Zip together elements from each list. For example,
|
|
|
|
@begin(code)
|
|
* (zip '(a b c) '(1 2 3))
|
|
'((a 1) (b 2) (c 3)).
|
|
@end(code)"
|
|
(labels ((zip-acc (lsts)
|
|
(unless (some #'null lsts)
|
|
(cons (mapcar #'car lsts) (zip-acc (mapcar #'cdr lsts))))))
|
|
(zip-acc lsts)))
|
|
|
|
|
|
(defun read-file-string (path)
|
|
"Read the contents of the file at path as a string."
|
|
(with-open-file (s path)
|
|
(let ((data (make-string (file-length s))))
|
|
(read-sequence data s)
|
|
data)))
|
|
|
|
(defun new-vector ()
|
|
"Create a new, empty, adjustable vector with fill pointer."
|
|
(make-array 0 :adjustable t :fill-pointer t))
|
|
|
|
(defmacro mapv (fn &rest vecs)
|
|
"Utility to map @c(fn) over the vectors @c(vecs), producing a vector."
|
|
`(map 'vector ,fn ,@vecs))
|
|
|
|
(defun build-vector (arg)
|
|
"If @c(arg) is an atom, return it as a list. If it's a list,
|
|
coerce it to a vector. If it's a vector, return the
|
|
vector. Otherwise, attempt to map it into a vector."
|
|
(cond ((listp arg) (apply #'vector arg))
|
|
((vectorp arg) arg)
|
|
((atom arg)
|
|
(let ((v (new-vector)))
|
|
(vector-push-extend arg v)
|
|
v))
|
|
(t (mapv #'identity arg))))
|
|
|
|
(defun extend-vector (v)
|
|
"Create a new vector from the contents of its argument where the
|
|
new vector is adjustable and has a fill pointer set."
|
|
(make-array (length v)
|
|
:adjustable t
|
|
:initial-contents v
|
|
:fill-pointer t))
|
|
|
|
(defmacro assoc-val (item alist &rest key-args)
|
|
"Return the value of @c(item) in @c(alist). @c(key-args) should
|
|
contain any additional keyword arguments to @c(assoc)."
|
|
`(rest (assoc ,item ,alist ,@key-args)))
|
|
|
|
|
|
(defun cartprod2 (a b)
|
|
"Produce the cartesian product of the two lists."
|
|
(apply #'concatenate 'list
|
|
(mapcar (lambda (x)
|
|
(mapcar (lambda (y)
|
|
(cons x y))
|
|
b))
|
|
a)))
|