diff --git a/lisp/klatre/default.nix b/lisp/klatre/default.nix new file mode 100644 index 000000000..41c3ef809 --- /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 000000000..afe16a90b --- /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 000000000..0cf7336fe --- /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))