llibra avatar llibra committed 678f603

Implemented extensible foreign string conversion.

- Added conv.lisp.
- Defined the new package LVDB.CONV.
- Defined the generic functions, LVDB.CONV:X->FOREIGN-STRING and
LVDB.CONV:FOREIGN-STRING->X.
- Implemented the foreign string converters for string.
- Added the new keyword argument AS into LVDB.DB.FS:GET.
- Defined utility macros for existing foreign strings in LVDB.UTIL.

Comments (0)

Files changed (5)

                         :components ((:file "packages")
                                      (:file "ffi")
                                      (:file "util")
+                                     (:file "conv")
                                      (:file "opt")
                                      (:file "db")))))
+(in-package :lvdb.conv)
+
+(defgeneric x->foreign-string (x)
+  (:documentation "Converts X to a foreign string.
+
+If you would like to support a new user-defined data structure, define a method
+for the data structure. Each method is required to return a allocated foreign
+string and the length of it."))
+
+(defmethod x->foreign-string ((s string))
+  (foreign-string-alloc s :null-terminated-p nil))
+
+(defgeneric foreign-string->x (type fs len)
+  (:documentation "Converts a foreign string to a Lisp object.
+
+If you would like to support a new user-defined data structure, define a method
+for the data structure. Each method is required to return a Lisp object."))
+
+(defmethod foreign-string->x ((type (eql 'string)) fs len)
+  (foreign-string-to-lisp fs :count len))
     (handle-error-pointer err-ptr)
     (values)))
 
-(defun get (db opt key-fs key-len)
+(defun get (db opt key-fs key-len &key (as 'string))
   (with-foreign-object (val-len-ptr 'size_t)
     (with-error-pointer (err-ptr)
       (let ((val-ptr (leveldb-get db opt key-fs key-len val-len-ptr err-ptr)))
         (handle-error-pointer err-ptr)
         (with-malloced-pointer (val-ptr)
           (let ((val-len (mem-aref val-len-ptr 'size_t)))
-            (foreign-string-to-lisp val-ptr :count val-len)))))))
+            (foreign-string->x as val-ptr val-len)))))))
 
 (in-package :lvdb.db)
 
   (leveldb-close db))
 
 (defun put (db opt key val)
-  (with-foreign-strings (((key-fs key-len) key :null-terminated-p nil)
-                         ((val-fs val-len) val :null-terminated-p nil))
+  (with-alloced-foreign-strings ((key-fs key-len (x->foreign-string key))
+                                 (val-fs val-len (x->foreign-string val)))
     (lvdb.db.fs:put db opt key-fs key-len val-fs val-len)))
 
-(defun get (db opt key)
-  (with-foreign-string ((key-fs key-len) key :null-terminated-p nil)
-    (lvdb.db.fs:get db opt key-fs key-len)))
+(defun get (db opt key &rest args)
+  (with-alloced-foreign-string (key-fs key-len (x->foreign-string key))
+    (apply #'lvdb.db.fs:get db opt key-fs key-len args)))

src/packages.lisp

 (defpackage :leveldb.utilities
   (:nicknames :leveldb.util :lvdb.util)
   (:use :cl :cffi :lvdb.ffi)
-  (:export :with-error-pointer :with-malloced-pointer :handle-error-pointer))
+  (:export :with-error-pointer :with-malloced-pointer :handle-error-pointer
+           :with-alloced-foreign-string :with-alloced-foreign-strings))
+
+(defpackage :leveldb.conversion
+  (:nicknames :leveldb.conv :lvdb.conv)
+  (:use :cl :cffi :lvdb.ffi)
+  (:export :x->foreign-string :foreign-string->x))
 
 (defpackage :leveldb.options
   (:nicknames :leveldb.opt :lvdb.opt)
 
 (defpackage :leveldb.database
   (:nicknames :leveldb.db :lvdb.db)
-  (:use :cl :cffi :lvdb.ffi :lvdb.util)
+  (:use :cl :cffi :lvdb.ffi :lvdb.util :lvdb.conv)
   (:shadow :close :get :open)
   (:export :open :close :put :get))
 
 (defpackage :leveldb.database.foreign-string
   (:nicknames :leveldb.db.fs :lvdb.db.fs)
-  (:use :cl :cffi :lvdb.ffi :lvdb.util)
+  (:use :cl :cffi :lvdb.ffi :lvdb.util :lvdb.conv)
   (:shadow :get)
   (:export :put :get))
     (unless (null-pointer-p ptr)
       (with-malloced-pointer (ptr)
         (error (foreign-string-to-lisp ptr))))))
+
+(defmacro with-alloced-foreign-string ((var len-var form) &body body)
+  `(multiple-value-bind (,var ,len-var) ,form
+     (unwind-protect (progn ,@body) (foreign-free ,var))))
+
+(defmacro with-alloced-foreign-strings (bindings &body body)
+  (destructuring-bind (binding . rest) bindings
+    (if rest
+        `(with-alloced-foreign-string ,binding
+           (with-alloced-foreign-strings ,rest ,@body))
+        `(with-alloced-foreign-string ,binding ,@body))))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.