Author: lgiessmann Date: Wed Dec 15 08:15:40 2010 New Revision: 364
Log: TM-SPARQL: added the evaluation of the unary-operators: !, +, -
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp trunk/src/base-tools/base-tools.lisp
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Wed Dec 15 08:15:40 2010 @@ -45,13 +45,15 @@ (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)) + (filter-string-unary-ops (set-unary-operators construct filter-string)) )))) ;;TODO: implement + ;; *replace #comment => in set boundings ;; **replace () by (progn ) ;; **replace ', """, ''' by ''' - ;; *replace !x by (not x) - ;; *replace +x by (1+ x) - ;; *replace -x by (1- x) + ;; **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) @@ -59,6 +61,171 @@ ;; *create and store this filter object
+(defgeneric set-unary-operators (construct filter-string) + (:documentation "Transforms the unary operators !, +, - to (not ), + (1+ ) and (1- ). The return value is a modified filter + string.") + (:method ((construct SPARQL-Query) (filter-string String)) + (let ((result-string "")) + (dotimes (idx (length filter-string)) + (let ((current-char (subseq filter-string idx (1+ idx)))) + (cond ((string= current-char "!") + (if (and (< idx (1- (length filter-string))) + (string= (subseq filter-string (1+ idx) (+ 2 idx)) "=")) + (push-string current-char result-string) + (let ((result (unary-operator-scope filter-string idx))) + (push-string "(not " result-string) + (push-string (set-unary-operators construct (getf result :scope)) + result-string) + (push-string ")" result-string) + (setf idx (- (1- (length filter-string)) + (length (getf result :next-query))))))) + ((or (string= current-char "-") + (string= current-char "+")) + (let ((string-before + (trim-whitespace-right (subseq filter-string 0 idx)))) + (if (or (string= string-before "") + (string-ends-with string-before "(progn") + (string-ends-with-one-of string-before + *supported-operators*)) + (let ((result (unary-operator-scope filter-string idx))) + (push-string (concatenate 'string "(1" current-char " ") + result-string) + (push-string (set-unary-operators construct + (getf result :scope)) + result-string) + (push-string ")" result-string) + (setf idx (- (1- (length filter-string)) + (length (getf result :next-query))))) + (push-string current-char result-string)))) + (t + (push-string current-char result-string))))) + result-string))) + + +(defun unary-operator-scope (filter-string idx) + "Returns a list of the form (:next-query <string> :scope <string>). + scope contains the statement that is in the scope of one of the following + operators !, +, -." + (declare (String filter-string) + (Integer idx)) + (let* ((string-after (subseq filter-string (1+ idx))) + (cleaned-str (cut-comment string-after))) + (cond ((string-starts-with cleaned-str "(") + (let ((result (bracket-scope cleaned-str))) + (list :next-query (string-after cleaned-str result) + :scope result))) + ((or (string-starts-with "?" cleaned-str) + (string-starts-with "$" cleaned-str)) + (let ((result (get-filter-variable cleaned-str))) + (list :next-query (string-after cleaned-str result) + :scope result))) + ((string-starts-with "'''" cleaned-str) + (let ((result (get-literal cleaned-str))) + (list :next-query (getf result :next-query) + :scope (getf result :literal)))) + ((string-starts-with-digit cleaned-str) + (separate-leading-digits cleaned-str)) + ((string-starts-with "true" cleaned-str) + (list :next-query (string-after cleaned-str "true") + :scope "true")) + ((string-starts-with "false" cleaned-str) + (list :next-query (string-after cleaned-str "false") + :scope "false")) + ((let ((pos (search-first *supported-functions* cleaned-str))) + (when pos + (= pos 0))) + (let ((result (function-scope cleaned-str))) + (list :next-query (string-after cleaned-str result) + :scope result))) + (t + (error + (make-condition + 'sparql-parser-error + :message + (format + nil "Invalid filter: "~a". An unary operator must be followed by ~a" + filter-string + "a number, boolean, string, function or a variable"))))))) + + +(defun function-scope (str) + "If str starts with a supported function it there is given the entire substr + that is the scope of the function, i.e. the function name and all its + variable including the closing )." + (declare (String str)) + (let* ((cleaned-str (cut-comment str)) + (after-fun + (remove-null (map 'list #'(lambda(fun) + (when (string-starts-with cleaned-str fun) + (string-after str fun))) + *supported-functions*))) + (fun-suffix (when after-fun + (cut-comment (first after-fun))))) + (when fun-suffix + (let* ((args (bracket-scope fun-suffix)) + (fun-name (string-until cleaned-str args))) + (concatenate 'string fun-name args))))) + + +(defun get-filter-variable (str) + "Returns the substring of str if str starts with ? or $ until the variable ends, + otherwise the return value is nil." + (declare (String str)) + (when (or (string-starts-with str "?") + (string-starts-with str "$")) + (let ((found-end (search-first (append (white-space) *supported-operators* + *supported-brackets* (list "?" "$")) + (subseq str 1)))) + (if found-end + (subseq str 0 (1+ found-end)) + str)))) + + +(defun bracket-scope (str &key (open-bracket "(") (close-bracket ")")) + "If str starts with open-bracket there will be returned the substring until + the matching close-bracket is found. Otherwise the return value is nil." + (declare (String str open-bracket close-bracket)) + (when (string-starts-with str open-bracket) + (let ((open-brackets 0) + (result "")) + (dotimes (idx (length str)) + (let ((current-char (subseq str idx (1+ idx)))) + (cond ((or (string= "'" current-char) + (string= """ current-char)) + (let* ((sub-str (subseq str idx)) + (quotation + (cond ((string-starts-with sub-str "'''") + "'''") + ((string-starts-with sub-str """"") + """"") + ((string-starts-with sub-str "'") + "'") + ((string-starts-with sub-str """) + """))) + (literal + (get-literal (subseq str idx) :quotation quotation))) + (if literal + (progn + (setf idx (- (1- (length str)) + (length (getf literal :next-query)))) + (push-string (getf literal :literal) str)) + (progn + (setf result nil) + (setf idx (length str)))))) + ((string= current-char close-bracket) + (decf open-brackets) + (push-string current-char result) + (when (= open-brackets 0) + (setf idx (length str)))) + ((string= current-char open-bracket) + (incf open-brackets) + (push-string current-char result)) + (t + (push-string current-char result))))) + result))) + + (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 @@ -80,19 +247,20 @@ ((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")) + (error + (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")) + (error (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))) @@ -109,10 +277,10 @@ (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")) + (error (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))) @@ -177,29 +345,30 @@ t))))
-(defun get-literal (query-string) +(defun get-literal (query-string &key (quotation "'''")) "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)) + (declare (String query-string) + (String quotation)) (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 "'''" + :literal (concatenate 'string quotation (subseq query-string 3 literal-end) - "'''"))))) + quotation))))) ((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 "'''" + :literal (concatenate 'string quotation (subseq query-string 1 literal-end) - "'''"))))))) + quotation)))))))
(defun find-literal-end (query-string delimiter &optional (overall-pos 0))
Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Wed Dec 15 08:15:40 2010 @@ -19,17 +19,33 @@ :trim-whitespace :string-starts-with :string-ends-with + :string-ends-with-one-of :string-starts-with-char :string-until :string-after :search-first :concatenate-uri :absolute-uri-p - :string-starts-with-digit)) + :string-starts-with-digit + :string-after-number + :separate-leading-digits + :white-space))
(in-package :base-tools)
+(defparameter *white-space* + (list #\Space #\Tab #\Newline #\cr) + "Contains all characters that are treated as white space.") + + +(defun white-space() + "Returns a lit os string that represents a white space." + (map 'list #'(lambda(char) + (string char)) + *white-space*)) + + (defmacro push-string (obj place) "Imitates the push macro but instead of pushing object in a list, there will be appended the given string to the main string object." @@ -70,19 +86,19 @@ (defun trim-whitespace-left (value) "Uses string-left-trim with a predefined character-list." (declare (String value)) - (string-left-trim '(#\Space #\Tab #\Newline #\cr) value)) + (string-left-trim *white-space* value))
(defun trim-whitespace-right (value) "Uses string-right-trim with a predefined character-list." (declare (String value)) - (string-right-trim '(#\Space #\Tab #\Newline #\cr) value)) + (string-right-trim *white-space* value))
(defun trim-whitespace (value) "Uses string-trim with a predefined character-list." (declare (String value)) - (string-trim '(#\Space #\Tab #\Newline #\cr) value)) + (string-trim *white-space* value))
(defun string-starts-with (str prefix &key (ignore-case nil)) @@ -119,6 +135,16 @@ 0))))
+(defun string-ends-with-one-of (str suffixes &key (ignore-case nil)) + "Returns t if str ends with one of the string contained in suffixes." + (declare (String str) + (List suffixes) + (Boolean ignore-case)) + (loop for suffix in suffixes + when (string-ends-with str suffix :ignore-case ignore-case) + return t)) + + (defun string-starts-with-digit (str) "Checks whether the passed string starts with a digit." (declare (String str)) @@ -126,6 +152,26 @@ when (string-starts-with str (write-to-string item)) return t))
+(defun string-after-number (str) + "If str starts with a digit, there is returned the first + substring after a character that is a non-digit. + If str does not start with a digit str is returned." + (declare (String str)) + (if (and (string-starts-with-digit str) + (> (length str) 0)) + (string-after-number (subseq str 1)) + str)) + + +(defun separate-leading-digits (str &optional digits) + "If str starts with a number the number is returned." + (declare (String str) + (type (or Null String) digits)) + (if (string-starts-with-digit str) + (separate-leading-digits + (subseq str 1) (concatenate 'string digits (subseq str 0 1))) + digits)) +
(defun string-starts-with-char (begin str) (equal (char str 0) begin))