Re: sqlite3

[Qiantan Hong <qhong@mit.edu>]

[-- Attachment #1: Type: text/plain, Size: 1164 bytes --]

>>> I’m thinking of rather not exposing multisession.el directly,
>>> but instead use it as a backend for store.el.
>> 
>> What is store.el?  Could you show us its interface specs?
>> Is it written, or is it a proposal?
> 
> still a proposal, of a common abstraction over persistent key-value 
> stores, that would have sqlite among backends, but also lisp-implemented 
> stores such as the “one-file-per-value in a directory” persist.el currently 
> use (most efficient on btree fs like btrfs or zfs), and a logging delta 
> store qiantan hong implemented initially on a scratch by reaction to 
> sqlite suggestion.
It is now written BTW. I’ve finished the work of extracting
key value store part from resist!.el. I haven’t start extracting
persistent variable part as I haven’t hear back about persist.el
namespace availability yet.

I’ve already included the above mentioned two backends.
Lars’ sqlite3 implementation could be included as the third
with slight modification.

Code is hosted at https://code.librehq.com/qhong/store.el/
For people that don’t want to follow link, I also attach the
current revision below

[-- Attachment #2: store.el --]
[-- Type: application/octet-stream, Size: 15645 bytes --]

;;; store.el --- Persistant Key-Value Store  -*- lexical-binding: t; -*-

;; Copyright (C) 2021 Free Software Foundation, Inc.

;; Author: Qiantan Hong <qhong@alum.mit.edu>
;; Maintainer: Qiantan Hong <qhong@alum.mit.edu>
;; Keywords: persistence database
;; Version: 0.0.1

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;; This package implements a persistent key-value store facility.

;; The interface provides the following functions:

;; - Creating and compacting store: `store-create', `store-compact'
;; - Get the path of a store: `store-path'
;; - Put, remove and look up key value pairs: `store-put',
;;   `store-rem', `store-get',
;; - List operations: `store-push', `store-delete'
;; See their docstrings for details.

;; The package supports multiple backends.  All backends should
;; persist all changes immediately into external storage.  It comes
;; with the following built-in backends:

;; - `log': Log-structured incremental S-expr store.  Only increments
;;   are stored, therefore the cost for each persistent operation
;;   should be independent of the total size of the store, and the
;;   cost for each persistent list operation should be independent of
;;   the total size of the list.

;; - `fs': File-system based S-expr store.  Use a file per key-value
;;   pair, with key S-expr as file name and value S-expr as content.

;;; Code:

(require 'cl-lib)
(require 'cl-generic)

;;; Customs
(defgroup persistence nil "Persistence facility."
          :group 'emacs)

(defcustom store-compact-idle-time 30
  "Idle time in seconds to wait before compacting key value stores."
  :type 'number :group 'persistence)

;;; Generic Interface
(cl-defgeneric store-create (path backend &key &allow-other-keys)
  "Create and return a key value store backed by PATH and BACKEND.
If the backing storage doesn't exist, create it.  Otherwise,
content of the returned store is synchronized to the backing
storage.")
(cl-defgeneric store-compact (store &optional nonblock)
  "Compress/vacuum/garbage collect STORE, if applicable.
If the backing storage is already locked, signal `file-locked'
immediately if NONBLOCK is non nil or wait if NONBLOCK is nil."
  ;; We provide a mock implementation for backends that do not support
  ;; compacting.
  nil)
(cl-defgeneric store-path (store)
  "Return the path of STORE's backing storage.
The returned path should create a store backed by the same
storage when passed to `store-create'.")

(cl-defgeneric store-call-with-transaction (store function &key (nonblock nil) (lock t))
  "Call FUNCTION while holding a transaction for STORE.
If LOCK is non nil, grab a lock of the backing storage when
applicable.  If the backing storage is already locked, wait if
NONBLOCK is nil or signal `file-locked' immediately if NONBLOCK
is non nil."
  ;; We provide a mock implementation for backends that do not support
  ;; transaction.
  (funcall function))
(cl-defmacro store-with-transaction
    ((store &key (nonblock nil) (lock t)) &rest body)
  "Run BODY while holding a transaction for STORE.
If LOCK is non nil, grab a lock of the backing storage when
applicable.  If the backing storage is already locked, wait if
NONBLOCK is nil or signal `file-locked' immediately if NONBLOCK
is non nil."
  (declare (indent 1) (debug ([&rest form] body)))
  `(store-call-with-transaction ,store (lambda () ,@body)
                             :lock ,lock :nonblock ,nonblock))

(cl-defgeneric store-put (key value store)
  "Associate KEY with VALUE in STORE.
The operation is immediately persisted.
Return VALUE.")
(cl-defgeneric store-get (key store &optional dflt)
  "Look up KEY in STORE and return its associated value.
If KEY is not found, return DFLT which defaults to nil.")
(cl-defgeneric store-rem (key store)
  "Remove KEY from STORE.
The operation is immediately persisted.
Return nil.")
(gv-define-setter store-get (val key store &optional _dflt)
  ;; TODO: can we detect if the place is used in `push', `cl-pushnew',
  ;; etc and use the potentially more efficient `store-push' instead?
  `(store-put ,key ,val ,store))

(cl-defgeneric store-push (key value store)
  "Add VALUE to the list associated with KEY in STORE.
The operation is immediately persisted.
Return the new list with VALUE added."
  ;; We provide a default implementation for backends not natively
  ;; supporting list operations.  Backends are encouraged to override
  ;; this with more efficient implementation.
  (store-put key (cons value (store-get key store)) store))
(cl-defgeneric store-delete (key value store)
  "Remove VALUE from the list associated with KEY in STORE.
The operation is immediately persisted.
Return the new list with VALUE removed."
  ;; We provide a default implementation for backends not natively
  ;; supporting list operations.  Backends are encouraged to override
  ;; this with more efficient implementation.
  (store-put key (delete value (store-get key store)) store))

;;; Automatic Compacting
(defvar store-need-compacting-list nil
  "List of stores that shall be compacted by `store-compact-demon'.")
(defvar store-compact-idle-timer nil "Idle timer that runs `store-compact-demon'.")
(defun store-compact-demon ()
  (while store-need-compacting-list
    (let ((store (pop store-need-compacting-list)))
      (condition-case nil
          (store-compact store 'nonblock)
        (file-locked
         (message "Giving up compacting %s this time, because it is locked."
                  (store-path store))
         nil)))))
(defun store-compact-demon-summon ()
  (unless store-compact-idle-timer
    (setq store-compact-idle-timer (timer-create))
    (timer-set-function store-compact-idle-timer 'store-compact-demon)
    (timer-set-idle-time store-compact-idle-timer store-compact-idle-time))
  (unless (memq store-compact-idle-timer timer-list)
    (timer-activate-when-idle store-compact-idle-timer t)))

;;; Serialization utility
(defsubst store--print (form)
  (let ((print-length nil) (print-level nil))
    (prin1 form (current-buffer)))
  (insert "\n"))

;;; `log' backend
(defvar store-inhibit-ask-user-about-lock nil)
(defun store-inhibit-ask-user-about-lock-advice (orig-func file opponent)
  (if store-inhibit-ask-user-about-lock
      (signal 'file-locked (list file opponent))
    (funcall orig-func file opponent)))
(advice-add 'ask-user-about-lock :around #'store-inhibit-ask-user-about-lock-advice)
(defvar store-inhibit-ask-user-about-supersession-threat nil)
(defun store-inhibit-ask-user-about-supersession-threat-advice (orig-func file)
  (unless store-inhibit-ask-user-about-supersession-threat
    (funcall orig-func file)))
(advice-add 'ask-user-about-supersession-threat :around #'store-inhibit-ask-user-about-supersession-threat-advice)

(cl-defstruct (store-log (:constructor store-log--make))
  path (table (make-hash-table :test 'equal)) (log-count 0) compact-ratio
  ;; I used to use a `gensym' redirection to exploit thread-safe
  ;; dynamic binding for `store-log-transaction-buffer', but currently
  ;; I dropped the support for recursive and concurrent transaction
  ;; (due to limitation of `lock-file').  When we add it back in the
  ;; future, remember the `gensym' trick.
  transaction-buffer)

(defun store-log--lock (store)
  (setf (buffer-modified-p (store-log-transaction-buffer store)) t) ; otherwise `lock-buffer' would do nothing
  (with-current-buffer (store-log-transaction-buffer store)
    (let ((create-lockfiles t)
          (store-inhibit-ask-user-about-lock t)
          (store-inhibit-ask-user-about-supersession-threat t))
      (lock-buffer))))
(cl-defmethod store-call-with-transaction ((store store-log) function &key (nonblock nil) (lock t))
  (when (store-log-transaction-buffer store)
    (error "Recursive or concurrent transaction is currently not supported"))
  (let ((buffer (generate-new-buffer " *temp log transaction*")))
    (setf (buffer-local-value 'buffer-file-truename buffer) (store-log-path store))
    (unwind-protect
         (progn
           (setf (store-log-transaction-buffer store) buffer)
           (when lock
             (if nonblock
                 (store-log--lock store)
               (while (not (ignore-errors (store-log--lock store) t))
                 (sit-for 0.0 t))))
           (prog1 (funcall function)
             (with-current-buffer buffer
               (write-region nil nil (store-log-path store) t 'silent))))
      (setf (store-log-transaction-buffer store) nil)
      (kill-buffer buffer))))
(cl-defmacro store-log--ensure-transaction-buffer ((store &rest args) &rest body)
  "Make sure BODY is executed inside a transaction buffer for STORE.
If no transaction buffer for STORE is in effect, create a temporary buffer
for appending logs.
ARGS are passed to `store-call-with-transaction'."
  (declare (indent 1) (debug ([&rest form] body)))
  (let ((store-var (gensym "store"))
        (body-sym (gensym "body")))
    `(let ((,store-var ,store))
       (cl-flet ((,body-sym ()
                   (with-current-buffer (store-log-transaction-buffer ,store-var)
                     ,@body)))
         (if (store-log-transaction-buffer ,store-var)
             (,body-sym)
           (store-call-with-transaction ,store-var #',body-sym ,@args))))))

(defun store-log-load (store &optional incremental)
  "Load the content STORE from its backing file.
If INCREMENTAL is nil, load the entire backing file and replace
STORE's content.  Otherwise, INCREMENTAL should be a number
specifying a start offset of the backing file, and the portion
after this offset will be loaded and added to STORE's
content."
  (store-with-transaction (store)
    (unless incremental (clrhash (store-log-table store)))
    (condition-case nil
        (with-temp-buffer
          (insert-file-contents (store-log-path store) nil (or incremental 0))
          (while (< (point) (1- (point-max))) ; exclude trailing newline
            (let ((entry (read (current-buffer))))
              (pcase (car entry)
                ('++ (puthash (cadr entry) (caddr entry) (store-log-table store)))
                ('-- (remhash (cadr entry) (store-log-table store)))
                ('l+ (push (caddr entry) (gethash (cadr entry) (store-log-table store))))
                ('l- (puthash (cadr entry)
                              (delete (caddr entry) (gethash (cadr entry) (store-log-table store)))
                              (store-log-table store))))
              (cl-incf (store-log-log-count store)))))
      (end-of-file
       ;; We might encounter trailing unbalanced form if Emacs
       ;; crashed in the middle of `log-put'.  We compact the file
       ;; and fix unbalanced form as a side effect
       (store-compact store)))))
(cl-defmethod store-create (path (_backend (eql log)) &key (compact-ratio 4.0) &allow-other-keys)
  "Create a key value store backed by file PATH.
If file PATH does not exist, create it and return an empty key value store.
If file PATH exists, load its content into a key value store and return it.

COMPACT-RATIO controls automatic compacting.  Arrange for
compacting if log count exceeds (COMPACT-RATIO * size-of-table)."
  (let* ((store-log (store-log--make :path path :compact-ratio compact-ratio)))
    (when (file-exists-p path)
      (store-log-load store-log))
    store-log))
(cl-defmethod store-path ((store store-log))
  (store-log-path store))

(cl-defmethod store-compact ((store store-log) &optional nonblock)
  (store-log--ensure-transaction-buffer (store :nonblock nonblock)
    (setf (store-log-log-count store) (hash-table-count (store-log-table store)))
    (with-temp-buffer
      (maphash (lambda (key value) (store--print (list '++ key value)))
               (store-log-table store))
      (let ((file-precious-flag t))
        (write-region nil nil (store-log-path store) nil 'silent)))))

(defsubst store-log--inc-log-count (store)
  "Increase log count for STORE, possibly arrange for compacting.
Arrange for compacting if log count exceeds (compact-ratio * size-of-table)."
  (cl-incf (store-log-log-count store))
  (when (and (store-log-compact-ratio store)
             (> (store-log-log-count store)
                (* (store-log-compact-ratio store) (hash-table-count (store-log-table store)))))
    (cl-pushnew store store-need-compacting-list)
    (store-compact-demon-summon)))
(cl-defmethod store-put (key value (store store-log))
  (store-log--ensure-transaction-buffer (store)
    (store--print (list '++ key value))
    (store-log--inc-log-count store)
    (puthash key value (store-log-table store))))
(cl-defmethod store-rem (key (store store-log))
  (store-log--ensure-transaction-buffer (store)
    (store--print (list '-- key))
    (store-log--inc-log-count store)
    (remhash key (store-log-table store))))
(cl-defmethod store-push (key value (store store-log))
  (store-log--ensure-transaction-buffer (store)
    (store--print (list 'l+ key value))
    (store-log--inc-log-count store)
    (push value (gethash key (store-log-table store)))))
(cl-defmethod store-delete (key value (store store-log))
  (store-log--ensure-transaction-buffer (store)
    (store--print (list 'l- key value))
    (store-log--inc-log-count store)
    (puthash key (delete value (gethash key (store-log-table store)))
             (store-log-table store))))
(cl-defmethod store-get (key (store store-log) &optional dflt)
  (gethash key (store-log-table store) dflt))

;; `fs' backend
(cl-defstruct (store-fs (:constructor store-fs--make))
  path)
(cl-defmethod store-create (path (_backend (eql fs)) &key &allow-other-keys)
  (if (file-exists-p path)
      (unless (file-directory-p path)
        (error "`fs' backend requires PATH to be a directory, but %s is not" path))
    (mkdir path))
  ;; We normalize PATH right away, saving future hassles.
  (store-fs--make :path (file-name-as-directory path)))
(cl-defmethod store-path ((store store-fs))
  (store-fs-path store))

(defsubst store-fs--key-to-path (key store)
  ;; TODO: escape illegal characters
  (concat (store-fs-path store) (prin1-to-string key)))
(cl-defmethod store-put (key value (store store-fs))
  (with-temp-buffer
    (store--print value)
    (let ((file-precious-flag t))
      (write-region nil nil
                    (store-fs--key-to-path key store)
                    nil 'quiet)))
  value)
(cl-defmethod store-get (key (store store-fs) &optional dflt)
  (let ((path (store-fs--key-to-path key store)))
    (if (file-exists-p path)
        (with-temp-buffer
          (insert-file-contents path)
          (read (current-buffer)))
      dflt)))
(cl-defmethod store-rem (key (store store-fs))
  (delete-file (store-fs--key-to-path key store))
  nil)
(provide 'store)
;;; store.el ends here

[-- Attachment #3: ATT00001.c --]
[-- Type: text/plain, Size: 22 bytes --]



Best,
Qiantan