Commit ff036d18512592c09d30a180f60f800343ba21de

Thomas de Grivel 2023-06-19T17:18:44

replace lessp with compare

diff --git a/README.md b/README.md
index 7abd80e..7a39dd0 100644
--- a/README.md
+++ b/README.md
@@ -67,7 +67,8 @@ testing the presence or absence of triples (facts).
 ```common-lisp
 (defun movie-title (movie)
   (facts:with ((movie :is-a :movie
-                      :title ?title))
+                      :title ?title)
+               (:not movie :is-a :fake))
     (return ?title)))
 ```
 
@@ -76,7 +77,8 @@ is equivalent to
 ```common-lisp
 (defun movie-title (movie)
   (facts:with ((movie :is-a :movie)
-               (movie :title ?title))
+               (movie :title ?title)
+               (:not movie :is-a :fake))
     (return ?title)))
 ```
 
@@ -86,7 +88,8 @@ which is itself equivalent to
 (defun movie-title (movie)
   (facts:with ((movie :is-a :movie))
     (facts:with ((movie :title ?title))
-      (return ?title))))
+      (facts:without ((movie :is-a :fake))
+        (return ?title)))))
 ```
 
 Multiple queries on the same subject can be grouped together easily :
@@ -122,10 +125,3 @@ Transactions can be nested safely.
 # TODO
 
 ## Replace cl-lessp with cl-compare
-
-## Negative facts specifications
-
-```
-'((not ?subject ?predicate object1
-                ?predicate2 object2))
-```
diff --git a/database.lisp b/database.lisp
index efe3875..6e8f9d5 100644
--- a/database.lisp
+++ b/database.lisp
@@ -16,11 +16,11 @@
 ;;  Database
 
 (defclass db ()
-  ((index-spo :initform (make-index #'fact-spo-lessp)
+  ((index-spo :initform (make-index #'compare-facts-spo)
               :reader db-index-spo)
-   (index-pos :initform (make-index #'fact-pos-lessp)
+   (index-pos :initform (make-index #'compare-facts-pos)
               :reader db-index-pos)
-   (index-osp :initform (make-index #'fact-osp-lessp)
+   (index-osp :initform (make-index #'compare-fact-osp)
               :reader db-index-osp)))
 
 (defgeneric db-fact (db fact))
diff --git a/facts.asd b/facts.asd
index 440723f..fbe00bf 100644
--- a/facts.asd
+++ b/facts.asd
@@ -21,7 +21,7 @@
   :author "Thomas de Grivel <thoxdg@gmail.com>"
   :version "0.2"
   :description "in-memory graph database"
-  :depends-on ("lessp" "local-time" "rollback")
+  :depends-on ("compare" "lessp" "local-time" "rollback")
   :components
   ((:file "package")
    (:file "fact" :depends-on ("package"))
diff --git a/index.lisp b/index.lisp
index f035887..43fc611 100644
--- a/index.lisp
+++ b/index.lisp
@@ -15,37 +15,36 @@
 
 ;;  Facts ordering
 
-(defun lessp/3 (a1 a2 a3 b1 b2 b3)
-  (or (lessp a1 b1)
-      (and (not (lessp b1 a1))
-           (or (lessp a2 b2)
-               (and (not (lessp b2 a2))
-                    (lessp a3 b3))))))
+(defun compare/3 (a1 a2 a3 b1 b2 b3)
+  (ecase (compare a1 b1)
+    (-1 -1)
+    (1 1)
+    (0 (ecase (compare a2 b2)
+         (-1 -1)
+         (1 1)
+         (0 (ecase (compare a3 b3)
+              (-1 -1)
+              (1 1)
+              (0 0)))))))
 
-(defun fact-spo-lessp (a b)
-  (or (null a)
-      (and b
-           (lessp/3 (fact-subject a) (fact-predicate a) (fact-object a)
-                    (fact-subject b) (fact-predicate b) (fact-object b)))))
+(defun compare-facts-spo (a b)
+  (compare/3 (fact-subject a) (fact-predicate a) (fact-object a)
+             (fact-subject b) (fact-predicate b) (fact-object b)))
 
-(defun fact-pos-lessp (a b)
-  (or (null a)
-      (and b
-           (lessp/3 (fact-predicate a) (fact-object a) (fact-subject a)
-                    (fact-predicate b) (fact-object b) (fact-subject b)))))
+(defun compare-facts-pos (a b)
+  (compare/3 (fact-predicate a) (fact-object a) (fact-subject a)
+             (fact-predicate b) (fact-object b) (fact-subject b)))
 
-(defun fact-osp-lessp (a b)
-  (or (null a)
-      (and b
-           (lessp/3 (fact-object a) (fact-subject a) (fact-predicate a)
-                    (fact-object b) (fact-subject b) (fact-predicate b)))))
+(defun compare-facts-osp (a b)
+  (compare/3 (fact-object a) (fact-subject a) (fact-predicate a)
+             (fact-object b) (fact-subject b) (fact-predicate b)))
 
 ;;  Index operations
 
 ;;    skip lists
 
-(defun make-index (lessp)
-  (make-usl :lessp lessp))
+(defun make-index (compare)
+  (make-usl :compare compare))
 
 (defun index-get (index fact)
   (declare (type fact/v fact))
diff --git a/package.lisp b/package.lisp
index e20481f..42ec431 100644
--- a/package.lisp
+++ b/package.lisp
@@ -14,7 +14,7 @@
 (in-package :common-lisp-user)
 
 (defpackage :facts
-  (:use :cl :lessp :local-time :rollback)
+  (:use :cl :compare :local-time :rollback)
   (:export #:anon #:with-anon
            #:with #:bound-p #:collect #:first-bound #:let-with
            #:without
diff --git a/skip-list.lisp b/skip-list.lisp
index ae0d002..be1c701 100644
--- a/skip-list.lisp
+++ b/skip-list.lisp
@@ -182,7 +182,7 @@ L1: 50%, L2: 25%, L3: 12.5%, ..."
 
 (defstruct usl
   (spacing 3 :type (positive-fixnum 2))
-  (lessp #'lessp:lessp :type (function (t t) (or t nil)))
+  (compare #'compare:compare :type (function (t t) (or t nil)))
   (head (make-usl-node nil 1) :type usl-node)
   (length 0 :type positive-fixnum))
 
@@ -195,18 +195,17 @@ L1: 50%, L2: 25%, L3: 12.5%, ..."
   "Return two values : the predecessor node for VALUE in USL,
 and the stored value if VALUE was found."
   (declare (type usl usl))
-  (with-slots (lessp head) (the usl usl)
+  (with-slots (compare head) (the usl usl)
     (labels ((usl-find/node (node)
                (declare (type usl-node node))
-               ;; We have (lessp node value) => t
+               ;; We have (compare node value) => -1
                (let ((next (usl-node-link node 0)))
                  (if next
                      (let ((next-value (usl-node-value next)))
-                       (if (funcall lessp next-value value)
-                           (usl-find/node next)
-                           (if (funcall lessp value next-value)
-                               (values node nil)
-                               (values node next-value))))
+                       (ecase (funcall compare value next-value)
+                         (-1 (values node nil))
+                         (0 (values node next-value))
+                         (1 (usl-find/node next))))
                      (values node nil)))))
       (usl-find/node head))))
 
@@ -258,11 +257,12 @@ and the stored value if VALUE was found."
 
 (defun usl-each (usl fn &key start end)
   ;;  FIXME: level
-  (with-slots (lessp head) usl
+  (with-slots (compare head) usl
     (labels ((usl-each/node (node)
                (when node
                  (unless (and end
-                              (funcall lessp end (usl-node-value node)))
+                              (= -1 (funcall compare end
+                                             (usl-node-value node))))
                    (funcall fn (usl-node-value node))
                    (usl-each/node (usl-node-link node 0))))))
       (usl-each/node (multiple-value-bind (node found) (usl-find usl start)
diff --git a/usl.lisp b/usl.lisp
index 05c1ec2..3d0a50d 100644
--- a/usl.lisp
+++ b/usl.lisp
@@ -251,24 +251,24 @@ L1: 50%, L2: 25%, L3: 12.5%, ..."
 ;;  Skip list
 
 (defstruct (usl (:constructor make-usl%))
-  (lessp-fun nil :type (function (t t) (or t nil)))
+  (compare-fun nil :type (function (t t) (or t nil)))
   (head nil :type usl-node)
   (length 0 :type (fixnum* 0))
   (spacing nil :type (fixnum-float 1))
   (height-fun nil :type (function () (fixnum* 1))))
 
-(defun make-usl (&key (lessp #'lessp:lessp) (height 3) (spacing +e+))
-  (make-usl% :lessp-fun lessp :spacing spacing
+(defun make-usl (&key (compare #'compare:compare) (height 3) (spacing +e+))
+  (make-usl% :compare-fun compare :spacing spacing
              :head (make-usl-node nil height)
              :height-fun (usl-random-height-fun height spacing)))
 
 (defun usl-height (usl)
   (usl-node-height (usl-head usl)))
 
-(defun usl-lessp (usl a b)
+(defun usl-compare (usl a b)
   (declare (type usl usl))
   (funcall (the (function (t t) t)
-             (usl-lessp-fun usl))
+                (usl-compare-fun usl))
            a b))
 
 ;;  Find
@@ -285,14 +285,14 @@ PRED if given must be an array, fill it with predecessor usl nodes."
           ((< level 0))
         (do ((n node (usl-node-next n level)))
             ((or (null n)
-                 (not (usl-lessp usl (usl-node-value n) value))))
+                 (< -1 (usl-compare usl (usl-node-value n) value))))
           (setf node n))
         (when (and pred (< level (length pred)))
           (setf (aref pred level) node)))
       (let* ((next (usl-node-next node 0))
              (found (when next
                       (let ((next-value (usl-node-value next)))
-                        (unless (usl-lessp usl value next-value)
+                        (unless (> -1 (usl-compare usl value next-value))
                           value)))))
         found))))
 
@@ -357,7 +357,7 @@ PRED if given must be an array, fill it with predecessor usl nodes."
   (do ((node (usl-node-next (usl-cursor usl start)) (usl-node-next node)))
       ((or (null node)
            (when end
-             (usl-lessp usl end (usl-node-value node)))))
+             (= -1 (usl-compare usl end (usl-node-value node))))))
     (funcall fn (usl-node-value node))))
 
 #+test
diff --git a/view.lisp b/view.lisp
index 928a1cd..dd4f1b3 100644
--- a/view.lisp
+++ b/view.lisp
@@ -19,7 +19,7 @@
   ((refresh :initarg refresh
             :reader view-refresh
             :type function)
-   (index :initform (make-usl :lessp lessp)
+   (index :initform (make-usl :compare compare)
           :reader view-index
           :type usl)))