changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/ffi/rocksdb/macs.lisp

changeset 679: 12287fab15d0
parent: 5e57683a0c28
author: Richard Westhaver <ellis@rwest.io>
date: Thu, 26 Sep 2024 21:16:45 -0400
permissions: -rw-r--r--
description: rocksdb load opts and env updates 
     1 ;;; macs.lisp --- RocksDB Alien Macros
     2 
     3 ;; Convenience Macros for working with RocksDB Alien types
     4 
     5 ;;; Code:
     6 (in-package :rocksdb)
     7 
     8 (deftype rocksdb-mergeoperator-function ()
     9   '(function (octet-vector (or octet-vector null) &rest t) (or null octet-vector)))
    10 
    11 (deftype rocksdb-comparator-function ()
    12   '(function (octet-vector octet-vector) (integer -1 1)))
    13 
    14 (deftype rocksdb-compactionfilter-function ()
    15   ;;           level              key           val           new         changed
    16   '(function ((unsigned-byte 32) octet-vector octet-vector octet-vector) boolean))
    17 
    18 (deftype rocksdb-logger-function ()
    19   '(function (unsigned-byte string) (values)))
    20 
    21 ;;; Options
    22 (defmacro with-latest-options (db-path (db-opts-var cf-names-var cf-opts-var) &body body)
    23   ;;  TODO 2024-09-26: ignore unknown?
    24   (with-gensyms (db-opts cf-names cf-opts)
    25     `(with-alien ((,db-opts (* rocksdb-options))
    26                   (,cf-names (* c-string))
    27                   (,cf-opts (* (* rocksdb-options)))
    28                   (ncols size-t)
    29                   (errptr rocksdb-errptr))
    30        (rocksdb-load-latest-options 
    31         ,db-path 
    32         (rocksdb-create-default-env) 
    33         t
    34         (rocksdb-cache-create-lru 1080)
    35         (addr ,db-opts)
    36         (addr ncols)
    37         (addr ,cf-names)
    38         (addr ,cf-opts)
    39         errptr)
    40        (let ((,db-opts-var ,db-opts)
    41              (,cf-names-var (coerce
    42                              (loop for i below ncols
    43                                    collect (deref ,cf-names i))
    44                              'vector))
    45              (,cf-opts-var (coerce
    46                             (loop for i below ncols
    47                                   collect (deref ,cf-opts i))
    48                             'vector)))
    49          (unwind-protect ,@body
    50            (rocksdb-load-latest-options-destroy ,db-opts ,cf-names ,cf-opts ncols))))))
    51       
    52 ;;; Merge Ops
    53 (defmacro define-full-merge-op (name &body body)
    54   `(define-alien-callable ,name (* t)
    55        ,*rocksdb-full-merge-lambda-list*
    56      ,@body))
    57 
    58 (defmacro define-partial-merge-op (name &body body)
    59   `(define-alien-callable ,name (* t)
    60        ,*rocksdb-partial-merge-lambda-list*
    61      ,@body))
    62 
    63 (defmacro define-merge-operator (name state &key full
    64                                                  partial
    65                                                  (destructor 'rocksdb-destructor)
    66                                                  (delete 'rocksdb-delete-value))
    67   (with-gensyms (fmerge pmerge mcreate mname)
    68     (setf fmerge (symbolicate name "-FULL-MERGE")
    69           pmerge (symbolicate name "-PARTIAL-MERGE")
    70           mcreate (symbolicate "CREATE-" name "-MERGEOPERATOR")
    71           mname (symbolicate name "-MERGEOPERATOR-NAME"))
    72       `(progn
    73          (define-full-merge-op ,fmerge ,@full)
    74          (define-partial-merge-op ,pmerge ,@partial)
    75          (define-alien-callable ,mname c-string () (string ',name))
    76          (defun ,mcreate ()
    77            (rocksdb-mergeoperator-create ,state
    78                                          (alien-sap (alien-callable-function ',destructor))
    79                                          (alien-sap (alien-callable-function ',fmerge))
    80                                          (alien-sap (alien-callable-function ',pmerge))
    81                                          (alien-sap (alien-callable-function ',delete))
    82                                          (alien-sap (alien-callable-function ',mname)))))))