[elephant-cvs] CVS elephant/src/query

[ieslick]

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

Modified Files:
	syntax.lisp 
Log Message:
A few details to go green on sbcl and acl on mac32

--- /project/elephant/cvsroot/elephant/src/query/syntax.lisp	2007/03/06 04:15:27	1.1
+++ /project/elephant/cvsroot/elephant/src/query/syntax.lisp	2007/03/08 21:29:53	1.2
@@ -72,13 +72,18 @@
 ;; Dictionary
 
 (defun make-relation-dictionary ()
-  (cons nil nil))
+  (cons nil 0))
 
 (defun add-set (name class stmt dictionary &optional annotations)
   (push (list name class stmt annotations) (car dictionary)))
 
+(defun add-anonymous-set (class dict)
+  (let ((name (format nil "?class~A" (incf (cdr dict)))))
+    (add-set name class nil dict)
+    name))
+
 (defun lookup-set (name dict)
-  (awhen (assoc name (car dict))
+  (awhen (assoc name (car dict) :test #'equal)
     it))
 
 (defun set-name (setrec)
@@ -94,6 +99,7 @@
   (fourth setrec))
 
 
+
 ;; Constraints
     
 (defun parse-constraints (exprs dictionary)
@@ -212,18 +218,68 @@
 		  ,(reference-slot-or-value rec2))
 	     ,(setname))))
 
-(defun make-join-statement (op rec1 rec2)
+(defun make-join-statement (op rec1 rec2 dictionary)
   (cond ((and (simple-record-p rec1) (simple-record-p rec2))
-	 ;; An explicit join (assuming op is '=')
 	 `(theta-join ,op 
 		      ,(reference-slot rec1) ,(reference-setname rec1)
 		      ,(reference-slot rec2) ,(reference-setname rec2)))
 	((and (nested-record-p rec1) (value-record-p rec2))
-	 `(theta-join ,op 
- 	 )
+	 (make-nested-join op rec1 rec2))
 	((and (value-record-p rec1) (nested-record-p rec1))
-	 )
+	 (make-nested-join op rec2 rec1 :reverse t))
+	(t (error "Cannot construct complex join statement with ~A and ~A" rec1 rec2))))
 
+(defun make-nested-join (op rec-nest rec-value dict &key reverse)
+  (let* ((slot (reference-slot rec-nest))
+	 (sc-list (assign-join-types nil (reference-form rec-nest)))
+	 (select `(select (,op ,@(when reverse 
+				       (list value slot)
+				       (list slot value))
+			       ,(second (first sc-list))))))
+    (nest-joins (rest sc-list) select)))
+
+(defun nest-joins (sc-list inner-stmt)
+  "Wraps a cascade of joins with anonymous classes"
+  (if (null sc-list)
+      inner-stmt
+      (let ((slot-class (first sc-list)))
+	(nest-joins (cdr sc-list)
+		    `(join ,(first slot-class) ,(second slot-class) oid ,inner-stmt)))))
+
+(defun assign-join-types (accessor nested-form dict)
+  (if (simple-reference-form-p nested-form dict)
+      (list nested-form)
+      (let* ((list (assign-join-types (first nested-form) (second nested-form) dict))
+	     (type-form (first list)))
+	(cons (list accessor
+		    (get-set-type (list (first type-form) (get-set-type (second type-form) dict)) dict))
+	      list))))
+
+(defun get-set-type (form dict)
+  (let ((setrec (lookup-set form dict)))
+    (if setrec (set-type setrec)
+	(ifret (infer-type (first form) (second form)) nil))))
+	       
+	       
+
+(defun infer-type (slot class)
+  "Determine the type "
+
+  ((nil namerec)
+   (name person)
+   (manager department)
+   (department emp))
+
+	 
+
+(= (name (manager (department emp))) "George")
+(department emp) = foo
+(manager foo) = foo1
+(name foo1) 
+
+(join department emp oid 
+      (project (oid) (join manager ?class1 oid 
+			   (project oid (select (= name "George") ?class2)))))
 
 (defun reference-slot-or-value (rec)
   (cond ((value-record-p rec)