# HG changeset patch
# User Richard Westhaver <ellis@rwest.io>
# Date 1723686596 14400
# Node ID 5bd0eb9fa1fab37442d368bd8285d612722513e3
# Parent  7046f3bdb66899a6c94efc47723e4c38404a4bfb
rocksdb callbacks, missing symbol fixes

diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/ffi/rocksdb/compaction.lisp
--- a/lisp/ffi/rocksdb/compaction.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/ffi/rocksdb/compaction.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -4,11 +4,6 @@
 
 ;;; Code:
 (in-package :rocksdb)
-;; (define-alien-routine rocksdb-compactionfilter-create (* rocksdb-compactionfilter)
-;;   (state (* void))
-;;   (destructor (* void))
-;;   (filter (* unsigned-char))
-;;   (name (* unsigned-char)))
 
 (define-alien-routine rocksdb-compactionfilter-set-ignore-snapshots void
   (self (* rocksdb-compactionfilter)) (val unsigned-char))
@@ -27,3 +22,19 @@
           rocksdb-compactionfiltercontext-is-full-compaction rocksdb-compactionfiltercontext-is-manual-compaction))
 
 ;;; Compaction Filter Factory
+(define-alien-routine rocksdb-compactionfilter-create (* rocksdb-compactionfilter)
+  (state (* t))
+  (destructor (* t))
+  (create-compaction-filter (* unsigned-char))
+  (context (* rocksdb-compactionfiltercontext)))
+
+(define-alien-routine rocksdb-compacitonfilter-destroy void
+  (factory (* rocksdb-compactionfilterfactory)))
+
+(export '(rocksdb-compactionfilter-create rocksdb-compactionfilter-destroy))
+
+(define-alien-callable rocksdb-create-compaction-filter (* rocksdb-compactionfilter)
+    ((state (* t))
+     (context (* rocksdb-compactionfiltercontext)))
+  (declare (ignore state context))
+  nil)
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/ffi/rocksdb/comparator.lisp
--- a/lisp/ffi/rocksdb/comparator.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/ffi/rocksdb/comparator.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -1,11 +1,36 @@
 ;;; rocksdb/comparator.lisp --- RocksDB Comparators
 
-;;
+;; RocksDB Lisp Comparator API
 
 ;;; Code:
 (in-package :rocksdb)
 
-;; TODO 2023-12-11: 
+(define-alien-type rocksdb-compare-function
+  (function int
+            (* t)
+            c-string
+            size-t
+            c-string
+            size-t))
+
+(define-alien-type rocksdb-compare-ts-function
+  (function int
+            (* t)
+            c-string
+            size-t
+            c-string
+            size-t))
+
+(define-alien-type rocksdb-compare-without-ts-function
+  (function int
+            (* t)
+            c-string
+            size-t
+            unsigned-char
+            c-string
+            size-t
+            unsigned-char))
+
 (define-alien-routine rocksdb-comparator-create (* rocksdb-comparator)
   (state (* t))
   (destructor (* t))
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/ffi/rocksdb/merge.lisp
--- a/lisp/ffi/rocksdb/merge.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/ffi/rocksdb/merge.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -1,10 +1,40 @@
 ;;; rocksdb/merge.lisp --- RocksDB Merge Operators
 
-;;
+;; RocksDB Lisp Merge Operator API
+
+;;; Commentary:
+
+;; When to use built-in ROCKSDB-MERGE:
+
+;; - You have data that needs to be incrementally updated.
+
+;; - You would usually need to read the data before knowing what the new value would be.
+
+;; Oterwise as far as the FFI is concerned - which doesn't support
+;; AssociateMerge, you should use the Generic Merge API.
+
+;; When to use Associative Merge (unavailable in C/LISP API):
+
+;; - merge operands are formatted the same as Put values AND
+
+;; - it is okay to combine multiple operands into one
+
+;; When to use Generic Merge (this API):
+
+;; - you are unable to use Associate Merge
+
+;; - it is possible to combine multiple operands
+
+;;; Refs:
+
+;; impl: https://github.com/facebook/rocksdb/wiki/Merge-Operator-Implementation
+
+;; wiki: https://github.com/facebook/rocksdb/wiki/merge-operator
 
 ;;; Code:
 (in-package :rocksdb)
 
+;; FullMerge() is used when a Put/Delete is the *existing_value (or null)
 (define-alien-type rocksdb-full-merge-function
     (function (* t)
               (array unsigned-char)
@@ -14,7 +44,7 @@
               int
               (array unsigned-char)
               (* size-t)))
-
+;; PartialMerge() is used to combine two-merge operands (if possible)
 (define-alien-type rocksdb-partial-merge-function
     (function (* t)
               (array unsigned-char)
@@ -31,7 +61,7 @@
             size-t))
 
 (define-alien-type rocksdb-destructor-function
-    (function (* t)))
+  (function void (* t)))
 
 (define-alien-type rocksdb-name-function
     (function c-string))
@@ -40,7 +70,6 @@
 
 ;; (sb-alien::define-alien-callable mangle int () 0)
 
-;; (sb-alien::alien-callback
 (define-alien-routine rocksdb-mergeoperator-create (* rocksdb-mergeoperator)
   (state (* t))
   (destructor (* rocksdb-destructor-function))
@@ -61,17 +90,37 @@
 (deftype rocksdb-mergeoperator-function ()
   '(function (octet-vector (or octet-vector null) &rest t) (or null octet-vector)))
 
+(define-alien-callable rocksdb-delete-value (* t)
+    ((val (array unsigned-char))
+     (vlen size-t))
+  (declare (ignore val vlen))
+  nil)
+ 
+(define-alien-callable rocksdb-destructor void ((self (* t)))
+  (free-alien self))
+
+(define-alien-callable rocksdb-name c-string () (make-alien-string (symbol-name (gensym "rocksdb:"))))
+
 (define-alien-callable rocksdb-concat-full-merge (* t)
-    ((key (array unsigned-char)) (klen size-t)
-     (existing-val (array unsigned-char)) (existing-vlen size-t)
-     (ops (array (array unsigned-char))) (ops-length (* size-t)) (num-ops size-t)
+    ((key (array unsigned-char))
+     (klen size-t)
+     (existing-val (array unsigned-char))
+     (existing-vlen size-t)
+     (ops (array (array unsigned-char)))
+     (ops-length (* size-t))
+     (num-ops size-t)
      (success (array unsigned-char))
      (new-vlen (* size-t)))
+  (log:debug! (list key klen existing-val existing-vlen ops ops-length num-ops success new-vlen))
   nil)
 
 (define-alien-callable rocksdb-concat-partial-merge (* t)
-    ((key (array unsigned-char)) (klen size-t)
-     (ops (array (array unsigned-char))) (ops-length (* size-t)) (num-ops size-t)
+    ((key (array unsigned-char))
+     (klen size-t)
+     (ops (array (array unsigned-char)))
+     (ops-length (* size-t))
+     (num-ops size-t)
      (success (array unsigned-char))
      (new-vlen (* size-t)))
+  (log:debug! (list key klen ops ops-length num-ops success new-vlen))
   nil)
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/ffi/rocksdb/rocksdb.asd
--- a/lisp/ffi/rocksdb/rocksdb.asd	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/ffi/rocksdb/rocksdb.asd	Wed Aug 14 21:49:56 2024 -0400
@@ -18,9 +18,9 @@
                (:file "slice")
                (:file "db")
                (:file "metadata")
+               (:file "merge")
                (:file "compaction")
                (:file "comparator")
-               (:file "merge")
                (:file "stats")
                (:file "vars"))
   :in-order-to ((test-op (test-op "rocksdb/tests"))))
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/ffi/uring/uring.asd
--- a/lisp/ffi/uring/uring.asd	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/ffi/uring/uring.asd	Wed Aug 14 21:49:56 2024 -0400
@@ -16,8 +16,8 @@
                (:file "util")
                (:file "macs")
                (:file "alien")
+               (:file "opcode")
                (:file "prim")
-               (:file "opcode")
                (:file "register")
                (:file "submit")
                (:file "sq")
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/ffi/uring/uring.lisp
--- a/lisp/ffi/uring/uring.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/ffi/uring/uring.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -85,6 +85,8 @@
 ;;       res)))
 
 ;; io-uring instance
+(defvar *default-io-params* (make-io-params))
+
 (defstruct uring
   (sq nil :type submission-queue)
   (cq nil :type completion-queue)
@@ -92,8 +94,6 @@
   (params *default-io-params* :type io-params)
   (memory nil :type io-memory-map))
 
-(defvar *default-io-params* (make-io-params))
-
 (defstruct uring-builder
   (params *default-io-params* :type io-params)
   (dontfork nil :type boolean))
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/lib/dat/pkg.lisp
--- a/lisp/lib/dat/pkg.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/lib/dat/pkg.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -16,7 +16,8 @@
   (:export
    :sxp-fmt-designator
    :form :formp :sxp-error :sxp-syntax-error :reader :writer :fmt
-   :wrap :wrap! :wrap-from-string! :unwrap :unwrap! :unwrap-or
+   :wrap :unwrap
+   :unwrap-or
    :sxpp :build-ast :load-ast :load-ast*
    :ast
    :define-macro :define-fmt :read-sxp-file :write-sxp-file
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/lib/dat/sxp.lisp
--- a/lisp/lib/dat/sxp.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/lib/dat/sxp.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -18,10 +18,7 @@
 
  ;;; Protocol
 (defgeneric wrap (self form))
-(defgeneric wrap! (self form))
-(defgeneric wrap-from-string! (self str))
 (defgeneric unwrap (self))
-(defgeneric unwrap! (self))
 (defgeneric unwrap-or (self lambda))
 (defgeneric sxpp (self form))
 
@@ -43,16 +40,10 @@
   ((ast :initarg :ast :type form :accessor ast))
   (:documentation "Dynamic class representing a SXP form."))
 
-(defmethod wrap! ((self sxp) form) (setf (slot-value self 'ast) (ignore-errors form)))
-
-(defmethod wrap-from-string! ((self sxp) str) (setf (slot-value self 'ast) (ignore-errors (read str))))
-
 (defmethod wrap ((self sxp) form) (setf (slot-value self 'ast) form))
 
 (defmethod unwrap ((self sxp)) (slot-value self 'ast))
 
-(defmethod unwrap! ((self sxp)) (ignore-errors (slot-value self 'ast)))
-
 (defmethod unwrap-or ((self sxp) (else-fn function))
   (if (slot-unbound 'sxp self 'ast)
       (slot-value self 'ast)
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/lib/organ/object/timestamp.lisp
--- a/lisp/lib/organ/object/timestamp.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/lib/organ/object/timestamp.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -22,28 +22,6 @@
 ;;; Code:
 (in-package :organ)
 
-(defvar *org-duration-hmm-rx* (create-scanner "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{1,2\\}[ \t]*\\'")
-  "Regexp matching a duration expressed with H:MM or H:MM:SS format.
-See *org-duration-hmmss-rx* to only match the latter.  Hours
-can use any number of digits.")
-
-(defvar *org-duration-hmmss-rx* (create-scanner "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{2\\}[ \t]*\\'")
-  "Regexp matching a duration expressed H:MM:SS format.
-See *org-duration-hmm-rx* to also support H:MM format.  Hours
-can use any number of digits.")
-
-(defvar *org-duration-full-rx*
-  (create-scanner "\\`\\(?:[ 	]*\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ 	]*\\(min\\|[dhmwy]\\)\\)+[ 	]*\\'")
-  "Regexp matching a duration expressed with units.")
-
-(defvar *org-duration-mixed-rx*
-  (create-scanner "\\`\\(?1:\\([ 	]*\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ 	]*\\(min\\|[dhmwy]\\)\\)+\\)[ 	]*\\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)[ 	]*\\'")
-  "Regexp matching a duration with units and H:MM or H:MM:SS format.")
-
-(defvar *org-duration-units*
-  '(("min" . 1) ("h" . 60) ("d" . 1440) ("w" . 10080) ("m" . 43200)
-    ("y" . 525960.0)))
-
 (define-org-object active-timestamp (date time mod))
 (define-org-object active-timestamp-range (ts1 ts2))
 (define-org-object inactive-timestamp (date time mod))
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/lib/organ/vars.lisp
Binary file lisp/lib/organ/vars.lisp has changed
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/lib/skel/comp/makefile.lisp
--- a/lisp/lib/skel/comp/makefile.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/lib/skel/comp/makefile.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -96,7 +96,7 @@
 		    :description (sk-description self)
 		    :opts '("mode: makefile-gmake;"))
 		   out))
-    (sk-compile self out)))
+    (sk-compile self :stream out)))
 
 (defmethod sk-read-file ((self makefile) path)
   (with-open-file (in path :direction :input)))
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/lib/skel/core/obj.lisp
--- a/lisp/lib/skel/core/obj.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/lib/skel/core/obj.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -507,7 +507,7 @@
         (invalid-skel-ast ast))))
 
 ;; obj -> ast
-(defmethod build-ast ((self sk-project) &key (nullp nil) (exclude '(ast id)))
+(defmethod build-ast ((self sk-project) &key (nullp nil) (exclude '(ast id phases)))
   (setf (ast self)
         (unwrap-object self
                        :slots t
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/lib/skel/core/vm.lisp
--- a/lisp/lib/skel/core/vm.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/lib/skel/core/vm.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -10,6 +10,7 @@
   (defvar *skel-op-types*
     (vector :nil :eval :set :get :end :jump :pop :spawn :wait :print :let))
   (defvar *skel-arena-size* (ash 1 16))
+  (defvar *skel-stack-size* 128)
   (defun new-skel-arena () (sb-vm:new-arena *skel-arena-size*))
   (defun init-skel-scope (&optional (map (sb-lockless:make-so-map/fixnum)))
     (sb-lockless:so-insert map 0)
@@ -29,8 +30,6 @@
     
 (defvar *skel-arena* (new-skel-arena))
 
-(defvar *skel-stack-size* 128)
-
 (deftype skel-op-type () `(member ,@(coerce *skel-op-types* 'list)))
 
 (defstruct skel-op
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/lib/skel/tests.lisp
--- a/lisp/lib/skel/tests.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/lib/skel/tests.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -46,7 +46,8 @@
   "Ensure skelfiles are created and loaded correctly and that they signal
 the appropriate restarts."
   (do-tmp-path (tmp-path "sk")
-    (is (sk-write-file (make-instance 'sk-project :name "nada" :path "test" :vc :hg) :path %tmp :if-exists :supersede))
+    (is (sk-write-file
+         (make-instance 'sk-project :name "nada" :path "test" :vc :hg) :path %tmp :if-exists :supersede))
     (ignore-errors (delete-file %tmp))
     (setf %tmp (tmp-path "sk"))
     (is (init-skelfile %tmp))
@@ -90,13 +91,7 @@
 
 (deftest vm ()
   "EXPERIMENTAL"
-  (is (let ((vm (make-sk-vm 201)))
-	(dotimes (i 200)
-	  (sks-pop vm))
-	t))
-  (let ((vm (make-sk-vm 1)))
-    (is (sks-pop vm))
-    (signals simple-error (sks-pop vm))))
+  (is (make-skel-vm)))
 
 (deftest asd ()
   (let ((sk (make-instance 'sk-project :components '((:lisp "test")
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/std/macs/ana.lisp
--- a/lisp/std/macs/ana.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/std/macs/ana.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -528,8 +528,8 @@
 
 ;; Graham's alambda
 (defmacro alambda (parms &body body)
-  `(labels ((self ,parms ,@body))
-     #'self))
+  `(labels ((%a ,parms ,@body))
+     #'%a))
 
 ;; Graham's aif
 (defmacro aif (test then &optional else)
@@ -575,17 +575,17 @@
                     ,g!b (progn ,@body))))))))
 
 (defmacro alet% (letargs &rest body)
-  `(let ((this) ,@letargs)
-     (setq this ,@(last body))
+  `(let ((%a) ,@letargs)
+     (setq %a ,@(last body))
      ,@(butlast body)
-     this))
+     %a))
 
 (defmacro alet (letargs &rest body)
-  `(let ((this) ,@letargs)
-     (setq this ,@(last body))
+  `(let ((%a) ,@letargs)
+     (setq %a ,@(last body))
      ,@(butlast body)
      (lambda (&rest params)
-       (apply this params))))
+       (apply %a params))))
 
 ;; swiped from fiveam. This is just like acond except it assumes that
 ;; the TEST in each element of CLAUSES returns two values as opposed
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/std/macs/pan.lisp
--- a/lisp/std/macs/pan.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/std/macs/pan.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -23,11 +23,11 @@
 
 (defmacro pandoriclet (letargs &rest body)
   (let ((letargs (cons
-                  '(this)
+                  '(%a)
                   (std/list:let-binding-transform
                    letargs))))
     `(let (,@letargs)
-       (setq this ,@(last body))
+       (setq %a ,@(last body))
        ,@(butlast body)
        (dlambda
         (:pandoric-get (sym)
@@ -35,7 +35,7 @@
         (:pandoric-set (sym val)
                        ,(pandoriclet-set letargs))
         (t (&rest args)
-           (apply this args))))))
+           (apply %a args))))))
 
 (declaim (inline get-pandoric))
 
@@ -54,25 +54,25 @@
      ,@body))
 
 ;; (defun pandoric-hotpatch (box new)
-;;   (with-pandoric (this) box
-;;     (setq this new)))
+;;   (with-pandoric (%a) box
+;;     (setq %a new)))
 
 (defmacro pandoric-recode (vars box new)
-  `(with-pandoric (this ,@vars) ,box
-     (setq this ,new)))
+  `(with-pandoric (%a ,@vars) ,box
+     (setq %a ,new)))
 
 (defmacro plambda (largs pargs &rest body)
   (let ((pargs (mapcar #'list pargs)))
-    `(let (this self)
+    `(let (%a %p)
        (setq
-        this (lambda ,largs ,@body)
-        self (dlambda
+        %a (lambda ,largs ,@body)
+        %p (dlambda
               (:pandoric-get (sym)
                              ,(pandoriclet-get pargs))
               (:pandoric-set (sym val)
                              ,(pandoriclet-set pargs))
               (t (&rest args)
-                 (apply this args)))))))
+                 (apply %a args)))))))
 
 (defvar pandoric-eval-tunnel)
 
diff -r 7046f3bdb668 -r 5bd0eb9fa1fa lisp/std/pkg.lisp
--- a/lisp/std/pkg.lisp	Tue Aug 13 22:05:23 2024 -0400
+++ b/lisp/std/pkg.lisp	Wed Aug 14 21:49:56 2024 -0400
@@ -236,11 +236,11 @@
    :alet%
    :alet
    :acond2
+   :aif
    :it
-   :aif
-   :this
-   :self
+   :%a
    ;; pan
+   :%p
    :pandoriclet
    :pandoriclet-get
    :pandoriclet-set