1.1--- a/lisp/bin/skel.lisp	Thu May 09 18:14:53 2024 -0400
     1.2+++ b/lisp/bin/skel.lisp	Thu May 09 19:01:01 2024 -0400
     1.3@@ -50,6 +50,17 @@
     1.4 (defcmd skc-id
     1.5   (println (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t)))))
     1.6 
     1.7+(defcmd skc-rev
     1.8+  (case (sk-vc (find-skelfile #P"." :load t))
     1.9+    (:hg (progn
    1.10+           (let ((proc (run-hg-command "id" (list "-i") :stream)))
    1.11+             (copy-stream (process-output proc) *standard-output*)
    1.12+             (finish-output))))
    1.13+    (t (progn
    1.14+         (let ((proc (run-git-command "rev-parse" (list "HEAD") :stream)))
    1.15+           (copy-stream (process-output proc) *standard-output*)
    1.16+           (finish-output))))))
    1.17+
    1.18 (defun skc-show-case (sel)
    1.19   (std/string:string-case (sel :default (nyi!))
    1.20     (":id" (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t))))
    1.21@@ -150,6 +161,9 @@
    1.22           (:name id
    1.23            :description "print the project id"
    1.24            :thunk skc-id)
    1.25+          (:name rev
    1.26+           :description "print the current vc revision id"
    1.27+           :thunk skc-rev)
    1.28 	  (:name inspect
    1.29 	   :description "inspect the project skelfile"
    1.30 	   :opts (make-opts (:name "file" :description "path to skelfile" :kind file))

     2.1--- a/lisp/lib/cli/clap.lisp	Thu May 09 18:14:53 2024 -0400
     2.2+++ b/lisp/lib/cli/clap.lisp	Thu May 09 19:01:01 2024 -0400
     2.3@@ -4,10 +4,11 @@
     2.4 
     2.5 ;;; Code:
     2.6 (in-package :cli/clap)
     2.7-
     2.8+(declaim (optimize (speed 3)))
     2.9 (defun cli-arg0 () (car sb-ext:*posix-argv*))
    2.10 (defun cli-args () (cdr sb-ext:*posix-argv*))
    2.11 
    2.12+(declaim (simple-string *cli-group-separator*))
    2.13 (defparameter *cli-group-separator*
    2.14   "--"
    2.15   "A marker specifying the end of a unique group of CLI args.")
    2.16@@ -18,7 +19,7 @@
    2.17 (defmacro argp (arg &optional (args (cli-args)))
    2.18   "Test for presence of ARG in ARGS. Return the tail of
    2.19 ARGS starting from the position of ARG."
    2.20-  `(member ,arg ,args :test #'string=))
    2.21+  `(member ,arg ,args :test 'equal))
    2.22 
    2.23 (defmacro make-shorty (name)
    2.24   "Return the first char of symbol or string NAME."
    2.25@@ -132,25 +133,29 @@
    2.26 	(walk-cli-slots ',opts)))
    2.27 
    2.28 (defun long-opt-p (str)
    2.29+  (declare (simple-string str))
    2.30   (and (char= (aref str 0) (aref str 1) #\-)
    2.31        (> (length str) 2)))
    2.32 
    2.33 (defun short-opt-p (str)
    2.34+  (declare (simple-string str))
    2.35   (and (char= (aref str 0) #\-)
    2.36        (not (char= (aref str 1) #\-))
    2.37        (> (length str) 1)))
    2.38 
    2.39 (defun opt-group-p (str)
    2.40-  (string= str *cli-group-separator*))
    2.41+  (declare (simple-string str))
    2.42+  (equalp str *cli-group-separator*))
    2.43 
    2.44 (defun opt-string-prefix-eq (ch str)
    2.45+  (declare (simple-string str) (character ch))
    2.46   (char= ch (aref str 0)))
    2.47 
    2.48 ;; currently not in use
    2.49 (defun gen-thunk-ll (origin args)
    2.50   (let ((a0 (list (symbolicate '$a 0) origin)))
    2.51     (group 
    2.52-     (nconc (loop for i from 1 for a in args nconc (list (symbolicate '$a i) a)) a0 )
    2.53+     (nconc (loop for i from 1 for a in args nconc (list (symbolicate '$a (the fixnum i)) a)) a0)
    2.54      2)))
    2.55 
    2.56 ;; TODO 2023-10-06: 
    2.57@@ -215,7 +220,10 @@
    2.58 (defun default-thunk (args opts)
    2.59   (declare (ignore args opts)))
    2.60 
    2.61-(defvar *cli-opt-kinds* '(bool str form list sym key num file dir))
    2.62+(declaim ((vector symbol) *cli-opt-kinds*))
    2.63+(defvar *cli-opt-kinds*
    2.64+  (let ((kinds '(bool str form list sym key num file dir)))
    2.65+    (make-array (length kinds) :element-type 'symbol :initial-contents kinds)))
    2.66 
    2.67 (defun cli-opt-kind-p (s)
    2.68   (declare (type symbol s))
    2.69@@ -254,7 +262,7 @@
    2.70   (make-opt-parser (num form) (when (numberp $val) $val))
    2.71 
    2.72   (make-opt-parser (file str) 
    2.73-    (when $val (pathname (parse-native-namestring $val nil *default-pathname-defaults* :as-directory nil))))
    2.74+    (when $val (pathname (the simple-string (parse-native-namestring $val nil *default-pathname-defaults* :as-directory nil)))))
    2.75 
    2.76   (make-opt-parser (dir str) 
    2.77     (when $val (sb-ext:parse-native-namestring $val nil *default-pathname-defaults* :as-directory t))))
    2.78@@ -296,10 +304,11 @@
    2.79 (defmethod print-usage ((self cli-opt) &optional stream)
    2.80   (format stream " -~(~{~A~^/--~}~)~A~A"
    2.81 	  (let ((n (cli-opt-name self)))
    2.82+            (declare (simple-string n))
    2.83 	    (list (make-shorty n) n))
    2.84 	  (if (cli-opt-global self) "* " "  ")
    2.85 	  (if-let ((d (and (slot-boundp self 'description) (cli-opt-description self))))
    2.86-	    (format stream ":  ~A" d)
    2.87+	    (format stream ":  ~A" (the simple-string d))
    2.88 	    "")))
    2.89 
    2.90 (defmethod cli-equal ((a cli-opt) (b cli-opt))
    2.91@@ -556,20 +565,19 @@
    2.92   (println (cli-version self) stream))
    2.93 
    2.94 (defmethod print-help ((self cli) &optional stream) 
    2.95-  (println (format nil "~A v~A" (cli-name self) (cli-version self)) stream)
    2.96+  (println (format nil "~A v~A --- ~A~%" (cli-name self) (cli-version self) (cli-description self)) stream)
    2.97   (print-usage self stream)
    2.98-  (iprintln (cli-description self) 2 stream)
    2.99   ;; (terpri stream)
   2.100-  (iprintln "options:" 2 stream)
   2.101+  (println "options:" stream)
   2.102   (with-slots (opts cmds) self
   2.103     (unless (null opts)
   2.104       (loop for o across opts
   2.105-	    do (iprintln (print-usage o) 4 stream)))
   2.106-    ;; (terpri stream)
   2.107-    (iprintln "commands:" 2 stream)
   2.108+	    do (iprintln (print-usage o) 2 stream)))
   2.109+    (terpri stream)
   2.110+    (println "commands:" stream)
   2.111     (unless (null cmds)
   2.112       (loop for c across cmds
   2.113-	    do (iprintln (print-usage c) 4 stream)))))
   2.114+	    do (iprintln (print-usage c) 2 stream)))))
   2.115 
   2.116 (defmethod cli-equal :before ((a cli) (b cli))
   2.117   "Return T if A is the same cli object as B.
   2.118@@ -678,5 +686,5 @@
   2.119 ;; These macros help with defining a toplevel initialization
   2.120 ;; function. Initialization functions are responsible for parsing runtime
   2.121 ;; options and starting a REPL if needed.
   2.122-(defmacro define-toplevel-init (name (props opts) &body body))
   2.123-(defmacro define-toplevel-repl (name (props opts) &body body))
   2.124+;; (defmacro define-toplevel-init (name (props opts) &body body))
   2.125+;; (defmacro define-toplevel-repl (name (props opts) &body body))

     3.1--- a/lisp/std/list.lisp	Thu May 09 18:14:53 2024 -0400
     3.2+++ b/lisp/std/list.lisp	Thu May 09 19:01:01 2024 -0400
     3.3@@ -100,6 +100,7 @@
     3.4     (circularp object nil)))
     3.5 
     3.6 (defun group (source n)
     3.7+  (declare (fixnum n))
     3.8   (when (zerop n) (error "zero length"))
     3.9   (labels ((rec (source acc)
    3.10              (let ((rest (nthcdr n source)))