Author: lgiessmann Date: Tue Dec 14 11:01:38 2010 New Revision: 361
Log: TM-SPARQL: changed some function in the sparql-parser into mehtods=>SPARQL-Query; created the structure for the filter parser
Added: trunk/src/TM-SPARQL/sparql_filter.lisp Modified: trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/isidorus.asd trunk/src/unit_tests/sparql_test.lisp
Added: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- (empty file) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Tue Dec 14 11:01:38 2010 @@ -0,0 +1,45 @@ +;;+----------------------------------------------------------------------------- +;;+ Isidorus +;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff +;;+ +;;+ Isidorus is freely distributable under the LLGPL license. +;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and +;;+ trunk/docs/LGPL-LICENSE.txt. +;;+----------------------------------------------------------------------------- + +(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)) + ;;TODO: implement + ;; *replace () by (progn ) + ;; *replace ', """, ''' by " + ;; *replace !x by (not x) + ;; *replace +x by (1+ x) + ;; *replace -x by (1- x) + ;; *replace x operator y by (filter-operator x y) + ;; *=, !=, <, >, <=, >=, +, -, *, /, ||, && + ;; *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 + ) + +(defun find-literal-end (query-string delimiter &optional (overall-pos 0)) + "Returns the end of the literal corresponding to the passed delimiter + string. The query-string must start after the opening literal delimiter. + The return value is an int that represents the start index of closing + delimiter. delimiter must be either ", ', or '''. + If the returns value is nil, there is no closing delimiter." + (declare (String query-string delimiter) + (Integer overall-pos)) + (let ((current-pos (search delimiter query-string))) + (if current-pos + (if (string-ends-with (subseq query-string 0 current-pos) "\") + (find-literal-end (subseq query-string (+ current-pos + (length delimiter))) + delimiter (+ overall-pos current-pos 1)) + (+ overall-pos current-pos (length delimiter))) + nil))) \ No newline at end of file
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 11:01:38 2010 @@ -70,7 +70,7 @@ (parse-base construct (string-after trimmed-query-string "BASE") #'parser-start)) ((= (length trimmed-query-string) 0) - ;; If there is only a BASE and/or PREFIX statement return an + ;; If there is only a BASE and/or PREFIX statement return a ;; query-object with the result nil construct) (t @@ -128,7 +128,7 @@ trimmed-str (original-query construct) "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "FILTER") - nil) ;TODO: parse-filter and store it in construct => extend class + (parse-filter (string-after trimmed-str "FILTER") construct)) ((string-starts-with trimmed-str "OPTIONAL") (error (make-sparql-parser-condition trimmed-str (original-query construct) @@ -144,100 +144,89 @@ (parse-triple construct trimmed-str :last-subject last-subject))))))
-(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)." - ;; !, +, -, *, /, (, ), &&, ||, =, !=, <, >, >=, <=, REGEX(string, pattern) - (declare (String query-string) - (SPARQL-Query query-object)) - ;;TODO: implement - ) - - -(defun parse-triple-elem (query-string query-object &key (literal-allowed nil)) - "A helper function to parse a subject or predicate of an RDF triple." - (declare (String query-string) - (SPARQL-Query query-object) - (Boolean literal-allowed)) - (let ((trimmed-str (cut-comment query-string))) - (cond ((string-starts-with trimmed-str "a ") ;;rdf:type - (list :next-query (cut-comment (subseq trimmed-str 1)) - :value (make-instance 'SPARQL-Triple-Elem - :elem-type 'IRI - :value *type-psi*))) - ((string-starts-with trimmed-str "<") - (parse-base-suffix-pair trimmed-str query-object)) - ((or (string-starts-with trimmed-str "?") - (string-starts-with trimmed-str "$")) - (let ((result - (parse-variable-name trimmed-str query-object - :additional-delimiters (list "}")))) - (list :next-query (cut-comment (getf result :next-query)) +(defgeneric parse-triple-elem (construct query-string &key literal-allowed) + (:documentation "A helper function to parse a subject or predicate of an RDF triple.") + (:method ((construct SPARQL-Query) (query-string String) + &key (literal-allowed nil)) + (declare (Boolean literal-allowed)) + (let ((trimmed-str (cut-comment query-string))) + (cond ((string-starts-with trimmed-str "a ") ;;rdf:type + (list :next-query (cut-comment (subseq trimmed-str 1)) :value (make-instance 'SPARQL-Triple-Elem - :elem-type 'VARIABLE - :value (getf result :value))))) - (t - (if (or (string-starts-with-digit trimmed-str) - (string-starts-with trimmed-str """) - (string-starts-with trimmed-str "true") - (string-starts-with trimmed-str "false") - (string-starts-with trimmed-str "'")) - (progn - (unless literal-allowed - (error (make-sparql-parser-condition - trimmed-str (original-query query-object) - "an IRI of the form prefix:suffix or <iri> but found a literal."))) - (parse-literal-elem trimmed-str query-object)) - (parse-prefix-suffix-pair trimmed-str query-object)))))) - - -(defun parse-literal-elem (query-string query-object) - "A helper-function that returns a literal vaue of the form - (:value (:value object :literal-type string :literal-lang - string :type <'LITERAL>) :next-query string)." - (declare (String query-string) - (SPARQL-Query query-object)) - (let* ((trimmed-str (cut-comment query-string)) - (value-type-lang-query - (cond ((or (string-starts-with trimmed-str """) + :elem-type 'IRI + :value *type-psi*))) + ((string-starts-with trimmed-str "<") + (parse-base-suffix-pair construct trimmed-str)) + ((or (string-starts-with trimmed-str "?") + (string-starts-with trimmed-str "$")) + (let ((result + (parse-variable-name construct trimmed-str + :additional-delimiters (list "}")))) + (list :next-query (cut-comment (getf result :next-query)) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'VARIABLE + :value (getf result :value))))) + (t + (if (or (string-starts-with-digit trimmed-str) + (string-starts-with trimmed-str """) + (string-starts-with trimmed-str "true") + (string-starts-with trimmed-str "false") (string-starts-with trimmed-str "'")) - (parse-literal-string-value trimmed-str query-object)) - ((string-starts-with trimmed-str "true") - (list :value t :type *xml-boolean* - :next-query (subseq trimmed-str (length "true")))) - ((string-starts-with trimmed-str "false") - (list :value nil :type *xml-boolean* - :next-query (subseq trimmed-str (length "false")))) - ((string-starts-with-digit trimmed-str) - (parse-literal-number-value trimmed-str query-object))))) - (list :next-query (getf value-type-lang-query :next-query) - :value (make-instance - 'SPARQL-Triple-Elem - :elem-type 'LITERAL - :value (getf value-type-lang-query :value) - :literal-lang (getf value-type-lang-query :lang) - :literal-datatype (getf value-type-lang-query :type))))) - - -(defun parse-literal-string-value (query-string query-object) - "A helper function that parses a string that is a literal. - The return value is of the form - (list :value object :type string :lang string :next-query string)." - (declare (String query-string) - (SPARQL-Query query-object)) - (let* ((trimmed-str (cut-comment query-string)) - (result-1 (separate-literal-value trimmed-str query-object)) - (after-literal-value (getf result-1 :next-query)) - (l-value (getf result-1 :literal)) - (result-2 (separate-literal-lang-or-type - after-literal-value query-object)) - (l-type (if (getf result-2 :type) - (getf result-2 :type) - *xml-string*)) - (l-lang (getf result-2 :lang)) - (next-query (getf result-2 :next-query))) - (list :next-query next-query :lang l-lang :type l-type - :value (cast-literal l-value l-type)))) + (progn + (unless literal-allowed + (error (make-sparql-parser-condition + trimmed-str (original-query construct) + "an IRI of the form prefix:suffix or <iri> but found a literal."))) + (parse-literal-elem construct trimmed-str)) + (parse-prefix-suffix-pair construct trimmed-str))))))) + + +(defgeneric parse-literal-elem (construct query-string) + (:documentation "A helper-function that returns a literal vaue of the form + (:value (:value object :literal-type string :literal-lang + string :type <'LITERAL>) :next-query string).") + (:method ((construct SPARQL-Query) (query-string String)) + (let* ((trimmed-str (cut-comment query-string)) + (value-type-lang-query + (cond ((or (string-starts-with trimmed-str """) + (string-starts-with trimmed-str "'")) + (parse-literal-string-value construct trimmed-str)) + ((string-starts-with trimmed-str "true") + (list :value t :type *xml-boolean* + :next-query (subseq trimmed-str (length "true")))) + ((string-starts-with trimmed-str "false") + (list :value nil :type *xml-boolean* + :next-query (subseq trimmed-str (length "false")))) + ((string-starts-with-digit trimmed-str) + (parse-literal-number-value construct trimmed-str))))) + (list :next-query (getf value-type-lang-query :next-query) + :value (make-instance + 'SPARQL-Triple-Elem + :elem-type 'LITERAL + :value (getf value-type-lang-query :value) + :literal-lang (getf value-type-lang-query :lang) + :literal-datatype (getf value-type-lang-query :type)))))) + + +(defgeneric parse-literal-string-value (construct query-string) + (:documentation "A helper function that parses a string that is a literal. + The return value is of the form + (list :value object :type string :lang string + :next-query string).") + (:method ((construct SPARQL-Query) (query-string String)) + (let* ((trimmed-str (cut-comment query-string)) + (result-1 (separate-literal-value construct trimmed-str)) + (after-literal-value (getf result-1 :next-query)) + (l-value (getf result-1 :literal)) + (result-2 (separate-literal-lang-or-type + construct after-literal-value)) + (l-type (if (getf result-2 :type) + (getf result-2 :type) + *xml-string*)) + (l-lang (getf result-2 :lang)) + (next-query (getf result-2 :next-query))) + (list :next-query next-query :lang l-lang :type l-type + :value (cast-literal l-value l-type)))))
(defun cast-literal (literal-value literal-type) @@ -278,171 +267,150 @@ (write-to-string literal-value)))))
-(defun separate-literal-lang-or-type (query-string query-object) - "A helper function that returns (:next-query string :lang string - :type string). Only one of :lang and :type can be set, the other - element is set to nil. The query string must be the string direct - after the closing literal bounding." - (declare (String query-string) - (SPARQL-Query query-object)) - (let ((delimiters-1 (list "." ";" "}" " " (string #\tab) - (string #\newline))) - (delimiters-2 (list " ." ". " ";" "}" " " (string #\tab) - (string #\newline) - (concatenate 'string "." (string #\newline)) - (concatenate 'string "." (string #\tab))))) - (cond ((string-starts-with query-string "@") - (let ((end-pos (search-first delimiters-1 - (subseq query-string 1)))) - (unless end-pos - (error (make-sparql-parser-condition - query-string (original-query query-object) - "'.', ';', '}', ' ', '\t', or '\n'"))) - (list :next-query (subseq (subseq query-string 1) end-pos) - :lang (subseq (subseq query-string 1) 0 end-pos) - :type nil))) - ((string-starts-with query-string "^^") - (let ((end-pos (search-first delimiters-2 (subseq query-string 2)))) - (unless end-pos - (error (make-sparql-parser-condition - query-string (original-query query-object) - "'. ', ,' .', ';', '}', ' ', '\t', or '\n'"))) - (let* ((type-str (subseq (subseq query-string 2) 0 end-pos)) - (next-query (subseq (subseq query-string 2) end-pos)) - (final-type (if (get-prefix query-object type-str) - (get-prefix query-object type-str) - type-str))) - (list :next-query (cut-comment next-query) - :type final-type :lang nil)))) - (t - (list :next-query (cut-comment query-string) :type nil :lang nil))))) - - -(defun separate-literal-value (query-string query-object) - "A helper function that returns (:next-query string :literal string). - The literal string contains the pure literal value." - (declare (String query-string) - (SPARQL-Query query-object)) - (let* ((trimmed-str (cut-comment query-string)) - (delimiter (cond ((string-starts-with trimmed-str """) - """) - ((string-starts-with trimmed-str "'''") - "'''") - ((string-starts-with trimmed-str "'") - "'") - (t - (error (make-sparql-parser-condition - trimmed-str (original-query query-object) - "a literal starting with ', ''', or ""))))) - (literal-end (find-literal-end (subseq trimmed-str (length delimiter)) - delimiter 0))) - (list :next-query (subseq trimmed-str (+ literal-end (length delimiter))) - :literal (subseq trimmed-str (length delimiter) literal-end)))) - - -(defun find-literal-end (query-string delimiter &optional (overall-pos 0)) - "Returns the end of the literal corresponding to the passed delimiter - string. The query-string must start after the opening literal delimiter. - The return value is an int that represents the start index of closing - delimiter. delimiter must be either ", ', or '''. - If the returns value is nil, there is no closing delimiter." - (declare (String query-string delimiter) - (Integer overall-pos)) - (let ((current-pos (search delimiter query-string))) - (if current-pos - (if (string-ends-with (subseq query-string 0 current-pos) "\") - (find-literal-end (subseq query-string (+ current-pos - (length delimiter))) - delimiter (+ overall-pos current-pos 1)) - (+ overall-pos current-pos (length delimiter))) - nil))) - - -(defun parse-literal-number-value (query-string query-object) - "A helper function that parses any number that is a literal. - The return value is of the form - (list :value nil :type string :next-query string." - (declare (String query-string) - (SPARQL-Query query-object)) - (let* ((trimmed-str (cut-comment query-string)) - (triple-delimiters - (list ". " ";" " " (string #\tab) - (string #\newline) "}")) - (end-pos (search-first triple-delimiters - trimmed-str))) - (unless end-pos - (error (make-sparql-parser-condition - trimmed-str (original-query query-object) - "'. ', , ';' ' ', '\t', '\n' or '}'"))) - (let* ((literal-number - (read-from-string (subseq trimmed-str 0 end-pos))) - (number-type - (if (search "." (subseq trimmed-str 0 end-pos)) - *xml-double* ;could also be an xml:decimal, since the doucble has - ;a bigger range it shouldn't matter - *xml-integer*))) - (unless (numberp literal-number) +(defgeneric separate-literal-lang-or-type (construct query-string) + (:documentation "A helper function that returns (:next-query string + :lang string :type string). Only one of :lang and + :type can be set, the other element is set to nil. + The query string must be the string direct after + the closing literal bounding.") + (:method ((construct SPARQL-Query) (query-string String)) + (let ((delimiters-1 (list "." ";" "}" " " (string #\tab) + (string #\newline))) + (delimiters-2 (list " ." ". " ";" "}" " " (string #\tab) + (string #\newline) + (concatenate 'string "." (string #\newline)) + (concatenate 'string "." (string #\tab))))) + (cond ((string-starts-with query-string "@") + (let ((end-pos (search-first delimiters-1 + (subseq query-string 1)))) + (unless end-pos + (error (make-sparql-parser-condition + query-string (original-query construct) + "'.', ';', '}', ' ', '\t', or '\n'"))) + (list :next-query (subseq (subseq query-string 1) end-pos) + :lang (subseq (subseq query-string 1) 0 end-pos) + :type nil))) + ((string-starts-with query-string "^^") + (let ((end-pos (search-first delimiters-2 (subseq query-string 2)))) + (unless end-pos + (error (make-sparql-parser-condition + query-string (original-query construct) + "'. ', ,' .', ';', '}', ' ', '\t', or '\n'"))) + (let* ((type-str (subseq (subseq query-string 2) 0 end-pos)) + (next-query (subseq (subseq query-string 2) end-pos)) + (final-type (if (get-prefix construct type-str) + (get-prefix construct type-str) + type-str))) + (list :next-query (cut-comment next-query) + :type final-type :lang nil)))) + (t + (list :next-query (cut-comment query-string) :type nil :lang nil)))))) + + +(defgeneric separate-literal-value (construct query-string) + (:documentation "A helper function that returns (:next-query string + :literal string). The literal string contains the + pure literal value.") + (:method ((construct SPARQL-Query) (query-string String)) + (let* ((trimmed-str (cut-comment query-string)) + (delimiter (cond ((string-starts-with trimmed-str """) + """) + ((string-starts-with trimmed-str "'''") + "'''") + ((string-starts-with trimmed-str "'") + "'") + (t + (error (make-sparql-parser-condition + trimmed-str (original-query construct) + "a literal starting with ', ''', or ""))))) + (literal-end (find-literal-end (subseq trimmed-str (length delimiter)) + delimiter 0))) + (list :next-query (subseq trimmed-str (+ literal-end (length delimiter))) + :literal (subseq trimmed-str (length delimiter) literal-end))))) + + +(defgeneric parse-literal-number-value (construct query-string) + (:documentation "A helper function that parses any number that is a literal. + The return value is of the form + (list :value nil :type string :next-query string.") + (:method ((construct SPARQL-Query) (query-string String)) + (let* ((trimmed-str (cut-comment query-string)) + (triple-delimiters + (list ". " ";" " " (string #\tab) + (string #\newline) "}")) + (end-pos (search-first triple-delimiters + trimmed-str))) + (unless end-pos (error (make-sparql-parser-condition - trimmed-str (original-query query-object) - "a valid number of the form '1', '1.3', 1.0e6'"))) - (list :value literal-number :type number-type - :next-query (subseq trimmed-str end-pos))))) - - -(defun parse-base-suffix-pair (query-string query-object) - "A helper function that returns a list of the form - (list :next-query string :value (:value uri :type 'IRI))." - (declare (String query-string) - (SPARQL-Query query-object)) - (let* ((trimmed-str (cut-comment query-string)) - (result (parse-closed-value trimmed-str query-object)) - (result-uri - (if (or (absolute-uri-p (getf result :value)) - (not (base-value query-object))) - (getf result :value) - (concatenate-uri (base-value query-object) - (getf result :value)))) - (next-query (getf result :next-query))) - (list :next-query (cut-comment next-query) - :value (make-instance 'SPARQL-Triple-Elem - :elem-type 'IRI - :value result-uri)))) - - -(defun parse-prefix-suffix-pair(query-string query-object) - "A helper function that returns a list of the form - (list :next-query string :value (:value uri :type 'IRI))." - (declare (String query-string) - (SPARQL-Query query-object)) - (let* ((trimmed-str (cut-comment query-string)) - (delimiters (list "." ";" "}" "<" " " (string #\newline) - (string #\tab) "#")) - (end-pos (search-first delimiters trimmed-str)) - (elem-str (when end-pos - (subseq trimmed-str 0 end-pos))) - (prefix (when elem-str - (string-until elem-str ":"))) - (suffix (when prefix - (string-after elem-str ":"))) - (full-url - (when (and suffix prefix) - (get-prefix query-object (concatenate 'string prefix ":" suffix))))) - (unless (and end-pos prefix suffix) - (error (make-sparql-parser-condition - trimmed-str (original-query query-object) - "An IRI of the form prefix:suffix"))) - (unless full-url - (error (make-condition - 'sparql-parser-error - :message (format nil "The prefix in "~a:~a" is not registered" - prefix suffix)))) - (list :next-query (cut-comment - (string-after - trimmed-str - (concatenate 'string prefix ":" suffix))) - :value (make-instance 'SPARQL-Triple-Elem - :elem-type 'IRI - :value full-url)))) + trimmed-str (original-query construct) + "'. ', , ';' ' ', '\t', '\n' or '}'"))) + (let* ((literal-number + (read-from-string (subseq trimmed-str 0 end-pos))) + (number-type + (if (search "." (subseq trimmed-str 0 end-pos)) + *xml-double* ;could also be an xml:decimal, since the doucble has + ;a bigger range it shouldn't matter + *xml-integer*))) + (unless (numberp literal-number) + (error (make-sparql-parser-condition + trimmed-str (original-query construct) + "a valid number of the form '1', '1.3', 1.0e6'"))) + (list :value literal-number :type number-type + :next-query (subseq trimmed-str end-pos)))))) + + +(defgeneric parse-base-suffix-pair (construct query-string) + (:documentation "A helper function that returns a list of the form + (list :next-query string :value (:value uri :type 'IRI)).") + (:method ((construct SPARQL-Query) (query-string String)) + (let* ((trimmed-str (cut-comment query-string)) + (result (parse-closed-value trimmed-str construct)) + (result-uri + (if (or (absolute-uri-p (getf result :value)) + (not (base-value construct))) + (getf result :value) + (concatenate-uri (base-value construct) + (getf result :value)))) + (next-query (getf result :next-query))) + (list :next-query (cut-comment next-query) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value result-uri))))) + + +(defgeneric parse-prefix-suffix-pair(construct query-string) + (:documentation "A helper function that returns a list of the form + (list :next-query string :value (:value uri :type 'IRI)).") + (:method ((construct SPARQL-Query) (query-string String)) + (let* ((trimmed-str (cut-comment query-string)) + (delimiters (list "." ";" "}" "<" " " (string #\newline) + (string #\tab) "#")) + (end-pos (search-first delimiters trimmed-str)) + (elem-str (when end-pos + (subseq trimmed-str 0 end-pos))) + (prefix (when elem-str + (string-until elem-str ":"))) + (suffix (when prefix + (string-after elem-str ":"))) + (full-url + (when (and suffix prefix) + (get-prefix construct (concatenate 'string prefix ":" suffix))))) + (unless (and end-pos prefix suffix) + (error (make-sparql-parser-condition + trimmed-str (original-query construct) + "An IRI of the form prefix:suffix"))) + (unless full-url + (error (make-condition + 'sparql-parser-error + :message (format nil "The prefix in "~a:~a" is not registered" + prefix suffix)))) + (list :next-query (cut-comment + (string-after + trimmed-str + (concatenate 'string prefix ":" suffix))) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value full-url)))))
(defgeneric parse-triple (construct query-string &key last-subject) @@ -452,14 +420,15 @@ (let* ((trimmed-str (cut-comment query-string)) (subject-result (if last-subject ;;is used after a ";" last-subject - (parse-triple-elem trimmed-str construct))) + (parse-triple-elem construct trimmed-str))) (predicate-result (parse-triple-elem + construct (if last-subject trimmed-str - (getf subject-result :next-query)) - construct)) - (object-result (parse-triple-elem (getf predicate-result :next-query) - construct :literal-allowed t))) + (getf subject-result :next-query)))) + (object-result (parse-triple-elem construct + (getf predicate-result :next-query) + :literal-allowed t))) (add-triple construct (make-instance 'SPARQL-Triple :subject (if last-subject @@ -487,42 +456,42 @@ (if (string-starts-with trimmed-str "*") (progn (add-variable construct "*") (parse-variables construct (string-after trimmed-str "*"))) - (let ((result (parse-variable-name trimmed-str construct))) + (let ((result (parse-variable-name construct trimmed-str))) (add-variable construct (getf result :value)) (parse-variables construct (getf result :next-query))))))))
-(defun parse-variable-name (query-string query-object &key additional-delimiters) - "A helper function that parses the first non-whitespace character - in the query. since it must be a variable, it must be prefixed - by a ? or $. The return value is of the form - (:next-query string :value string)." - (declare (String query-string) - (SPARQL-Query query-object) - (List additional-delimiters)) - (let ((trimmed-str (cut-comment query-string)) - (delimiters (append - (list " " "?" "$" "." (string #\newline) (string #\tab)) - additional-delimiters))) - (unless (or (string-starts-with trimmed-str "?") - (string-starts-with trimmed-str "$")) - (error (make-sparql-parser-condition - trimmed-str (original-query query-object) "? or $"))) - (let* ((var-name-end (search-first delimiters (subseq trimmed-str 1))) - (var-name - (if var-name-end - (subseq trimmed-str 0 (+ 1 var-name-end)) - (error (make-sparql-parser-condition - trimmed-str (original-query query-object) - "space, newline, tab, ?, ., $ or WHERE")))) - (next-query (string-after trimmed-str var-name)) - (normalized-var-name - (if (<= (length var-name) 1) - (error (make-sparql-parser-condition - next-query (original-query query-object) - "a variable name")) - (subseq var-name 1)))) - (list :next-query next-query :value normalized-var-name)))) +(defgeneric parse-variable-name (construct query-string &key additional-delimiters) + (:documentation "A helper function that parses the first non-whitespace character + in the query. since it must be a variable, it must be prefixed + by a ? or $. The return value is of the form + (:next-query string :value string).") + (:method ((construct SPARQL-Query) (query-string String) + &key (additional-delimiters)) + (declare (List additional-delimiters)) + (let ((trimmed-str (cut-comment query-string)) + (delimiters (append + (list " " "?" "$" "." (string #\newline) (string #\tab)) + additional-delimiters))) + (unless (or (string-starts-with trimmed-str "?") + (string-starts-with trimmed-str "$")) + (error (make-sparql-parser-condition + trimmed-str (original-query construct) "? or $"))) + (let* ((var-name-end (search-first delimiters (subseq trimmed-str 1))) + (var-name + (if var-name-end + (subseq trimmed-str 0 (+ 1 var-name-end)) + (error (make-sparql-parser-condition + trimmed-str (original-query construct) + "space, newline, tab, ?, ., $ or WHERE")))) + (next-query (string-after trimmed-str var-name)) + (normalized-var-name + (if (<= (length var-name) 1) + (error (make-sparql-parser-condition + next-query (original-query construct) + "a variable name")) + (subseq var-name 1)))) + (list :next-query next-query :value normalized-var-name)))))
(defgeneric parse-base (construct query-string next-fun)
Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Tue Dec 14 11:01:38 2010 @@ -42,8 +42,10 @@ :depends-on ("constants" "base-tools")) (:module "TM-SPARQL" :components ((:file "sparql") + (:file "sparql_filter" + :depends-on ("sparql")) (:file "sparql_parser" - :depends-on ("sparql"))) + :depends-on ("sparql" "sparql_filter"))) :depends-on ("constants" "base-tools" "model")) (:module "xml" :components ((:module "xtm"
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 11:01:38 2010 @@ -169,7 +169,7 @@ (query-9 (concatenate 'string ""13e4"^^" *xml-boolean* " .")) (dummy-object (make-instance 'SPARQL-Query :query ""))) (is-true dummy-object) - (let ((res (tm-sparql::parse-literal-elem query-1 dummy-object))) + (let ((res (tm-sparql::parse-literal-elem dummy-object query-1))) (is (string= (getf res :next-query) ".")) (is (string= (tm-sparql::value (getf res :value)) "literal-value")) @@ -178,35 +178,35 @@ (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-string*)) (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) - (let ((res (tm-sparql::parse-literal-elem query-2 dummy-object))) + (let ((res (tm-sparql::parse-literal-elem dummy-object query-2))) (is (string= (getf res :next-query) ".")) (is (eql (tm-sparql::value (getf res :value)) t)) (is-false (tm-sparql::literal-lang (getf res :value))) (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-boolean*)) (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) - (let ((res (tm-sparql::parse-literal-elem query-3 dummy-object))) + (let ((res (tm-sparql::parse-literal-elem dummy-object query-3))) (is (string= (getf res :next-query) "}")) (is (eql (tm-sparql::value (getf res :value)) nil)) (is-false (tm-sparql::literal-lang (getf res :value))) (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-boolean*)) (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) - (let ((res (tm-sparql::parse-literal-elem query-4 dummy-object))) + (let ((res (tm-sparql::parse-literal-elem dummy-object query-4))) (is (string= (getf res :next-query) (string #\tab))) (is (= (tm-sparql::value (getf res :value)) 1234.43e10)) (is-false (tm-sparql::literal-lang (getf res :value))) (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-double*)) (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) - (let ((res (tm-sparql::parse-literal-elem query-5 dummy-object))) + (let ((res (tm-sparql::parse-literal-elem dummy-object query-5))) (is (string= (getf res :next-query) ";")) (is (eql (tm-sparql::value (getf res :value)) t)) (is-false (tm-sparql::literal-lang (getf res :value))) (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-boolean*)) (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) - (let ((res (tm-sparql::parse-literal-elem query-6 dummy-object))) + (let ((res (tm-sparql::parse-literal-elem dummy-object query-6))) (is (string= (getf res :next-query) (concatenate 'string "." (string #\newline)))) (is (eql (tm-sparql::value (getf res :value)) 123.4)) @@ -214,7 +214,7 @@ (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-double*)) (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) - (let ((res (tm-sparql::parse-literal-elem query-7 dummy-object))) + (let ((res (tm-sparql::parse-literal-elem dummy-object query-7))) (is (string= (getf res :next-query) ".")) (is (string= (tm-sparql::value (getf res :value)) "Just a test @@ -225,9 +225,9 @@ *xml-string*)) (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) (signals sparql-parser-error - (tm-sparql::parse-literal-elem query-8 dummy-object)) + (tm-sparql::parse-literal-elem dummy-object query-8)) (signals sparql-parser-error - (tm-sparql::parse-literal-elem query-9 dummy-object)))) + (tm-sparql::parse-literal-elem dummy-object query-9))))
(test test-parse-triple-elem @@ -245,40 +245,40 @@ (var 'TM-SPARQL::VARIABLE) (iri 'TM-SPARQL::IRI)) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value") - (let ((res (tm-sparql::parse-triple-elem query-1 dummy-object))) + (let ((res (tm-sparql::parse-triple-elem dummy-object query-1))) (is (string= (getf res :next-query) ".")) (is (string= (tm-sparql::value (getf res :value)) "var1")) (is (eql (tm-sparql::elem-type (getf res :value)) var))) - (let ((res (tm-sparql::parse-triple-elem query-2 dummy-object))) + (let ((res (tm-sparql::parse-triple-elem dummy-object query-2))) (is (string= (getf res :next-query) ";")) (is (string= (tm-sparql::value (getf res :value)) "var2")) (is (eql (tm-sparql::elem-type (getf res :value)) var))) - (let ((res (tm-sparql::parse-triple-elem query-3 dummy-object))) + (let ((res (tm-sparql::parse-triple-elem dummy-object query-3))) (is (string= (getf res :next-query) "}")) (is (string= (tm-sparql::value (getf res :value)) "var3")) (is (eql (tm-sparql::elem-type (getf res :value)) var))) - (let ((res (tm-sparql::parse-triple-elem query-4 dummy-object))) + (let ((res (tm-sparql::parse-triple-elem dummy-object query-4))) (is (string= (getf res :next-query) ".")) (is (string= (tm-sparql::value (getf res :value)) "http://full.url")) (is (eql (tm-sparql::elem-type (getf res :value)) iri))) - (let ((res (tm-sparql::parse-triple-elem query-5 dummy-object))) + (let ((res (tm-sparql::parse-triple-elem dummy-object query-5))) (is (string= (getf res :next-query) "}")) (is (string= (tm-sparql::value (getf res :value)) "http://base.value/url-suffix")) (is (eql (tm-sparql::elem-type (getf res :value)) iri))) - (let ((res (tm-sparql::parse-triple-elem query-6 dummy-object))) + (let ((res (tm-sparql::parse-triple-elem dummy-object query-6))) (is (string= (getf res :next-query) ".")) (is (string= (tm-sparql::value (getf res :value)) "http://prefix.value/suffix")) (is (eql (tm-sparql::elem-type (getf res :value)) iri))) - (let ((res (tm-sparql::parse-triple-elem query-7 dummy-object))) + (let ((res (tm-sparql::parse-triple-elem dummy-object query-7))) (is (string= (getf res :next-query) "}")) (is (string= (tm-sparql::value (getf res :value)) "http://prefix.value/suffix")) (is (eql (tm-sparql::elem-type (getf res :value)) iri))) (signals sparql-parser-error - (tm-sparql::parse-triple-elem query-8 dummy-object)))) + (tm-sparql::parse-triple-elem dummy-object query-8))))
(test test-parse-group-1