tvl-depot/lisp/klatre/klatre.lisp
Griffin Smith d60c639162 feat(lisp/klatre): Add klatre, a grab-bag lisp util package
Add Klatre, a grab-bag common lisp utility package, including
definitions for `comment`, `posp`, `chunk-list`, and `mapconcat`.

The name traces its lineage back to Abseil, a similar grab-bag utility
library for C++ - abseiling is what you do to go down a route after
you're done climbing it, and klatre is norwegian for "to climb"

Change-Id: I5efd91d8af827883679ce1a2eed3229b28e082ac
Reviewed-on: https://cl.tvl.fyi/c/depot/+/1346
Tested-by: BuildkiteCI
Reviewed-by: tazjin <mail@tazj.in>
2020-07-23 00:08:29 +00:00

70 lines
2.2 KiB
Common Lisp

(in-package #:klatre)
(declaim (optimize (safety 3)))
(defmacro comment (&rest _))
(defun posp (n) (> n 0))
;;; Sequence utilities
(defun slice (vector start end)
(make-array (- end start)
:element-type (array-element-type vector)
:displaced-to vector
:displaced-index-offset start))
(defun chunk-vector (size vector &key start end sharedp)
(check-type size (integer 1))
(loop
with slicer = (if sharedp #'slice #'subseq)
and low = (or start 0)
and high = (or end (length vector))
for s from low below high by size
for e from (+ low size) by size
collect (funcall slicer vector s (min e high))))
(defun chunk-list/unbounded (size list)
(loop
for front = list then next
for next = (nthcdr size front)
collect (ldiff front next)
while next))
(defun chunk-list/bounded (size list upper-limit)
(loop
for front = list then next
for next = (nthcdr (min size upper-limit) front)
collect (ldiff front next)
do (decf upper-limit size)
while (and next (plusp upper-limit))))
(defun chunk-list (size list &key (start 0) end)
"Returns successive chunks of list of size SIZE, starting at START and ending
at END."
(declare (inline check-list/bounded check-list/simple))
(check-type size (integer 1))
(let ((list (nthcdr start list)))
(when list
(if end
(chunk-list/bounded size list (- end start))
(chunk-list/unbounded size list)))))
(defun mapconcat (func lst sep)
"Apply FUNC to each element of LST, and concat the results as strings,
separated by SEP."
(check-type lst cons)
(check-type sep (simple-array character (*)))
(let ((vs (make-array 0
:element-type 'character
:fill-pointer 0
:adjustable t))
(lsep (length sep)))
(mapcar #'(lambda (str)
(let ((nstr (the (simple-array character (*))
(funcall func str))))
(dotimes (j (length nstr) j)
(vector-push-extend (char nstr (the fixnum j)) vs))
(dotimes (k lsep k)
(vector-push-extend (char sep (the fixnum k)) vs))))
lst)
vs))