[isidorus-cvs] r364 - in trunk/src: TM-SPARQL base-tools
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Dec 15 13:15:40 UTC 2010
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))
More information about the Isidorus-cvs
mailing list