From d60c639162e8390397b6808f78ac4e2def9324cb Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Tue, 21 Jul 2020 22:37:45 -0400
Subject: 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>
---
 lisp/klatre/default.nix  | 10 +++++++
 lisp/klatre/klatre.lisp  | 70 ++++++++++++++++++++++++++++++++++++++++++++++++
 lisp/klatre/package.lisp |  9 +++++++
 3 files changed, 89 insertions(+)
 create mode 100644 lisp/klatre/default.nix
 create mode 100644 lisp/klatre/klatre.lisp
 create mode 100644 lisp/klatre/package.lisp

(limited to 'lisp')

diff --git a/lisp/klatre/default.nix b/lisp/klatre/default.nix
new file mode 100644
index 000000000000..41c3ef8094d0
--- /dev/null
+++ b/lisp/klatre/default.nix
@@ -0,0 +1,10 @@
+{ depot, ... }:
+
+depot.nix.buildLisp.library {
+  name = "klatre";
+
+  srcs = [
+    ./package.lisp
+    ./klatre.lisp
+  ];
+}
diff --git a/lisp/klatre/klatre.lisp b/lisp/klatre/klatre.lisp
new file mode 100644
index 000000000000..afe16a90b81a
--- /dev/null
+++ b/lisp/klatre/klatre.lisp
@@ -0,0 +1,70 @@
+(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))
diff --git a/lisp/klatre/package.lisp b/lisp/klatre/package.lisp
new file mode 100644
index 000000000000..0cf7336feb06
--- /dev/null
+++ b/lisp/klatre/package.lisp
@@ -0,0 +1,9 @@
+(defpackage #:klatre
+  (:documentation "Grab-bag utility library for Common Lisp")
+  (:use #:cl)
+  (:export
+   ;; Miscellanious utilities
+   #:comment #:posp
+
+   ;; Sequence functions
+   #:chunk-list #:mapconcat))
-- 
cgit 1.4.1