1.1--- a/lisp/bin/organ.lisp Wed Sep 11 18:08:29 2024 -0400
1.2+++ b/lisp/bin/organ.lisp Wed Sep 11 21:40:01 2024 -0400
1.3@@ -57,7 +57,7 @@
1.4
1.5 (defun run ()
1.6 (let ((*log-level* :info))
1.7- (with-cli (opts cmds args) *cli*
1.8+ (with-cli (*cli* opts cmds args) ()
1.9 (do-cmd *cli*)
1.10 (debug-opts *cli*))))
1.11
2.1--- a/lisp/bin/skel.lisp Wed Sep 11 18:08:29 2024 -0400
2.2+++ b/lisp/bin/skel.lisp Wed Sep 11 21:40:01 2024 -0400
2.3@@ -4,8 +4,8 @@
2.4 ;; level. :INPUT :WAIT :OUTPUT
2.5 (in-package :std-user)
2.6 (defpkg :bin/skel
2.7- (:use :cl :std :cli/clap :cli/clap/vars
2.8- :vc :sb-ext :skel :log
2.9+ (:use :cl :std :cli
2.10+ :vc :sb-ext :skel :log :cli/clap/util
2.11 :dat/sxp #+tools :skel/tools/viz)
2.12 (:import-from :cli/shell :*shell-input* :*shell-directory*)
2.13 (:use :cli/tools/sbcl)
2.14@@ -344,12 +344,12 @@
2.15 (in-package :sk-user)
2.16 (let ((*log-level* :info))
2.17 (in-readtable :shell)
2.18- (with-cli (opts cmds) *cli*
2.19+ (with-cli (*cli* opts cmds) (cli:args)
2.20 (debug-opts *cli*)
2.21 (init-skel-vars)
2.22 (when-let ((project (find-skelfile #P".")))
2.23 (let ((*default-pathname-defaults* (pathname (directory-namestring project))))
2.24 (setq *skel-project* (load-skelfile project))
2.25- (setq *skel-shell* (sk-src *skel-project*))
2.26+ (setq *skel-path* (sk-src *skel-project*))
2.27 (setq *shell-directory* (sk-src *skel-project*))))
2.28 (do-cmd *cli*))))
3.1--- a/lisp/lib/cli/clap/cli.lisp Wed Sep 11 18:08:29 2024 -0400
3.2+++ b/lisp/lib/cli/clap/cli.lisp Wed Sep 11 21:40:01 2024 -0400
3.3@@ -56,13 +56,13 @@
3.4 (defun make-cmds (cmds)
3.5 "Make a vector of CLI-CMDs based on CMDS."
3.6 (map 'vector
3.7- (lambda (x)
3.8- (etypecase x
3.9- (cli-cmd x)
3.10- (string (make-cli :cmd :name x))
3.11- (list (apply #'make-cli :cmd x))
3.12- (t (make-cli :cmd :name (format nil "~(~A~)" x)))))
3.13- cmds))
3.14+ (lambda (x)
3.15+ (etypecase x
3.16+ (cli-cmd x)
3.17+ (string (make-cli :cmd :name x))
3.18+ (list (apply #'make-cli :cmd x))
3.19+ (t (make-cli :cmd :name (format nil "~(~A~)" x)))))
3.20+ cmds))
3.21
3.22 (defclass cli (cli-cmd)
3.23 ;; name slot defaults to *package*, must be string
3.24@@ -70,7 +70,7 @@
3.25 (version :initarg :version :initform "0.1.0" :accessor cli-version :type string)
3.26 ;; TODO 2023-10-11: look into pushd popd - cd-stack?
3.27 (cd :initarg :cd :initform (sb-posix:getcwd) :type string :accessor cli-cd
3.28- :documentation "working directory of the top-level CLI."))
3.29+ :documentation "working directory of the top-level CLI."))
3.30 (:documentation "CLI"))
3.31
3.32 (defmethod print-usage ((self cli) &optional stream)
3.33@@ -114,15 +114,16 @@
3.34 (loop for opt across (active-opts self global)
3.35 do (do-opt opt)))
3.36
3.37-(defmacro with-cli (slots cli &body body)
3.38+(defmacro with-cli ((cli &rest slots) args &body body)
3.39 "Like with-slots with some extra bindings.
3.40
3.41 SLOTS is a list passed to WITH-SLOTS.
3.42
3.43-CLI is updated based on the current environment and dynamically bound to
3.44-*CLI*."
3.45+CLI is updated based on the current environment and dynamically bound
3.46+to *CLI*. ARGS is a list of CLI args, defaults to *POSIX-ARGV* at
3.47+runtime if nil."
3.48 `(progn
3.49- (setq *cli* ,cli)
3.50- (setf (cli-cd ,cli) (sb-posix:getcwd))
3.51- (with-slots ,slots (parse-args ,cli (args) :compile t)
3.52- ,@body)))
3.53+ (let ((*cli* ,cli))
3.54+ (setf (cli-cd *cli*) *default-pathname-defaults*)
3.55+ (with-slots ,slots (parse-args *cli* ,args :compile t)
3.56+ ,@body))))
4.1--- a/lisp/lib/cli/clap/cmd.lisp Wed Sep 11 18:08:29 2024 -0400
4.2+++ b/lisp/lib/cli/clap/cmd.lisp Wed Sep 11 21:40:01 2024 -0400
4.3@@ -96,9 +96,8 @@
4.4 (when-let ((c (find name (cli-cmds self) :key #'cli-name :test #'string=)))
4.5 (if active
4.6 ;; maybe issue warning here? report to user
4.7- (if (cli-lock-p c)
4.8- c
4.9- (clap-simple-error "inactive (unlocked) cmd: ~A" c))
4.10+ (when (cli-lock-p c)
4.11+ c)
4.12 c)))
4.13
4.14 (defmethod active-cmds ((self cli-cmd))
4.15@@ -143,16 +142,12 @@
4.16 "Bind restarts 'use-as-arg' and 'discard-arg' for duration of BODY."
4.17 `(restart-case ,condition
4.18 (use-as-arg () () (make-cli-node 'arg ,arg))
4.19- (discard-arg () () nil)))
4.20+ (discard-arg () () (setf ,arg nil))))
4.21
4.22 (defmethod proc-args ((self cli-cmd) args)
4.23 "Process ARGS into an ast. Each element of the ast is a node with a
4.24 :kind slot, indicating the type of node and a :form slot which stores
4.25-a value.
4.26-
4.27-For now we parse group separators '--' and insert a nil into the tree,
4.28-this will likely change to generating a new branch in the ast as it
4.29-should be."
4.30+a value."
4.31 (make-cli-ast
4.32 (let ((holes)) ;; list of arg indexes which can be skipped since they're
4.33 ;; consumed by an opt
5.1--- a/lisp/lib/cli/tests.lisp Wed Sep 11 18:08:29 2024 -0400
5.2+++ b/lisp/lib/cli/tests.lisp Wed Sep 11 21:40:01 2024 -0400
5.3@@ -218,7 +218,7 @@
5.4 (is (string= "foobar"
5.5 (completing-read "nothing: " tcoll :history thist :default "foobar")))))
5.6
5.7-(defparameter *opts* '((:name "foo" :global t :description "bar")
5.8+(defparameter *opts* '((:name "foo" :global t :description "bar" :kind string)
5.9 (:name "bar" :description "foo" :kind string)))
5.10
5.11 (defparameter *cmd1* (make-cli :cmd :name "holla" :opts *opts* :description "cmd1 description"))
5.12@@ -683,13 +683,12 @@
5.13 (proc-args *cli* '("--log" "default" "--foo=11"))))
5.14
5.15 (defmain (:exit nil :export nil)
5.16- (with-cli () *cli*
5.17+ (with-cli (*cli*) ()
5.18 (log:trace! "defmain is OK")
5.19 t))
5.20
5.21 (deftest clap-main ()
5.22- (let ((sb-ext:*posix-argv* nil))
5.23- (is (null (funcall #'main)))))
5.24+ (is (null (funcall #'main))))
5.25
5.26 (deftest sbcl-tools ()
5.27 (with-sbcl (:noinform t :quit t)
6.1--- a/lisp/lib/rt/fuzz.lisp Wed Sep 11 18:08:29 2024 -0400
6.2+++ b/lisp/lib/rt/fuzz.lisp Wed Sep 11 21:40:01 2024 -0400
6.3@@ -48,4 +48,8 @@
6.4 (let ((ret (make-hash-table)))
6.5 (dotimes (i count ret)
6.6 (destructuring-bind (k v) (funcall generator state)
6.7- (setf (gethash k ret) v))))))
6.8+ (setf (gethash k ret) v)))))
6.9+ (:method ((state random-state) (generator function) &key (count 1))
6.10+ (let ((ret))
6.11+ (dotimes (i count ret)
6.12+ (push (funcall generator state) ret)))))
7.1--- a/lisp/lib/rt/tests.lisp Wed Sep 11 18:08:29 2024 -0400
7.2+++ b/lisp/lib/rt/tests.lisp Wed Sep 11 21:40:01 2024 -0400
7.3@@ -1,5 +1,5 @@
7.4 (defpackage :rt/tests
7.5- (:use :cl :std :rt :sb-sprof :rt/flamegraph :rt/tracing :rt/cover :rt/bench))
7.6+ (:use :cl :std :rt :sb-sprof :rt/flamegraph :rt/tracing :rt/cover :rt/bench :rt/fuzz))
7.7
7.8 (in-package :rt/tests)
7.9
7.10@@ -44,7 +44,7 @@
7.11
7.12 (deftest tmp ()
7.13 (is (null (with-tmp-directory ())))
7.14- (is (null (with-tmp-file ())))
7.15+ (is (null (with-tmp-file (file))))
7.16 (is (with-tmp-file (f1 :name "temporary-file")
7.17 (is (probe-file *tmp*))
7.18 (write-string "1 2 3 4" f1)
7.19@@ -52,4 +52,9 @@
7.20 (is (= 7 (file-length f1)))))
7.21 (is (with-tmp-directory ("foobar")
7.22 (is (directory-path-p (probe-file *tmp*))))))
7.23-
7.24+
7.25+(deftest fuzz ()
7.26+ (defclass foo-fuzz (fuzzer) ())
7.27+ (is (integerp
7.28+ (fuzz (make-instance 'foo-fuzz))))
7.29+ (is (= 100 (length (fuzz* (make-random-state) (fuzz-generator (make-instance 'foo-fuzz)) :count 100)))))
8.1--- a/lisp/lib/skel/pkg.lisp Wed Sep 11 18:08:29 2024 -0400
8.2+++ b/lisp/lib/skel/pkg.lisp Wed Sep 11 21:40:01 2024 -0400
8.3@@ -47,5 +47,5 @@
8.4 (:use-reexport :skel/core :skel/comp))
8.5
8.6 (pkg:defpkg :sk-user
8.7- (:use :cl :std :std-user :cl-user :log :sb-debug :sb-ext :net/proto/dns :net/fetch :cli/tools/sbcl :pod)
8.8+ (:use :cl :std :std-user :cl-user :log :sb-debug :sb-ext :net/proto/dns :net/fetch :cli/tools/sbcl :pod :cli/clap)
8.9 (:use :skel :skel/core :skel/comp))
9.1--- a/skelfile Wed Sep 11 18:08:29 2024 -0400
9.2+++ b/skelfile Wed Sep 11 21:40:01 2024 -0400
9.3@@ -31,24 +31,32 @@
9.4 alien.c -o ../../../.stash/libtree-sitter-alien.so$#)
9.5 (:install () #$cp .stash/libtree-sitter-alien.so /usr/local/lib/$#))
9.6 (psl.dat (%stash)
9.7- (download "https://publicsuffix.org/list/public_suffix_list.dat" :output ".stash/psl.dat"))
9.8+ (download "https://publicsuffix.org/list/public_suffix_list.dat"
9.9+ :output (merge-pathnames
9.10+ ".stash/psl.dat"
9.11+ *skel-path*)))
9.12 (rgb.txt (%stash)
9.13- (download "https://packy.compiler.company/data/rgb.txt" :output ".stash/rgb.txt"))
9.14+ (download "https://packy.compiler.company/data/rgb.txt"
9.15+ :output (merge-pathnames
9.16+ ".stash/rgb.txt"
9.17+ *skel-path*)))
9.18 (x11.lisp (rgb.txt)
9.19- (color::parse-x11-color-definitions :input ".stash/rgb.txt" :output "color/x11.lisp"))
9.20+ (color::parse-x11-color-definitions
9.21+ :input ".stash/rgb.txt"
9.22+ :output (merge-pathnames "color/x11.lisp" *skel-path*)))
9.23 (parquet.thrift (%stash)
9.24 (download
9.25 "https://raw.githubusercontent.com/apache/parquet-format/master/src/main/thrift/parquet.thrift"
9.26- :output ".stash/parquet.thrift")
9.27+ :output (merge-pathnames ".stash/parquet.thrift" *skel-path*))
9.28 #$thrift --gen json -out .stash .stash/parquet.thrift$#)
9.29 (parquet.json (%stash)
9.30 (download "https://packy.compiler.company/data/parquet.json"
9.31- :output ".stash/parquet.json"))
9.32+ :output (merge-pathnames ".stash/parquet.json" *skel-path*)))
9.33 (freedesktop.org.xml (%stash)
9.34 (download "https://packy.compiler.company/data/freedesktop.org.xml"
9.35- :output ".stash/freedesktop.org.xml"))
9.36+ :output (merge-pathnames ".stash/freedesktop.org.xml" *skel-path*)))
9.37 (parquet-test-data (%stash) (download "https://packy.compiler.company/data/test/alltypes_plain.parquet"
9.38- :output ".stash/alltypes_plain.parquet"))
9.39+ :output (merge-pathnames ".stash/alltypes_plain.parquet" *skel-path*)))
9.40 ;; lisp
9.41 (%stash () #$mkdir -pv .stash$#)
9.42 (rdb (%stash)
