1.1--- a/.hgsubstate Fri Nov 24 18:11:20 2023 -0500
1.2+++ b/.hgsubstate Fri Nov 24 21:12:36 2023 -0500
1.3@@ -1,1 +1,1 @@
1.4-0000000000000000000000000000000000000000 infra
1.5+406b7640f3e4a2bdd4c9c4c04341d193a06b4f4f infra
2.1--- a/lisp/app/app.asd Fri Nov 24 18:11:20 2023 -0500
2.2+++ b/lisp/app/app.asd Fri Nov 24 21:12:36 2023 -0500
2.3@@ -1,7 +1,83 @@
2.4 ;;; app.asd --- application library
2.5+#+sb-core-compression
2.6+(defmethod asdf:perform ((o asdf:image-op) (c asdf:system))
2.7+ (uiop:dump-image (asdf:output-file o c) :executable t :compression t))
2.8+
2.9 (defsystem :app
2.10 :class :package-inferred-system
2.11 :defsystem-depends-on (:asdf-package-system)
2.12- :depends-on (:uiop :cl-ppcre :std/all :skel :organ :rdb :app/cli :app/gui :app/web)
2.13+ :depends-on
2.14+ (:uiop :cl-ppcre :std/all :skel :organ :rdb
2.15+ :app/cli/skel :app/cli/organ :app/cli/homer
2.16+ :app/gui/skel
2.17+ :app/web/index :app/web/dash)
2.18+ :in-order-to ((test-op (test-op "app/tests")))
2.19+ :perform (test-op (o c) (symbol-call :std/rt :do-tests :app))
2.20+ :build-operation "program-op"
2.21+ ;; :build-pathname "skel"
2.22+ :entry-point "main")
2.23+
2.24+(defsystem :app/cli/skel
2.25+ :class :package-inferred-system
2.26+ :defsystem-depends-on (:asdf-package-system)
2.27+ :build-operation "program-op"
2.28+ :depends-on (:uiop :cl-ppcre :std/all :skel)
2.29+ :in-order-to ((test-op (test-op "app/tests")))
2.30+ :perform (test-op (o c) (symbol-call :std/rt :do-tests :app))
2.31+ :build-operation "program-op"
2.32+ :build-pathname "skel"
2.33+ :entry-point "app/cli/skel::main")
2.34+
2.35+(defsystem :app/cli/organ
2.36+ :class :package-inferred-system
2.37+ :defsystem-depends-on (:asdf-package-system)
2.38+ :build-operation "program-op"
2.39+ :depends-on (:uiop :cl-ppcre :std/all :organ :nlp)
2.40 :in-order-to ((test-op (test-op "app/tests")))
2.41- :perform (test-op (o c) (symbol-call :std/rt :do-tests :app)))
2.42+ :perform (test-op (o c) (symbol-call :std/rt :do-tests :app))
2.43+ :build-operation "program-op"
2.44+ :build-pathname "organ"
2.45+ :entry-point "app/cli/organ::main")
2.46+
2.47+(defsystem :app/cli/homer
2.48+ :class :package-inferred-system
2.49+ :defsystem-depends-on (:asdf-package-system)
2.50+ :build-operation "program-op"
2.51+ :depends-on (:uiop :cl-ppcre :std/all :organ :skel :nlp)
2.52+ :in-order-to ((test-op (test-op "app/tests")))
2.53+ :perform (test-op (o c) (symbol-call :std/rt :do-tests :app))
2.54+ :build-operation "program-op"
2.55+ :build-pathname "homer"
2.56+ :entry-point "app/cli/homer::main")
2.57+
2.58+(defsystem :app/cli/rdb
2.59+ :class :package-inferred-system
2.60+ :defsystem-depends-on (:asdf-package-system)
2.61+ :build-operation "program-op"
2.62+ :depends-on (:uiop :cl-ppcre :std/all :rdb)
2.63+ :in-order-to ((test-op (test-op "app/tests")))
2.64+ :perform (test-op (o c) (symbol-call :std/rt :do-tests :app))
2.65+ :build-operation "program-op"
2.66+ :build-pathname "rdb"
2.67+ :entry-point "app/cli/rdb::main")
2.68+
2.69+(defsystem :app/web/index
2.70+ :class :package-inferred-system
2.71+ :defsystem-depends-on (:asdf-package-system :lass)
2.72+ :depends-on (:uiop :cl-ppcre :std/all :rdb :hunchentoot :parenscript :lass :spinneret :organ)
2.73+ :components ((:lass-file "web/style"))
2.74+ :build-operation "program-op"
2.75+ :in-order-to ((test-op (test-op "app/tests")))
2.76+ :perform (test-op (o c) (symbol-call :std/rt :do-tests :app))
2.77+ :build-pathname "web-index"
2.78+ :entry-point "app/web/index::main")
2.79+
2.80+(defsystem :app/web/dash
2.81+ :class :package-inferred-system
2.82+ :defsystem-depends-on (:asdf-package-system)
2.83+ :depends-on (:uiop :cl-ppcre :std/all :rdb :hunchentoot :parenscript :lass :spinneret :organ)
2.84+ :build-operation "program-op"
2.85+ :in-order-to ((test-op (test-op "app/tests")))
2.86+ :perform (test-op (o c) (symbol-call :std/rt :do-tests :app))
2.87+ :build-pathname "web-dash"
2.88+ :entry-point "app/web/dash::main")
3.1--- a/lisp/app/cli.lisp Fri Nov 24 18:11:20 2023 -0500
3.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
3.3@@ -1,7 +0,0 @@
3.4-(uiop:define-package :app/cli
3.5- (:use :cl :std)
3.6- (:use-reexport
3.7- :app/cli/skel
3.8- :app/cli/organ
3.9- :app/cli/homer
3.10- :app/cli/rdb))
4.1--- a/lisp/app/cli/organ.lisp Fri Nov 24 18:11:20 2023 -0500
4.2+++ b/lisp/app/cli/organ.lisp Fri Nov 24 21:12:36 2023 -0500
4.3@@ -1,8 +1,65 @@
4.4 ;;; organ.lisp --- Org-mode utility
4.5
4.6 ;;; Code:
4.7-(uiop:define-package :app/cli/organ
4.8- (:use :cl))
4.9+(defpackage :app/cli/organ
4.10+ (:use :cl :organ :std)
4.11+ (:export :main))
4.12
4.13 (in-package :app/cli/organ)
4.14
4.15+(defopt organ-help (print-help $cli))
4.16+(defopt organ-version (print-version $cli))
4.17+(defopt organ-debug (setq *log-level* (if $val :debug nil)))
4.18+
4.19+(defcmd organ-inspect (inspect (read-org-file (car $args))))
4.20+
4.21+(defcmd organ-show
4.22+ (fmt-tree t
4.23+ (remove-if-not
4.24+ (lambda (x) (eql (cadr x) 'headline))
4.25+ (org-parse-lines (read-org-file (open (car $args)))))
4.26+ :layout :down))
4.27+
4.28+(defcmd organ-parse (print t))
4.29+
4.30+(define-cli $cli
4.31+ :name "organ"
4.32+ :version "0.0.1"
4.33+ :description "org-mode toolbox"
4.34+ :opts (make-opts
4.35+ (:name debug :global t)
4.36+ (:name help :global t)
4.37+ (:name version :global t))
4.38+ :cmds (make-cmds
4.39+ (:name inspect :opts (make-opts (:name input)) :thunk organ-inspect)
4.40+ (:name show :thunk organ-show)
4.41+ (:name parse
4.42+ :opts (make-opts (:name input) (:name output))
4.43+ :thunk organ-parse)))
4.44+
4.45+(defun run ()
4.46+ (with-cli (opts cmds args) $cli
4.47+ (when (find-opt $cli "debug" t) (setq *log-level* :debug))
4.48+ (debug! (cli-opts $cli) (cli-cmd-args $cli) (cli-cmds $cli))
4.49+
4.50+ (when-let ((a (find-cmd $cli "inspect" t)))
4.51+ (inspect (read-org-file (open (car a)))))
4.52+
4.53+ (when-let ((a (find-cmd $cli "parse" t)))
4.54+ (fmt-tree t (remove-if #'null (org-parse-lines (read-org-file (open (car a))))) :layout :down))
4.55+
4.56+ (when-let ((a (find-cmd $cli "show" t)))
4.57+ (fmt-tree t
4.58+ (mapcar (lambda (x) `(,(car x) ,(cddr x)))
4.59+ (remove-if-not (lambda (x) (equal (cadr x) (symb 'headline)))
4.60+ (org-parse-lines (read-org-file (open (car a))))))
4.61+ :layout :down))
4.62+
4.63+ (when (find-opt $cli "help" t) (print-help $cli))
4.64+ (when (find-opt $cli "version" t) (print-version $cli))))
4.65+
4.66+(defmain ()
4.67+ (run)
4.68+ (sb-ext:exit :code 0))
4.69+
4.70+
5.1--- a/lisp/app/gui.lisp Fri Nov 24 18:11:20 2023 -0500
5.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
5.3@@ -1,4 +0,0 @@
5.4-(uiop:define-package :app/gui
5.5- (:use :cl :std)
5.6- (:use-reexport
5.7- :app/gui/skel))
6.1--- a/lisp/app/gui/skel.lisp Fri Nov 24 18:11:20 2023 -0500
6.2+++ b/lisp/app/gui/skel.lisp Fri Nov 24 21:12:36 2023 -0500
6.3@@ -1,6 +1,6 @@
6.4 (uiop:define-package :app/gui/skel
6.5 (:use :cl :std :std/gui :skel :skel/core/vc :skel/core/virt :skel/comp/make)
6.6- (:export :gui-main))
6.7+ (:export :main))
6.8
6.9 (in-package :app/gui/skel)
6.10
7.1--- a/lisp/app/web.lisp Fri Nov 24 18:11:20 2023 -0500
7.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
7.3@@ -1,4 +0,0 @@
7.4-(uiop:define-package :app/cli
7.5- (:use :cl :std)
7.6- (:use-reexport
7.7- :app/web/index))
8.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
8.2+++ b/lisp/app/web/dash.lisp Fri Nov 24 21:12:36 2023 -0500
8.3@@ -0,0 +1,42 @@
8.4+;;; web/dash.lisp --- local user dashboard
8.5+
8.6+;;; Code:
8.7+(uiop:define-package :app/web/dash
8.8+ (:use :cl :std :hunchentoot :lass :spinneret)
8.9+ (:export
8.10+ :main
8.11+ :serve-static-assets
8.12+ :*web-dash-port*))
8.13+
8.14+(in-package :app/web/dash)
8.15+
8.16+(defparameter *web-dash-port* 8800)
8.17+(defparameter *web-dash-static-directory* #P"/tmp/web/dash/static/")
8.18+
8.19+(defun serve-static-assets ()
8.20+ "Serve static assets under the /src/static/ directory when called with the /static/ URL root."
8.21+ (push (create-folder-dispatcher-and-handler
8.22+ "/static/" (merge-pathnames *web-dash-static-directory*
8.23+ (asdf:system-source-directory :app) ;; => NOT src/
8.24+ ))
8.25+ *dispatch-table*))
8.26+
8.27+(defvar *server* (serve-static-assets))
8.28+
8.29+(defun main (&key (output *standard-output*))
8.30+ (let ((*standard-output* output))
8.31+ (print "starting dash server on ~A" *web-dash-port*)
8.32+ (handler-case (bt:join-thread (find-if (lambda (th)
8.33+ (search "hunchentoot" (bt:thread-name th)))
8.34+ (bt:all-threads)))
8.35+ ;; Catch a user's C-c
8.36+ (#+sbcl sb-sys:interactive-interrupt
8.37+ #+ccl ccl:interrupt-signal-condition
8.38+ #+clisp system::simple-interrupt-condition
8.39+ #+ecl ext:interactive-interrupt
8.40+ #+allegro excl:interrupt-signal
8.41+ () (progn
8.42+ (format *error-output* "Aborting.~&")
8.43+ (hunchentoot:stop *server*)
8.44+ (uiop:quit)))
8.45+ (error (c) (format t "Woops, an unknown error occured:~&~a~&" c)))))
9.1--- a/lisp/app/web/index.lisp Fri Nov 24 18:11:20 2023 -0500
9.2+++ b/lisp/app/web/index.lisp Fri Nov 24 21:12:36 2023 -0500
9.3@@ -1,5 +1,54 @@
9.4+;;; web/index.lisp --- local user index
9.5+
9.6+;;; Code:
9.7 (uiop:define-package :app/web/index
9.8- (:use :cl :std :organ :hunchentoot)
9.9- (:export :gui-main))
9.10+ (:use :cl :std :hunchentoot :lass :spinneret)
9.11+ (:export
9.12+ :main
9.13+ :*web-index-port*))
9.14
9.15 (in-package :app/web/index)
9.16+
9.17+(defparameter *last-update* (get-universal-time))
9.18+
9.19+(defun current-time () (setq *last-update* (get-universal-time)))
9.20+
9.21+(defparameter *web-index-port* 8888)
9.22+
9.23+(defmacro with-index-page (&optional (title "local index") &body body)
9.24+ `(with-html
9.25+ (:doctype)
9.26+ (:html
9.27+ (:head
9.28+ (:title ,title)
9.29+ (:body
9.30+ ,@body
9.31+ (:footer ("Last update: ~A" (current-time))))))))
9.32+
9.33+ (defun tabulate (&rest rows)
9.34+ (with-html
9.35+ (flet ((tabulate ()
9.36+ (loop for row in rows do
9.37+ (:tr (loop for cell in row do
9.38+ (:td cell))))))
9.39+ (if (find :table (get-html-path))
9.40+ (tabulate)
9.41+ (:table (:tbody (tabulate)))))))
9.42+
9.43+(defun inner-section ()
9.44+ "Binds *HTML-PATH* to replicate the depth the output is used in."
9.45+ (with-html-string
9.46+ (let ((*html-path* (append *html-path* '(:section :section))))
9.47+ (:h* "Heading three levels deep"))))
9.48+
9.49+(defun outer-section (html)
9.50+ "Uses HTML from elsewhere and embed it into a section"
9.51+ (with-html-string
9.52+ (:section
9.53+ (:h* "Heading two levels deep")
9.54+ (:section
9.55+ (:raw html)))))
9.56+
9.57+(defun main (&key (output *standard-output*))
9.58+ (let ((*standard-output* output))
9.59+ (print "starting index server on ~A" *web-index-port*)))
11.1--- a/lisp/lib/nlp/doc.lisp Fri Nov 24 18:11:20 2023 -0500
11.2+++ b/lisp/lib/nlp/doc.lisp Fri Nov 24 21:12:36 2023 -0500
11.3@@ -2,7 +2,7 @@
11.4
11.5 ;;; Code:
11.6 (defpackage :nlp/doc
11.7- (:use :cl :std/fu :std/list :nlp/tokenize)
11.8+ (:use :cl :std/fu :std/list :nlp/data :nlp/tokenize)
11.9 (:export
11.10 :document
11.11 :documents
12.1--- a/lisp/lib/nlp/readme.org Fri Nov 24 18:11:20 2023 -0500
12.2+++ b/lisp/lib/nlp/readme.org Fri Nov 24 21:12:36 2023 -0500
12.3@@ -4,9 +4,8 @@
12.4 utilities for [[https://en.wikipedia.org/wiki/Natural_language][Natural Languages]].
12.5
12.6 - Features
12.7- - simple algorithms for:
12.8- - tokenization
12.9- - token storage (rocksdb)
12.10- - stemming (porter)
12.11- - TODO lemmatization
12.12- - data clustering (dbscan)
12.13+ - tokenization
12.14+ - stop-words
12.15+ - porter stemming
12.16+ - dbscan
12.17+ - textrank
13.1--- a/lisp/lib/nlp/tests.lisp Fri Nov 24 18:11:20 2023 -0500
13.2+++ b/lisp/lib/nlp/tests.lisp Fri Nov 24 21:12:36 2023 -0500
13.3@@ -1,10 +1,17 @@
13.4 (defpackage :nlp/tests
13.5- (:use :cl :std :std/rt :nlp/stem/porter))
13.6+ (:use :cl :std :std/rt :nlp))
13.7
13.8 (in-package :nlp/tests)
13.9
13.10 (defsuite :nlp)
13.11 (in-suite :nlp)
13.12
13.13-(deftest stem ()
13.14- (stem "hacking"))
13.15+(defvar %docs (make-instance 'document-collection))
13.16+
13.17+(deftest porter-stem ()
13.18+ (is (string= (stem "hacking") "hack")))
13.19+
13.20+(deftest dbscan ())
13.21+
13.22+(deftest textrank ())
13.23+
14.1--- a/lisp/lib/nlp/textrank.lisp Fri Nov 24 18:11:20 2023 -0500
14.2+++ b/lisp/lib/nlp/textrank.lisp Fri Nov 24 21:12:36 2023 -0500
14.3@@ -1,4 +1,4 @@
14.4-;;; rank.lisp --- TextRank
14.5+;;; textrank.lisp --- TextRank
14.6
14.7 ;; based on https://web.eecs.umich.edu/~mihalcea/papers/mihalcea.emnlp04.pdf
14.8
15.1--- a/lisp/lib/nlp/tokenize.lisp Fri Nov 24 18:11:20 2023 -0500
15.2+++ b/lisp/lib/nlp/tokenize.lisp Fri Nov 24 21:12:36 2023 -0500
15.3@@ -1,13 +1,12 @@
15.4 (defpackage :nlp/tokenize
15.5- (:use :cl :std :std/str :cl-ppcre :nlp/data)
15.6+ (:use :cl :std :std/str :cl-ppcre :nlp/data :nlp/stem/porter)
15.7 (:export :word-tokenize :sentence-tokenize))
15.8
15.9 (in-package :nlp/tokenize)
15.10
15.11 (defun word-tokenize (string &key (remove-stop-words t) (stem nil) (down-case t) (alphabetic t))
15.12 "Split a string into a list of words."
15.13- (let* ((alpha-scanner (cl-ppcre:create-scanner "^[A-Za-z]*$"))
15.14- (tokens (split " " (collapse-whitespaces string)))
15.15+ (let* ((tokens (split " " (collapse-whitespaces string)))
15.16 (tokens (if remove-stop-words
15.17 (delete-if (lambda (x) (gethash (string-downcase x) (stop-words-lookup *language-data*))) tokens)
15.18 tokens))
15.19@@ -18,7 +17,7 @@
15.20 (mapcar #'string-downcase tokens)
15.21 tokens))
15.22 (tokens (if alphabetic
15.23- (delete-if-not (lambda (x) (cl-ppcre:scan alpha-scanner x)) tokens)
15.24+ (delete-if-not (lambda (x) (cl-ppcre:scan "^[A-Za-z]*$" x)) tokens)
15.25 tokens)))
15.26 tokens))
15.27
16.1--- a/lisp/lib/organ/cli.lisp Fri Nov 24 18:11:20 2023 -0500
16.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
16.3@@ -1,56 +0,0 @@
16.4-(defpackage :organ/cli
16.5- (:use :cl :organ :std)
16.6- (:export :main :$cli))
16.7-
16.8-(in-package :organ/cli)
16.9-
16.10-(defcmd organ-inspect (inspect (read-org-file (car $args))))
16.11-
16.12-(defcmd organ-show
16.13- (fmt-tree t
16.14- (remove-if-not
16.15- (lambda (x) (eql (cadr x) 'headline))
16.16- (org-parse-lines (read-org-file (open (car $args)))))
16.17- :layout :down))
16.18-
16.19-(defcmd organ-parse (print t))
16.20-
16.21-(define-cli $cli
16.22- :name "organ"
16.23- :version "0.0.1"
16.24- :description "org-mode toolbox"
16.25- :opts (make-opts
16.26- (:name debug :global t)
16.27- (:name help :global t)
16.28- (:name version :global t))
16.29- :cmds (make-cmds
16.30- (:name inspect :opts (make-opts (:name input)) :thunk organ-inspect)
16.31- (:name show :thunk organ-show)
16.32- (:name parse
16.33- :opts (make-opts (:name input) (:name output))
16.34- :thunk organ-parse)))
16.35-
16.36-(defun run ()
16.37- (with-cli (opts cmds args) $cli
16.38- (when (find-opt $cli "debug" t) (setq *log-level* :debug))
16.39- (debug! (cli-opts $cli) (cli-cmd-args $cli) (cli-cmds $cli))
16.40-
16.41- (when-let ((a (find-cmd $cli "inspect" t)))
16.42- (inspect (read-org-file (open (car a)))))
16.43-
16.44- (when-let ((a (find-cmd $cli "parse" t)))
16.45- (fmt-tree t (remove-if #'null (org-parse-lines (read-org-file (open (car a))))) :layout :down))
16.46-
16.47- (when-let ((a (find-cmd $cli "show" t)))
16.48- (fmt-tree t
16.49- (mapcar (lambda (x) `(,(car x) ,(cddr x)))
16.50- (remove-if-not (lambda (x) (equal (cadr x) (symb 'headline)))
16.51- (org-parse-lines (read-org-file (open (car a))))))
16.52- :layout :down))
16.53-
16.54- (when (find-opt $cli "help" t) (print-help $cli))
16.55- (when (find-opt $cli "version" t) (print-version $cli))))
16.56-
16.57-(defmain ()
16.58- (run)
16.59- (sb-ext:exit :code 0))
17.1--- a/lisp/lib/organ/organ.asd Fri Nov 24 18:11:20 2023 -0500
17.2+++ b/lisp/lib/organ/organ.asd Fri Nov 24 21:12:36 2023 -0500
17.3@@ -3,7 +3,7 @@
17.4 :description "org-mode utils"
17.5 :class :package-inferred-system
17.6 :defsystem-depends-on (:asdf-package-system)
17.7- :depends-on (:std/all :cl-ppcre)
17.8+ :depends-on (:std/all :cl-ppcre :nlp)
17.9 :in-order-to ((test-op (test-op :organ/tests)))
17.10 :perform (test-op (o c) (symbol-call :rt :do-tests :organ))
17.11 :build-operation "program-op"
18.1--- a/lisp/lib/organ/organ.lisp Fri Nov 24 18:11:20 2023 -0500
18.2+++ b/lisp/lib/organ/organ.lisp Fri Nov 24 21:12:36 2023 -0500
18.3@@ -1,6 +1,6 @@
18.4 ;;; organ.lisp --- Org parser
18.5 (pkg:defpkg :organ
18.6- (:use :cl :cl-ppcre :std/sym :std/fu)
18.7+ (:use :cl :cl-ppcre :std/sym :std/fu :organ/lexer)
18.8 (:shadowing-import-from :sb-gray :fundamental-stream)
18.9 (:import-from :uiop :read-file-string)
18.10 (:export
19.1--- a/lisp/lib/skel/cli.lisp Fri Nov 24 18:11:20 2023 -0500
19.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
19.3@@ -1,133 +0,0 @@
19.4-;;; cli.lisp --- skel cli
19.5-
19.6-;; $args, $argv $cli $opt
19.7-;;; Code:
19.8-(defpackage :skel/cli
19.9- (:use :cl :std :skel :skel/core/vc :skel/core/virt :skel/comp/make)
19.10- (:import-from :sb-posix :getcwd)
19.11- (:import-from :uiop :println)
19.12- (:export :main))
19.13-
19.14-(in-package :skel/cli)
19.15-
19.16-;; HACK 2023-10-14: a bit too early to implement this, would rather
19.17-;; use the repl. they're useful for linking up with the debugger tho.
19.18-(defvar skc-file-prompt-history '(""))
19.19-(make-prompt! skc-file "file")
19.20-(defvar skc-name-prompt-history '(""))
19.21-(make-prompt! skc-name "name")
19.22-
19.23-(defopt skc-help (print-help $cli))
19.24-(defopt skc-version (print-version $cli))
19.25-(defopt skc-debug (setq *log-level* (if $val :debug nil)))
19.26-;; TODO 2023-10-13: almost there
19.27-(defopt skc-config (init-skel-user-config (parse-file-opt $val)))
19.28-
19.29-(defcmd skc-init
19.30- (let ((file (when $args (pop $args)))
19.31- (name (if (> $argc 1) (pop $args))))
19.32- (handler-bind
19.33- ((sb-ext:file-exists
19.34- #'(lambda (s)
19.35- (println (format nil "file already exists: ~A" (or file *default-skelfile*)))
19.36- (let ((f2 (skc-file-prompt)))
19.37- (if (string= f2 "")
19.38- (error s)
19.39- (use-value f2 s))))))
19.40- (init-skelfile file name))))
19.41-
19.42-(defcmd skc-describe
19.43- (describe
19.44- (find-skelfile
19.45- (if $args (pathname (car $args))
19.46- #P".")
19.47- :load t)))
19.48-
19.49-(defcmd skc-inspect
19.50- (inspect
19.51- (find-skelfile
19.52- (if $args (pathname (car $args))
19.53- #P".")
19.54- :load t)))
19.55-
19.56-(defcmd skc-show
19.57- (find-skelfile
19.58- (if $args (pathname (car $args))
19.59- #P".")
19.60- :load t))
19.61-
19.62-(defcmd skc-push
19.63- (case
19.64- (sk-vc
19.65- (find-skelfile
19.66- (if $args (pathname (car $args))
19.67- #P".")
19.68- :load t))
19.69- (:hg (run-hg-command "push"))))
19.70-
19.71-(defcmd skc-make
19.72- (if $args
19.73- (debug! (sk-rules (find-skelfile (car $args) :load t)))
19.74- (debug! (sk-rules (find-skelfile #P"." :load t)))))
19.75-
19.76-(define-cli $cli
19.77- :name "skel"
19.78- :version "0.1.1"
19.79- :description "A hacker's project compiler and build tool."
19.80- :thunk skc-describe
19.81- :opts (make-opts
19.82- (:name help :global t :description "print this message"
19.83- :thunk skc-help)
19.84- (:name version :global t :description "print version"
19.85- :thunk skc-version)
19.86- (:name debug :global t :description "set log level (debug,info,trace,warn)"
19.87- :thunk skc-debug)
19.88- (:name config :global t :description "set a custom skel user config" :kind file
19.89- :thunk skc-config) ;; :kind?
19.90- (:name input :description "input source" :kind string)
19.91- (:name output :description "output target" :kind string))
19.92- :cmds (make-cmds
19.93- (:name init
19.94- :description "initialize a skelfile in the current directory"
19.95- :opts (make-opts (:name name :description "project name" :kind string))
19.96- :thunk skc-init)
19.97- (:name show
19.98- :description "describe the project skelfile"
19.99- :opts (make-opts (:name file :description "path to skelfile" :kind file))
19.100- :thunk skc-describe)
19.101- (:name inspect
19.102- :description "inspect the project skelfile"
19.103- :opts (make-opts (:name file :description "path to skelfile" :kind file))
19.104- :thunk skc-inspect)
19.105- (:name make
19.106- :description "build project targets"
19.107- :opts (make-opts (:name target :description "target to build" :kind string))
19.108- :thunk skc-make)
19.109- (:name run
19.110- :description "run a script or command")
19.111- (:name push
19.112- :description "push the current project upstream"
19.113- :thunk skc-push)
19.114- (:name pull
19.115- :description "pull the current project from remote")
19.116- (:name clone
19.117- :description "clone a remote project")
19.118- (:name commit
19.119- :description "commit changes to the project vc")
19.120- (:name edit
19.121- :description "edit a project file")
19.122- (:name shell
19.123- :description "open the sk-shell interpreter")))
19.124-
19.125-(defun run ()
19.126- (let ((*log-level* nil)
19.127- (*skel-user-config* (init-skel-user-config)))
19.128- (in-readtable *macs-readtable*) ;; should be in sxp
19.129- (with-cli () $cli
19.130- (do-cmd $cli)
19.131- (debug-opts $cli)
19.132- (dbg! *skel-user-config*))))
19.133-
19.134-(defmain ()
19.135- (run)
19.136- (sb-ext:exit :code 0))
20.1--- a/lisp/lib/skel/core.lisp Fri Nov 24 18:11:20 2023 -0500
20.2+++ b/lisp/lib/skel/core.lisp Fri Nov 24 21:12:36 2023 -0500
20.3@@ -0,0 +1,10 @@
20.4+(uiop:define-package :skel/core
20.5+ (:use-reexport
20.6+ :skel/core/proto
20.7+ :skel/core/err
20.8+ :skel/core/header
20.9+ :skel/core/vc
20.10+ :skel/core/obj
20.11+ :skel/core/util
20.12+ :skel/core/virt
20.13+ :skel/core/vm))
21.1--- a/lisp/lib/skel/core/cfg.lisp Fri Nov 24 18:11:20 2023 -0500
21.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
21.3@@ -1,34 +0,0 @@
21.4-(in-package :skel)
21.5-;;; Vars
21.6-(declaim (type vc-designator *default-skel-vc-kind*))
21.7-(deftype vc-designator () '(member :hg :git nil))
21.8-(defparameter *default-skel-vc-kind* :hg)
21.9-
21.10-(declaim (type sk-project *skel-project*))
21.11-(defvar *skel-project*)
21.12-(declaim (type sk-user-config *skel-user-config*))
21.13-(defvar *skel-user-config*)
21.14-
21.15-;; TODO (defparameter *skel-project-registry* nil)
21.16-;; TODO (defvar *skelfile-boundary* nil "Set an upper bounds on how
21.17-;; many times and how far to walk an arbitrary file directory.")
21.18-
21.19-(declaim (type string *default-skel-user* *default-skelfile* *default-skel-extension*))
21.20-(defparameter *default-skel-user* (uid-username (getuid)))
21.21-(defparameter *default-skelfile* "skelfile")
21.22-(defparameter *default-skel-extension* "sk")
21.23-(defparameter *default-skelrc* ".skelrc")
21.24-
21.25-(declaim (type pathname *default-skel-stash* *default-skel-shed*
21.26- *default-skel-cache* *default-user-skelrc* *default-system-skelrc*))
21.27-
21.28-
21.29-(defparameter *default-skel-stash* (pathname (format nil "/home/~a/stash/" *default-skel-user*)))
21.30-
21.31-(defparameter *default-skel-shed* (pathname (format nil "/home/~a/shed/" *default-skel-user*)))
21.32-
21.33-(defparameter *default-skel-cache* (pathname (format nil "/home/~a/.cache/skel/" *default-skel-user*)))
21.34-
21.35-(defparameter *default-user-skelrc* (pathname (format nil "/home/~A/~A" *default-skel-user* *default-skelrc*)))
21.36-
21.37-(defparameter *default-system-skelrc* (pathname "/etc/skelrc"))
22.1--- a/lisp/lib/skel/core/header.lisp Fri Nov 24 18:11:20 2023 -0500
22.2+++ b/lisp/lib/skel/core/header.lisp Fri Nov 24 21:12:36 2023 -0500
22.3@@ -1,6 +1,7 @@
22.4 ;;; File Headers
22.5 (defpackage :skel/core/header
22.6- (:use :cl :std :skel/core/proto))
22.7+ (:use :cl :std :skel/core/proto)
22.8+ (:export :make-source-header-comment))
22.9
22.10 (in-package :skel/core/header)
22.11
23.1--- a/lisp/lib/skel/core/obj.lisp Fri Nov 24 18:11:20 2023 -0500
23.2+++ b/lisp/lib/skel/core/obj.lisp Fri Nov 24 21:12:36 2023 -0500
23.3@@ -1,9 +1,44 @@
23.4 ;;; Objects
23.5 (defpackage :skel/core/obj
23.6- (:use :cl :std :skel/core/proto))
23.7+ (:use :cl :std :skel/core/proto :skel/core/vc :skel/core/header :sb-unix)
23.8+ (:import-from :uiop :read-file-forms :ensure-absolute-pathname))
23.9
23.10 (in-package :skel/core/obj)
23.11
23.12+;;; Vars
23.13+(declaim (type vc-designator *default-skel-vc-kind*))
23.14+(deftype vc-designator () '(member :hg :git nil))
23.15+(defparameter *default-skel-vc-kind* :hg)
23.16+
23.17+(declaim (type sk-project *skel-project*))
23.18+(defvar *skel-project*)
23.19+(declaim (type sk-user-config *skel-user-config*))
23.20+(defvar *skel-user-config*)
23.21+
23.22+;; TODO (defparameter *skel-project-registry* nil)
23.23+;; TODO (defvar *skelfile-boundary* nil "Set an upper bounds on how
23.24+;; many times and how far to walk an arbitrary file directory.")
23.25+
23.26+(declaim (type string *default-skel-user* *default-skelfile* *default-skel-extension*))
23.27+(defparameter *default-skel-user* (uid-username (unix-getuid)))
23.28+(defparameter *default-skelfile* "skelfile")
23.29+(defparameter *default-skel-extension* "sk")
23.30+(defparameter *default-skelrc* ".skelrc")
23.31+
23.32+(declaim (type pathname *default-skel-stash* *default-skel-shed*
23.33+ *default-skel-cache* *default-user-skelrc* *default-system-skelrc*))
23.34+
23.35+
23.36+(defparameter *default-skel-stash* (pathname (format nil "/home/~a/stash/" *default-skel-user*)))
23.37+
23.38+(defparameter *default-skel-shed* (pathname (format nil "/home/~a/shed/" *default-skel-user*)))
23.39+
23.40+(defparameter *default-skel-cache* (pathname (format nil "/home/~a/.cache/skel/" *default-skel-user*)))
23.41+
23.42+(defparameter *default-user-skelrc* (pathname (format nil "/home/~A/~A" *default-skel-user* *default-skelrc*)))
23.43+
23.44+(defparameter *default-system-skelrc* (pathname "/etc/skelrc"))
23.45+
23.46 (defclass skel ()
23.47 ((id :initarg :id :initform (sxhash nil) :accessor sk-id :type fixnum))
23.48 (:documentation "Base class for skeleton objects. Inherits from `sxp'."))
23.49@@ -269,9 +304,9 @@
23.50 :if-exists if-exists
23.51 :if-does-not-exist :create)
23.52 (when header (princ
23.53- (make-source-header-comment
23.54- (sk-name self)
23.55- :cchar #\;
23.56+ (make-source-header-comment
23.57+ (sk-name self)
23.58+ :cchar #\;
23.59 :timestamp t
23.60 :description (sk-description self)
23.61 :opts '("mode: skel;"))
24.1--- a/lisp/lib/skel/core/util.lisp Fri Nov 24 18:11:20 2023 -0500
24.2+++ b/lisp/lib/skel/core/util.lisp Fri Nov 24 21:12:36 2023 -0500
24.3@@ -1,5 +1,8 @@
24.4 ;;; Utils
24.5-(in-package :skel)
24.6+(defpackage :skel/core/util
24.7+ (:use :cl :skel/core/obj :skel/core/proto))
24.8+
24.9+(in-package :skel/core/util)
24.10
24.11 (defun init-skelrc (&optional file)
24.12 "Initialize a skelrc configuration based on the currently active
25.1--- a/lisp/lib/skel/core/vc.lisp Fri Nov 24 18:11:20 2023 -0500
25.2+++ b/lisp/lib/skel/core/vc.lisp Fri Nov 24 21:12:36 2023 -0500
25.3@@ -38,7 +38,7 @@
25.4
25.5 ;;; Code:
25.6 (defpackage :skel/core/vc
25.7- (:use :sb-bsd-sockets :cl)
25.8+ (:use :cl :sb-bsd-sockets)
25.9 (:import-from :sb-posix :getcwd)
25.10 (:import-from :sb-ext :run-program)
25.11 (:export
26.1--- a/lisp/lib/skel/core/virt.lisp Fri Nov 24 18:11:20 2023 -0500
26.2+++ b/lisp/lib/skel/core/virt.lisp Fri Nov 24 21:12:36 2023 -0500
26.3@@ -50,7 +50,7 @@
26.4
26.5 ;;; Code:
26.6 (defpackage :skel/core/virt
26.7- (:use :cl)
26.8+ (:use :cl :skel/core/obj :skel/core/proto)
26.9 (:export :containerfile))
26.10
26.11 (in-package :skel/core/virt)
27.1--- a/lisp/lib/skel/core/vm.lisp Fri Nov 24 18:11:20 2023 -0500
27.2+++ b/lisp/lib/skel/core/vm.lisp Fri Nov 24 21:12:36 2023 -0500
27.3@@ -3,7 +3,7 @@
27.4 ;; Stack slots refer to objects. a Stack is a sequence of objects
27.5 ;; which can be output to a stream using a specialized function.
27.6 (defpackage :skel/core/vm
27.7- (:use :cl))
27.8+ (:use :cl :std :skel/core/obj :skel/core/proto))
27.9
27.10 (in-package :skel/core/vm)
27.11
28.1--- a/lisp/lib/skel/skel.asd Fri Nov 24 18:11:20 2023 -0500
28.2+++ b/lisp/lib/skel/skel.asd Fri Nov 24 21:12:36 2023 -0500
28.3@@ -1,7 +1,3 @@
28.4-#+sb-core-compression
28.5-(defmethod asdf:perform ((o asdf:image-op) (c asdf:system))
28.6- (uiop:dump-image (asdf:output-file o c) :executable t :compression t))
28.7-
28.8 (defsystem "skel"
28.9 :version "0.1.0"
28.10 :maintainer "ellis <ellis@rwest.io>"
28.11@@ -10,7 +6,4 @@
28.12 :defsystem-depends-on (:asdf-package-system)
28.13 :depends-on (:uiop :asdf :sb-posix :sb-bsd-sockets :sb-concurrency :cl-ppcre :std :organ :skel/pkg)
28.14 :in-order-to ((test-op (test-op skel/tests)))
28.15- :perform (test-op (op c) (uiop:symbol-call '#:rt '#:do-tests))
28.16- :build-operation "program-op"
28.17- :build-pathname "skel"
28.18- :entry-point "skel/cli:main")
28.19+ :perform (test-op (op c) (uiop:symbol-call '#:rt '#:do-tests)))
29.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
29.2+++ b/lisp/lisp.sk Fri Nov 24 21:12:36 2023 -0500
29.3@@ -0,0 +1,4 @@
29.4+;;; lisp.sk --- lisp skelfile -*- mode: skel; -*-
29.5+:name "core/lisp"
29.6+:description "Core Lisp Code"
29.7+:author "Richard Westhaver <ellis@rwest.io>"
30.1--- a/lisp/std/named-readtables.lisp Fri Nov 24 18:11:20 2023 -0500
30.2+++ b/lisp/std/named-readtables.lisp Fri Nov 24 21:12:36 2023 -0500
30.3@@ -13,7 +13,6 @@
30.4
30.5 ;;; Code:
30.6 (uiop:define-package :std/named-readtables
30.7- (:nicknames :named-readtables)
30.8 (:use :cl)
30.9 (:export
30.10 #:defreadtable
31.1--- a/lisp/std/rt.lisp Fri Nov 24 18:11:20 2023 -0500
31.2+++ b/lisp/std/rt.lisp Fri Nov 24 21:12:36 2023 -0500
31.3@@ -171,7 +171,7 @@
31.4 "Return the normalized `test-suite-designator' of A."
31.5 (etypecase a
31.6 (string a)
31.7- (symbol (symbol-name a))
31.8+ (symbol (string-downcase (symbol-name a)))
31.9 (test-object (test-name a))
31.10 (t (format nil "~A" a))))
31.11
31.12@@ -675,7 +675,8 @@
31.13 "Set `*test-suite*' to the `test-suite' referred to by symbol
31.14 NAME. Return the `test-suite'."
31.15 (assert-suite name)
31.16- `(setf *test-suite* (ensure-suite ',name)))
31.17+ `(progn
31.18+ (setq *test-suite* (ensure-suite ,name))))
31.19
31.20 ;;; Coverage
31.21 (defmacro enable-coverage ()
32.1--- a/lisp/std/sxp.lisp Fri Nov 24 18:11:20 2023 -0500
32.2+++ b/lisp/std/sxp.lisp Fri Nov 24 21:12:36 2023 -0500
32.3@@ -8,7 +8,7 @@
32.4 (:nicknames :sxp)
32.5 (:import-from :uiop :read-file-forms :slurp-stream-forms :with-output-file)
32.6 ;; TODO: hot-patch readtables into sxp classes/parsers
32.7- (:import-from :named-readtables :defreadtable :in-readtable)
32.8+ (:import-from :std/named-readtables :defreadtable :in-readtable)
32.9 (:export
32.10 :sxp-fmt-designator
32.11 :form :formp :sxp-error :sxp-fmt-error :sxp-syntax-error :reader :writer :fmt
33.1--- a/lisp/system-index.txt Fri Nov 24 18:11:20 2023 -0500
33.2+++ b/lisp/system-index.txt Fri Nov 24 21:12:36 2023 -0500
33.3@@ -1,10 +1,14 @@
33.4+app/app.asd
33.5 std/std.asd
33.6 lib/rdb/rdb.asd
33.7 lib/skel/skel.asd
33.8+lib/packy/packy.asd
33.9+lib/organ/organ.asd
33.10+lib/nlp/nlp.asd
33.11 ffi/btrfs/btrfs.asd
33.12 ffi/uring/uring.asd
33.13-lib/organ/organ.asd
33.14-lib/packy/packy.asd
33.15-ffi/quiche/quiche.asd
33.16 ffi/rocksdb/rocksdb.asd
33.17 ffi/tree-sitter/tree-sitter.asd
33.18+ffi/blake3/blake3.asd
33.19+ffi/k/k.asd
33.20+ffi/bqn/bqn.asd
