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
_______________________________________________
elephant-devel site list
elephant-devel@common-lisp.net
http://common-lisp.net/mailman/listinfo/elephant-devel
