lmdb.scm -> lmdb/low-level.scm

4 files changed, 200 insertions, 192 deletions

diff --git a/Makefile.am b/Makefile.am
index 93515f1..64ca8a7 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -35,7 +35,8 @@ SUFFIXES = .scm .go
 	$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
 
 SOURCES = lmdb.scm \
-          lmdb/internal.scm
+          lmdb/internal.scm \
+          lmdb/low-level.scm
 
 TESTS = 
 
diff --git a/hall.scm b/hall.scm
index 20eceed..3d8c9ed 100644
--- a/hall.scm
+++ b/hall.scm
@@ -11,7 +11,8 @@
  (dependencies `())
  (files (libraries
          ((scheme-file "lmdb")
-          (directory "lmdb" ((scheme-file "internal")))))
+          (directory "lmdb" ((scheme-file "internal")
+                             (scheme-file "low-level")))))
         (tests ((directory "tests" ())))
         (programs ((directory "scripts" ())))
         (documentation
diff --git a/lmdb.scm b/lmdb.scm
index da34190..e933e20 100644
--- a/lmdb.scm
+++ b/lmdb.scm
@@ -3,193 +3,4 @@
 ; SPDX-License-Identifier: GPL-3.0-or-later
 
 (define-module (lmdb)
-  #:use-module (system foreign)
-
-  #:use-module (ice-9 format)
-
-  #:use-module (srfi srfi-34)
-  #:use-module (srfi srfi-35)
-
-  #:use-module (rnrs bytevectors)
-
-  #:use-module (lmdb internal))
-
-;; MDB_env
-
-(define-wrapped-pointer-type <mdb-env>
-  mdb-env?
-  wrap-mdb-env unwrap-mdb-env
-  (lambda (mdb-env port)
-    (format port "#<mdb-env ~x>"
-            (pointer-address (unwrap-mdb-env mdb-env)))))
-
-(define (mdb-env-create)
-  "Create an LMDB environment handle"
-  (let ((proc (liblmdb-func "mdb_env_create" (list '*)))
-        (mdb-env-ptr (bytevector->pointer
-                      (make-bytevector (sizeof '*) 0))))
-    ;; call mdb_env_create
-    (proc mdb-env-ptr)
-    ;; wrap returned pointer as <mdb-env>
-    (wrap-mdb-env (dereference-pointer mdb-env-ptr))))
-
-(define (mdb-env-open mdb-env path)
-  "Open an environment handle"
-  (let ((proc (liblmdb-func "mdb_env_open"
-                            (list
-                             ;; MDB_env* env
-                             '*
-                             ;; char* path
-                             '*
-                             ;; unsigned int flags
-                             unsigned-int
-                             ;; mdb_mode_t mode (int)
-                             int))))
-    (proc (unwrap-mdb-env mdb-env) (string->pointer path) 0 #o644)))
-
-(define (mdb-env-close mdb-env)
-  "Close the environment and release the memory map"
-  (let ((proc (liblmdb-void-func "mdb_env_close" (list '*))))
-    (proc (unwrap-mdb-env mdb-env))))
-
-;; MDB_txn
-
-(define-wrapped-pointer-type <mdb-txn>
-  mdb-txn?
-  wrap-mdb-txn unwrap-mdb-txn
-  (lambda (mdb-txn port)
-    (format port "#<mdb-txn ~x>"
-            (pointer-address (unwrap-mdb-txn mdb-txn)))))
-
-(define (mdb-txn-begin env)
-  "Create a transaction for use with the environment"
-  (let ((proc (liblmdb-func "mdb_txn_begin"
-                            (list
-                             ;; MDB_env* env
-                             '*
-                             ;; MDB_txn* parent
-                             '*
-                             ;; unsigned int flags
-                             unsigned-int
-                             ;; MDB_txn** txn
-                             '*)))
-
-        ;; allocate a new pointer for returned txn
-        (txn-ptr (bytevector->pointer
-                  (make-bytevector (sizeof '*)))))
-
-    ;; call mdb_txn_begin
-    (proc (unwrap-mdb-env env)
-          ;; TODO allow specifying parent txn
-          (make-pointer 0)
-          0
-          txn-ptr)
-
-    ;; wrap pointer as <mdb-txn>
-    (wrap-mdb-txn (dereference-pointer txn-ptr))))
-
-
-(define (mdb-txn-abort txn)
-  "Abandon all the operations of the transaction instead of saving them"
-  (let ((proc (liblmdb-void-func "mdb_txn_abort" (list '*))))
-    (proc (unwrap-mdb-txn txn))))
-
-(define (mdb-txn-commit txn)
-  "Commit all the operations of a transaction into the database"
-  (let ((proc (liblmdb-func "mdb_txn_commit" (list '*))))
-    (proc (unwrap-mdb-txn txn))))
-
-;; MDB_dbi
-
-(define-wrapped-pointer-type <mdb-dbi>
-  mdb-dbi?
-  wrap-mdb-dbi unwrap-mdb-dbi
-  (lambda (mdb-dbi port)
-    (format port "#<mdb-dbi ~x>"
-            (pointer-address (unwrap-mdb-dbi mdb-dbi)))))
-
-
-(define (mdb-dbi-open txn)
-  (let ((proc (liblmdb-func "mdb_dbi_open"
-                            (list
-                             ;; MDB_txn* txn
-                             '*
-                             ;; const char* name
-                             '*
-                             ;; unsigned int flags
-                             unsigned-int
-                             ;; MDB_dbi* dbi
-                             '*)))
-        (dbi-ptr (bytevector->pointer
-                  (make-bytevector (sizeof '*)))))
-    (proc (unwrap-mdb-txn txn)
-          ;; null pointer TODO allow specifying name
-          (make-pointer 0)
-          0
-          dbi-ptr)
-    ;; wrap pointer as <mdb-dbi>
-    (wrap-mdb-dbi (dereference-pointer dbi-ptr))))
-
-
-;; MDB_val
-
-(define-wrapped-pointer-type <mdb-val>
-  mdb-val?
-  wrap-mdb-val unwrap-mdb-val
-  (lambda (mdb-val port)
-    (format port "#<mdb-val ~x>"
-            (pointer-address (unwrap-mdb-val mdb-val)))))
-
-(define (make-mdb-val value)
-  (wrap-mdb-val (make-c-struct (list size_t '*)
-                               (list (bytevector-length value)
-                                     (bytevector->pointer value)))))
-
-(define (mdb-val-data val)
-  (let ((size-data-ptr (parse-c-struct (unwrap-mdb-val val) (list size_t '*))))
-    (pointer->bytevector (cadr size-data-ptr)
-                         (car size-data-ptr))))
-
-;; put and get
-
-(define (mdb-put txn dbi key data)
-  "Store items into a database."
-  (let ((proc (liblmdb-func "mdb_put"
-                            (list
-                             ;; MDB_txn* txn
-                             '*
-                             ;; MDB_dbi* dbi
-                             '*
-                             ;; MDB_val* key
-                             '*
-                             ;; MDB_val* data
-                             '*
-                             ;; unsigned int flags
-                             unsigned-int))))
-    (proc (unwrap-mdb-txn txn)
-          (unwrap-mdb-dbi dbi)
-          (unwrap-mdb-val key)
-          (unwrap-mdb-val data)
-          0)))
-
-(define (mdb-get txn dbi key)
-  "Store items into a database."
-  (let ((proc (liblmdb-func "mdb_get"
-                            (list
-                             ;; MDB_txn* txn
-                             '*
-                             ;; MDB_dbi* dbi
-                             '*
-                             ;; MDB_val* key
-                             '*
-                             ;; MDB_val* data
-                             '*)))
-        (data-ptr (bytevector->pointer
-                   (make-bytevector (sizeof '*)))))
-    ;; call mdb_get
-    (proc (unwrap-mdb-txn txn)
-          (unwrap-mdb-dbi dbi)
-          (unwrap-mdb-val key)
-          data-ptr)
-    ;; wrap data as <mdb-val>
-    (wrap-mdb-val data-ptr)))
+  #:use-module (lmdb low-level))
diff --git a/lmdb/low-level.scm b/lmdb/low-level.scm
new file mode 100644
index 0000000..56bdf49
--- /dev/null
+++ b/lmdb/low-level.scm
@@ -0,0 +1,195 @@
+; SPDX-FileCopyrightText: 2021 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (lmdb low-level)
+  #:use-module (system foreign)
+
+  #:use-module (ice-9 format)
+
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+
+  #:use-module (rnrs bytevectors)
+
+  #:use-module (lmdb internal))
+
+;; MDB_env
+
+(define-wrapped-pointer-type <mdb-env>
+  mdb-env?
+  wrap-mdb-env unwrap-mdb-env
+  (lambda (mdb-env port)
+    (format port "#<mdb-env ~x>"
+            (pointer-address (unwrap-mdb-env mdb-env)))))
+
+(define (mdb-env-create)
+  "Create an LMDB environment handle"
+  (let ((proc (liblmdb-func "mdb_env_create" (list '*)))
+        (mdb-env-ptr (bytevector->pointer
+                      (make-bytevector (sizeof '*) 0))))
+    ;; call mdb_env_create
+    (proc mdb-env-ptr)
+    ;; wrap returned pointer as <mdb-env>
+    (wrap-mdb-env (dereference-pointer mdb-env-ptr))))
+
+(define (mdb-env-open mdb-env path)
+  "Open an environment handle"
+  (let ((proc (liblmdb-func "mdb_env_open"
+                            (list
+                             ;; MDB_env* env
+                             '*
+                             ;; char* path
+                             '*
+                             ;; unsigned int flags
+                             unsigned-int
+                             ;; mdb_mode_t mode (int)
+                             int))))
+    (proc (unwrap-mdb-env mdb-env) (string->pointer path) 0 #o644)))
+
+(define (mdb-env-close mdb-env)
+  "Close the environment and release the memory map"
+  (let ((proc (liblmdb-void-func "mdb_env_close" (list '*))))
+    (proc (unwrap-mdb-env mdb-env))))
+
+;; MDB_txn
+
+(define-wrapped-pointer-type <mdb-txn>
+  mdb-txn?
+  wrap-mdb-txn unwrap-mdb-txn
+  (lambda (mdb-txn port)
+    (format port "#<mdb-txn ~x>"
+            (pointer-address (unwrap-mdb-txn mdb-txn)))))
+
+(define (mdb-txn-begin env)
+  "Create a transaction for use with the environment"
+  (let ((proc (liblmdb-func "mdb_txn_begin"
+                            (list
+                             ;; MDB_env* env
+                             '*
+                             ;; MDB_txn* parent
+                             '*
+                             ;; unsigned int flags
+                             unsigned-int
+                             ;; MDB_txn** txn
+                             '*)))
+
+        ;; allocate a new pointer for returned txn
+        (txn-ptr (bytevector->pointer
+                  (make-bytevector (sizeof '*)))))
+
+    ;; call mdb_txn_begin
+    (proc (unwrap-mdb-env env)
+          ;; TODO allow specifying parent txn
+          (make-pointer 0)
+          0
+          txn-ptr)
+
+    ;; wrap pointer as <mdb-txn>
+    (wrap-mdb-txn (dereference-pointer txn-ptr))))
+
+
+(define (mdb-txn-abort txn)
+  "Abandon all the operations of the transaction instead of saving them"
+  (let ((proc (liblmdb-void-func "mdb_txn_abort" (list '*))))
+    (proc (unwrap-mdb-txn txn))))
+
+(define (mdb-txn-commit txn)
+  "Commit all the operations of a transaction into the database"
+  (let ((proc (liblmdb-func "mdb_txn_commit" (list '*))))
+    (proc (unwrap-mdb-txn txn))))
+
+;; MDB_dbi
+
+(define-wrapped-pointer-type <mdb-dbi>
+  mdb-dbi?
+  wrap-mdb-dbi unwrap-mdb-dbi
+  (lambda (mdb-dbi port)
+    (format port "#<mdb-dbi ~x>"
+            (pointer-address (unwrap-mdb-dbi mdb-dbi)))))
+
+
+(define (mdb-dbi-open txn)
+  (let ((proc (liblmdb-func "mdb_dbi_open"
+                            (list
+                             ;; MDB_txn* txn
+                             '*
+                             ;; const char* name
+                             '*
+                             ;; unsigned int flags
+                             unsigned-int
+                             ;; MDB_dbi* dbi
+                             '*)))
+        (dbi-ptr (bytevector->pointer
+                  (make-bytevector (sizeof '*)))))
+    (proc (unwrap-mdb-txn txn)
+          ;; null pointer TODO allow specifying name
+          (make-pointer 0)
+          0
+          dbi-ptr)
+    ;; wrap pointer as <mdb-dbi>
+    (wrap-mdb-dbi (dereference-pointer dbi-ptr))))
+
+
+;; MDB_val
+
+(define-wrapped-pointer-type <mdb-val>
+  mdb-val?
+  wrap-mdb-val unwrap-mdb-val
+  (lambda (mdb-val port)
+    (format port "#<mdb-val ~x>"
+            (pointer-address (unwrap-mdb-val mdb-val)))))
+
+(define (make-mdb-val value)
+  (wrap-mdb-val (make-c-struct (list size_t '*)
+                               (list (bytevector-length value)
+                                     (bytevector->pointer value)))))
+
+(define (mdb-val-data val)
+  (let ((size-data-ptr (parse-c-struct (unwrap-mdb-val val) (list size_t '*))))
+    (pointer->bytevector (cadr size-data-ptr)
+                         (car size-data-ptr))))
+
+;; put and get
+
+(define (mdb-put txn dbi key data)
+  "Store items into a database."
+  (let ((proc (liblmdb-func "mdb_put"
+                            (list
+                             ;; MDB_txn* txn
+                             '*
+                             ;; MDB_dbi* dbi
+                             '*
+                             ;; MDB_val* key
+                             '*
+                             ;; MDB_val* data
+                             '*
+                             ;; unsigned int flags
+                             unsigned-int))))
+    (proc (unwrap-mdb-txn txn)
+          (unwrap-mdb-dbi dbi)
+          (unwrap-mdb-val key)
+          (unwrap-mdb-val data)
+          0)))
+
+(define (mdb-get txn dbi key)
+  "Store items into a database."
+  (let ((proc (liblmdb-func "mdb_get"
+                            (list
+                             ;; MDB_txn* txn
+                             '*
+                             ;; MDB_dbi* dbi
+                             '*
+                             ;; MDB_val* key
+                             '*
+                             ;; MDB_val* data
+                             '*)))
+        (data-ptr (bytevector->pointer
+                   (make-bytevector (sizeof '*)))))
+    ;; call mdb_get
+    (proc (unwrap-mdb-txn txn)
+          (unwrap-mdb-dbi dbi)
+          (unwrap-mdb-val key)
+          data-ptr)
+    ;; wrap data as <mdb-val>
+    (wrap-mdb-val data-ptr)))