1.1--- a/db.lisp	Fri May 05 22:44:22 2023 -0400
     1.2+++ b/db.lisp	Sat May 06 16:09:22 2023 -0400
     1.3@@ -1,1 +1,197 @@
     1.4 (in-package :demo)
     1.5+
     1.6+(define-foreign-library rocksdb
     1.7+  (:win32 "rocksdb")
     1.8+  (t (:default "librocksdb")))
     1.9+
    1.10+(use-foreign-library rocksdb)
    1.11+
    1.12+(defcfun ("rocksdb_options_create" create-options) :pointer)
    1.13+(defcfun ("rocksdb_options_destroy" destroy-options) :void (options :pointer))
    1.14+(defcfun ("rocksdb_options_increase_parallelism" increase-parallelism) :void (opt :pointer) (total-threads :int))
    1.15+(defcfun ("rocksdb_options_optimize_level_style_compaction" optimize-level-style-compaction) :void (opt :pointer) (memtable_memory_budget :uint64))
    1.16+(defcfun ("rocksdb_options_set_create_if_missing" set-create-if-missing) :void (opt :pointer) (val :boolean))
    1.17+
    1.18+(defcfun ("rocksdb_writeoptions_create" create-writeoptions) :pointer)
    1.19+(defcfun ("rocksdb_writeoptions_destroy" destroy-writeoptions) :void (opt :pointer))
    1.20+(defcfun ("rocksdb_readoptions_create" create-readoptions) :pointer)
    1.21+(defcfun ("rocksdb_readoptions_destroy" destroy-readoptions) :void (opt :pointer))
    1.22+
    1.23+(defcfun ("rocksdb_open" open-db*) :pointer (opt :pointer) (name :string) (errptr :pointer))
    1.24+(defcfun ("rocksdb_close" close-db) :void (opt :pointer))
    1.25+(defcfun ("rocksdb_cancel_all_background_work" cancel-all-background-work) :void (db :pointer) (wait :boolean))
    1.26+
    1.27+(defcfun ("rocksdb_put" put*) :void (db :pointer) (options :pointer) (key :pointer) (keylen :unsigned-int) (val :pointer) (vallen :unsigned-int) (errptr :pointer))
    1.28+(defcfun ("rocksdb_get" get*) :pointer (db :pointer) (options :pointer) (key :pointer) (keylen :unsigned-int) (vallen :pointer) (errptr :pointer))
    1.29+
    1.30+(defcfun ("rocksdb_create_iterator" create-iter*) :pointer (db :pointer) (opt :pointer))
    1.31+(defcfun ("rocksdb_iter_destroy" destroy-iter) :void (iter :pointer))
    1.32+(defcfun ("rocksdb_iter_seek_to_first" move-iter-to-first) :void (iter :pointer))
    1.33+(defcfun ("rocksdb_iter_valid" valid-iter-p) :boolean (iter :pointer))
    1.34+(defcfun ("rocksdb_iter_next" move-iter-forward) :void (iter :pointer))
    1.35+(defcfun ("rocksdb_iter_prev" move-iter-backward) :void (iter :pointer))
    1.36+(defcfun ("rocksdb_iter_key" iter-key*) :pointer (iter :pointer) (klen-ptr :pointer))
    1.37+(defcfun ("rocksdb_iter_value" iter-value*) :pointer (iter :pointer) (vlen-ptr :pointer))
    1.38+
    1.39+(define-condition unable-to-open-db (error)
    1.40+  ((db-path :initarg :db-path
    1.41+            :reader db-path)
    1.42+   (error-message :initarg :error-message
    1.43+                  :reader error-message)))
    1.44+
    1.45+(defmethod print-object ((obj unable-to-open-db) stream)
    1.46+  (print-unreadable-object (obj stream :type t :identity t)
    1.47+    (format stream "error-message=~A" (error-message obj))))
    1.48+
    1.49+(define-condition unable-to-put-key-value-to-db (error)
    1.50+  ((db :initarg :db
    1.51+       :reader db)
    1.52+   (key :initarg :key
    1.53+        :reader key)
    1.54+   (val :initarg :val
    1.55+        :reader val)
    1.56+   (error-message :initarg :error-message
    1.57+                  :reader error-message)))
    1.58+
    1.59+(define-condition unable-to-get-value-to-db (error)
    1.60+  ((db :initarg :db
    1.61+       :reader db)
    1.62+   (key :initarg :key
    1.63+        :reader key)
    1.64+   (error-message :initarg :error-message
    1.65+                  :reader error-message)))
    1.66+
    1.67+(defun open-db (db-path &optional opt)
    1.68+  (unless opt
    1.69+    (setq opt (create-options)))
    1.70+  (let ((errptr (foreign-alloc :pointer)))
    1.71+    (setf (mem-ref errptr :pointer) (null-pointer))
    1.72+    (let* ((db-path (if (pathnamep db-path)
    1.73+                        (namestring db-path)
    1.74+                        db-path))
    1.75+           (db (open-db* opt db-path errptr))
    1.76+           (err (mem-ref errptr :pointer)))
    1.77+      (unless (null-pointer-p err)
    1.78+        (error 'unable-to-open-db
    1.79+               :db-path db-path
    1.80+               :error-message (foreign-string-to-lisp err)))
    1.81+      db)))
    1.82+
    1.83+(defmacro clone-octets-to-foreign (lisp-array foreign-array)
    1.84+  (let ((i (gensym)))
    1.85+    `(loop for ,i from 0 below (length ,lisp-array)
    1.86+           do (setf (mem-aref ,foreign-array :unsigned-char ,i)
    1.87+                    (aref ,lisp-array ,i)))))
    1.88+
    1.89+(defmacro clone-octets-from-foreign (foreign-array lisp-array len)
    1.90+  (let ((i (gensym)))
    1.91+    `(loop for ,i from 0 below ,len
    1.92+           do (setf (aref ,lisp-array ,i)
    1.93+                    (mem-aref ,foreign-array :unsigned-char ,i)))))
    1.94+
    1.95+(defun put-kv (db key val &optional opt)
    1.96+  (unless opt
    1.97+    (setq opt (create-writeoptions)))
    1.98+  (with-foreign-objects ((errptr :pointer)
    1.99+                         (key* :unsigned-char (length key))
   1.100+                         (val* :unsigned-char (length val)))
   1.101+    (clone-octets-to-foreign key key*)
   1.102+    (clone-octets-to-foreign val val*)
   1.103+    (setf (mem-ref errptr :pointer) (null-pointer))
   1.104+    (put* db
   1.105+          opt
   1.106+          key*
   1.107+          (length key)
   1.108+          val*
   1.109+          (length val)
   1.110+          errptr)
   1.111+    (let ((err (mem-ref errptr :pointer)))
   1.112+      (unless (null-pointer-p err)
   1.113+        (error 'unable-to-put-key-value-to-db
   1.114+               :db db
   1.115+               :key key
   1.116+               :val val
   1.117+               :error-message (foreign-string-to-lisp err))))))
   1.118+
   1.119+(defun put-kv-str (db key val &optional opt)
   1.120+  (let ((key-octets (babel:string-to-octets key))
   1.121+        (val-octets (babel:string-to-octets val)))
   1.122+    (put-kv db key-octets val-octets opt)))
   1.123+
   1.124+(defun get-kv (db key &optional opt)
   1.125+  (unless opt
   1.126+    (setq opt (create-readoptions)))
   1.127+
   1.128+  (with-foreign-objects ((val-len-ptr :unsigned-int)
   1.129+                         (errptr :pointer)
   1.130+                         (key* :unsigned-char (length key)))
   1.131+    (clone-octets-to-foreign key key*)
   1.132+    (setf (mem-ref errptr :pointer) (null-pointer))
   1.133+    (let ((val (get* db
   1.134+                     opt
   1.135+                     key*
   1.136+                     (length key)
   1.137+                     val-len-ptr
   1.138+                     errptr)))
   1.139+      (let ((err (mem-ref errptr :pointer)))
   1.140+        (unless (null-pointer-p err)
   1.141+          (error 'unable-to-get-value-to-db
   1.142+                 :db db
   1.143+                 :key key
   1.144+                 :error-message (foreign-string-to-lisp err)))
   1.145+        
   1.146+        (unless (null-pointer-p val)
   1.147+          (let* ((val-len (mem-ref val-len-ptr :unsigned-int))
   1.148+                 (val* (make-array val-len
   1.149+                                      :element-type '(unsigned-byte 8))))
   1.150+            (clone-octets-from-foreign val val* val-len)
   1.151+            val*))))))
   1.152+
   1.153+(defun get-kv-str (db key &optional opt)
   1.154+  (let ((key-octets (babel:string-to-octets key)))
   1.155+    (let ((#1=val-octets (get-kv db key-octets opt)))
   1.156+      (when #1#
   1.157+        (babel:octets-to-string #1#)))))
   1.158+
   1.159+(defun create-iter (db &optional opt)
   1.160+  (unless opt
   1.161+    (setq opt (create-readoptions)))
   1.162+  (create-iter* db opt))
   1.163+
   1.164+(defun iter-key (iter)
   1.165+  (with-foreign-objects ((klen-ptr :unsigned-int))
   1.166+    (setf (mem-ref klen-ptr :unsigned-int) 0)
   1.167+    (let* ((key-ptr (iter-key* iter klen-ptr))
   1.168+           (klen (mem-ref klen-ptr :unsigned-int))
   1.169+           (key (make-array klen :element-type '(unsigned-byte 8))))
   1.170+      (clone-octets-from-foreign key-ptr key klen)
   1.171+      key)))
   1.172+
   1.173+(defun iter-key-str (iter)
   1.174+  (let ((#1=key-octets (iter-key iter)))
   1.175+    (when #1#
   1.176+      (babel:octets-to-string #1#))))
   1.177+
   1.178+(defun iter-value (iter)
   1.179+  (with-foreign-objects ((len-ptr :unsigned-int))
   1.180+    (setf (mem-ref len-ptr :unsigned-int) 0)
   1.181+    (let* ((value-ptr (iter-value* iter len-ptr))
   1.182+           (vlen (mem-ref len-ptr :unsigned-int))
   1.183+           (value* (make-array vlen :element-type '(unsigned-byte 8))))
   1.184+      (clone-octets-from-foreign value-ptr value* vlen)
   1.185+      value*)))
   1.186+
   1.187+(defun iter-value-str (iter)
   1.188+  (let ((#1=val-octets (iter-value iter)))
   1.189+    (when #1#
   1.190+      (babel:octets-to-string #1#))))
   1.191+
   1.192+(defmacro with-open-db ((db-var db-path &optional opt) &body body)
   1.193+  `(let ((,db-var (open-db ,db-path ,opt)))
   1.194+     (unwind-protect (progn ,@body)
   1.195+       (close-db ,db-var))))
   1.196+
   1.197+(defmacro with-iter ((iter-var db &optional opt) &body body)
   1.198+  `(let ((,iter-var (create-iter ,db ,opt)))
   1.199+     (unwind-protect (progn ,@body)
   1.200+       (destroy-iter ,iter-var))))

     2.1--- a/ffi.lisp	Fri May 05 22:44:22 2023 -0400
     2.2+++ b/ffi.lisp	Sat May 06 16:09:22 2023 -0400
     2.3@@ -1,8 +1,7 @@
     2.4 (in-package :demo)
     2.5 
     2.6 (define-foreign-library demo_ffi
     2.7-  (:win32 (:default "./target/release/demo_ffi"))
     2.8-  (t (:default "./target/release/libdemo_ffi")))
     2.9+  (:win32 (:default "demo"))
    2.10+  (t (:default "libdemo")))
    2.11 
    2.12-(use-foreign-library demo_ffi)
    2.13-
    2.14+;; (use-foreign-library "./target/release/libdemo_ffi.dylib")

     3.1--- a/pkg.lisp	Fri May 05 22:44:22 2023 -0400
     3.2+++ b/pkg.lisp	Sat May 06 16:09:22 2023 -0400
     3.3@@ -1,6 +1,5 @@
     3.4 #|
     3.5 demo
     3.6-
     3.7 > (demo:main)
     3.8 |#
     3.9 (defpackage #:demo
    3.10@@ -11,26 +10,50 @@
    3.11    (#:bt #:bordeaux-threads)
    3.12    (#:cli #:clingon))
    3.13   ;; db.lisp
    3.14-  (:export
    3.15-   ;; #:make-db
    3.16-   ;; #:with-db
    3.17-   ;; #:db
    3.18-   )
    3.19+  (:export #:create-options
    3.20+           #:destroy-options
    3.21+           #:increase-parallelism
    3.22+           #:optimize-level-style-compaction
    3.23+           #:set-create-if-missing
    3.24+           #:create-writeoptions
    3.25+           #:destroy-writeoptions
    3.26+           #:create-readoptions
    3.27+           #:destroy-readoptions
    3.28+           #:open-db
    3.29+           #:close-db
    3.30+           #:cancel-all-background-work
    3.31+           #:put-kv
    3.32+           #:put-kv-str
    3.33+           #:get-kv
    3.34+           #:get-kv-str
    3.35+           #:create-iter
    3.36+           #:destroy-iter
    3.37+           #:move-iter-to-first
    3.38+           #:move-iter-forward
    3.39+           #:move-iter-backword
    3.40+           #:valid-iter-p
    3.41+           #:iter-key
    3.42+           #:iter-key-str
    3.43+           #:iter-value
    3.44+           #:iter-value-str
    3.45+           #:with-open-db
    3.46+           #:with-iter)
    3.47   ;; demo.lisp
    3.48-  (:export
    3.49-   #:main
    3.50-   #:demo-path
    3.51-   #:db-path
    3.52-   #:cli-opts
    3.53-   #:cli-handler
    3.54-   #:cli-cmd)
    3.55+  (:export #:main
    3.56+	   #:demo-path
    3.57+	   #:db-path
    3.58+	   #:cli-opts
    3.59+	   #:cli-handler
    3.60+	   #:cli-cmd)
    3.61   ;; ui.lisp
    3.62-  (:export
    3.63-   #:on-new-window
    3.64-   #:start-ui)
    3.65+  (:export #:on-new-window
    3.66+	   #:start-ui)
    3.67   ;; tk.lisp
    3.68-  (:export
    3.69-   #:random-id
    3.70-   #:scan-dir)
    3.71+  (:export #:random-id
    3.72+	   #:scan-dir
    3.73+	   #:mkstr
    3.74+	   #:symb
    3.75+	   #:sbq-reader)
    3.76   ;; ffi.lisp
    3.77+  ;; (:export)
    3.78   )

     4.1--- a/tk.lisp	Fri May 05 22:44:22 2023 -0400
     4.2+++ b/tk.lisp	Sat May 06 16:09:22 2023 -0400
     4.3@@ -1,8 +1,42 @@
     4.4 (in-package #:demo)
     4.5 
     4.6+(defvar *cargo-target* #P"/Users/ellis/dev/otom8/demo/target/")
     4.7+
     4.8+(defmacro find-rust-dll (name &optional debug)
     4.9+  "Find the rust dll specified by NAME."
    4.10+  (cond
    4.11+    ((uiop:directory-exists-p (merge-pathnames *cargo-target* "release"))
    4.12+     `,(mkstr "./target/release/" name))
    4.13+    ((uiop:directory-exists-p  (merge-pathnames *cargo-target* "debug"))
    4.14+     `,(mkstr "./target/debug/" name))
    4.15+    (t (progn
    4.16+	 (uiop:run-program `("cargo" "build" ,(unless debug "--release")) :output t)
    4.17+	 `,(find-rust-dll name debug)))))
    4.18+
    4.19 (defun random-id ()
    4.20   (format NIL "~8,'0x-~8,'0x" (random #xFFFFFFFF) (get-universal-time)))
    4.21 
    4.22 (defun scan-dir (dir filename callback)
    4.23   (dolist (path (directory (merge-pathnames (merge-pathnames filename "**/") dir)))
    4.24     (funcall callback path)))
    4.25+
    4.26+(defun mkstr (&rest args)
    4.27+  (with-output-to-string (s)
    4.28+    (dolist (a args) (princ a s))))
    4.29+
    4.30+(defun symb (&rest args)
    4.31+  (values (intern (apply #'mkstr args))))
    4.32+
    4.33+(defun sbq-reader (stream sub-char numarg)
    4.34+  "The anaphoric sharp-backquote reader: #`((,a1))"
    4.35+  (declare (ignore sub-char))
    4.36+  (unless numarg (setq numarg 1))
    4.37+  `(lambda ,(loop for i from 1 to numarg
    4.38+		  collect (symb 'a i))
    4.39+     ,(funcall
    4.40+       (get-macro-character #\`) stream nil)))
    4.41+
    4.42+(eval-when (:execute)
    4.43+  (in-package :demo)
    4.44+  (set-dispatch-macro-character
    4.45+   #\# #\` #'demo:sbq-reader))