Commits

llibra  committed ea424d0

Implemented KC.CUR.LOW:GET-VALUE and KC.CUR:GET-VALUE.

At the same time, refactored KC.CUR.LOW:GET-KEY and KC.CUR:GET-KEY to share
common part.

  • Participants
  • Parent commits 7c82015

Comments (0)

Files changed (3)

File src/cur.lisp

      (unwind-protect (progn (jump ,var) ,@body)
        (delete ,var))))
 
-(defun get-key (cur step)
-  (let ((step (convert-to-foreign step :boolean)))
-    (with-foreign-object (key-len 'size_t) 
-      (aif/ptr (kccurgetkey cur key-len step)
-               (values it (mem-aref key-len 'size_t))
-               (error cur "Can't get the key of the current record.")))))
+(flet ((body (fn msg cur step)
+         (let ((step (convert-to-foreign step :boolean)))
+           (with-foreign-object (value-len 'size_t) 
+             (aif/ptr (funcall fn cur value-len step)
+                      (values it (mem-aref value-len 'size_t))
+                      (error cur msg))))))
+  (declare (inline body))
+  (defun get-key (cur step)
+    (body #'kccurgetkey "Can't get the key of the current record."
+          cur step))
+  (defun get-value (cur step)
+    (body #'kccurgetvalue "Can't get the value of the current record."
+          cur step)))
 
 (in-package :kc.cur)
 
-(defun get-key (cur step &key (as :string))
-  (multiple-value-bind (key-ptr key-len) (kc.cur.base:get-key cur step)
-    (with-kcmalloced-pointer (key-ptr key-ptr)
-      (foreign-string->x as key-ptr key-len))))
+(flet ((body (fn cur step as)
+         (multiple-value-bind (value-ptr value-len) (funcall fn cur step)
+           (with-kcmalloced-pointer (value-ptr value-ptr)
+             (foreign-string->x as value-ptr value-len)))))
+  (declare (inline body))
+  (defun get-key (cur step &key (as :string))
+    (body #'kc.cur.base:get-key cur step as))
+  (defun get-value (cur step &key (as :string))
+    (body #'kc.cur.base:get-value cur step as)))

File src/packages.lisp

   (:nicknames :kc.cur.base)
   (:use :cl :cffi :kc.ffi :kc.type :kc.var :kc.conv :kc.util)
   (:shadow :error :delete)
-  (:export :error :db :delete :jump :with-cursor :get-key))
+  (:export :error :db :delete :jump :with-cursor :get-key :get-value))
 
 (defpackage :kyoto-cabinet.cursor.low-level
   (:nicknames :kc.cur.low)
   (:use :kc.cur.base)
-  (:export :get-key))
+  (:export :get-key :get-value))
 
 (defpackage :kyoto-cabinet.cursor
   (:nicknames :kc.cur)
   (:use :cl :cffi :kc.ffi :kc.type :kc.var :kc.conv :kc.util :kc.cur.base)
-  (:shadow :get-key)
+  (:shadow :get-key :get-value)
   (:shadowing-import-from :kc.cur.base :error :delete)
-  (:export :error :db :delete :jump :with-cursor :get-key))
+  (:export :error :db :delete :jump :with-cursor :get-key :get-value))
     (body "x" "1"
           #'kc.cur.low:get-key
           (lambda (v) (equal "x" v))
+          (lambda (l) (= 1 l))))
+  (5am:test (get-value/low/value :compile-at :definition-time)
+    (body "x" "1"
+          #'kc.cur.low:get-value
+          (lambda (v) (equal "1" v))
           (lambda (l) (= 1 l)))))
 
 (flet ((body (key value fn pred)
   (5am:test (get-key/value :compile-at :definition-time)
     (body "x" "1"
           (lambda (c) (kc.cur:get-key c nil))
-          (lambda (v) (equal "x" v)))))
+          (lambda (v) (equal "x" v))))
+  (5am:test (get-value/value :compile-at :definition-time)
+    (body "x" "1"
+          (lambda (c) (kc.cur:get-value c nil))
+          (lambda (v) (equal "1" v)))))
 
 (flet ((body (fn)
          (with-new-db (db)
   (5am:test (get-key/low/step :compile-at :definition-time)
     (body (lambda (cur step)
             (kc.ffi:kcfree (kc.cur.low:get-key cur step)))))
+  (5am:test (get-value/low/step :compile-at :definition-time)
+    (body (lambda (cur step)
+            (kc.ffi:kcfree (kc.cur.low:get-value cur step)))))
   (5am:test (get-key/step :compile-at :definition-time)
-    (body #'kc.cur:get-key)))
+    (body #'kc.cur:get-key))
+  (5am:test (get-value/step :compile-at :definition-time)
+    (body #'kc.cur:get-value)))