[isidorus-cvs] r362 - in trunk/src: TM-SPARQL base-tools unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Dec 14 21:07:50 UTC 2010
Author: lgiessmann
Date: Tue Dec 14 16:07:50 2010
New Revision: 362
Log:
TM-SPARQL: added some functions that separate a single filter-statement, handle bracketing, and handle unsupported functions
Modified:
trunk/src/TM-SPARQL/sparql_filter.lisp
trunk/src/TM-SPARQL/sparql_parser.lisp
trunk/src/base-tools/base-tools.lisp
trunk/src/unit_tests/sparql_test.lisp
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_filter.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_filter.lisp Tue Dec 14 16:07:50 2010
@@ -9,14 +9,42 @@
(in-package :TM-SPARQL)
-(defun parse-filter (query-string query-object)
- "A helper functions that returns a filter and the next-query string
- in the form (:next-query string :filter object)."
- (declare (String query-string)
- (SPARQL-Query query-object))
+
+(defparameter *supported-functions*
+ (list "BOUND" "isLITERAL" "STR" "DATATYPE" "REGEX")
+ "Contains all supported SPARQL-functions")
+
+
+(defparameter *supported-operators*
+ (list "!" "||" "&&" "=" "!=" "<" "<=" ">" ">=" "+" "-" "*" "/")
+ "Contains all supported operators, note some unary operators
+ are handled as functions, e.g. + and -")
+
+
+(defun make-sparql-parser-condition(rest-of-query entire-query expected)
+ "Creates a spqrql-parser-error object."
+ (declare (String rest-of-query entire-query expected))
+ (let ((message
+ (format nil "The query:~%\"~a\"~%~%has a bad token at position ~a => ~a.~%Expected: ~a"
+ entire-query (- (length entire-query)
+ (length rest-of-query))
+ (subseq entire-query (- (length entire-query)
+ (length rest-of-query)))
+ expected)))
+ (make-condition 'sparql-parser-error :message message)))
+
+
+(defgeneric parse-filter (construct query-string)
+ (:documentation "A helper functions that returns a filter and the next-query
+ string in the form (:next-query string :filter object).")
+ (:method ((construct SPARQL-Query) (query-string String))
+ (let* ((result-set-boundings (set-boundings construct query-string))
+ (filter-string (getf result-set-boundings :filter-string))
+ (next-query (getf result-set-boundings :next-query))
+ ))))
;;TODO: implement
- ;; *replace () by (progn )
- ;; *replace ', """, ''' by "
+ ;; **replace () by (progn )
+ ;; **replace ', """, ''' by '''
;; *replace !x by (not x)
;; *replace +x by (1+ x)
;; *replace -x by (1- x)
@@ -25,7 +53,147 @@
;; *replace function(x), function(x, y), function(x, y, z)
;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z)
;; *create and store this filter object
- )
+
+
+(defgeneric set-boundings (construct query-string)
+ (:documentation "Returns a list of the form (:next-query <string>
+ :filter-string <string>). next-query is a string containing
+ the query after the filter and filter is a string
+ containing the actual filter. Additionally all free
+ '(' are transformed into '(progn' and all ', ''', \"\"\"
+ are transformed into \".")
+ (:method ((construct SPARQL-Query) (query-string String))
+ (let ((filter-string "")
+ (open-brackets 0)
+ (result nil))
+ (dotimes (idx (length query-string))
+ (let ((current-char (subseq query-string idx (1+ idx))))
+ (cond ((string= "(" current-char)
+ (setf open-brackets (1+ open-brackets))
+ (if (progn-p query-string idx)
+ (push-string "(progn " filter-string)
+ (push-string current-char filter-string)))
+ ((string= ")" current-char)
+ (setf open-brackets (1- open-brackets))
+ (when (< open-brackets 0)
+ (make-sparql-parser-condition
+ (subseq query-string idx)
+ (original-query construct)
+ "an opening bracket \"(\" is missing for the current closing one"))
+ (push-string current-char filter-string))
+ ((or (string= "'" current-char)
+ (string= "\"" current-char))
+ (let ((result (get-literal (subseq query-string idx))))
+ (unless result
+ (make-sparql-parser-condition
+ (subseq query-string idx)
+ (original-query construct)
+ "a closing character for the given literal"))
+ (setf idx (- (1- (length query-string))
+ (length (getf result :next-query))))
+ (push-string (getf result :literal) filter-string)))
+ ((string= "#" current-char)
+ (let ((comment-string
+ (string-until (subseq query-string idx)
+ (string #\newline))))
+ (setf idx (+ idx (length comment-string)))))
+ ((and (string= current-char (string #\newline))
+ (= 0 open-brackets))
+ (setf result
+ (list :next-query (subseq query-string idx)
+ :filter-string filter-string))
+ (setf idx (1- (length query-string))))
+ ((string= current-char "}")
+ (when (/= open-brackets 0)
+ (make-sparql-parser-condition
+ (subseq query-string idx)
+ (original-query construct)
+ "a valid filter, but the filter is not complete"))
+ (setf result
+ (list :next-query (subseq query-string idx)
+ :filter-string filter-string)))
+ (t
+ (push-string current-char filter-string)))))
+ result)))
+
+
+(defun progn-p(query-string idx)
+ "Returns t if the ( at position idx in the filter string
+ represents a (progn) block."
+ (declare (String query-string)
+ (Integer idx))
+ (let* ((delimiters (append (list " " (string #\Space) (string #\Tab)
+ (string #\Newline) (string #\cr) "(" ")")
+ *supported-operators*))
+ (string-before (trim-whitespace-right (subseq query-string 0 idx)))
+ (fragment-before-idx
+ (search-first delimiters string-before :from-end t))
+ (fragment-before
+ (if (and (not fragment-before-idx)
+ (and (> (length string-before) 0)
+ (not (find string-before *supported-functions*
+ :test #'string=))))
+ (error (make-condition
+ 'SPARQL-PARSER-ERROR
+ :message (format nil "Invalid filter: \"~a\"~%"
+ query-string)))
+ (when fragment-before-idx
+ (let ((inner-value
+ (subseq string-before fragment-before-idx)))
+ (if (and (> (length inner-value) 1)
+ (string-starts-with inner-value "("))
+ (subseq inner-value 1)
+ inner-value))))))
+ (if fragment-before
+ (progn
+ (when (or (string-starts-with fragment-before "?")
+ (string-starts-with fragment-before "$"))
+ (error
+ (make-condition
+ 'SPARQL-PARSER-ERROR
+ :message (format nil "Invalid filter: found \"~a\" but expected ~a"
+ fragment-before *supported-functions*))))
+ (when (not (find fragment-before (append *supported-functions*
+ delimiters)
+ :test #'string=))
+ (error
+ (make-condition
+ 'SPARQL-PARSER-ERROR
+ :message
+ (format nil "Invalid character: ~a, expected characters: ~a"
+ fragment-before (append *supported-functions* delimiters)))))
+ (if (find fragment-before *supported-functions* :test #'string=)
+ nil
+ t))
+ (if (find string-before *supported-functions* :test #'string=)
+ nil
+ t))))
+
+
+(defun get-literal (query-string)
+ "Returns a list of the form (:next-query <string> :literal <string>
+ where next-query is the query after the found literal and literal
+ is the literal string."
+ (declare (String query-string))
+ (cond ((or (string-starts-with query-string "\"\"\"")
+ (string-starts-with query-string "'''"))
+ (let ((literal-end
+ (find-literal-end (subseq query-string 3) (subseq query-string 0 3))))
+ (when literal-end
+ (list :next-query (subseq query-string (+ 3 literal-end))
+ :literal (concatenate 'string "'''"
+ (subseq query-string 3 literal-end)
+ "'''")))))
+ ((or (string-starts-with query-string "\"")
+ (string-starts-with query-string "'"))
+ (let ((literal-end
+ (find-literal-end (subseq query-string 1)(subseq query-string 0 1))))
+ (when literal-end
+ (list :next-query (subseq query-string (+ 1 literal-end))
+ :literal (concatenate 'string "'''"
+ (subseq query-string 1 literal-end)
+ "'''")))))))
+
(defun find-literal-end (query-string delimiter &optional (overall-pos 0))
"Returns the end of the literal corresponding to the passed delimiter
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp Tue Dec 14 16:07:50 2010
@@ -9,19 +9,6 @@
(in-package :TM-SPARQL)
-(defun make-sparql-parser-condition(rest-of-query entire-query expected)
- "Creates a spqrql-parser-error object."
- (declare (String rest-of-query entire-query expected))
- (let ((message
- (format nil "The query:~%\"~a\"~%~%has a bad token at position ~a => ~a.~%Expected: ~a"
- entire-query (- (length entire-query)
- (length rest-of-query))
- (subseq entire-query (- (length entire-query)
- (length rest-of-query)))
- expected)))
- (make-condition 'sparql-parser-error :message message)))
-
-
(defun parse-closed-value(query-string query-object &key (open "<") (close ">"))
"A helper function that checks the value of a statement within
two brackets, i.e. <prefix-value>. A list of the
Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp (original)
+++ trunk/src/base-tools/base-tools.lisp Tue Dec 14 16:07:50 2010
@@ -150,16 +150,20 @@
nil)))
-(defun search-first (search-strings main-string)
+(defun search-first (search-strings main-string &key from-end)
"Returns the position of one of the search-strings. The returned position
is the one closest to 0. If no search-string is found, nil is returned."
(declare (String main-string)
- (List search-strings))
+ (List search-strings)
+ (Boolean from-end))
(let ((positions
- (remove-null (map 'list #'(lambda(search-str)
- (search search-str main-string))
- search-strings))))
- (let ((sorted-positions (sort positions #'<)))
+ (remove-null
+ (map 'list #'(lambda(search-str)
+ (search search-str main-string :from-end from-end))
+ search-strings))))
+ (let ((sorted-positions (if from-end
+ (sort positions #'>)
+ (sort positions #'<))))
(when sorted-positions
(first sorted-positions)))))
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp (original)
+++ trunk/src/unit_tests/sparql_test.lisp Tue Dec 14 16:07:50 2010
@@ -29,7 +29,8 @@
:test-set-result-3
:test-set-result-4
:test-set-result-5
- :test-result))
+ :test-result
+ :test-set-boundings))
(in-package :sparql-test)
@@ -1038,6 +1039,29 @@
(getf (first (result q-obj-2)) :result) :test #'string=)))))))))
+(test test-set-boundings
+ "Tests various cases of the function set-boundings"
+ (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " "))
+ (str-1 "BOUND(( (?var) )) || (isLITERAL($var) && ?var = 'abc')}")
+ (result-1 (tm-sparql::set-boundings dummy-object str-1))
+ (str-2
+ "(REGEX(?var1, '''''', ?var3) || (?var1 > ?var3 && (STR( ?var) = \"abc\")))}")
+ (result-2 (tm-sparql::set-boundings dummy-object str-2))
+ (str-3
+ "DATATYPE(?var3) || +?var1 = -?var2
+ ?var1 ?var2 ?var3}")
+ (result-3 (tm-sparql::set-boundings dummy-object str-3)))
+ (is-true result-1)
+ (is-true result-2)
+ (is (string= (getf result-1 :filter-string)
+ "BOUND((progn (progn ?var) )) || (progn isLITERAL($var) && ?var = '''abc''')"))
+ (is (string= (getf result-1 :next-query) "}"))
+ (is (string= (getf result-2 :filter-string)
+ "(progn REGEX(?var1, '''''', ?var3) || (progn ?var1 > ?var3 && (progn STR( ?var) = '''abc''')))"))
+ (is (string= (getf result-2 :next-query) "}"))
+ (is (string= (getf result-3 :filter-string)
+ "DATATYPE(?var3) || +?var1 = -?var2"))
+ (is (string= (getf result-3 :next-query) (subseq str-3 34)))))
(defun run-sparql-tests ()
More information about the Isidorus-cvs
mailing list