summaryrefslogtreecommitdiff
path: root/lmdb/internal.scm.in
diff options
context:
space:
mode:
Diffstat (limited to 'lmdb/internal.scm.in')
-rw-r--r--lmdb/internal.scm.in60
1 files changed, 60 insertions, 0 deletions
diff --git a/lmdb/internal.scm.in b/lmdb/internal.scm.in
new file mode 100644
index 0000000..eb04656
--- /dev/null
+++ b/lmdb/internal.scm.in
@@ -0,0 +1,60 @@
+; SPDX-FileCopyrightText: 2021 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (lmdb internal)
+ #:use-module (system foreign)
+
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+
+ #:export (liblmdb
+
+ lmdb-error?
+ lmdb-error-function-name
+ lmdb-error-code
+ lmdb-error-description
+
+ liblmdb-func
+ liblmdb-void-func))
+
+;; Internal helpers
+
+(define liblmdb (dynamic-link "@LIBLMDB_LIBDIR@/liblmdb"))
+
+;; Error handling
+
+(define-condition-type &lmdb-error
+ &error
+ lmdb-error?
+ (function-name lmdb-error-function-name)
+ (code lmdb-error-code)
+ (description lmdb-error-description))
+
+(define (mdb-strerror err)
+ "Return a string describing a given error code."
+ (let ((proc (pointer->procedure '*
+ (dynamic-func "mdb_strerror" liblmdb)
+ (list int))))
+ (pointer->string (proc err))))
+
+;; Helper for calling lmdb functions
+
+(define (liblmdb-func name arg-types)
+ (let ((proc (pointer->procedure int
+ (dynamic-func name liblmdb)
+ arg-types)))
+ (lambda* (#:rest args)
+ (let ((return-value (apply proc args)))
+ (unless (= 0 return-value)
+ (raise
+ (condition (&lmdb-error
+ (function-name name)
+ (code return-value)
+ (description (mdb-strerror return-value))))))
+ return-value))))
+
+(define (liblmdb-void-func name arg-types)
+ (pointer->procedure void
+ (dynamic-func name liblmdb)
+ arg-types))