Update of /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch In directory clnet:/tmp/cvs-serv27507/eslick/query-sketch Added Files: constraint-parser.lisp query-algebra.lisp query-planner.lisp query-syntax.lisp scratch.lisp Log Message: Archive of various attacks on query system --- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/constraint-parser.lisp 2007/03/06 04:17:14 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/constraint-parser.lisp 2007/03/06 04:17:14 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; query-syntax.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) ;; ;; Constraint graph ;; (defclass constraint-graph () ((variables :accessor constraint-variables :initarg :vars :initform nil) (edges :accessor constraint-edges :initarg :edges :initform nil))) (defmethod find-constraint-variable ((graph constraint-graph) var-name) (find var-name (constraint-variables graph) :test #'variable-name)) (defmethod find-constraint-edge ((graph constraint-graph) var1 var2) (when (symbolp var1) (setf var1 (find-constraint-variable graph var1))) (when (symbolp var2) (setf var2 (find-constraint-variable graph var2))) (flet ((match-p (edge) (and (or (eq (edge-src edge) var1) (eq (edge-dst edge) var1)) (or (eq (edge-dst edge) var2) (eq (edge-src edge) var2))))) (find nil (constraint-edges graph) :test #'match-p))) (defmethod add-constraint ((graph constraint-graph) var constraint bindings) (unless (find-constraint-variable graph var) (make-instance 'constraint-variable :class (get-var-class bindings var) (push constraint (constraint-variables (find-constraint-variable graph var)))))) (defclass constraint-variable () ((name :accessor variable-name :initarg :name) (class :accessor variable-class :initarg :class) (constraints :accessor variable-constraints :initarg :constraints :initform nil))) (defclass edge () ((src :accessor edge-src :initarg :src) (dst :accessor edge-dst :initarg :dst) (constraint :accessor destination-constraint :initarg :constraint))) (defclass constraint () ((class :accessor constraint-class :initarg :class) (fn :accessor constraint-fn :initarg :test-fn :documentation "Predicate accepting an instance and returns whether it was accepted (t) or rejected (nil)") (expr :accessor constraint-expr :initarg :test-expr :documentation "Predicate expression for inline expansion"))) (defclass value-constraint (constraint) ((slot :accessor constraint-slot :initarg :slot :initform nil) (indexed-p :accessor indexed-p :initarg :indexed-p :initform nil) (index-type :accessor index-type :initarg :type :initform t) (range-p :accessor range-p :initarg :range-p :initform nil) (value :accessor constraint-value :initarg :value))) (defmethod initialize-index-info ((c value-constraint)) (when (constraint-slot c) (let ((idx (find-inverted-index (constraint-class c) (constraint-slot c) :null-on-fail t))) (when idx (setf (indexed-p c) t))))) (defclass range-constraint (constraint) ((range :accessor constraint-range :initarg :range))) (defclass and-constraint (constraint) ((constraints :accessor constraints :initarg :constraints))) (defclass or-constraint (constraint) ()) (defclass xor-constraint (constraint) ()) ;; ;; Constraint patterns for parsing ;; (defvar *constraint-dictionary* '((= parse-numeric) (< parse-numeric range) (> parse-numeric range) (>= parse-numeric range) (<= parse-numeric range) (string= parse-string) (string< parse-string range) (string> parse-string range) (string>= parse-string range) (string<= parse-string range) (member parse-member) (fn parse-function) (between parse-range) (or parse-or) (and parse-and) (eq parse-equiv))) (defun parse-constraint (expr bindings graph) (let ((op (first expr))) (multiple-value-bind (var constraint) (funcall (symbol-function (second (assoc op *constraint-dictionary*))) expr binding) (add-constraint graph var constraint bindings)))) (defun parse-numeric (expr bindings) (destructuring-bind (rel (slot var) value) expr (assert (numberp value)) (values var (make-instance 'value-constraint :slot slot :range-p nil :class (binding-class var) :value value :expr `((inst) (,rel (slot-value inst ,slot) ,value)))))) ;; ;; Bindings ;; (defun make-constraint-bindings () (make-hash-table :test #'equal)) (defun add-binding (name rec bindings) (setf (gethash name bindings) rec)) (defun get-binding (name bindings) (gethash name bindings)) (defun make-binding (type name) (list type name)) (defun binding-type (rec) (first rec)) (defun binding-target (rec) (second rec)) --- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-algebra.lisp 2007/03/06 04:17:14 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-algebra.lisp 2007/03/06 04:17:14 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; merge.lisp -- Implement efficient OID lists for merge-sort ;;; ;;; 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) --- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-planner.lisp 2007/03/06 04:17:14 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-planner.lisp 2007/03/06 04:17:14 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; query-planner.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) ;; ================================================================================ ;; Simple graph abstraction for keeping track of plan constraints ;; ================================================================================ (defclass edge () ((type :accessor edge-type :initarg :type :initform nil) (source :accessor edge-source :initarg :source :initform nil) (target :accessor edge-target :initarg :target :initform nil))) (defclass graph () ((edges :accessor edge-list :initarg :edges :initform nil) (nodes :accessor node-list :initarg :nodes :initform nil))) ;; ============================= ;; Query Plans ;; ============================= ;; These operations are the basis for estimating the cost ;; of different orderings of query operations. For simple ;; queries this is unnecessary, but for queries with constraints ;; between classes, this is very useful. (defclass query-op () ((set-size :accessor set-size :initarg :set-size :initform 0) (page-queries :accessor page-queries :initarg :page-queries :initform 0) (slot-queries :accessor slot-queries :initarg :slot-queries :initform 0))) (defclass instance-op () ((class :accessor op-class :initarg :cost) (constraints :accessor op-constraints :initarg :constraints))) (defclass index-op (instance-op) ((index :accessor query-index :initarg :cons))) (defclass scan-op (instance-op) () (:documentation "Scan the class applying the per-instance operator")) ;; intersection, unions (defclass merge-op (query-op) ((merge-type :accessor merge-type :initarg :type :initform :intersection))) (defun compute-constraint-graph (constraint-expr) "" (defun compute-query-plan (constraints) "Given a constraint graph, compute a query plan" --- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-syntax.lisp 2007/03/06 04:17:14 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/query-syntax.lisp 2007/03/06 04:17:14 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; query-syntax.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) ;; Want syntax such that we can recursively walk the definition and ;; produce a query graph that can be subject to algebraic optimization ;; How to handle nested queries? (string= (name (department inst)) "Marketing") ;; Name unique, no idx on dept inst := (class people) v1 := (lookup-select string= (name department) "marketing") s1 := (class-select ref= department people v1) s2 := (class-select < salary people 100k) s3 := (join s1 s2) s4 := (objects s3) ;; graph of instance sets and selections against them ;; ;; Constraint graph ;; (defclass constraint-graph () ((variables :accessor constraint-variables :initarg :vars :initform nil) (edges :accessor constraint-edges :initarg :edges :initform nil))) (defmethod find-constraint-variable ((graph constraint-graph) var-name) (find var-name (constraint-variables graph) :test #'variable-name)) (defmethod find-constraint-edge ((graph constraint-graph) var1 var2) (when (symbolp var1) (setf var1 (find-constraint-variable graph var1))) (when (symbolp var2) (setf var2 (find-constraint-variable graph var2))) (flet ((match-p (edge) (and (or (eq (edge-src edge) var1) (eq (edge-dst edge) var1)) (or (eq (edge-dst edge) var2) (eq (edge-src edge) var2))))) (find nil (constraint-edges graph) :test #'match-p))) (defmethod add-constraint ((graph constraint-graph) var constraint bindings) (unless (find-constraint-variable graph var) (make-instance 'constraint-variable :class (get-var-class bindings var) (push constraint (constraint-variables (find-constraint-variable graph var))) (defclass constraint-variable () ((name :accessor variable-name :initarg :name) (class :accessor variable-class :initarg :class) (constraints :accessor variable-constraints :initarg :constraints :initform nil))) (defclass edge () ((src :accessor edge-src :initarg :src) (dst :accessor edge-dst :initarg :dst) (constraint :accessor destination-constraint :initarg :constraint))) (defclass constraint () ((class :accessor constraint-class :initarg :class) (fn :accessor constraint-fn :initarg :test-fn :documentation "Predicate accepting an instance and returns whether it was accepted (t) or rejected (nil)") (expr :accessor constraint-expr :initarg :test-expr :documentation "Predicate expression for inline expansion"))) (defclass value-constraint (constraint) ((slot :accessor constraint-slot :initarg :slot :initform nil) (indexed-p :accessor indexed-p :initarg :indexed-p :initform nil) (index-type :accessor index-type :initarg :type :initform t) (range-p :accessor range-p :initarg :range-p :initform nil) (value :accessor constraint-value :initarg :value))) (defmethod initialize-index-info ((c value-constraint)) (when (constraint-slot c) (let ((idx (find-inverted-index (constraint-class c) (constraint-slot c) :null-on-fail t))) (when idx (setf (indexed-p c) t))))) (defclass range-constraint (constraint) ((range :accessor constraint-range :initarg :range))) (defclass and-constraint (constraint) ((constraints :accessor constraints :initarg :constraints))) (defclass or-constraint (constraint) ()) (defclass xor-constraint (constraint) ()) ;; ;; Constraint patterns for parsing ;; (defvar *constraint-dictionary* '((= parse-numeric) (< parse-numeric range) (> parse-numeric range) (>= parse-numeric range) (<= parse-numeric range) (string= parse-string) (string< parse-string range) (string> parse-string range) (string>= parse-string range) (string<= parse-string range) (member parse-member) (fn parse-function) (between parse-range) (or parse-or) (and parse-and) (eq parse-equiv))) (defun parse-constraint (expr bindings graph) (let ((op (first expr))) (multiple-value-bind (var constraint) (funcall (symbol-function (second (assoc op *constraint-dictionary*))) expr binding) (add-constraint graph var constraint bindings)))) (defun parse-numeric (expr bindings) (destructuring-bind (rel (slot var) value) expr (assert (numberp value)) (values var (make-instance 'value-constraint :slot slot :range-p nil :class (binding-class var) :value value :expr `((inst) (,rel (slot-value inst ,slot) ,value)))))) ;; ;; Bindings ;; (defun make-constraint-bindings () (make-hash-table :test #'equal)) (defun add-binding (name rec bindings) (setf (gethash name bindings) rec)) (defun get-binding (name bindings) (gethash name bindings)) (defun make-binding (type name) (list type name)) (defun binding-type (rec) (first rec)) (defun binding-target (rec) (second rec)) --- /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/scratch.lisp 2007/03/06 04:17:14 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/query-sketch/scratch.lisp 2007/03/06 04:17:14 1.1 ;; ;; Constraint definitions ;; ;; A constraint is an expression that requires the value of an object slot ;; to be one or more values or a reference to an object satisfying a constraint. ;; The object slot reference and the value slot reference can be complex. ;; (defvar *constraint-definitions* (make-hash-table :size 40)) (defmacro define-constraint (name &body body) `(progn (push ,(generate-constraint-pattern body) (gethash ',name *constraint-dispatch*)))) [276 lines skipped]