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))