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

[Lukas Giessmann]

Author: lgiessmann
Date: Thu Apr  7 07:23:13 2011
New Revision: 424

Log:
TM-SPARQL: fixed a bug with the FILTER function BOUND; fixed also a performance problem when using defvar in functions, so now defvar is replaced by let followed by a (declare (Special <vars>)) command

Modified:
   trunk/src/TM-SPARQL/sparql.lisp
   trunk/src/TM-SPARQL/sparql_filter.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	Thu Apr  7 07:23:13 2011
@@ -368,6 +368,38 @@
 				(elt (getf results :result) idx)))))))))
 
 
+;(defun to-lisp-code (variable-values filter)
+;  "Concatenates all variable names and elements with the filter expression
+;   in a let statement and returns a string representing the corresponding
+;   lisp code."
+;  (declare (List variable-values))
+;  (let ((result "")
+;	(cleanup-str ""))
+;    (dolist (var-elem variable-values)
+;      (push-string
+;       (concat "(defvar ?" (getf var-elem :variable-name) " "
+;	       (write-to-string (getf var-elem :variable-value)) ")")
+;       result)
+;      (push-string
+;       (concat "(defvar $" (getf var-elem :variable-name) " "
+;	       (write-to-string (getf var-elem :variable-value)) ")")
+;       result))
+;    (push-string "(let* ((true t)(false nil)" result)
+;    (push-string (concat "(result " filter "))") result)
+;    (push-string "(declare (Ignorable true false " result)
+;    (push-string "))" result)
+;    (dolist (var-elem variable-values)
+;      (push-string (concat "(makunbound '?" (getf var-elem :variable-name) ")")
+;		   cleanup-str)
+;      (push-string (concat "(makunbound '$" (getf var-elem :variable-name) ")")
+;		   cleanup-str))
+;    (push-string "(in-package :cl-user)" cleanup-str)
+;    (push-string cleanup-str result)
+;    (push-string "result)" result)
+;    (concat "(handler-case (progn " result ") (condition () (progn " cleanup-str
+;	    "nil)))")))
+
+
 (defun to-lisp-code (variable-values filter)
   "Concatenates all variable names and elements with the filter expression
    in a let statement and returns a string representing the corresponding
@@ -386,6 +418,12 @@
     (when variable-values
       (dolist (var-elem variable-values)
 	(push-string (concat "?" (getf var-elem :variable-name) " ") result)
+	(push-string (concat "$" (getf var-elem :variable-name) " ") result))
+      (push-string ")" result))
+    (when variable-values
+      (push-string "(Special " result)
+      (dolist (var-elem variable-values)
+	(push-string (concat "?" (getf var-elem :variable-name) " ") result)
 	(push-string (concat "$" (getf var-elem :variable-name) " ") result)))
     (push-string ")) result)" result)
     (concat "(handler-case " result " (condition () nil))")))

Modified: trunk/src/TM-SPARQL/sparql_filter.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_filter.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_filter.lisp	Thu Apr  7 07:23:13 2011
@@ -235,10 +235,14 @@
 			     (let* ((var-start
 				     (search-first (list "?" "$") cleaned-arg-list))
 				    (var-end
-				     (when var-start
-				       (search-first
-					(list ")")
-					(subseq cleaned-arg-list var-start)))))
+				     (let ((val
+					    (when var-start
+					      (search-first
+					       (list ")")
+					       (subseq cleaned-arg-list var-start)))))
+				       (if val
+					   val
+					   (length (subseq cleaned-arg-list var-start))))))
 			       (when (and var-start var-end)
 				 (concat (subseq cleaned-arg-list 0 var-start)
 					 "\"" (subseq cleaned-arg-list var-start

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Thu Apr  7 07:23:13 2011
@@ -2407,7 +2407,8 @@
                    <http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
                    FILTER isLITERAL(?obj1) && !isLITERAL(?pred1) && ?obj1 = 'von Goethe' || ?obj1 = 82
                    FILTER ?pred1 = $pred1 && $obj1 = $obj1 && ?pred1 != ?obj1
-		   FILTER ?obj1 >= 82 || ?obj1 = 'von Goethe'"
+		   FILTER ?obj1 >= 82 || ?obj1 = 'von Goethe'
+                   FILTER BOUND(?obj1) && !BOUND(?obj2) && BOUND(?pred1)"
 		 "}"))
 	   (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
       ;(is-true (= (length r-1) 2))