about summary refs log tree commit diff
path: root/lisp/klatre
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/klatre')
-rw-r--r--lisp/klatre/OWNERS3
-rw-r--r--lisp/klatre/default.nix14
-rw-r--r--lisp/klatre/klatre.lisp119
-rw-r--r--lisp/klatre/package.lisp16
4 files changed, 152 insertions, 0 deletions
diff --git a/lisp/klatre/OWNERS b/lisp/klatre/OWNERS
new file mode 100644
index 000000000000..ce7e0e37ee4f
--- /dev/null
+++ b/lisp/klatre/OWNERS
@@ -0,0 +1,3 @@
+inherited: true
+owners:
+  - grfn
diff --git a/lisp/klatre/default.nix b/lisp/klatre/default.nix
new file mode 100644
index 000000000000..2c7bb6490a9f
--- /dev/null
+++ b/lisp/klatre/default.nix
@@ -0,0 +1,14 @@
+{ depot, ... }:
+
+depot.nix.buildLisp.library {
+  name = "klatre";
+
+  deps = with depot.third_party.lisp; [
+    local-time
+  ];
+
+  srcs = [
+    ./package.lisp
+    ./klatre.lisp
+  ];
+}
diff --git a/lisp/klatre/klatre.lisp b/lisp/klatre/klatre.lisp
new file mode 100644
index 000000000000..79c7259752c6
--- /dev/null
+++ b/lisp/klatre/klatre.lisp
@@ -0,0 +1,119 @@
+(in-package #:klatre)
+(declaim (optimize (safety 3)))
+
+(defmacro comment (&rest _)
+  (declare (ignore _)))
+
+(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 chunk-list/bounded chunk-list/unbounded))
+  (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))
+
+;;;
+;;; String handling
+;;;
+
+(defparameter dottime-format
+  '((:year 4) #\- (:month 2) #\- (:day 2)
+    #\T
+    (:hour 2) #\· (:min 2))
+  "`:LOCAL-TIME' format specifier for dottime")
+
+(defun format-dottime (timestamp &optional (offset 0))
+  "Return TIMESTAMP formatted as dottime, with a specified offset or +00"
+  (check-type timestamp local-time:timestamp)
+  (concatenate 'string
+    (local-time:format-timestring nil timestamp
+                                  :format dottime-format
+                                  :timezone local-time:+utc-zone+)
+    (format-dottime-offset offset)))
+
+(defun format-dottime-offset (offset)
+  "Render OFFSET in hours in the format specified by dottime."
+  (check-type offset integer)
+  (concatenate 'string
+    ; render sign manually since format prints it after padding
+    (if (>= offset 0) "+" "-")
+    (format nil "~2,'0D" (abs offset))))
+
+(comment
+ (format-dottime (local-time:now))
+ (format-dottime (local-time:now) 2))
+
+(defun try-parse-integer (str)
+  "Attempt to parse STR as an integer, returning nil if it is invalid."
+  (check-type str string)
+  (handler-case (parse-integer str)
+    (#+sbcl sb-int:simple-parse-error
+     #-sbcl parse-error (_) (declare (ignore _)) nil)))
+
+;;;
+;;; Function utilities
+;;;
+
+(defun partial (f &rest args)
+  "Return a function that calls F with ARGS prepended to any remaining
+  arguments"
+  (lambda (&rest more-args)
+    (apply f (append args more-args))))
diff --git a/lisp/klatre/package.lisp b/lisp/klatre/package.lisp
new file mode 100644
index 000000000000..41174bbb3cf7
--- /dev/null
+++ b/lisp/klatre/package.lisp
@@ -0,0 +1,16 @@
+(defpackage #:klatre
+  (:documentation "Grab-bag utility library for Common Lisp")
+  (:use #:cl)
+  (:export
+   ;; Miscellanious utilities
+   #:comment #:posp
+
+   ;; Sequence functions
+   #:chunk-list #:mapconcat
+
+   ;; String handling
+   #:+dottime-format+ #:format-dottime
+   #:try-parse-integer #:format-dottime-offset
+
+   ;; Function utilities
+   #:partial))