1364eb7e452b

Add utilities from the past few months
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 11 Nov 2025 14:33:47 -0500
parents 443af0e76dd6
children d05f5412e9aa
branches/tags (none)
files losh.asd make-docs.lisp src/debugging.lisp src/iterate.lisp src/package.lisp src/regex.lisp src/sequences.lisp src/shell.lisp

Changes

--- a/losh.asd	Sun Jun 23 13:34:51 2024 -0400
+++ b/losh.asd	Tue Nov 11 14:33:47 2025 -0500
@@ -38,6 +38,7 @@
                  (:file "io" :depends-on ("base"))
                  (:file "lists" :depends-on ("base"))
                  (:file "mutation" :depends-on ("base"))
+                 (:file "regex" :depends-on ("base"))
                  (:file "shell" :depends-on ("base"))
                  (:file "streams" :depends-on ("base"))
 
--- a/make-docs.lisp	Sun Jun 23 13:34:51 2024 -0400
+++ b/make-docs.lisp	Tue Nov 11 14:33:47 2025 -0500
@@ -25,6 +25,7 @@
         "LOSH.QUEUES"
         "LOSH.RANDOM"
         "LOSH.READTABLE"
+        "LOSH.REGEX"
         "LOSH.RING-BUFFERS"
         "LOSH.SEQUENCES"
         "LOSH.SHELL"
--- a/src/debugging.lisp	Sun Jun 23 13:34:51 2024 -0400
+++ b/src/debugging.lisp	Tue Nov 11 14:33:47 2025 -0500
@@ -59,25 +59,20 @@
 
   "
   ;; http://blog.chaitanyagupta.com/2013/10/print-bit-representation-of-signed.html
-  (format stream (format nil "~~~D,'0B" size) (ldb (byte size 0) n)))
+  (format stream (format nil "~~~D,'0B" size) (ldb (byte size 0) n))
+  (values))
 
-(defun hex (&optional (thing *) (stream t))
-  "Print the `thing` to `stream` with numbers in base 16.
+(defun hex (&optional (n *) (size 8) (stream t))
+  "Print the hex of the `size`-bit unsigned byte `n` to `stream`.
 
   Examples:
 
     (hex 255)
     => FF
 
-    (hex #(0 128))
-    => #(0 80)
-
   "
-  (let ((*print-base* 16))
-    (case stream
-      ((nil) (prin1-to-string thing))
-      ((t) (prin1 thing stream) (terpri stream) nil)
-      (otherwise (prin1 thing stream) (terpri stream) nil))))
+  (format stream "~v,'0X" (/ size 4) n)
+  (values))
 
 (defmacro shut-up (&body body)
   "Run `body` with stdout and stderr redirected to the void."
--- a/src/iterate.lisp	Sun Jun 23 13:34:51 2024 -0400
+++ b/src/iterate.lisp	Tue Nov 11 14:33:47 2025 -0500
@@ -274,6 +274,7 @@
                                    (elt ,source ,i))))))))
 
 
+
 (defclause-sequence ACROSS-FLAT-ARRAY INDEX-OF-FLAT-ARRAY
   :access-fn 'row-major-aref
   :size-fn 'array-total-size
--- a/src/package.lisp	Sun Jun 23 13:34:51 2024 -0400
+++ b/src/package.lisp	Tue Nov 11 14:33:47 2025 -0500
@@ -103,6 +103,12 @@
 
     :do-hash-set))
 
