diff options
Diffstat (limited to 'lisp/klatre')
| -rw-r--r-- | lisp/klatre/OWNERS | 3 | ||||
| -rw-r--r-- | lisp/klatre/default.nix | 14 | ||||
| -rw-r--r-- | lisp/klatre/klatre.lisp | 119 | ||||
| -rw-r--r-- | lisp/klatre/package.lisp | 16 |
4 files changed, 152 insertions, 0 deletions
diff --git a/lisp/klatre/OWNERS b/lisp/klatre/OWNERS new file mode 100644 index 0000000000..ce7e0e37ee --- /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 0000000000..2c7bb6490a --- /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 0000000000..79c7259752 --- /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 0000000000..41174bbb3c --- /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)) |