[isidorus-cvs] r418 - in trunk/src: TM-SPARQL unit_tests

Lukas Giessmann lgiessmann at common-lisp.net
Wed Apr 6 11:01:58 UTC 2011


Author: lgiessmann
Date: Wed Apr  6 07:01:57 2011
New Revision: 418

Log:
TM-SPARQL: filters use now the actual datatype, e.g. 82 instead of '82' ...

Modified:
   trunk/src/TM-SPARQL/sparql.lisp
   trunk/src/unit_tests/sparql_test.lisp

Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql.lisp	Wed Apr  6 07:01:57 2011
@@ -297,6 +297,28 @@
       (push variable-name (variables construct)))))
 
 
+
+(defgeneric cast-variable-values(construct variable-value-list)
+  (:documentation "Casts all values contained in the variable value list
+                   to the corresponding type that is also stored in the
+                   variable-value list.")
+  (:method ((construct SPARQL-Query) (variable-value-list List))
+    (map 'list
+	 #'(lambda(item)
+	     (map 'list
+		  #'(lambda(inner-item)
+		      (list :variable-name (getf inner-item :variable-name)
+			    :variable-value
+			    (if (and (getf inner-item :variable-value)
+				     (getf inner-item :literal-datatype))
+				(cast-literal (getf inner-item :variable-value)
+					      (getf inner-item :literal-datatype)
+					      :back-as-string-when-unsupported t)
+				(getf inner-item :variable-value))))
+		  item))
+	 variable-value-list)))
+
+
 (defgeneric make-variable-values(construct variable-name existing-results)
   (:documentation "Returns a list of values that are bound to the passed
                    variable. The first occurrence of the given variable
@@ -310,29 +332,40 @@
 	       when (and (variable-p (subject triple))
 			 (string= (value (subject triple)) variable-name))
 	       return (progn (setf found-p t)
-			     (subject-result triple))
+			     (list :result (subject-result triple)))
 	       when (and (variable-p (predicate triple))
 			 (string= (value (predicate triple)) variable-name))
 	       return (progn (setf found-p t)
-			     (predicate-result triple))
+			     (list :result (predicate-result triple)))
 	       when (and (variable-p (object triple))
 			 (string= (value (object triple))
 				  variable-name))
 	       return (progn (setf found-p t)
-			     (object-result triple))))
+			     (list :result (object-result triple)
+				   :literal-datatype (object-datatype triple)))))
 	   (new-results nil))
       (if (not found-p)
 	  existing-results
 	  (if existing-results
-	      (dolist (result results new-results)
+	      (dotimes (idx (length (getf results :result)) new-results)
 		(dolist (old-result existing-results)
-		  (push (append old-result (list (list :variable-name variable-name
-						       :variable-value result)))
+		  (push (append old-result
+				(list
+				 (list :variable-name variable-name
+				       :literal-datatype
+				       (when (getf results :literal-datatype)
+					 (elt (getf results :literal-datatype) idx))
+				       :variable-value
+				       (elt (getf results :result) idx))))
 			new-results)))
-	      (map 'list #'(lambda(result)
-			     (list (list :variable-name variable-name
-					 :variable-value result)))
-		   results))))))
+	      (loop for idx to (1- (length (getf results :result)))
+		 collect (list
+			  (list :variable-name variable-name
+				:literal-datatype
+				(when (getf results :literal-datatype)
+				  (elt (getf results :literal-datatype) idx))
+				:variable-value
+				(elt (getf results :result) idx)))))))))
 
 
 (defun to-lisp-code (variable-values filter)
@@ -389,16 +422,24 @@
 	(dolist (var-name filter-variable-names)
 	  (setf filter-variable-values
 		(make-variable-values construct var-name filter-variable-values)))
+	(setf filter-variable-values
+	      (cast-variable-values construct filter-variable-values))
 	(dolist (filter (filters construct))
 	  (dolist (var-elem filter-variable-values)
+
+	    ;(format t "~a~%==>~a~%~%" (to-lisp-code var-elem filter)
+	    ;(eval (read-from-string (to-lisp-code var-elem filter)))) ;TODO: remove
+
 	    (when (eval (read-from-string (to-lisp-code var-elem filter)))
 	      (map 'list #'(lambda(list-elem)
 			     (push list-elem true-values))
 		   var-elem))))
+	;(format t "tv: -->~a<--~%" true-values) ;TODO: remove
 	(let ((values-to-remove
 	       (return-false-values filter-variable-values
 				    (remove-duplicates true-values
 						       :test #'variable-list=))))
+	  ;(format t "vr: -->~a<--~%" values-to-remove) ;TODO: remove
 	  (dolist (to-del values-to-remove)
 	    (delete-rows-by-value construct (getf to-del :variable-name)
 				  (getf to-del :variable-value))))))
@@ -415,8 +456,18 @@
 	  (local-results
 	   (cond ((eql what :subject) (subject-result construct))
 		 ((eql what :predicate) (predicate-result construct))
-		 ((eql what :object) (object-result construct))))
-	  (is-variable
+		 ((eql what :object)
+		  (if (object-datatype construct)
+		      (loop for idx to (1- (length (object-result construct)))
+			 when (elt (object-datatype construct) idx)
+			 collect (cast-literal
+				  (elt (object-result construct) idx)
+				  (elt (object-datatype construct) idx)
+				  :back-as-string-when-unsupported t)
+			 else
+			 collect (elt (object-result construct) idx))
+		      (object-result construct)))))
+	  (variable-p
 	   (cond ((eql what :subject)
 		  (and (variable-p (subject construct))
 		       (value (subject construct))))
@@ -426,7 +477,7 @@
 		 ((eql what :object)
 		  (and (variable-p (object construct))
 		       (value (object construct)))))))
-      (when is-variable
+      (when variable-p
 	(remove-null
 	 (dotimes (idx (length local-results))
 	   (when (literal= variable-value (elt local-results idx))

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Wed Apr  6 07:01:57 2011
@@ -2365,22 +2365,22 @@
 		 "SELECT * WHERE {
                    <http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
                    FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
-                   FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
-		   FILTER (?obj1 = 'von Goethe' || 82 = ?obj1)
-                   FILTER (?obj1 = 'von Goethe') || (82 = ?obj1)
-		   FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))"
-                 "
+                   #FILTER ?obj1 = 'von Goethe' || ?obj1 = '82'^^" *xml-integer* "
+		   #FILTER (?obj1 = 'von Goethe' || 82 = ?obj1)
+                   #FILTER (?obj1 = 'von Goethe') || (82 = ?obj1)
+		   #FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))"
+		 "
 }"))
 	   (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
 
 
-      (map 'list #'(lambda(triple)
-		     (format t "~a - ~a - ~a[~a]~%"
-			     (tm-sparql::subject-result triple)
-			     (tm-sparql::predicate-result triple)
-			     (tm-sparql::object-result triple)
-			     (tm-sparql::object-datatype triple)))
-	   (tm-sparql::select-group (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))
+      ;(map 'list #'(lambda(triple)
+      ;(format t "~a - ~a - ~a[~a]~%"
+      ;(tm-sparql::subject-result triple)
+      ;(tm-sparql::predicate-result triple)
+      ;(tm-sparql::object-result triple)
+      ;(tm-sparql::object-datatype triple)))
+      ;(tm-sparql::select-group (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))
 
 
 




More information about the Isidorus-cvs mailing list