1.1--- a/emacs/babel.org Sun Aug 04 21:14:51 2024 -0400
1.2+++ b/emacs/babel.org Mon Aug 05 21:57:13 2024 -0400
1.3@@ -2,7 +2,7 @@
1.4 #+author: Richard Westhaver
1.5 #+description: Core Library of Babel
1.6 #+setupfile: https://cdn.compiler.company/org/clean.theme
1.7-#+property: header-args :eval never-export :exports both
1.8+#+property: header-args :exports both
1.9
1.10 Welcome to the Core [[https://www.gnu.org/software/emacs/manual/html_node/org/Library-of-Babel.html][Library of Babel]]. This file contains a
1.11 collection of code blocks used throughout our Org documents.
1.12@@ -116,7 +116,7 @@
1.13 #+header: :var version="0.1.0"
1.14 #+header: :var name=(org-sbe org-current-h1-title)
1.15 #+header: :var dir="/home/ellis/comp/"
1.16-#+begin_src emacs-lisp :results table replace :eval no-export
1.17+#+begin_src emacs-lisp :results table replace
1.18 (let* ((src (concat dir name))
1.19 (age (org-sbe "hg-log-age" ''(dir src)))
1.20 (rev (org-sbe "hg-rev" ''(dir src)))
2.1--- a/emacs/default.el Sun Aug 04 21:14:51 2024 -0400
2.2+++ b/emacs/default.el Mon Aug 05 21:57:13 2024 -0400
2.3@@ -918,6 +918,22 @@
2.4 (set-buffer-modified-p b-m-p))
2.5 (error nil)))))
2.6
2.7+;; TODO 2024-08-05: infer logbook column-titles/props
2.8+(defun column-display-value-transformer (column-title value)
2.9+ "Modifies the value to display in column view."
2.10+ (let ((title (upcase column-title)))
2.11+ (when (and (member title '("UPDATED" "NOTE")))
2.12+ (org-back-to-heading)
2.13+ (re-search-forward
2.14+ "Note taken on \\[\\(.*\\)\\] \\\\\\\\\\\n +\\(.*\\) *$"
2.15+ (org-entry-end-position) t))
2.16+ (if (equal column-title "UPDATED")
2.17+ (match-string-no-properties 1)
2.18+ (match-string-no-properties 2))))
2.19+
2.20+(setq org-columns-modify-value-for-display-function
2.21+ #'column-display-value-transformer)
2.22+
2.23 ;;;###autoload
2.24 (defun org-align-all-tables ()
2.25 "align all tables in current buffer"
3.1--- a/emacs/lib/sk.el Sun Aug 04 21:14:51 2024 -0400
3.2+++ b/emacs/lib/sk.el Mon Aug 05 21:57:13 2024 -0400
3.3@@ -29,6 +29,7 @@
3.4 (require 'cl-lib)
3.5 (require 'sxp (expand-file-name "sxp.el" (join-paths user-emacs-directory "lib/")))
3.6 (require 'skeleton)
3.7+ (require 'org)
3.8 (require 'tempo)
3.9 (require 'autoinsert)
3.10 (defvar skel-debug nil)
4.1--- a/lisp/lib/cli/clap/cli.lisp Sun Aug 04 21:14:51 2024 -0400
4.2+++ b/lisp/lib/cli/clap/cli.lisp Mon Aug 05 21:57:13 2024 -0400
4.3@@ -38,7 +38,7 @@
4.4 ;; RESEARCH 2023-09-12: closed over hash-table with short/long flags
4.5 ;; to avoid conflicts. if not, need something like a flag-function
4.6 ;; slot at class allocation.
4.7-(defun make-opts (opts)
4.8+(defun make-opts (&rest opts)
4.9 "Make a vector of CLI-OPTs based on OPTS."
4.10 (map 'vector
4.11 (lambda (x)
4.12@@ -48,7 +48,7 @@
4.13 (t (make-cli :opt :name (format nil "~(~A~)" x) :global t))))
4.14 opts))
4.15
4.16-(defun make-cmds (cmds)
4.17+(defun make-cmds (&rest cmds)
4.18 "Make a vector of CLI-CMDs based on CMDS."
4.19 (map 'vector
4.20 (lambda (x)
5.1--- a/lisp/lib/cli/clap/opt.lisp Sun Aug 04 21:14:51 2024 -0400
5.2+++ b/lisp/lib/cli/clap/opt.lisp Mon Aug 05 21:57:13 2024 -0400
5.3@@ -6,30 +6,30 @@
5.4 (in-package :cli/clap/obj)
5.5
5.6 ;;; Parsers
5.7-(make-opt-parser string $val)
5.8+(make-opt-parser string *arg*)
5.9
5.10-(make-opt-parser boolean (when $val t))
5.11+(make-opt-parser boolean (when *arg* t))
5.12
5.13-(make-opt-parser (form string) (read-from-string $val))
5.14+(make-opt-parser (form string) (read-from-string *arg*))
5.15
5.16-(make-opt-parser (list form) (when (listp $val) $val))
5.17+(make-opt-parser (list form) (when (listp *arg*) *arg*))
5.18
5.19-(make-opt-parser (symbol form) (when (symbolp $val) $val))
5.20+(make-opt-parser (symbol form) (when (symbolp *arg*) *arg*))
5.21
5.22-(make-opt-parser (keyword form) (when (keywordp $val) $val))
5.23+(make-opt-parser (keyword form) (when (keywordp *arg*) *arg*))
5.24
5.25-(make-opt-parser number (when $val (parse-number $val)))
5.26+(make-opt-parser number (when *arg* (parse-number *arg*)))
5.27
5.28-(make-opt-parser integer (when $val (parse-integer $val)))
5.29+(make-opt-parser integer (when *arg* (parse-integer *arg*)))
5.30
5.31 (make-opt-parser (file string)
5.32- (parse-native-namestring $val nil *default-pathname-defaults* :as-directory nil))
5.33+ (parse-native-namestring *arg* nil *default-pathname-defaults* :as-directory nil))
5.34
5.35 (make-opt-parser (directory string)
5.36- (sb-ext:parse-native-namestring $val nil *default-pathname-defaults* :as-directory t))
5.37+ (sb-ext:parse-native-namestring *arg* nil *default-pathname-defaults* :as-directory t))
5.38
5.39 (make-opt-parser (pathname string)
5.40- (pathname $val))
5.41+ (pathname *arg*))
5.42
5.43 ;;; Objects
5.44 (defstruct cli-opt
6.1--- a/lisp/lib/cli/clap/vars.lisp Sun Aug 04 21:14:51 2024 -0400
6.2+++ b/lisp/lib/cli/clap/vars.lisp Mon Aug 05 21:57:13 2024 -0400
6.3@@ -49,4 +49,4 @@
6.4
6.5 (defvar *arg* nil
6.6 "Current option argument.
6.7-Bound for the lifetime of afunction defined with DEFCMD.")
6.8+Bound for the lifetime of a function defined with DEFOPT.")
7.1--- a/lisp/lib/cli/tests.lisp Sun Aug 04 21:14:51 2024 -0400
7.2+++ b/lisp/lib/cli/tests.lisp Mon Aug 05 21:57:13 2024 -0400
7.3@@ -1,3 +1,8 @@
7.4+;;; cli/tests.lisp --- CLI Tests
7.5+
7.6+;;
7.7+
7.8+;;; Code:
7.9 (defpackage :cli/tests
7.10 (:use :cl :std :rt :cli :cli/shell :cli/progress :cli/spark :cli/repl :cli/ansi :cli/prompt :cli/clap :cli/tools/sbcl))
7.11
7.12@@ -212,12 +217,12 @@
7.13 (completing-read "nothing: " tcoll :history thist :default "foobar")))))
7.14
7.15 (defparameter *opts* (make-opts
7.16- (:name "foo" :global t :description "bar")
7.17- (:name "bar" :description "foo")))
7.18+ '(:name "foo" :global t :description "bar")
7.19+ '(:name "bar" :description "foo")))
7.20
7.21 (defparameter *cmd1* (make-cli :cmd :name "holla" :opts *opts* :description "cmd1 description"))
7.22 (defparameter *cmd2* (make-cli :cmd :name "ayo" :cmds #(*cmd1*) :opts *opts* :description "cmd1 description"))
7.23-(defparameter *cmds* (make-cmds (:name "baz" :description "baz" :opts *opts*)))
7.24+(defparameter *cmds* (make-cmds '(:name "baz" :description "baz" :opts *opts*)))
7.25
7.26 (defparameter *cli* (make-cli :cli :opts *opts* :cmds *cmds* :description "test cli"))
7.27
7.28@@ -671,11 +676,12 @@
7.29
7.30 (deftest clap-ast ())
7.31
7.32+(compile (defmain (:exit nil :export nil)
7.33+ (let ((test-target t))
7.34+ test-target)))
7.35+
7.36 (deftest main-output ()
7.37- (compile (defmain (:exit nil :export nil)
7.38- (let ((test-target t))
7.39- test-target)))
7.40- (is (not (funcall #'main))))
7.41+ (is (not (funcall 'main))))
7.42
7.43 (deftest sbcl-tools ()
7.44 (with-sbcl (:noinform t :quit t)
8.1--- a/lisp/lib/dat/csv.lisp Sun Aug 04 21:14:51 2024 -0400
8.2+++ b/lisp/lib/dat/csv.lisp Mon Aug 05 21:57:13 2024 -0400
8.3@@ -1,6 +1,19 @@
8.4 ;;; lib/dat/csv.lisp --- CSV Data Format
8.5
8.6-;; Character Separated Values
8.7+;; Comma Separated Values (or tabs or whatever)
8.8+
8.9+;;; Commentary:
8.10+
8.11+;; This package prioritizes flexibility. If you want speed, convert to
8.12+;; parquet.
8.13+
8.14+;; Still, efficiency is worth pursuing here and there are some obvious gaps to
8.15+;; remedy.
8.16+
8.17+;; - remove sequence functions
8.18+;; - research optimized access patterns used in other langs/state of art
8.19+;; - buffered reads
8.20+;; - multithreading
8.21
8.22 ;;; Code:
8.23 (in-package :dat/csv)
8.24@@ -223,8 +236,13 @@
8.25 (coerce result 'vector)
8.26 header)))))
8.27
8.28-(defun read-csv-file (filename &key (header t) type-spec map-fns (delimiter *csv-separator*) (external-format *csv-default-external-format*)
8.29- (start 0) end)
8.30+(defun read-csv-file (filename &key (header t)
8.31+ type-spec
8.32+ map-fns
8.33+ (delimiter *csv-separator*)
8.34+ (external-format *csv-default-external-format*)
8.35+ (start 0)
8.36+ end)
8.37 "Read from stream until eof and return a csv table.
8.38
8.39 A csv table is a vector of csv records.
8.40@@ -239,10 +257,8 @@
8.41 each function in it will be applied to the parsed element.
8.42 If any function in the list is nil or t, it equals to #'identity.
8.43 If map-fns is nil, then nothing will be applied.
8.44-https://cgit.gentoo.org/proj/lisp.git/tree/dev-lisp/cl-rsm-finance/cl-rsm-finance-1.1.ebuild?h=old-portage&id=e9b71910b0d4f22aeb66f14e158a2451f9955b0d
8.45-external-format (default is shift-jis) is a valid AllegroCL external-format type.
8.46
8.47-OS is a set to eol-convention of the file stream.
8.48+external-format (default is :UTF-8)
8.49
8.50 start and end specifies how many elements per record will be included.
8.51 If start or end is negative, it counts from the end. -1 is the last element.
8.52@@ -266,3 +282,11 @@
8.53 (stable-sort table (ecase order (:ascend #'string<=) (:descend #'string>=))
8.54 :key (lambda (rec) (aref rec i))))
8.55 finally (return table))))
8.56+
8.57+(defclass csv-file-data (file-data-source) ())
8.58+
8.59+;; TODO 2024-08-05:
8.60+(defmethod scan-data ((self csv-file-data) (projection sequence))
8.61+ (if (null projection)
8.62+ (read-csv-file (file-data-path self))
8.63+ (nyi!)))
9.1--- a/lisp/lib/dat/pkg.lisp Sun Aug 04 21:14:51 2024 -0400
9.2+++ b/lisp/lib/dat/pkg.lisp Mon Aug 05 21:57:13 2024 -0400
9.3@@ -33,7 +33,7 @@
9.4 :parse-dot-string))
9.5
9.6 (defpackage :dat/csv
9.7- (:use :cl :std :dat/proto)
9.8+ (:use :cl :std :dat/proto :obj/query)
9.9 (:export
9.10 :read-csv-file
9.11 :*csv-separator*
10.1--- a/lisp/lib/doc/pkg.lisp Sun Aug 04 21:14:51 2024 -0400
10.2+++ b/lisp/lib/doc/pkg.lisp Mon Aug 05 21:57:13 2024 -0400
10.3@@ -72,7 +72,8 @@
10.4 ;; dist
10.5 :dist-documentation
10.6 ;; image
10.7- :image-documentation))
10.8+ :image-documentation
10.9+ :explain))
10.10
10.11 (in-package :doc)
10.12
11.1--- a/lisp/lib/obj/pkg.lisp Sun Aug 04 21:14:51 2024 -0400
11.2+++ b/lisp/lib/obj/pkg.lisp Mon Aug 05 21:57:13 2024 -0400
11.3@@ -453,7 +453,9 @@
11.4 :execute*
11.5 :register-file
11.6 :register-data-source
11.7- :register-df))
11.8+ :register-df
11.9+ :file-data-path
11.10+ :file-data-source))
11.11
11.12 (defpackage :obj/secret
11.13 (:nicknames :secret)
12.1--- a/lisp/lib/obj/query.lisp Sun Aug 04 21:14:51 2024 -0400
12.2+++ b/lisp/lib/obj/query.lisp Mon Aug 05 21:57:13 2024 -0400
12.3@@ -166,7 +166,10 @@
12.4 (defclass data-source ()
12.5 ((schema :type schema :accessor schema)))
12.6
12.7-(defgeneric scan-data-source (self projection)
12.8+(defclass file-data-source (data-source)
12.9+ ((path :initarg :path :accessor file-data-path)))
12.10+
12.11+(defgeneric scan-data (self projection)
12.12 (:documentation "Scan the data source, selecting the specified columns."))
12.13
12.14 ;;; Expressions
12.15@@ -508,7 +511,7 @@
12.16 (schema (data-frame-plan df)))
12.17
12.18 (defmethod (setf schema) ((schema schema) (df data-frame))
12.19- (setf (schema df) schema))
12.20+ (setf (slot-value (data-frame-plan df) 'schema) schema))
12.21
12.22 (defgeneric df-plan (df)
12.23 (:documentation "Return the logical plan associated with this data-frame.")
12.24@@ -648,7 +651,7 @@
12.25 (select (schema (slot-value self 'data-source)) (slot-value self 'projection)))
12.26
12.27 (defmethod execute ((self scan-exec))
12.28- (scan-data-source (slot-value self 'data-source) (slot-value self 'projection)))
12.29+ (scan-data (slot-value self 'data-source) (slot-value self 'projection)))
12.30
12.31 (defclass projection-exec (physical-plan)
12.32 ((input :type physical-plan :initarg :input)
13.1--- a/lisp/lib/q/sql.lisp Sun Aug 04 21:14:51 2024 -0400
13.2+++ b/lisp/lib/q/sql.lisp Mon Aug 05 21:57:13 2024 -0400
13.3@@ -11,7 +11,7 @@
13.4 ;;; Code:
13.5 (in-package :q/sql)
13.6
13.7-(declaim (optimize (speed 3) (safety 2)))
13.8+(declaim (optimize (speed 3)))
13.9
13.10 ;;; Conditions
13.11 (define-condition sql-error (error) ())
14.1--- a/lisp/lib/q/tests/suite.lisp Sun Aug 04 21:14:51 2024 -0400
14.2+++ b/lisp/lib/q/tests/suite.lisp Mon Aug 05 21:57:13 2024 -0400
14.3@@ -10,18 +10,24 @@
14.4 (in-suite :q)
14.5
14.6 (deftest sanity ()
14.7- (is (make-instance 'query-engine :parser (make-instance 'query-parser))))
14.8+ (is (make-instance 'query-engine
14.9+ :parser (make-instance 'query-parser)
14.10+ :optimizer (make-instance 'sql-optimizer)
14.11+ :sources nil)))
14.12
14.13 (deftest sql-select ()
14.14- (with-sql (expr "SELECT BAR FROM FOO")
14.15+ (with-sql (expr "SELECT * FROM FOO")
14.16 (is (typep expr 'sql-select))
14.17- (let ((tbl (make-hash-table :test 'equal))
14.18- (df (make-instance 'data-frame)))
14.19- (setf (schema df) (make-schema))
14.20- ;; (signals simple-sql-error (make-sql-data-frame expr tbl))
14.21- (setf (gethash "FOO" tbl) df)
14.22- ;; (make-sql-data-frame expr tbl))
14.23- )))
14.24+ (signals simple-sql-error (make-sql-data-frame expr tbl))))
14.25+
14.26+(deftest sql-df ()
14.27+ (let ((tbl (make-hash-table :test 'equal))
14.28+ (df (make-instance 'data-frame)))
14.29+ (setf (schema df) (make-schema))
14.30+ (is (setf (gethash "FOO" tbl) df))
14.31+ (is (gethash "FOO" tbl))
14.32+ ;; (is (make-sql-data-frame df tbl))
14.33+ ))
14.34
14.35 (deftest sql-math ()
14.36 (with-sql (expr "1 + 2 * 3")
15.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
15.2+++ b/lisp/std/macs/loop.lisp Mon Aug 05 21:57:13 2024 -0400
15.3@@ -0,0 +1,48 @@
15.4+;;; loop.lisp --- Loop-like Macros
15.5+
15.6+;; LOOP extensions
15.7+
15.8+;;; Code:
15.9+(in-package :std/macs)
15.10+;; ref: https://github.com/bendudson/array-operations
15.11+(defmacro nested-loop (syms dimensions &body body)
15.12+ "Iterates over a multidimensional range of indices.
15.13+
15.14+ SYMS must be a list of symbols, with the first symbol
15.15+ corresponding to the outermost loop.
15.16+
15.17+ DIMENSIONS will be evaluated, and must be a list of
15.18+ dimension sizes, of the same length as SYMS.
15.19+
15.20+ Example:
15.21+ (nested-loop (i j) '(10 20) (format t '~a ~a~%' i j))"
15.22+ (unless syms (return-from nested-loop `(progn ,@body))) ; No symbols
15.23+ ;; Generate gensyms for dimension sizes
15.24+ (let* ((rank (length syms))
15.25+ ;; reverse our symbols list,
15.26+ ;; since we start from the innermost.
15.27+ (syms-rev (reverse syms))
15.28+ ;; innermost dimension first:
15.29+ (dims-rev (loop for i from 0 below rank
15.30+ collecting (gensym)))
15.31+ ;; start with innermost expression
15.32+ (result `(progn ,@body)))
15.33+ ;; Wrap previous result inside a loop for each dimension
15.34+ (loop for sym in syms-rev for dim in dims-rev do
15.35+ (unless (symbolp sym)
15.36+ (error "~S is not a symbol. First argument to nested-loop must be a list of symbols" sym))
15.37+ (setf result
15.38+ `(loop for ,sym from 0 below ,dim do
15.39+ ,result)))
15.40+ ;; Add checking of rank and dimension types,
15.41+ ;; and get dimensions into gensym list.
15.42+ (let ((dims (gensym)))
15.43+ `(let ((,dims ,dimensions))
15.44+ (unless (= (length ,dims) ,rank)
15.45+ (error "Incorrect number of dimensions: Expected ~a but got ~a" ,rank (length ,dims)))
15.46+ (dolist (dim ,dims)
15.47+ (unless (integerp dim)
15.48+ (error "Dimensions must be integers: ~S" dim)))
15.49+ ;; dimensions reversed so that innermost is last:
15.50+ (destructuring-bind ,(reverse dims-rev) ,dims
15.51+ ,result)))))
16.1--- a/lisp/std/pkg.lisp Sun Aug 04 21:14:51 2024 -0400
16.2+++ b/lisp/std/pkg.lisp Mon Aug 05 21:57:13 2024 -0400
16.3@@ -191,6 +191,7 @@
16.4 (:import-from :std/list :flatten :defmacro!)
16.5 (:export
16.6 :named-lambda
16.7+ :nested-loop
16.8 :g!-symbol-p
16.9 :defmacro/g!
16.10 :o!-symbol-p
17.1--- a/lisp/std/std.asd Sun Aug 04 21:14:51 2024 -0400
17.2+++ b/lisp/std/std.asd Mon Aug 05 21:57:13 2024 -0400
17.3@@ -45,6 +45,7 @@
17.4 (:file "pan")
17.5 (:file "const")
17.6 (:file "collecting")
17.7+ (:file "loop")
17.8 (:file "control")))
17.9 (:file "bit")
17.10 (:file "thread")
