# HG changeset patch # User Steve Losh # Date 1762889627 18000 # Node ID 1364eb7e452b64062375056705f6a356e839ff93 # Parent 443af0e76dd6d667783c9f9069c3ef6d553f3f45 Add utilities from the past few months diff -r 443af0e76dd6 -r 1364eb7e452b losh.asd --- 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")) diff -r 443af0e76dd6 -r 1364eb7e452b make-docs.lisp --- 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" diff -r 443af0e76dd6 -r 1364eb7e452b src/debugging.lisp --- 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." diff -r 443af0e76dd6 -r 1364eb7e452b src/iterate.lisp --- 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 diff -r 443af0e76dd6 -r 1364eb7e452b src/package.lisp --- 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! diff -r 443af0e76dd6 -r 1364eb7e452b src/regex.lisp --- /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)))))) diff -r 443af0e76dd6 -r 1364eb7e452b src/sequences.lisp --- 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)))) diff -r 443af0e76dd6 -r 1364eb7e452b src/shell.lisp --- 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))