facts-db/cl-facts

diff --git a/fact.lisp b/fact.lisp
index 8a35de4..d8f54f5 100644
--- a/fact.lisp
+++ b/fact.lisp
@@ -37,21 +37,22 @@
 (deftype fact () '(or fact/v fact/l))
 
 (defun fact-subject (f)
-  (if (consp f)
-      (first f)
-      (svref f 0)))
+  (when f
+    (if (consp f)
+        (first f)
+        (svref f 0))))
 
 (defun fact-predicate (f)
-  (declare (type fact f))
-  (if (consp f)
-      (second f)
-      (svref f 1)))
+  (when f
+    (if (consp f)
+        (second f)
+        (svref f 1))))
 
 (defun fact-object (f)
-  (declare (type fact f))
-  (if (consp f)
-      (third f)
-      (svref f 2)))
+  (when f
+    (if (consp f)
+        (third f)
+        (svref f 2))))
 
 (defun fact-equal (a b)
   (and (equal (fact-subject   a) (fact-subject b))
diff --git a/index.lisp b/index.lisp
index 43fc611..bc8964e 100644
--- a/index.lisp
+++ b/index.lisp
@@ -28,16 +28,31 @@
               (0 0)))))))
 
 (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)))
+  (cond
+    ((eq a b) 0)
+    ((null a) -1)
+    ((null b) 1)
+    (t
+     (compare/3 (fact-subject a) (fact-predicate a) (fact-object a)
+                (fact-subject b) (fact-predicate b) (fact-object 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)))
+  (cond
+    ((eq a b) 0)
+    ((null a) -1)
+    ((null b) 1)
+    (t
+     (compare/3 (fact-predicate a) (fact-object a) (fact-subject a)
+                (fact-predicate b) (fact-object b) (fact-subject 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)))
+  (cond
+    ((eq a b) 0)
+    ((null a) -1)
+    ((null b) 1)
+    (t
+     (compare/3 (fact-object a) (fact-subject a) (fact-predicate a)
+                (fact-object b) (fact-subject b) (fact-predicate b)))))
 
 ;;  Index operations
 
diff --git a/skip-list.lisp b/skip-list.lisp
index be1c701..3c27f59 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))
-  (compare #'compare:compare :type (function (t t) (or t nil)))
+  (compare #'compare:compare :type (function (t t) fixnum))
   (head (make-usl-node nil 1) :type usl-node)
   (length 0 :type positive-fixnum))
 
diff --git a/test.lisp b/test.lisp
index 86aad9d..075b385 100644
--- a/test.lisp
+++ b/test.lisp
@@ -13,33 +13,21 @@
 
 (in-package :facts)
 
-(add ('result 'source ?s)
-     (?s 'id "plop")
-     (?s 'score 42))
+(facts:add ("Blade Runner" :is-a :movie
+                           :director "Ridley Scott"
+                           :actor "Harison Ford"
+                           :actor "Rutger Hauer")
+           ("Snow White" :is-a :movie
+                         :director "William Cottrell"
+                         :director "David Hand"))
 
-(trace replace-bindings collect-bindings% with%)
-(trace make-fact/v fact/v-subject fact/v-predicate fact/v-object)
+(trace with/0 db-each usl-each usl-find)
 
 (with ((?s ?p ?o))
   (format t "~&~S ~S ~S~&" ?s ?p ?o))
 
-(llrbtree:map-tree (lambda (key value)
-                     (format t "~&~S -> ~S~%" key value))
-                   (db-pos-tree *db*)
-                   :START (MAKE-FACT/V NIL nil NIL))
+facts:*db*
 
-(macroexpand-1
- (third
-  (macroexpand-1
-   '(with (('result 'source ?p))
-     (format t "~S~&" ?p)))))
+(untrace usl-compare)
 
-(with (('result 'source ?p)
-       (?p 'id ?id))
-  (return (list ?p ?id)))
-
-(with (('result 'source ?p)
-       (?p 'id ?id)
-       (?p 'score ?score))
-  (format t "~S~%" (list (list ?p 'score ?score)
-                         (list ?p 'id ?id))))
+(clear-db)
diff --git a/usl.lisp b/usl.lisp
index 3d0a50d..68ee5ca 100644
--- a/usl.lisp
+++ b/usl.lisp
@@ -251,14 +251,15 @@ L1: 50%, L2: 25%, L3: 12.5%, ..."
 ;;  Skip list
 
 (defstruct (usl (:constructor make-usl%))
-  (compare-fun nil :type (function (t t) (or t nil)))
+  (compare-fun nil :type (function (t t) fixnum))
   (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 (compare #'compare:compare) (height 3) (spacing +e+))
-  (make-usl% :compare-fun compare :spacing spacing
+  (make-usl% :compare-fun compare
+             :spacing spacing
              :head (make-usl-node nil height)
              :height-fun (usl-random-height-fun height spacing)))
 
@@ -267,10 +268,18 @@ L1: 50%, L2: 25%, L3: 12.5%, ..."
 
 (defun usl-compare (usl a b)
   (declare (type usl usl))
-  (funcall (the (function (t t) t)
+  (funcall (the (function (t t) fixnum)
                 (usl-compare-fun usl))
            a b))
 
+(defun usl-compare (usl a b)
+  (declare (type usl usl))
+  (let* ((compare-fun (the (function (t t) fixnum)
+                           (usl-compare-fun usl)))
+         (result (funcall compare-fun a b)))
+    (format t "~&USL-COMPARE: ~S ~S ~S => ~S~%" compare-fun a b result)
+    result))
+
 ;;  Find
 
 (defun usl-find (usl value &optional pred)
@@ -285,14 +294,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)
-                 (< -1 (usl-compare usl (usl-node-value n) value))))
+                 (not (= -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 (> -1 (usl-compare usl value next-value))
+                        (unless (= -1 (usl-compare usl value next-value))
                           value)))))
         found))))
 
diff --git a/with.lisp b/with.lisp
index 1bf15a7..51f4470 100644
--- a/with.lisp
+++ b/with.lisp
@@ -61,38 +61,25 @@
 
 (eval-when (:compile-toplevel :load-toplevel)
 
+  (defun with/dispatch (s p o binding-vars body)
+    (let ((var-s (when (binding-p s) (cdr (assoc s binding-vars))))
+          (var-p (when (binding-p p) (cdr (assoc p binding-vars))))
+          (var-o (when (binding-p o) (cdr (assoc o binding-vars)))))
+      (cond ((and var-s var-p var-o) (with/0 var-s var-p var-o body))
+            ((nor var-s var-p var-o) (with/3 s p o body))
+            (t (with/1-2 s p o var-s var-p var-o
+                         (cond ((and (null var-s) var-o) 'db-index-spo)
+                               ((null var-p)             'db-index-pos)
+                               (t                        'db-index-osp))
+                         body)))))
+
   (defun with/iter (spec binding-vars body)
-    (destructuring-bind (s p o) spec
-      (let ((var-s (when (binding-p s) (cdr (assoc s binding-vars))))
-            (var-p (when (binding-p p) (cdr (assoc p binding-vars))))
-            (var-o (when (binding-p o) (cdr (assoc o binding-vars)))))
-        (cond ((and var-s var-p var-o) (with/0 var-s var-p var-o body))
-              ((nor var-s var-p var-o) (with/3 s p o body))
-              (t (with/1-2 s p o var-s var-p var-o
-                           (cond ((and (null var-s) var-o) 'db-index-spo)
-                                 ((null var-p)             'db-index-pos)
-                                 (t                        'db-index-osp))
-                           body))))))
-
-  (defun without/iter (spec binding-vars body)
-    (destructuring-bind (not s p o) spec
-      (assert (eq :not not))
-      (let ((var-s (when (binding-p s) (cdr (assoc s binding-vars))))
-            (var-p (when (binding-p p) (cdr (assoc p binding-vars))))
-            (var-o (when (binding-p o) (cdr (assoc o binding-vars)))))
-        (unless (cond ((and var-s var-p var-o)
-                       (with/0 var-s var-p var-o '(return t)))
-                      ((nor var-s var-p var-o)
-                       (with/3 s p o '(return t)))
-                      (t (with/1-2 s p o var-s var-p var-o
-                                   (cond ((and (null var-s) var-o)
-                                          'db-index-spo)
-                                         ((null var-p)
-                                          'db-index-pos)
-                                         (t
-                                          'db-index-osp))
-                                   '(return t))))
-          body)))))
+    (ecase (length spec)
+      ((3) (destructuring-bind (s p o) spec
+             (with/dispatch s p o binding-vars body)))
+      ((4) (destructuring-bind (not s p o) spec
+             (assert (eq :not not))
+             (with/dispatch s p o binding-vars '(return nil)))))))
 
 (defmacro with/rec ((spec &rest more-specs) &body body)
   (let* ((bindings (collect-bindings spec))
@@ -110,7 +97,7 @@
        ,@body)))
 
 (defmacro with (binding-specs &body body)
-  `(with/expanded ,(sort-bindings (expand-specs binding-specs))
+  `(with/expanded ,(expand-specs binding-specs)
      ,@body))
 
 (defmacro bound-p (binding-specs)