+(defpackage :losh.regex
+  (:use :cl :iterate :losh.base)
+  (:documentation "Utilities related to regular expressions.")
+  (:export
+    :recase))
+
 (defpackage :losh.streams
   (:use :cl :iterate :losh.base)
   (:documentation "Utilities related to strings, reading, and/or printing.")
@@ -153,7 +159,9 @@
     :pbcopy
     :pbpaste
     :*pbcopy-command*
-    :*pbpaste-command*))
+    :*pbpaste-command*
+    :rscript
+    :rscript-file))
 
 
 (defpackage :losh.arrays
@@ -489,9 +497,9 @@
 (defpackage-inheriting :losh
   (
 
-   :losh.base
    :losh.arrays
    :losh.astar
+   :losh.base
    :losh.bits
    :losh.chili-dogs
    :losh.clos
@@ -511,6 +519,7 @@
    :losh.queues
    :losh.random
    :losh.readtable
+   :losh.regex
    :losh.ring-buffers
    :losh.sequences
    :losh.shell
@@ -527,5 +536,7 @@
 
   "))
 
+(defpackage :losh-user
+  (:use :cl :iterate :losh))
 
 ;;;; Remember to add it to the docs!
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/regex.lisp	Tue Nov 11 14:33:47 2025 -0500
@@ -0,0 +1,53 @@
+(in-package :losh.regex)
+
+;; Nerd-sniped by https://news.ycombinator.com/item?id=43468972, sigh
+
+(defmacro recase ((target-string &optional) &body clauses)
+  "Match a target string against regexes, also binding variables.
+
+  Each clause is of the form:
+
+    (condition &rest body)
+
+  Where `condition` is a list (or just the regex if no variables are required):
+
+    (regex &rest ppcre-var-list)
+
+  The target string will be matched against `regex` and `ppcre-var-list` bound
+  with `ppcre:register-groups-bind`.  If it matches, `body` will be executed and
+  its value returned, otherwise execution continues to later clauses.
+
+  A final condition of `t` can be used as a fallback.
+
+  Declarations are supported.
+
+  Example:
+
+    (recase (string)
+      ((\"([0-9]{4})-([0-9]{2})-([0-9]{2})\" (#'parse-integer year month day))
+       (declare (ignore month day))
+       (format t \"~S was a good year for PLs.\" year))
+      ((\"([A-Z][a-z]+) ([0-9]{1,2}), ([0-9]{4})\" month (#'parse-integer day year))
+       (declare (ignore year day))
+       (format t \"~A was a good month for Lisp.\" month))
+      (t \"Programming is hard.\"))
+
+  "
+  (with-gensyms (block-name)
+    (once-only (target-string)
+      (flet ((parse-clause (clause)
+               (destructuring-bind (condition &rest body) clause
+                 (multiple-value-bind
+                     (body declarations)
+                     (alexandria:parse-body body)
+                   (if (eql t condition)
+                     `(let ()
+                        ,@declarations
+                        (return-from ,block-name (progn ,@body)))
+                     (destructuring-bind (regex &rest vars) (ensure-list condition)
+                       `(ppcre:register-groups-bind (,@vars)
+                          (,regex ,target-string)
+                          ,@declarations
+                          (return-from ,block-name (progn ,@body)))))))))
+        `(block ,block-name
+           ,@(mapcar #'parse-clause clauses))))))
--- a/src/sequences.lisp	Sun Jun 23 13:34:51 2024 -0400
+++ b/src/sequences.lisp	Tue Nov 11 14:33:47 2025 -0500
@@ -77,7 +77,7 @@
     (mutate-hash-values (lambda (v) (/ v total))
                         freqs)))
 
-(defun group-by (function sequence &key (test #'eql) (key #'identity))
+(defun group-by (function sequence &key (test #'eql) (key #'identity) (map #'identity))
   "Return a hash table of the elements of `sequence` grouped by `function`.
 
   This function groups the elements of `sequence` into buckets.  The bucket for
@@ -91,6 +91,9 @@
   `function` to produce the bucket identifier.  This does not effect what is
   stored in the lists.
 
+  If `map` is given it will be called on each element before storing it in the
+  hash table.
+
   Examples:
 
     (defparameter *items* '((1 foo) (1 bar) (2 cats) (3 cats)))
@@ -113,7 +116,8 @@
   (iterate
     (with result = (make-hash-table :test test))
     (for i :in-whatever sequence)
-    (push i (gethash (funcall function (funcall key i)) result))
+    (push (funcall map i)
+          (gethash (funcall function (funcall key i)) result))
     (finally (return result))))
 
 
--- a/src/shell.lisp	Sun Jun 23 13:34:51 2024 -0400
+++ b/src/shell.lisp	Tue Nov 11 14:33:47 2025 -0500
@@ -82,3 +82,37 @@
 (defun pbpaste ()
   "`pbpaste` the current clipboard as a string."
   (values (sh *pbpaste-command* :result-type 'string)))
+
+
+(defun rscript (code &rest args)
+  "Invoke `Rscript` on the given `code` and `args`.
+
+  `code` must be a string of R code and will be piped into `Rscript` over
+  `stdin`.  Use `rscript-file` if you have a file of R code to run.
+
+  `args` will be passed as command line arguments and can be retrieved on the
+  R side with e.g.:
+
+    args <- commandArgs(trailingOnly=TRUE)
+
+  "
+  (write-string (sh (list* "Rscript" "-" args)
+                    :input code
+                    :result-type 'string))
+  (values))
+
+(defun rscript-file (path &rest args)
+  "Invoke `Rscript` on the given `path` and `args`.
+
+  `path` must be a path to a file R code.  Use `rscript` if you have a string of
+  R code to run.
+
+  `args` will be passed as command line arguments and can be retrieved on the
+  R side with e.g.:
+
+    args <- commandArgs(trailingOnly=TRUE)
+
+  "
+  (write-string (sh (list* "Rscript" path args)
+                    :result-type 'string))
+  (values))