changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/rdb/macs.lisp

changeset 274: 5f782d361e08
parent: 6d56c4950fa2
child: e2e5c4831389
author: Richard Westhaver <ellis@rwest.io>
date: Thu, 11 Apr 2024 18:59:19 -0400
permissions: -rw-r--r--
description: threads and db tweaks. fixed a tricky macro error caused by string-case, dat/html now works. 
     1 ;;; rdb/macs.lisp --- macros
     2 
     3 ;;; Code:
     4 (in-package :rdb)
     5 
     6 ;;; error handling
     7 (defmacro with-errptr ((e &optional errtyp params) &body body)
     8   `(with-alien ((,e rocksdb-errptr nil))
     9      (unwind-protect 
    10           (handler-bind ((sb-sys:memory-fault-error 
    11                            (lambda (condition)
    12                              (error 'rdb-error
    13                                     :message
    14                                     (format nil
    15                                             "~a" condition))))
    16                          (error 
    17                            (lambda (condition)
    18                              (error 'rdb-error 
    19                                     :message 
    20                                     (format nil 
    21                                             "WITH-ERRPTR signaled: ~A"
    22                                             condition)))))
    23             (progn ,@body))
    24        (handle-errptr ,e ,errtyp ,params))))
    25 
    26 ;;; opts
    27 (defmacro rdb-opt-setter (key)
    28   `(find-symbol (format nil "~:@(rocksdb-options-set-~x~)" ,key) :rocksdb))
    29 
    30 (defmacro rdb-opt-getter (key)
    31   `(find-symbol (format nil "~:@(rocksdb-options-get-~x~)" ,key) :rocksdb))
    32 
    33 ;;; db
    34 (defmacro with-open-db-raw ((db-var db-path &optional (opt (default-rocksdb-options))) &body body)
    35   `(let ((,db-var (open-db-raw ,db-path ,opt)))
    36      (unwind-protect (progn ,@body)
    37        (rocksdb-close ,db-var)
    38        (with-errptr (err 'rocksdb-error)
    39          ;; (rocksdb-destroy-db ,opt ,db-path err) ;; when :destroy only
    40          (rocksdb-options-destroy ,opt)))))
    41 
    42 (defmacro with-db ((db-var db) &body body)
    43   "Bind DB-VAR to the database object DB for the lifetime of BODY."
    44   `(let ((,db-var ,db))
    45      (handler-bind ((error (lambda (condition)
    46                              (error 'rdb-error
    47                                     :message
    48                                     (format nil "WITH-DB signaled: ~A" condition)))))
    49        ,@body)))
    50 
    51 ;;; cf
    52 (defmacro with-cf ((cf-var cf) &body body)
    53   "Bind CF to CF-VAR for the lifetime of BODY."
    54   `(let ((,cf-var ,cf))
    55      (handler-bind ((error (lambda (condition)
    56                              (error 'cf-error
    57                                     :message
    58                                     (format nil "WITH-CF signaled: ~A" condition)))))
    59        ,@body)))
    60 
    61 (defmacro do-cfs ((cf cfs) &body body)
    62   "Do BODY for each CF in the array CFS."
    63   (with-gensyms (%cf)
    64     `(loop for ,%cf across ,cfs
    65            do (with-cf (,cf ,%cf) ,@body))))
    66 
    67 ;;; iter
    68 (defmacro with-iter-raw ((iter-var db &optional (opt (rocksdb-readoptions-create))) &body body)
    69   `(let ((,iter-var (create-iter-raw ,db ,opt)))
    70      (unwind-protect (progn ,@body)
    71        (destroy-iter-raw ,iter-var))))
    72 
    73 (defmacro with-iter ((iter-var iter) &body body)
    74   "Bind object ITER to ITER-VAR.
    75 
    76 ((%ITER ITER) BODY) is passed to ROCKSDB:WITH-ITER-RAW, binding the
    77 raw handle to the same symbol prefixed with '%'.
    78 
    79 Errors that occur in the inner body will be handled but the iterator
    80 handle will not be freed on exit."
    81   (let ((%iter-var (symbolicate '% (symbol-name iter-var))))
    82     `(let ((,iter-var ,iter))
    83        (let ((,%iter-var (rdb-iter-sap ,iter-var)))
    84          ,@body))))
    85 
    86 ;; TODO: sb-ext:with-current-source-form ?
    87 ;;; backup
    88 (defmacro with-open-backup-engine-raw ((be-var be-path &optional (opt (rocksdb-options-create)))
    89                                        &body body)
    90   `(let ((,be-var (open-backup-engine-raw ,be-path ,opt)))
    91      (unwind-protect (progn ,@body)
    92        (rocksdb-backup-engine-close ,be-var))))
    93 
    94 ;;; top-level
    95 (defmacro do-db ((db opts) accessors &body body)
    96   "Database Iteration construct. OPTS are used to provide top-level
    97   options dynamically bound to DB. ACCESSORS is a list of database
    98    accessors which are available to call in BODY."
    99   )
   100 
   101 ;;; temp-db
   102 (defvar *temp-db-path-generator*
   103   (lambda (&optional (name "temp-db"))
   104     (make-pathname :directory "tmp" :name (symbol-name (gensym name))))
   105   "A single arg function returning the absolute path to a temp-db path.")
   106 
   107 (defvar *temp-db-destroy* nil)
   108 
   109 (defmacro with-temp-db ((db-var (&rest cfs) &key (destroy *temp-db-destroy*) open) &body body)
   110   "Bind DB-VAR to a temporary RDB object, arranging for CF-VARS to be
   111 created as column-families and destroying the database after executing
   112 the forms in BODY."
   113   (setf cfs
   114         (mapcar
   115          (lambda (var)
   116            (setf var (make-rdb-cf (symbol-name var))))
   117          cfs))
   118   `(with-db (,db-var (make-rdb
   119                       (namestring (funcall ,*temp-db-path-generator* ,(symbol-name db-var)))
   120                       (default-rdb-opts)
   121                       (make-array ,(length cfs) :element-type 'rdb-cf :initial-contents ',cfs)))
   122      ,@(when open `((open-db ,db-var)
   123                     (create-cfs ,db-var)))
   124        (prog1
   125            (progn ,@body)
   126          ,(if destroy
   127               `(destroy-db ,db-var)
   128               `(shutdown-db ,db-var)))))