Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv19354

Added Files: query-example.lisp query.lisp Log Message: Quick hack for object filtering queries; example of first pass at constraint syntax

--- /project/elephant/cvsroot/elephant/src/elephant/query-example.lisp 2007/03/01 02:45:45 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/query-example.lisp 2007/03/01 02:45:45 1.1

(in-package :elephant)

;; TEST DATA

(defparameter *constraint-spec* '(:BDB "/Users/eslick/Work/db/constraint/"))

(defun print-name (inst) (format t "Name: ~A~%" (slot-value inst 'name)))

(defpclass person () ((name :initarg :name :index t) (salary :initarg :salary :index t) (department :initarg :dept)))

(defpclass department () ((name :initarg :name) (manager :initarg :manager)))

(defparameter *names* '("Jacob" "Emily" "Michael" "Emma" "Joshua" "Madison" "Matthew" "Abigail" "Ethan" "Olivia" "Andrew" "Isabella" "Daniel" "Hannah" "Anthony" "Samantha" "Christopher" "Ava" "Joseph" "Ashley" ))

(defun test-dataset () (let* ((greg (make-instance 'person :name "Greg" :salary 100000)) (sally (make-instance 'person :name "Sally" :salary 110000)) (mkt (make-instance 'department :name "Marketing" :manager greg)) (engr (make-instance 'department :name "Engineering" :manager sally))) (setf (slot-value greg 'department) mkt) (setf (slot-value sally 'department) engr) (with-transaction () (loop for i from 0 upto 500 do (make-instance 'person :name (format nil "~A~A" (utils:random-element *names*) i) :salary (floor (+ (* (random 1000) 150) 30000)) :department (if (= 1 (random 2)) mkt engr))))))

(defun print-person (person &optional (stream t)) (format stream "name: ~A salary: ~A dept: ~A~%" (slot-value person 'name) (slot-value person 'salary) (slot-value (slot-value person 'department) 'name)))

(defun example-query1 () "Performs a query against a single class. Trivial string & integer matchingA" (map-class-query #'print-person '((person name = "Greg") (person salary >= 100000))))

(defun example-query2 (low-salary high-salary) "Parameterized query" (map-class-query #'print-person `((person salary >= ,low-salary) (person salary <= ,high-salary))))

--- /project/elephant/cvsroot/elephant/src/elephant/query.lisp 2007/03/01 02:45:45 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/query.lisp 2007/03/01 02:45:45 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; query.lisp -- Implement syntax for the elephant query engine ;;; ;;; Copyright (c) 2007 by Ian S. Eslick ;;; <ieslick at common-lisp.net> ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Limited General Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;

(in-package :elephant)

(defparameter *string-relation-functions* `((< . ,#'string<) (< . ,#'string<=) (> . ,#'string>) (> . ,#'string>=) (= . ,#'equal) (!= . ,(lambda (x y) (not (equal x y))))))

(defparameter *number-relation-functions* `((< . ,#'<) (> . ,#'>) (= . ,#'=) (!= . ,#'(lambda (x y) (not (= x y))))))

(defun relation-string-function (rel) (cdr (assoc rel *string-relation-functions*)))

(defun relation-number-function (rel) (cdr (assoc rel *number-relation-functions*)))

(defun test-relation (rel ival tvals) (assert (or (and (numberp ival) (numberp (first tvals))) (and (stringp ival) (stringp (first tvals))))) (typecase ival (string (funcall (relation-string-function rel) ival (first tvals))) (number (funcall (relation-number-function rel) ival (first tvals)))))

(defun get-query-instances (constraints) (let ((list nil)) (flet ((collect (inst) (push inst list))) (declare (dynamic-extent collect)) (map-class-query #'collect constraints))))

(defun map-class-query (fn constraints) "Map instances using the query constaints to filter objects, exploiting slot indices (for last query) and stack allocated test closures" (assert (not (null constraints))) (destructuring-bind (class slot relation &rest values) (first constraints) (flet ((filter-by-relation (inst) (when (test-relation relation (slot-value inst slot) values) (funcall fn inst)))) (declare (dynamic-extent filter-by-relation)) (if (null (cdr constraints)) (if (find-inverted-index class slot) (if (= (length values) 1) (progn (map-class-index fn class slot (first values) (first values)) (map-class-index fn class slot (first values) (second values)))) (map-class #'filter-by-relation class)) (map-class-query #'filter-by-relation (cdr constraints))))))

;; ;; Conjunctions of indices ;;

;;(defun map-classes (fn classes) ;; (map-index-list fn (mapcar #'find-class-index classes)))

;;(defun map-index-list (fn indices) ;; (dolist (index indices) ;; (map-index fn index)))