1.1--- a/lisp/lib/cli/shell.lisp Thu May 30 21:48:39 2024 +0000
1.2+++ b/lisp/lib/cli/shell.lisp Thu May 30 18:31:53 2024 -0400
1.3@@ -23,28 +23,34 @@
1.4 (defparameter *shell-directory* nil)
1.5 (defparameter *shell-input* nil)
1.6
1.7+(deftype %shell-state () '(member :sh :dolla))
1.8+
1.9 (defun plain-shell-reader (stream)
1.10- (let (chars (state 'sh))
1.11+ (let (chars (state :sh))
1.12+ (declare (type %shell-state state))
1.13 (loop do
1.14 (let ((c (read-char stream)))
1.15 (cond
1.16- ((eq state 'sh)
1.17- (when (char= c #\$) (setq state 'dolla))
1.18+ ((eq state :sh)
1.19+ (when (char= c #\$) (setq state :dolla))
1.20 (push c chars))
1.21- ((eq state 'dolla)
1.22+ ((eq state :dolla)
1.23 (cond
1.24 ((char= c #\#)
1.25 ;; remove trailing '$'
1.26 (pop chars)
1.27 (return))
1.28- (t (setq state 'sh) (push c chars)))))))
1.29+ (t (setq state :sh) (push c chars)))))))
1.30 (coerce (nreverse chars) 'string)))
1.31
1.32-;; (defun lisp-shell-reader (stream numarg))
1.33+(defun lisp-shell-reader (stream numarg)
1.34+ (declare (ignore numarg))
1.35+ (read stream nil))
1.36
1.37 (defmacro define-process-output-handler (type &body body)
1.38 "Define a new function which handles the result of a SB-EXT:PROCESS in
1.39-the context of the $#-reader macro.")
1.40+the context of the $#-reader macro."
1.41+ (declare (ignore type body)))
1.42
1.43 (defun |#/-reader| (stream sub-char numarg)
1.44 "parse STREAM using the LISP-SHELL-READER, expanding 'unquoted' lisp
2.1--- a/lisp/lib/obj/db.lisp Thu May 30 21:48:39 2024 +0000
2.2+++ b/lisp/lib/obj/db.lisp Thu May 30 18:31:53 2024 -0400
2.3@@ -2,9 +2,18 @@
2.4
2.5 ;;
2.6
2.7+;;; Commentary:
2.8+
2.9+;; This set of
2.10+
2.11 ;;; Code:
2.12 (in-package :obj/db)
2.13
2.14+;;; Vars
2.15+(declaim (sb-kernel:type-specifier *default-database-type* *default-database-collection-type*))
2.16+(defparameter *default-database-type* 'vector)
2.17+(defparameter *default-database-collection-type* 'list)
2.18+
2.19 ;;; Database
2.20 (defgeneric db (self)
2.21 (:documentation "Return the Database associated with SELF."))
2.22@@ -12,29 +21,37 @@
2.23 (defclass database ()
2.24 ((db :initarg :db :accessor db)))
2.25
2.26-(defgeneric make-db (engine &rest initargs &key &allow-other-keys))
2.27+(defclass database-collection () ())
2.28
2.29-(defgeneric connect-db (db &key &allow-other-keys))
2.30+;; TODO 2024-05-30: maybe make into a macro?
2.31+(defgeneric make-db (engine &rest initargs &key &allow-other-keys)
2.32+ (:documentation "'make-instance' for databases. An ENGINE must be supplied, which is usually a key such as :ROCKSDB or :SQLITE."))
2.33
2.34-(defgeneric db-query (db query &key &allow-other-keys))
2.35+(defgeneric connect-db (db &key &allow-other-keys)
2.36+ (:documentation "Connect the database DB."))
2.37
2.38-(defgeneric db-get (db key &key &allow-other-keys))
2.39+(defgeneric db-query (db query &key &allow-other-keys)
2.40+ (:documentation "Execute QUERY against DB."))
2.41+
2.42+(defgeneric db-get (db key &key &allow-other-keys)
2.43+ (:documentation "Return the value associated with KEY from DB."))
2.44
2.45 (defgeneric (setf db-get) (db key val &key &allow-other-keys))
2.46
2.47-(defgeneric close-db (db &key &allow-other-keys))
2.48+(defgeneric close-db (db &key &allow-other-keys)
2.49+ (:documentation "Close the database DB."))
2.50
2.51 (defgeneric open-db (self))
2.52
2.53-(defgeneric destroy-db (self))
2.54-
2.55-(defgeneric find-db (dbs name)
2.56- (:documentation "Returns the db by name."))
2.57+(defgeneric destroy-db (self)
2.58+ (:documentation "Destroy all traces of a database, deleting any on-disk data and shutting down
2.59+in-memory objects."))
2.60
2.61-(defgeneric insert-db (dbs name &key base-path load-from-file-p)
2.62- (:documentation "Inserts a db to the dbs hashtable. A base-path can be
2.63-supplied here that is independatn of the dbs base-path so that a
2.64-database collection can be build that spans multiple disks etc."))
2.65+(defgeneric find-db (dbs name &key &allow-other-keys)
2.66+ (:documentation "Return the db by NAME, from a collection of databases DBS."))
2.67+
2.68+(defgeneric insert-db (dbs name &key &allow-other-keys)
2.69+ (:documentation "Inserts a database by NAME into the database-collection DBS."))
2.70
2.71 ;;; Common
2.72 (defun slot-val (instance slot-name)
2.73@@ -44,13 +61,8 @@
2.74
2.75 (defgeneric get-val (object element &optional data-type)
2.76 (:documentation "Returns the value in a object based on the supplied element name and possible
2.77-type hints."))
2.78-
2.79-(defgeneric (setf get-val) (new-value object element &optional data-type)
2.80- (:documentation "Set the value in a object based on the supplied element name and possible type
2.81-hints."))
2.82-
2.83-(defmethod get-val (object element &optional data-type)
2.84+type hints.")
2.85+ (:method (object element &optional data-type)
2.86 (when object
2.87 (typecase (or data-type object)
2.88 (hash-table
2.89@@ -68,21 +80,25 @@
2.90 (error "Does not handle this type of object. Implement your own get-val method.")))
2.91 (if (listp object)
2.92 (second (assoc element object :test #'equal))
2.93- (error "Does not handle this type of object. Implement your own get-val method.")))))))
2.94+ (error "Does not handle this type of object. Implement your own get-val method."))))))))
2.95+
2.96
2.97-(defmethod (setf get-val) (new-value object element &optional data-type)
2.98- (typecase (or data-type object)
2.99- (hash-table (setf (gethash element object) new-value))
2.100- (standard-object (setf (slot-value object element) new-value))
2.101- (t
2.102- (if data-type
2.103- (cond ((equal 'alist data-type)
2.104- (replace object (list (list element new-value))))
2.105- ((equal 'plist data-type)
2.106- ;;TODO: Implement this properly.
2.107- (get object element ))
2.108- (t
2.109- (error "Does not handle this type of object. Implement your own get-val method.")))
2.110- (if (listp object)
2.111- (replace object (list (list element new-value)))
2.112- (error "Does not handle this type of object. Implement your own get-val method."))))))
2.113+(defgeneric (setf get-val) (new-value object element &optional data-type)
2.114+ (:documentation "Set the value in a object based on the supplied element name and possible type
2.115+hints.")
2.116+ (:method (new-value object element &optional data-type)
2.117+ (typecase (or data-type object)
2.118+ (hash-table (setf (gethash element object) new-value))
2.119+ (standard-object (setf (slot-value object element) new-value))
2.120+ (t
2.121+ (if data-type
2.122+ (cond ((equal 'alist data-type)
2.123+ (replace object (list (list element new-value))))
2.124+ ((equal 'plist data-type)
2.125+ ;;TODO: Implement this properly.
2.126+ (get object element ))
2.127+ (t
2.128+ (error "Does not handle this type of object. Implement your own get-val method.")))
2.129+ (if (listp object)
2.130+ (replace object (list (list element new-value)))
2.131+ (error "Does not handle this type of object. Implement your own get-val method.")))))))
3.1--- a/lisp/lib/obj/direction.lisp Thu May 30 21:48:39 2024 +0000
3.2+++ b/lisp/lib/obj/direction.lisp Thu May 30 18:31:53 2024 -0400
3.3@@ -1,1 +1,3 @@
3.4+;;; obj/direction.lisp --- Physical and Metaphysical Directions
3.5+
3.6 (in-package :obj/direction)
4.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
4.2+++ b/lisp/lib/obj/graph/read.lisp Thu May 30 18:31:53 2024 -0400
4.3@@ -0,0 +1,16 @@
4.4+;;; obj/graph/read.lisp --- #G reader macro and readtable
4.5+
4.6+;;
4.7+
4.8+;;; Code:
4.9+(in-package :obj/graph)
4.10+
4.11+(defun |#G-reader| (stream sub-char numarg)
4.12+ "Enable the Graph reader for the following form."
4.13+ (declare (ignore sub-char))
4.14+ (std/readtable::|#~-reader|)
4.15+
4.16+(defreadtable :graph
4.17+ "Graph notation readtable"
4.18+ (:merge :std)
4.19+ (:dispatch-macro-char #\# #\G #'|#G-reader|))
5.1--- a/lisp/lib/obj/id.lisp Thu May 30 21:48:39 2024 +0000
5.2+++ b/lisp/lib/obj/id.lisp Thu May 30 18:31:53 2024 -0400
5.3@@ -28,3 +28,7 @@
5.4 (format stream "~A" (id obj))))
5.5
5.6 (defclass id-factory () ())
5.7+
5.8+(defgeneric identify (self)
5.9+ (:documentation "Return the identity of object SELF - usually meant for objects which don't
5.10+specialize on ID but should still sometimes return an ID."))
6.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
6.2+++ b/lisp/lib/rdb/db.lisp Thu May 30 18:31:53 2024 -0400
6.3@@ -0,0 +1,19 @@
6.4+;;; rdb/db.lisp --- RDB Database API
6.5+
6.6+;; RocksDB Implementation of OBJ/DB protocol.
6.7+
6.8+;;; Code:
6.9+(in-package :rdb)
6.10+
6.11+(defmethod make-db ((engine (eql :rocksdb)) &rest initargs)
6.12+ (declare (ignore engine))
6.13+ (funcall 'make-rdb initargs))
6.14+
6.15+(defmethod connect-db ((db rdb) &key) db)
6.16+
6.17+(defmethod db-query ((db rdb) (query (eql :get)) &key key &allow-other-keys)
6.18+ (declare (ignore query))
6.19+ (get-key db key))
6.20+
6.21+(defclass rdb-collection (database-collection)
6.22+ ((collection :initform (coerce nil db::*default-database-collection-type*))))
7.1--- a/lisp/std/readtable.lisp Thu May 30 21:48:39 2024 +0000
7.2+++ b/lisp/std/readtable.lisp Thu May 30 18:31:53 2024 -0400
7.3@@ -23,49 +23,48 @@
7.4 (unless (<= numarg 3)
7.5 (error "Bad value for #f: ~a" numarg))
7.6 `(declare (optimize (speed ,numarg)
7.7- (safety ,(- 3 numarg))))))
7.8+ (safety ,(- 3 numarg)))))
7.9
7.10-;; Nestable suggestion from Daniel Herring
7.11-(eval-when (:compile-toplevel :load-toplevel :execute)
7.12- (defun |#"-reader| (stream sub-char numarg)
7.13- (declare (ignore sub-char numarg))
7.14- (let (chars (state 'normal) (depth 1))
7.15- (loop do
7.16- (let ((curr (read-char stream)))
7.17- (cond ((eq state 'normal)
7.18- (cond ((char= curr #\#)
7.19- (push #\# chars)
7.20- (setq state 'read-sharp))
7.21- ((char= curr #\")
7.22- (setq state 'read-quote))
7.23- (t
7.24- (push curr chars))))
7.25- ((eq state 'read-sharp)
7.26- (cond ((char= curr #\")
7.27- (push #\" chars)
7.28- (incf depth)
7.29- (setq state 'normal))
7.30- (t
7.31- (push curr chars)
7.32- (setq state 'normal))))
7.33- ((eq state 'read-quote)
7.34- (cond ((char= curr #\#)
7.35- (decf depth)
7.36- (if (zerop depth) (return))
7.37- (push #\" chars)
7.38- (push #\# chars)
7.39- (setq state 'normal))
7.40- (t
7.41- (push #\" chars)
7.42- (if (char= curr #\")
7.43- (setq state 'read-quote)
7.44- (progn
7.45- (push curr chars)
7.46- (setq state 'normal)))))))))
7.47- (coerce (nreverse chars) 'string))))
7.48+ ;; Nestable suggestion from Daniel Herring
7.49+ (eval-when (:compile-toplevel :load-toplevel :execute)
7.50+ (defun |#"-reader| (stream sub-char numarg)
7.51+ (declare (ignore sub-char numarg))
7.52+ (let (chars (state 'normal) (depth 1))
7.53+ (loop do
7.54+ (let ((curr (read-char stream)))
7.55+ (cond ((eq state 'normal)
7.56+ (cond ((char= curr #\#)
7.57+ (push #\# chars)
7.58+ (setq state 'read-sharp))
7.59+ ((char= curr #\")
7.60+ (setq state 'read-quote))
7.61+ (t
7.62+ (push curr chars))))
7.63+ ((eq state 'read-sharp)
7.64+ (cond ((char= curr #\")
7.65+ (push #\" chars)
7.66+ (incf depth)
7.67+ (setq state 'normal))
7.68+ (t
7.69+ (push curr chars)
7.70+ (setq state 'normal))))
7.71+ ((eq state 'read-quote)
7.72+ (cond ((char= curr #\#)
7.73+ (decf depth)
7.74+ (if (zerop depth) (return))
7.75+ (push #\" chars)
7.76+ (push #\# chars)
7.77+ (setq state 'normal))
7.78+ (t
7.79+ (push #\" chars)
7.80+ (if (char= curr #\")
7.81+ (setq state 'read-quote)
7.82+ (progn
7.83+ (push curr chars)
7.84+ (setq state 'normal)))))))))
7.85+ (coerce (nreverse chars) 'string))))
7.86
7.87- ; This version is from Martin Dirichs
7.88-(eval-when (:compile-toplevel :load-toplevel :execute)
7.89+ ;; This version is from Martin Dirichs
7.90 (defun |#>-reader| (stream sub-char numarg)
7.91 (declare (ignore sub-char numarg))
7.92 (let (chars)
7.93@@ -92,8 +91,6 @@
7.94 (nthcdr (length pattern) output))
7.95 'string))))))
7.96
7.97-;; (set-dispatch-macro-character #\# #\> #'|#>-reader|)
7.98-
7.99 (defun segment-reader (stream ch n)
7.100 (if (> n 0)
7.101 (let ((chars))
7.102@@ -104,7 +101,6 @@
7.103 (cons (coerce (nreverse chars) 'string)
7.104 (segment-reader stream ch (- n 1))))))
7.105
7.106-#+cl-ppcre
7.107 (defmacro! match-mode-ppcre-lambda-form (o!args o!mods)
7.108 ``(lambda (,',g!str)
7.109 (cl-ppcre:scan-to-strings
7.110@@ -113,7 +109,6 @@
7.111 (format nil "(?~a)~a" ,g!mods (car ,g!args)))
7.112 ,',g!str)))
7.113
7.114-#+cl-ppcre
7.115 (defmacro! subst-mode-ppcre-lambda-form (o!args)
7.116 ``(lambda (,',g!str)
7.117 (cl-ppcre:regex-replace-all
7.118@@ -121,7 +116,6 @@
7.119 ,',g!str
7.120 ,(cadr ,g!args))))
7.121
7.122-#+cl-ppcre
7.123 (eval-when (:compile-toplevel :load-toplevel :execute)
7.124 (defun |#~-reader| (stream sub-char numarg)
7.125 (declare (ignore sub-char numarg))
