1.1--- a/lisp/bin/skel.lisp Thu May 09 23:08:14 2024 -0400
1.2+++ b/lisp/bin/skel.lisp Fri May 10 19:33:40 2024 -0400
1.3@@ -67,23 +67,25 @@
1.4 (finish-output))))))
1.5
1.6 (defun skc-show-case (sel)
1.7- (std/string:string-case (sel :default (nyi!))
1.8+ (std/string:string-case (sel :default (skel-error))
1.9 (":id" (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t))))
1.10+ (":name" (std:format-sxhash (sk-name (find-skelfile #P"." :load t))))
1.11+ (":author" (sk-author (find-skelfile #P"." :load t)))
1.12+ (":version" (sk-version (find-skelfile #P"." :load t)))
1.13+ (":description" (sk-description (find-skelfile #P"." :load t)))
1.14+ (":tags" (sk-tags (find-skelfile #P"." :load t)))
1.15+ (":license" (sk-license (find-skelfile #P"." :load t)))
1.16+ (":vc" (sk-vc (find-skelfile #P"." :load t)))
1.17+ (":docs" (sk-docs (find-skelfile #P"." :load t)))
1.18+ (":scripts" (sk-scripts (find-skelfile #P"." :load t)))
1.19+ (":snippets" (sk-snippets (find-skelfile #P"." :load t)))
1.20+ (":rules" (sk-rules (find-skelfile #P"." :load t)))
1.21+ (":imports" (sk-imports (find-skelfile #P"." :load t)))
1.22+ (":stash" (sk-stash (find-skelfile #P"." :load t)))
1.23+ (":store" (sk-store (find-skelfile #P"." :load t)))
1.24 (":config" (if (probe-file *user-skelrc*)
1.25 (describe (load-user-skelrc) t)
1.26 (describe *skel-user-config* nil)))
1.27- (":vc" (sk-vc (find-skelfile #P"." :load t)))
1.28- (":author" (sk-author (find-skelfile #P"." :load t)))
1.29- (":scripts" (sk-scripts (find-skelfile #P"." :load t)))
1.30- (":rules" (sk-rules (find-skelfile #P"." :load t)))
1.31- (":description" (sk-description (find-skelfile #P"." :load t)))
1.32- (":tags" (sk-tags (find-skelfile #P"." :load t)))
1.33- (":docs" (sk-docs (find-skelfile #P"." :load t)))
1.34- (":version" (sk-version (find-skelfile #P"." :load t)))
1.35- (":imports" (sk-imports (find-skelfile #P"." :load t)))
1.36- (":license" (sk-license (find-skelfile #P"." :load t)))
1.37- (":stash" (sk-stash (find-skelfile #P"." :load t)))
1.38- (":store" (sk-store (find-skelfile #P"." :load t)))
1.39 (":cache" (sk-cache (find-skelfile #P"." :load t)))))
1.40
1.41 (defcmd skc-show
1.42@@ -122,11 +124,15 @@
1.43
1.44 (defcmd skc-run
1.45 (if $args
1.46- (mapc (lambda (script) (debug! (sk-run (sk-find-script script (find-skelfile #P"." :load t))))) $args)
1.47+ (mapc (lambda (script)
1.48+ (debug!
1.49+ (sk-run
1.50+ (sk-find-script
1.51+ (pathname-name script)
1.52+ (find-skelfile #P"." :load t))))) $args)
1.53 (required-argument :script)))
1.54
1.55 (defcmd skc-shell
1.56- (setq *no-exit* t)
1.57 (sb-ext:enable-debugger)
1.58 (cli/clap::with-cli-handlers
1.59 (progn
1.60@@ -206,8 +212,7 @@
1.61 :thunk skc-shell)))
1.62
1.63 (defmain ()
1.64- (let ((*log-level* :info)
1.65- (*no-exit* nil))
1.66+ (let ((*log-level* :info))
1.67 (in-readtable :shell)
1.68 (with-cli (opts cmds) $cli
1.69 (load-skelrc)
2.1--- a/lisp/lib/nlp/data.lisp Thu May 09 23:08:14 2024 -0400
2.2+++ b/lisp/lib/nlp/data.lisp Fri May 10 19:33:40 2024 -0400
2.3@@ -6,6 +6,8 @@
2.4 :stop-words-lookup
2.5 :stop-words))
2.6
2.7+(in-package :nlp/data)
2.8+
2.9 (defclass language-data ()
2.10 ((stop-words
2.11 :initarg :stop-words
3.1--- a/lisp/lib/obj/cfg.lisp Thu May 09 23:08:14 2024 -0400
3.2+++ b/lisp/lib/obj/cfg.lisp Fri May 10 19:33:40 2024 -0400
3.3@@ -14,6 +14,7 @@
3.4 #|
3.5 |#
3.6 ;;; Code:
3.7+(in-package :obj/cfg)
3.8 (defclass cfg ()
3.9 ())
3.10
4.1--- a/lisp/lib/skel/core/err.lisp Thu May 09 23:08:14 2024 -0400
4.2+++ b/lisp/lib/skel/core/err.lisp Fri May 10 19:33:40 2024 -0400
4.3@@ -4,5 +4,5 @@
4.4 (define-condition skel-error (std-error) ())
4.5
4.6 (deferror skel-syntax-error (sxp-syntax-error) () (:auto t))
4.7-(define-condition skel-fmt-error (sxp-fmt-error) ())
4.8-(define-condition skel-compile-error nil nil)
4.9+(deferror skel-fmt-error (sxp-fmt-error) () (:auto t))
4.10+(deferror skel-compile-error (skel-error) () (:auto t))
5.1--- a/lisp/lib/skel/core/obj.lisp Thu May 09 23:08:14 2024 -0400
5.2+++ b/lisp/lib/skel/core/obj.lisp Fri May 10 19:33:40 2024 -0400
5.3@@ -170,13 +170,38 @@
5.4 ;; TODO 2023-10-13: integrate organ for working with org document
5.5 ;; types - mixins and such
5.6 (defclass sk-document (skel sk-meta sxp)
5.7- ((kind :initarg :kind :type document-designator)
5.8- (export :initarg :setup :type form
5.9+ ((kind :initarg :kind :type document-designator :accessor sk-kind)
5.10+ (export :initarg :export :type form :accessor sk-export
5.11 :documentation "document export options")
5.12- (attach :initarg :attach :type form
5.13+ (attach :initarg :attach :type form :accessor sk-attach
5.14 :documentation "document attachments"))
5.15 (:documentation "Document object."))
5.16
5.17+(defun make-sk-document (kind path &key export attach)
5.18+ "Make a new SK-RULE."
5.19+ ;; TODO 2024-05-10: component paths ala asdf
5.20+ (make-instance 'sk-document
5.21+ :name (pathname-name path)
5.22+ :kind (format nil "~(~a~)" kind)
5.23+ :path path
5.24+ :export export
5.25+ :attach attach))
5.26+
5.27+(defmethod write-sxp-stream ((self sk-document) stream &key (pretty t) (case :downcase) &allow-other-keys)
5.28+ (write `(,(keywordicate (sk-kind self)) ,(sk-path self)
5.29+ ,@(when-let ((e (sk-export self))) (list :export e))
5.30+ ,@(when-let ((a (sk-attach self))) (list :attach a)))
5.31+ :stream stream
5.32+ :pretty pretty
5.33+ :case case
5.34+ :readably t
5.35+ :array t
5.36+ :escape t))
5.37+
5.38+(defmethod sk-write ((self sk-document) stream)
5.39+ (write-string (keywordicate (sk-kind self)))
5.40+ (sk-write-string (sk-path self)))
5.41+
5.42 ;;;; Script
5.43 (defclass sk-script (skel sk-meta sxp)
5.44 ((kind :initform nil :initarg :kind :type (or null script-designator))))
5.45@@ -382,6 +407,8 @@
5.46 (find-files path)
5.47 (list path)))
5.48 (debug! (format nil "ignoring missing scripts directory: ~A" (sk-scripts self)))))
5.49+ (when-let ((docs (the list (sk-docs self))))
5.50+ (setf (sk-docs self) (map 'vector (lambda (d) (apply #'make-sk-document d)) docs)))
5.51 (when-let ((scripts (the list (sk-scripts self))))
5.52 (setf (sk-scripts self) (map 'vector #'make-sk-script scripts)))
5.53 (when-let ((rules (the list (sk-rules self))))
6.1--- a/lisp/lib/vc/err.lisp Thu May 09 23:08:14 2024 -0400
6.2+++ b/lisp/lib/vc/err.lisp Fri May 10 19:33:40 2024 -0400
6.3@@ -2,6 +2,6 @@
6.4
6.5 (define-condition vc-error (std-error) ())
6.6
6.7-(deferror git-error (vc-error) ())
6.8+(deferror git-error (vc-error) () (:auto t))
6.9
6.10-(deferror hg-error (vc-error) ())
6.11+(deferror hg-error (vc-error) () (:auto t))
7.1--- a/lisp/lib/vc/git.lisp Thu May 09 23:08:14 2024 -0400
7.2+++ b/lisp/lib/vc/git.lisp Fri May 10 19:33:40 2024 -0400
7.3@@ -2,8 +2,10 @@
7.4
7.5 (defvar *git-program* (find-exe "git"))
7.6
7.7-(defun run-git-command (cmd &rest args)
7.8- (run-program *git-program* (push cmd args) :output :stream))
7.9+(defun run-git-command (cmd &optional args output (wait t))
7.10+ (unless (listp args) (setf args (list args)))
7.11+ (setf args (mapcar #'namestring-or args)) ;; TODO 2024-05-10: slow
7.12+ (sb-ext:run-program *git-program* (push cmd args) :output output :wait wait :input nil))
7.13
7.14 (defun git-url-p (url)
7.15 "Return nil if URL does not look like a URL to a git valid remote."
7.16@@ -17,12 +19,18 @@
7.17 (:regex "^git@"))
7.18 url-str)))
7.19
7.20-(defclass git-repo (repo)
7.21+(defclass git-repo (vc-repo)
7.22 ((index))) ;; working-directory
7.23
7.24+(defmethod vc-init ((self (eql :git)))
7.25+ (make-instance 'git-repo :path (pathname *default-pathname-defaults*)))
7.26+
7.27 (defmethod vc-init ((self git-repo))
7.28 (with-slots (path) self
7.29- (sb-ext:process-exit-code (run-git-command "init" path))))
7.30+ (let ((existed (probe-file path)))
7.31+ (if (zerop (sb-ext:process-exit-code (run-git-command "init" path)))
7.32+ (not existed)
7.33+ (git-error "git init failed:" path)))))
7.34
7.35 (defmethod vc-run ((self git-repo) (cmd string) &rest args)
7.36 (with-slots (path) self
8.1--- a/lisp/lib/vc/hg.lisp Thu May 09 23:08:14 2024 -0400
8.2+++ b/lisp/lib/vc/hg.lisp Fri May 10 19:33:40 2024 -0400
8.3@@ -40,6 +40,7 @@
8.4 (defun run-hg-command (cmd &optional args output (wait t))
8.5 "Run an hg command."
8.6 (unless (listp args) (setf args (list args)))
8.7+ (setf args (mapcar #'namestring-or args)) ;; TODO 2024-05-10: slow
8.8 (sb-ext:run-program *hg-program* (push cmd args) :output output :wait wait :input nil))
8.9
8.10 (defun hg-url-p (url)
8.11@@ -77,12 +78,14 @@
8.12 (if ok res (error 'hg-error :message res))))))))
8.13
8.14 (defmethod vc-init ((self (eql :hg)))
8.15- (make-instance 'hg-repo :path (pathname (sb-posix:getcwd))))
8.16+ (make-instance 'hg-repo :path (pathname *default-pathname-defaults*)))
8.17
8.18 (defmethod vc-init ((self hg-repo))
8.19 (with-slots (path) self
8.20- ;; could throw error here but w/e
8.21- (vc-run self "init" path)))
8.22+ (let ((existed (probe-file path)))
8.23+ (if (zerop (sb-ext:process-exit-code (run-hg-command "init" path)))
8.24+ (not existed)
8.25+ (hg-error "hg init failed:" path)))))
8.26
8.27 (defmethod vc-clone ((self hg-repo) remote &key &allow-other-keys)
8.28 (with-slots (path) self
9.1--- a/lisp/lib/vc/proto.lisp Thu May 09 23:08:14 2024 -0400
9.2+++ b/lisp/lib/vc/proto.lisp Fri May 10 19:33:40 2024 -0400
9.3@@ -55,7 +55,7 @@
9.4 (defstruct vc-rev num id)
9.5
9.6 (defclass vc-repo ()
9.7- ((path :initform nil :type (or null string) :accessor vc-repo-path
9.8+ ((path :initform nil :type (or null string pathname) :accessor vc-repo-path
9.9 :initarg :path
9.10 :documentation "AKA working-directory or working-copy")
9.11 (head :initform nil :initarg :head :type (or null vc-rev) :accessor vc-repo-head)
10.1--- a/lisp/lib/vc/tests.lisp Thu May 09 23:08:14 2024 -0400
10.2+++ b/lisp/lib/vc/tests.lisp Fri May 10 19:33:40 2024 -0400
10.3@@ -4,8 +4,21 @@
10.4 (in-package :vc/tests)
10.5 (defsuite :vc)
10.6 (in-suite :vc)
10.7+(defmacro with-temp-repo (kind &body body)
10.8+ `(let ((repo ,(make-instance 'vc::vc-repo)))
10.9+ (setf (vc::vc-repo-path repo) (merge-pathnames (format nil "~A" (gensym "repo")) "/tmp/"))
10.10+ (case ,kind
10.11+ (:hg (sb-mop::change-class repo 'hg-repo))
10.12+ (:git (sb-mop::change-class repo 'git-repo))
10.13+ (t nil))
10.14+ (vc-init repo)
10.15+ (let ((*default-pathname-defaults* (vc::vc-repo-path repo)))
10.16+ ,@body)))
10.17
10.18-(deftest git ())
10.19+(deftest git ()
10.20+ (with-temp-repo :git
10.21+ (is (streamp (sb-ext:process-output (run-git-command "status" nil :stream))))))
10.22
10.23 (deftest hg ()
10.24- (is (stringp (run-hg-command "status"))))
10.25+ (with-temp-repo :hg
10.26+ (is (streamp (sb-ext:process-output (run-hg-command "status" nil :stream))))))
11.1--- a/lisp/lib/vc/vc.asd Thu May 09 23:08:14 2024 -0400
11.2+++ b/lisp/lib/vc/vc.asd Fri May 10 19:33:40 2024 -0400
11.3@@ -1,6 +1,7 @@
11.4 (defsystem :vc
11.5 :depends-on (:std :cli :obj :net :log)
11.6 :components ((:file "pkg")
11.7+ (:file "util")
11.8 (:file "err")
11.9 (:file "ignore")
11.10 (:file "proto")
12.1--- a/skelfile Thu May 09 23:08:14 2024 -0400
12.2+++ b/skelfile Fri May 10 19:33:40 2024 -0400
12.3@@ -1,4 +1,4 @@
12.4-;;; skelfile --- core skelfile -*- mode: skel; -*-
12.5+;;; skelfile --- CC/core skelfile -*- mode: skel; -*-
12.6 :name "core"
12.7 :author "Richard Westhaver <ellis@rwest.io>"
12.8 :version "0.1.0"
12.9@@ -6,13 +6,13 @@
12.10 :stash ".stash"
12.11 :store ".store"
12.12 :description "The Compiler Company Core"
12.13+:tags ("core" "lisp" "rust" "emacs" "c")
12.14+:imports ("lisp/skelfile" "rust/skelfile" "emacs/skelfile" "c/skelfile")
12.15 :vc :hg
12.16-:tags ("core" "lisp" "rust" "emacs" "c")
12.17 :docs ((:org "readme"))
12.18-:imports ("lisp/skelfile" "rust/skelfile" "emacs/skelfile" "c/skelfile")
12.19 :scripts "x.lisp"
12.20 :rules
12.21-((box () #$podman build . --build-arg IMAGE=localhost/box -t core$#)
12.22+((all (x compile std prelude build))
12.23 (x () #$if [ ! -f x ];
12.24 then ./x.lisp
12.25 fi$#)
12.26@@ -28,9 +28,11 @@
12.27 (homer (x) #$./x build homer$#)
12.28 (packy (x) #$./x build packy$#)
12.29 (build (x) #$./x build$#)
12.30+ (compile (x) #$./x compile$#)
12.31+ (std (x) #$./x save std$#)
12.32+ (prelude (x) #$./x save prelude$#)
12.33+ (box () #$podman build . --build-arg IMAGE=box -t core$#)
12.34 ;; x does the same thing, having issues with passing the shell input
12.35 ;; to SKEL though.
12.36- (install (x) #$./x install$#)
12.37- (std (x) #$./x save std$#)
12.38- (prelude (x) #$./x save prelude$#)
12.39+ (install (x) #$./x install$#)
12.40 (deploy (std prelude) #$mv .stash/{prelude.core,std.core} $PACKY_DIR$#))
