1.1--- a/lisp/bin/homer.lisp Sun Jul 28 21:47:57 2024 -0400
1.2+++ b/lisp/bin/homer.lisp Mon Jul 29 20:55:09 2024 -0400
1.3@@ -186,13 +186,11 @@
1.4 :version "0.1.0"
1.5 :description "user home manager"
1.6 :thunk homer-check
1.7- :opts (make-opts
1.8- (:name "level" :global t :description "set the log level" :thunk homer-log-level)
1.9- (:name "help" :global t :description "print help" :thunk homer-help)
1.10- (:name "version" :global t :description "print version" :thunk homer-version)
1.11- (:name "force" :global t :description "use force" :thunk homer-force))
1.12- :cmds (make-cmds
1.13- (:name show :thunk homer-show)
1.14+ :opts ((:name "level" :global t :description "set the log level" :thunk homer-log-level)
1.15+ (:name "help" :global t :description "print help" :thunk homer-help)
1.16+ (:name "version" :global t :description "print version" :thunk homer-version)
1.17+ (:name "force" :global t :description "use force" :thunk homer-force))
1.18+ :cmds ((:name show :thunk homer-show)
1.19 (:name check :thunk homer-check)
1.20 (:name push :thunk homer-push)
1.21 (:name pull :thunk homer-pull)
2.1--- a/lisp/bin/organ.lisp Sun Jul 28 21:47:57 2024 -0400
2.2+++ b/lisp/bin/organ.lisp Mon Jul 29 20:55:09 2024 -0400
2.3@@ -38,24 +38,22 @@
2.4 :version "0.0.1"
2.5 :description "org-mode toolbox"
2.6 :thunk organ-describe
2.7- :opts (make-opts
2.8- (:name "level" :global t :description "set the log level" :thunk organ-log-level)
2.9- (:name "help" :global t :description "print help" :thunk organ-help)
2.10- (:name "version" :global t :description "print version" :thunk organ-version)
2.11- ;; (:name "output" :description "output file" :kind file :thunk organ-output)
2.12- )
2.13- :cmds (make-cmds
2.14- (:name inspect
2.15- :description "inspect an org file"
2.16- :thunk organ-inspect)
2.17- (:name show
2.18- :description "display local org info"
2.19- :thunk organ-show)
2.20- (:name describe
2.21- :description "describe local org info"
2.22- :thunk organ-describe)
2.23- (:name parse
2.24- :thunk organ-parse)))
2.25+ :opts ((:name "level" :global t :description "set the log level" :thunk organ-log-level)
2.26+ (:name "help" :global t :description "print help" :thunk organ-help)
2.27+ (:name "version" :global t :description "print version" :thunk organ-version)
2.28+ ;; (:name "output" :description "output file" :kind file :thunk organ-output)
2.29+ )
2.30+ :cmds ((:name inspect
2.31+ :description "inspect an org file"
2.32+ :thunk organ-inspect)
2.33+ (:name show
2.34+ :description "display local org info"
2.35+ :thunk organ-show)
2.36+ (:name describe
2.37+ :description "describe local org info"
2.38+ :thunk organ-describe)
2.39+ (:name parse
2.40+ :thunk organ-parse)))
2.41
2.42 (defun run ()
2.43 (let ((*log-level* :info))
3.1--- a/lisp/bin/packy.lisp Sun Jul 28 21:47:57 2024 -0400
3.2+++ b/lisp/bin/packy.lisp Mon Jul 29 20:55:09 2024 -0400
3.3@@ -1,27 +1,28 @@
3.4 (defpackage :bin/packy
3.5- (:use :cl :std :sb-ext :cli :packy :clap)
3.6+ (:use :cl :std :sb-ext :cli :packy :clap :log)
3.7 (:export :main))
3.8
3.9 (in-package :bin/packy)
3.10
3.11 ;;; CLI
3.12+(defvar *pk-targets* nil)
3.13 (defopt pk-help (print-help *cli*))
3.14 (defopt pk-version (print-version *cli*))
3.15 (defopt pk-log-level (when *arg* (setq *log-level* :debug)))
3.16-
3.17-(defcmd pk-show)
3.18+(defopt pk-target (setq *pk-targets* *arg*))
3.19+(defcmd pk-show (print (list *optc* *argc* *opts* *args* *pk-targets*)))
3.20
3.21 (define-cli *cli*
3.22 :name "packy"
3.23 :version "0.1.0"
3.24 :description "Universal Package Manager"
3.25 :thunk pk-show
3.26- :opts (make-opts
3.27- (:name "level" :global t :description "set the log level" :thunk pk-log-level)
3.28- (:name "help" :global t :description "print help" :thunk pk-help)
3.29- (:name "version" :global t :description "print version" :thunk pk-version))
3.30- :cmds (make-cmds
3.31- (:name show :thunk pk-show)))
3.32+ :opts ((:name "level" :global t :description "set the log level" :thunk pk-log-level)
3.33+ (:name "help" :global t :description "print help" :thunk pk-help)
3.34+ (:name "version" :global t :description "print version" :thunk pk-version))
3.35+ :cmds ((:name show
3.36+ :opts (:name "target" :thunk pk-target)
3.37+ :thunk pk-show)))
3.38
3.39 (defun run ()
3.40 (let ((*log-level* :info))
4.1--- a/lisp/bin/rdb.lisp Sun Jul 28 21:47:57 2024 -0400
4.2+++ b/lisp/bin/rdb.lisp Mon Jul 29 20:55:09 2024 -0400
4.3@@ -2,7 +2,7 @@
4.4
4.5 ;;; Code:
4.6 (uiop:define-package :bin/rdb
4.7- (:use :cl :rdb :std :cli/clap :log :clap)
4.8+ (:use :cl :rdb :std :cli/clap :log :clap)
4.9 (:export :main))
4.10
4.11 (in-package :bin/rdb)
4.12@@ -64,28 +64,26 @@
4.13 (let ((seed (random 32)))
4.14 (dotimes (ii seed)
4.15 (setf (aref val ii) (random 256))))
4.16- (nreversef val)
4.17- (put-key db
4.18- (sb-ext:string-to-octets (string (gensym "foo")))
4.19- val)))))
4.20+ (nreversef val)
4.21+ (put-key db
4.22+ (sb-ext:string-to-octets (string (gensym "foo")))
4.23+ val)))))
4.24
4.25 (define-cli *cli*
4.26 :name "rdb"
4.27 :version "0.1.0"
4.28 :thunk rdb-show
4.29 :description "A simple helper for RocksDB."
4.30- :opts (make-opts
4.31- (:name "level" :global t :description "set the log level" :thunk rdb-log-level)
4.32- (:name "help" :global t :description "print help" :thunk rdb-help)
4.33- (:name "version" :global t :description "print version" :thunk rdb-version)
4.34- (:name "db" :global t :description "target db" :thunk rdb-target-db :kind dir))
4.35- :cmds (make-cmds
4.36- (:name new :thunk rdb-new)
4.37- (:name show :thunk rdb-show)
4.38- (:name set :thunk rdb-set)
4.39- (:name get :thunk rdb-get)
4.40- (:name fuzz :thunk rdb-fuzz)
4.41- (:name destroy :thunk rdb-destroy)))
4.42+ :opts ((:name "level" :global t :description "set the log level" :thunk rdb-log-level)
4.43+ (:name "help" :global t :description "print help" :thunk rdb-help)
4.44+ (:name "version" :global t :description "print version" :thunk rdb-version)
4.45+ (:name "db" :global t :description "target db" :thunk rdb-target-db :kind dir))
4.46+ :cmds ((:name new :thunk rdb-new)
4.47+ (:name show :thunk rdb-show)
4.48+ (:name set :thunk rdb-set)
4.49+ (:name get :thunk rdb-get)
4.50+ (:name fuzz :thunk rdb-fuzz)
4.51+ (:name destroy :thunk rdb-destroy)))
4.52
4.53 (defmain ()
4.54 (let ((*log-level* :info))
5.1--- a/lisp/bin/skel.lisp Sun Jul 28 21:47:57 2024 -0400
5.2+++ b/lisp/bin/skel.lisp Mon Jul 29 20:55:09 2024 -0400
5.3@@ -17,10 +17,10 @@
5.4 (defopt skc-help (print-help *cli*) *arg*)
5.5 (defopt skc-version (print-version *cli*))
5.6 (defopt skc-level *log-level*
5.7- (setq *log-level* (if *arg* (if (stringp *arg*)
5.8- (sb-int:keywordicate (string-upcase *arg*))
5.9- *arg*)
5.10- :info)))
5.11+ (setq *log-level* (if *arg* (if (stringp *arg*)
5.12+ (sb-int:keywordicate (string-upcase *arg*))
5.13+ *arg*)
5.14+ :info)))
5.15
5.16 ;; TODO 2023-10-13: almost there
5.17 ;; (defopt skc-config
5.18@@ -69,46 +69,44 @@
5.19 collect (sk-slot-case a))))
5.20 (sk-view (if (= 1 (length stuff)) (car stuff) stuff)))
5.21 (sk-view (if (boundp '*skel-project*) *skel-project*
5.22- (if (boundp '*skel-user-config*) *skel-user-config*
5.23- (if (boundp '*skel-system-config*) *skel-system-config*
5.24- (skel-simple-error "skel config files not installed")))))))
5.25+ (if (boundp '*skel-user-config*) *skel-user-config*
5.26+ (if (boundp '*skel-system-config*) *skel-system-config*
5.27+ (skel-simple-error "skel config files not installed")))))))
5.28
5.29 (defcmd skc-id
5.30 (println (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t)))))
5.31
5.32-(defcmd skc-compile ()
5.33- (sk-call *skel-project* :compile))
5.34+(defun call-with-args (action)
5.35+ (if (zerop *argc*)
5.36+ (sk-call *skel-project* action)
5.37+ (mapcar (lambda (x)
5.38+ (sk-call *skel-project* (print (keywordicate action '- (string-upcase x)))))
5.39+ *args*)))
5.40
5.41-(defcmd skc-build ()
5.42- (sk-call *skel-project* :build))
5.43-(defcmd skc-dist ()
5.44- (sk-call *skel-project* :dist))
5.45-(defcmd skc-install ()
5.46- (sk-call *skel-project* :install))
5.47-(defcmd skc-pack ()
5.48- (sk-call *skel-project* :pack))
5.49-(defcmd skc-unpack ()
5.50- (sk-call *skel-project* :unpack))
5.51-(defcmd skc-bundle ()
5.52- (sk-call *skel-project* :bundle))
5.53-(defcmd skc-unbundle ()
5.54- (sk-call *skel-project* :unbundle))
5.55-(defcmd skc-clean ()
5.56- (sk-call *skel-project* :clean))
5.57-(defcmd skc-test ()
5.58- (sk-call *skel-project* :test))
5.59-(defcmd skc-bench ()
5.60- (sk-call *skel-project* :bench))
5.61-
5.62-(defcmd skc-rev
5.63- (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
5.64- (:hg (progn
5.65- (let ((proc (run-hg-command "id" (list "-i") :stream)))
5.66- (println (read-line (process-output proc))))))
5.67- (:git (progn
5.68- (let ((proc (run-git-command "rev-parse" (list "HEAD") :stream)))
5.69- (println (read-line (process-output proc))))))
5.70- (t (skel-simple-error "unknown VC type"))))
5.71+(defcmd skc-compile
5.72+ (call-with-args :compile))
5.73+(defcmd skc-build
5.74+ (call-with-args :build))
5.75+(defcmd skc-dist
5.76+ (call-with-args :dist))
5.77+(defcmd skc-install
5.78+ (call-with-args :install))
5.79+(defcmd skc-pack
5.80+ (call-with-args :pack))
5.81+(defcmd skc-unpack
5.82+ (call-with-args :unpack))
5.83+(defcmd skc-bundle
5.84+ (call-with-args :bundle))
5.85+(defcmd skc-unbundle
5.86+ (call-with-args :unbundle))
5.87+(defcmd skc-clean
5.88+ (call-with-args :clean))
5.89+(defcmd skc-test
5.90+ (call-with-args :test))
5.91+(defcmd skc-bench
5.92+ (call-with-args :bench))
5.93+(defcmd skc-save
5.94+ (call-with-args :save))
5.95
5.96 (defun sk-slot-case (sel)
5.97 (std/string:string-case (sel :default (skel-simple-error "invalid slot"))
5.98@@ -227,129 +225,122 @@
5.99
5.100 (defcmd skc-new
5.101 (trace! *args* *opts*))
5.102-
5.103+
5.104 (define-cli *cli*
5.105 :name "skel"
5.106 :version #.(format nil "0.1.1:~A" (read-line (sb-ext:process-output (vc:run-hg-command "id" '("-i") :stream))))
5.107 :description "A hacker's project compiler."
5.108 :thunk skc-show
5.109- :opts (make-opts
5.110- (:name "help" :global t :description "print this message"
5.111- :thunk skc-help)
5.112- (:name "version" :global t :description "print version"
5.113- :thunk skc-version)
5.114- (:name "level" :global t :description "set log level (warn,info,debug,trace)"
5.115- :thunk skc-level)
5.116- (:name "config" :global t :description "set a custom skel user config" :kind file)
5.117- (:name "input" :global t :description "input source" :kind string)
5.118- (:name "output" :global t :description "output target" :kind string))
5.119- :cmds (make-cmds
5.120- (:name init
5.121- :description "initialize a skelfile in the current directory"
5.122- :opts (make-opts (:name "name" :description "project name" :kind string))
5.123- :thunk skc-init)
5.124- (:name new
5.125- :description "make a new skel project"
5.126- :opts (make-opts (:name "name" :description "project name" :kind string))
5.127- :thunk skc-new)
5.128- (:name describe
5.129- :description "describe a skelfile"
5.130- :thunk skc-describe)
5.131- (:name show
5.132- :description "show project slots"
5.133- :opts (make-opts
5.134- (:name "file" :description "path to skelfile" :kind file)
5.135- (:name "user" :description "print user configuration")
5.136- (:name "system" :description "print system configuration"))
5.137- :thunk skc-show)
5.138- (:name vc
5.139- :description "version control"
5.140- :thunk skc-vc
5.141- :opts (make-opts
5.142- (:name "root" :description "repository path" :kind directory)))
5.143- (:name id
5.144- :description "print the project id"
5.145- :thunk skc-id)
5.146- (:name rev
5.147- :description "print the current vc revision id"
5.148- :thunk skc-rev)
5.149- (:name inspect
5.150- :description "inspect the project skelfile"
5.151- :opts (make-opts (:name "file" :description "path to skelfile" :kind file))
5.152- :thunk skc-inspect)
5.153- #+tools
5.154- (:name view
5.155- :description "view an object in a new GUI window"
5.156- :thunk skc-view)
5.157- (:name make
5.158- :description "build project targets"
5.159- :opts (make-opts (:name "target" :description "target to build" :kind string))
5.160- :thunk skc-make)
5.161- (:name run
5.162- :description "run a script or command"
5.163- :thunk skc-run)
5.164- (:name compile
5.165- :description "compile source code"
5.166- :thunk skc-compile)
5.167- (:name build
5.168- :description "build programs and libraries"
5.169- :thunk skc-build)
5.170- (:name dist
5.171- :description "distribute build artifacts"
5.172- :thunk skc-dist)
5.173- (:name install
5.174- :description "install stuff"
5.175- :thunk skc-install)
5.176- (:name pack
5.177- :description "pack stuff"
5.178- :thunk skc-pack)
5.179- (:name unpack
5.180- :description "unpack stuff"
5.181- :thunk skc-unpack)
5.182- (:name bundle
5.183- :description "bundle source code"
5.184- :thunk skc-bundle)
5.185- (:name unbundle
5.186- :description "unbundle source code"
5.187- :thunk skc-unbundle)
5.188- (:name clean
5.189- :description "clean up the project"
5.190- :thunk skc-clean)
5.191- (:name test
5.192- :description "run tests"
5.193- :thunk skc-test)
5.194- (:name bench
5.195- :description "run benchmark"
5.196- :thunk skc-bench)
5.197- (:name status
5.198- :description "print the vc status"
5.199- :thunk skc-status)
5.200- (:name push
5.201- :description "push the current project upstream"
5.202- :thunk skc-push)
5.203- (:name pull
5.204- :description "pull the current project from remote"
5.205- :thunk skc-pull)
5.206- (:name clone
5.207- :description "clone a remote project"
5.208- :thunk skc-clone)
5.209- (:name commit
5.210- :description "commit changes to the project vc"
5.211- :thunk skc-commit)
5.212- (:name edit
5.213- :description "edit a project file in emacs."
5.214- :thunk skc-edit)
5.215- (:name shell
5.216- :description "open the sk-shell interpreter"
5.217- :thunk skc-shell)))
5.218+ :opts ((:name "help" :global t :description "print this message"
5.219+ :thunk skc-help)
5.220+ (:name "version" :global t :description "print version"
5.221+ :thunk skc-version)
5.222+ (:name "level" :global t :description "set log level (warn,info,debug,trace)"
5.223+ :thunk skc-level)
5.224+ (:name "config" :global t :description "set a custom skel user config" :kind file)
5.225+ (:name "input" :global t :description "input source" :kind string)
5.226+ (:name "output" :global t :description "output target" :kind string))
5.227+ :cmds ((:name init
5.228+ :description "initialize a skelfile in the current directory"
5.229+ :opts ((:name "name" :description "project name" :kind string))
5.230+ :thunk skc-init)
5.231+ (:name new
5.232+ :description "make a new skel project"
5.233+ :opts ((:name "name" :description "project name" :kind string))
5.234+ :thunk skc-new)
5.235+ (:name describe
5.236+ :description "describe a skelfile"
5.237+ :thunk skc-describe)
5.238+ (:name show
5.239+ :description "show project slots"
5.240+ :opts ((:name "file" :description "path to skelfile" :kind file)
5.241+ (:name "user" :description "print user configuration")
5.242+ (:name "system" :description "print system configuration"))
5.243+ :thunk skc-show)
5.244+ (:name vc
5.245+ :description "version control"
5.246+ :thunk skc-vc
5.247+ :opts ((:name "root" :description "repository path" :kind directory)))
5.248+ (:name id
5.249+ :description "print the project id"
5.250+ :thunk skc-id)
5.251+ (:name inspect
5.252+ :description "inspect the project skelfile"
5.253+ :opts ((:name "file" :description "path to skelfile" :kind file))
5.254+ :thunk skc-inspect)
5.255+ #+tools
5.256+ (:name view
5.257+ :description "view an object in a new GUI window"
5.258+ :thunk skc-view)
5.259+ (:name make
5.260+ :description "build project targets"
5.261+ :opts ((:name "target" :description "target to build" :kind string))
5.262+ :thunk skc-make)
5.263+ (:name run
5.264+ :description "run a script or command"
5.265+ :thunk skc-run)
5.266+ (:name compile
5.267+ :description "compile source code"
5.268+ :thunk skc-compile)
5.269+ (:name build
5.270+ :description "build programs and libraries"
5.271+ :thunk skc-build)
5.272+ (:name dist
5.273+ :description "distribute build artifacts"
5.274+ :thunk skc-dist)
5.275+ (:name install
5.276+ :description "install stuff"
5.277+ :thunk skc-install)
5.278+ (:name pack
5.279+ :description "pack stuff"
5.280+ :thunk skc-pack)
5.281+ (:name unpack
5.282+ :description "unpack stuff"
5.283+ :thunk skc-unpack)
5.284+ (:name bundle
5.285+ :description "bundle source code"
5.286+ :thunk skc-bundle)
5.287+ (:name unbundle
5.288+ :description "unbundle source code"
5.289+ :thunk skc-unbundle)
5.290+ (:name clean
5.291+ :description "clean up the project"
5.292+ :thunk skc-clean)
5.293+ (:name test
5.294+ :description "run tests"
5.295+ :thunk skc-test)
5.296+ (:name bench
5.297+ :description "run benchmark"
5.298+ :thunk skc-bench)
5.299+ (:name status
5.300+ :description "print the vc status"
5.301+ :thunk skc-status)
5.302+ (:name push
5.303+ :description "push the current project upstream"
5.304+ :thunk skc-push)
5.305+ (:name pull
5.306+ :description "pull the current project from remote"
5.307+ :thunk skc-pull)
5.308+ (:name clone
5.309+ :description "clone a remote project"
5.310+ :thunk skc-clone)
5.311+ (:name commit
5.312+ :description "commit changes to the project vc"
5.313+ :thunk skc-commit)
5.314+ (:name edit
5.315+ :description "edit a project file in emacs."
5.316+ :thunk skc-edit)
5.317+ (:name shell
5.318+ :description "open the sk-shell interpreter"
5.319+ :thunk skc-shell)))
5.320
5.321 (defmain ()
5.322 (in-package :sk-user)
5.323 (let ((*log-level* :info))
5.324 (in-readtable :shell)
5.325 (with-cli (opts cmds) *cli*
5.326+ (debug-opts *cli*)
5.327 (init-skel-vars)
5.328 (when-let ((project (find-skelfile #P".")))
5.329 (setq *skel-project* (load-skelfile project)))
5.330- (do-cmd *cli*)
5.331- (debug-opts *cli*))))
5.332+ (do-cmd *cli*))))
6.1--- a/lisp/ffi/arrow/tests.lisp Sun Jul 28 21:47:57 2024 -0400
6.2+++ b/lisp/ffi/arrow/tests.lisp Mon Jul 29 20:55:09 2024 -0400
6.3@@ -9,4 +9,5 @@
6.4 (defsuite :arrow)
6.5 (in-suite :arrow)
6.6 (load-arrow)
6.7+
6.8 (deftest sanity ())
7.1--- a/lisp/ffi/tree-sitter/lang.lisp Sun Jul 28 21:47:57 2024 -0400
7.2+++ b/lisp/ffi/tree-sitter/lang.lisp Mon Jul 29 20:55:09 2024 -0400
7.3@@ -14,13 +14,13 @@
7.4 ;;; Code:
7.5 (in-package :tree-sitter)
7.6
7.7+(defvar *ts-langs* (make-hash-table))
7.8+
7.9 (defun language-module (name)
7.10 (funcall
7.11 (or (gethash (sb-int:keywordicate name) *ts-langs*) ;; symbol -> keyword, string must be UPCASE
7.12 (error "tree-sitter language module not found: ~s." name))))
7.13
7.14-(defvar *ts-langs* (make-hash-table))
7.15-
7.16 (macrolet ((def-ts-lang-loader (lang)
7.17 (let ((name (symbolicate 'tree-sitter- lang)))
7.18 (let ((fname (symbolicate 'load- name)))
8.1--- a/lisp/lib/cli/clap/cli.lisp Sun Jul 28 21:47:57 2024 -0400
8.2+++ b/lisp/lib/cli/clap/cli.lisp Mon Jul 29 20:55:09 2024 -0400
8.3@@ -22,7 +22,7 @@
8.4 %class :cli)
8.5 (setq %name (car name)
8.6 %class (cdr name)))
8.7- `(,*default-cli-def* ,%name (apply #'make-cli ,%class (walk-cli-slots ',body)))))
8.8+ `(,*default-cli-def* ,%name (apply #'make-cli ,%class ',body))))
8.9
8.10 (defmacro defmain ((&key (exit t) (export t)) &body body)
8.11 "Define a CLI main function in the current package."
8.12@@ -38,25 +38,25 @@
8.13 ;; RESEARCH 2023-09-12: closed over hash-table with short/long flags
8.14 ;; to avoid conflicts. if not, need something like a flag-function
8.15 ;; slot at class allocation.
8.16-(defmacro make-opts (&body opts)
8.17+(defun make-opts (opts)
8.18 "Make a vector of CLI-OPTs based on OPTS."
8.19- `(map 'vector
8.20- (lambda (x)
8.21- (etypecase x
8.22- (string (make-cli-opt :name x))
8.23- (list (apply #'make-cli :opt x))
8.24- (t (make-cli :opt :name (format nil "~(~A~)" x) :global t))))
8.25- (walk-cli-slots ',opts)))
8.26+ (map 'vector
8.27+ (lambda (x)
8.28+ (etypecase x
8.29+ (string (make-cli-opt :name x))
8.30+ (list (apply #'make-cli :opt x))
8.31+ (t (make-cli :opt :name (format nil "~(~A~)" x) :global t))))
8.32+ opts))
8.33
8.34-(defmacro make-cmds (&body cmds)
8.35+(defun make-cmds (cmds)
8.36 "Make a vector of CLI-CMDs based on CMDS."
8.37- `(map 'vector
8.38+ (map 'vector
8.39 (lambda (x)
8.40 (etypecase x
8.41 (string (make-cli :cmd :name x))
8.42 (list (apply #'make-cli :cmd x))
8.43 (t (make-cli :cmd :name (format nil "~(~A~)" x)))))
8.44- (walk-cli-slots ',cmds)))
8.45+ cmds))
8.46
8.47 (defclass cli (cli-cmd)
8.48 ;; name slot defaults to *package*, must be string
9.1--- a/lisp/lib/cli/clap/cmd.lisp Sun Jul 28 21:47:57 2024 -0400
9.2+++ b/lisp/lib/cli/clap/cmd.lisp Mon Jul 29 20:55:09 2024 -0400
9.3@@ -24,10 +24,10 @@
9.4 a CLI is called without arguments, and all subcommands."))
9.5
9.6 (defmethod initialize-instance :after ((self cli-cmd) &key)
9.7- (with-slots (name cmds opts thunk) self
9.8+ (with-slots (name thunk opts cmds) self
9.9 (unless (stringp name) (setf name (format nil "~(~A~)" name)))
9.10- (unless (vectorp cmds) (setf cmds (funcall (compile nil `(lambda () ,cmds)))))
9.11- (unless (vectorp opts) (setf opts (funcall (compile nil `(lambda () ,opts)))))
9.12+ (unless (vectorp cmds) (setf cmds (make-cmds cmds)))
9.13+ (unless (vectorp opts) (setf opts (make-opts opts)))
9.14 (when (symbolp thunk) (setf thunk (symbol-function thunk)))
9.15 self))
9.16
9.17@@ -139,7 +139,7 @@
9.18 should be."
9.19 (make-cli-ast
9.20 (let ((holes)) ;; list of arg indexes which can be skipped since they're
9.21- ;; consumed by an opt
9.22+ ;; consumed by an opt
9.23 (loop
9.24 for i below (length args)
9.25 for (a . args) on args
10.1--- a/lisp/lib/cli/clap/macs.lisp Sun Jul 28 21:47:57 2024 -0400
10.2+++ b/lisp/lib/cli/clap/macs.lisp Mon Jul 29 20:55:09 2024 -0400
10.3@@ -47,16 +47,6 @@
10.4 (setq *arg* arg)
10.5 ,@body))
10.6
10.7-(declaim (inline walk-cli-slots))
10.8-(defun walk-cli-slots (cli)
10.9- "Walk the plist CLI, performing actions as necessary based on the slot
10.10-keys."
10.11- (loop for kv in (group cli 2)
10.12- when (eql :thunk (car kv))
10.13- return (let ((th (cdr kv)))
10.14- (if (or (functionp th) (symbolp th)) (funcall th) (compile nil (lambda () th)))))
10.15- cli)
10.16-
10.17 ;; TODO 2023-10-06:
10.18 ;; (defmacro gen-cli-thunk (pvars &rest thunk)
10.19 ;; "Generate and return a function based on THUNK suitable for the :thunk
11.1--- a/lisp/lib/cli/clap/pkg.lisp Sun Jul 28 21:47:57 2024 -0400
11.2+++ b/lisp/lib/cli/clap/pkg.lisp Mon Jul 29 20:55:09 2024 -0400
11.3@@ -17,7 +17,7 @@
11.4
11.5 (defpackage :cli/clap/macs
11.6 (:use :cl :std :log :sb-ext :cli/clap/util :cli/clap/vars)
11.7- (:export :defopt :defcmd :walk-cli-slots
11.8+ (:export :defopt :defcmd
11.9 :make-opt-parser :with-cli-handlers :make-shorty))
11.10
11.11 (defpackage :cli/clap/proto
12.1--- a/lisp/lib/cli/clap/vars.lisp Sun Jul 28 21:47:57 2024 -0400
12.2+++ b/lisp/lib/cli/clap/vars.lisp Mon Jul 29 20:55:09 2024 -0400
12.3@@ -34,7 +34,7 @@
12.4
12.5 (defvar *opts* nil
12.6 "Current command options.
12.7-Bound for the lifetime of a DEFOPT function.")
12.8+Bound for the lifetime of a DEFCMD function.")
12.9
12.10 (declaim (unsigned-byte *argc* *optc*))
12.11 (defvar *argc* 0
12.12@@ -45,4 +45,8 @@
12.13 (defvar *optc* 0
12.14 "Current count of command options.
12.15 This value may be updated throughout the lifetime of a function defined with
12.16-DEFOPT.")
12.17+DEFCMD.")
12.18+
12.19+(defvar *arg* nil
12.20+ "Current option argument.
12.21+Bound for the lifetime of afunction defined with DEFCMD.")
13.1--- a/skelfile Sun Jul 28 21:47:57 2024 -0400
13.2+++ b/skelfile Mon Jul 29 20:55:09 2024 -0400
13.3@@ -16,31 +16,31 @@
13.4 :rules
13.5 ((all (%stash
13.6 psl.dat parquet.json
13.7- compile std prelude user
13.8- infra core tests rdb
13.9- skel organ homer packy
13.10- fasl rust-bin tree-sitter-alien))
13.11+ compile save-std save-prelude save-user
13.12+ save-infra save-core save-tests build-rdb
13.13+ build-skel build-organ build-homer build-packy
13.14+ fasl rust-bin build-tree-sitter-alien))
13.15 (clean ()
13.16 #$rm -vrf .stash$#
13.17 #$find emacs -name '*.elc' -type f -delete$#
13.18 #$find lisp -name '*.fasl' -type f -delete$#
13.19 #$echo 'cargo clean:' && cd rust && cargo clean$#)
13.20- (tree-sitter-alien () #$cd lisp/ffi/tree-sitter &&
13.21- clang -g -O2 -Wall -Wno-unused-value -ltree-sitter -shared \
13.22- alien.c -o ../../../.stash/libtree-sitter-alien.so$#)
13.23- (tree-sitter-alien-install () #$cp .stash/libtree-sitter-alien.so /usr/local/lib/$#)
13.24- (psl.dat ()
13.25+ (build-tree-sitter-alien () #$cd lisp/ffi/tree-sitter &&
13.26+ clang -g -O2 -Wall -Wno-unused-value -ltree-sitter -shared \
13.27+ alien.c -o ../../../.stash/libtree-sitter-alien.so$#)
13.28+ (install-tree-sitter-alien () #$cp .stash/libtree-sitter-alien.so /usr/local/lib/$#)
13.29+ (psl.dat (%stash)
13.30 (download "https://publicsuffix.org/list/public_suffix_list.dat" :output ".stash/psl.dat"))
13.31- (parquet.thrift ()
13.32+ (parquet.thrift (%stash)
13.33 (download
13.34 "https://raw.githubusercontent.com/apache/parquet-format/master/src/main/thrift/parquet.thrift"
13.35 :output ".stash/parquet.thrift")
13.36 #$thrift --gen json -out .stash .stash/parquet.thrift$#)
13.37- (parquet.json ()
13.38+ (parquet.json (%stash)
13.39 (download "https://packy.compiler.company/data/parquet.json"
13.40 :output ".stash/parquet.json"))
13.41- (parquet-test-data () (download "https://packy.compiler.company/data/test/alltypes_plain.parquet"
13.42- :output ".stash/alltypes_plain.parquet"))
13.43+ (parquet-test-data (%stash) (download "https://packy.compiler.company/data/test/alltypes_plain.parquet"
13.44+ :output ".stash/alltypes_plain.parquet"))
13.45 ;; lisp
13.46 (%stash () #$mkdir -pv .stash$#)
13.47 (rdb (%stash) (with-sbcl (:noinform t :quit t)
13.48@@ -56,26 +56,26 @@
13.49 (ql:quickload :bin/skel)
13.50 (asdf:make :bin/skel))
13.51 #$mv lisp/bin/skel .stash/skel$#)
13.52- (organ (%stash) (with-sbcl (:noinform t :quit t)
13.53+ (build-organ (%stash) (with-sbcl (:noinform t :quit t)
13.54 (ql:quickload :bin/organ)
13.55 (asdf:make :bin/organ))
13.56 #$mv lisp/bin/organ .stash/organ$#)
13.57- (homer (%stash) (with-sbcl (:noinform t :quit t)
13.58+ (build-homer (%stash) (with-sbcl (:noinform t :quit t)
13.59 (ql:quickload :bin/homer)
13.60 (asdf:make :bin/homer))
13.61 #$mv lisp/bin/homer .stash/homer$#)
13.62- (packy (%stash) (with-sbcl (:noinform t :quit t)
13.63+ (build-packy (%stash) (with-sbcl (:noinform t :quit t)
13.64 (ql:quickload :bin/packy)
13.65 (asdf:make :bin/packy))
13.66 #$mv lisp/bin/packy .stash/packy$#)
13.67- (build (rdb skel organ homer packy))
13.68+ (build (build-rdb build-skel build-organ build-homer build-packy))
13.69 (compile () #$./x.lisp compile$#)
13.70- (std () #$./x.lisp save std$#)
13.71- (prelude () #$./x.lisp save prelude$#)
13.72- (user () #$./x.lisp save user$#)
13.73- (infra () #$./x.lisp save infra$#)
13.74- (core () #$./x.lisp save core$#)
13.75- (tests () #$./x.lisp save tests$#)
13.76+ (save-std () #$./x.lisp save std$#)
13.77+ (save-prelude () #$./x.lisp save prelude$#)
13.78+ (save-user () #$./x.lisp save user$#)
13.79+ (save-infra () #$./x.lisp save infra$#)
13.80+ (save-core () #$./x.lisp save core$#)
13.81+ (save-tests () #$./x.lisp save tests$#)
13.82 (prelude-fasl () #$./x.lisp make prelude$#)
13.83 (user-fasl () #$./x.lisp make user$#)
13.84 (core-fasl () #$./x.lisp make core$#)
