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)))