[elephant-devel] get-instances-by-range should work with string types

[Alain Picard]

Hello to all Elephant developers, and many words of thanks
for what appears to be a useful and well thought out library!

I've recently started a project which will (I hope) make some
good use of Elephant.  I'm still wrapping my head around things,
so go easy on me.  As a show of good will, here's my first attempt
at adding something to elephant.

Suppose you have a class like this:

(defclass test-user ()
  ((name :reader name :initarg :name
	 :type   string :index t)
   (timestamp :reader timestamp
	      :initform (get-universal-time)
	      :type integer
	      :index t))
  (:metaclass persistent-metaclass))

(defun make-some-users ()
  (let ((n 0)
	(*auto-commit* t))
    (dotimes (i 1000)
      (make-instance 'test-user :name (format nil "User name ~D" (incf n))))
    (get-instances-by-range 'test-user 'name "User name 10" "User name 20")))

(make-some-users)

If you try to do something like 

(length (get-instances-by-range 'test-user 'timestamp 0 999999999999))
==> 1000

It succeeds.
But if you try on the name, 

(get-instances-by-range 'test-user 'name "User name 10" "User name 11")
==>
Argument X is not a REAL: "User name 10"
   [Condition of type SIMPLE-TYPE-ERROR]

Because the get-instances-by-range function (needlessly) assumes
that the objects being returned can be compared with numeric
equality.

This little snippet fixes this problem:
(change from the 0.6 distribution)
=============cut================================================
(defun find-slot-type (class idx-name)
  (flet ((candidate-slot-p (slot)
	   (and (eq (type-of slot) 'persistent-effective-slot-definition)
		(slot-value slot 'indexed)
		(eq (slot-definition-name slot) idx-name))))
    (find-if #'candidate-slot-p (class-slots class))))

(defun find-index-comparison-function (class index)
  (let ((type (sb-pcl:slot-definition-type (find-indexed-slot class index))))
    (cond ((subtypep type 'number)
	   #'<=)
	  ((subtypep type 'string)
	   #'string<=)
	  (t
	   ;; We'll fall back to numerical, though it's not clear to
	   ;; me that this is sensible.  Maybe should just signal an error,
	   ;; and force users to declare :type on all indexed slots?
	   #'<=))))

(defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end)
  (let ((comparison (find-index-comparison-function class idx-name)))
    (with-inverted-cursor (cur class idx-name)
      (labels ((next-range (instances)
		 (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur)
		   (declare (ignore pkey))
		   (if (and exists? (funcall comparison skey end))
		       (next-in-range skey (cons val instances))
		       (nreverse instances))))
	       (next-in-range (key instances)
		 (multiple-value-bind (exists? skey val pkey) (cursor-pnext-dup cur)
		   (declare (ignore pkey skey))
		   (if exists?
		       (next-in-range key (cons val instances))
		       (progn
			 (cursor-pset-range cur key)
			 (next-range instances))))))
	(multiple-value-bind (exists? skey val pkey) (cursor-pset-range cur start)
	  (declare (ignore pkey))
	  (if (and exists? (funcall comparison skey end))
	      (next-in-range skey (cons val nil))
	      nil))))))
=============cut================================================

Note that unfortunately FIND-INDEX-COMPARISON-FUNCTION makes
use of SB-PCL:SLOT-DEFINITION-TYPE; I have not conditionalized
this for other lisps, nor do I really know what forms are appropriate
in any other lisps.

Obviously, it is possible to extend this scheme to let users register
their own comparison functions for more complex types;  I'll let you
judge if this is worth the effort.

Hoping this helps someone, somewhere.

If this was already covered in some other way, then consider this
message a bug report on the documentation instead.  :-)

                                Alain Picard


-- 
Please read about why Top Posting
is evil at: http://en.wikipedia.org/wiki/Top-posting
and http://www.dickalba.demon.co.uk/usenet/guide/faq_topp.html

Please read about why HTML in email is evil at: http://www.birdhouse.org/etc/evilmail.html