Author: lgiessmann
Date: Fri Dec 17 19:53:11 2010
New Revision: 369
Log:
added the handling of * and / => added some unit-tests; fixed a bug with right-scope of && and || operators
Modified:
trunk/src/TM-SPARQL/sparql_filter.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 Fri Dec 17 19:53:11 2010
@@ -15,17 +15,40 @@
"Contains all supported SPARQL-functions")
-(defparameter *supported-binary-operators*
- (list "||" "&&" "=" "!=" "<" "<=" ">" ">=" "+" "-" "*" "/")
+(defparameter *supported-primary-arithmetic-operators*
+ (list "*" "/") "Contains all supported arithmetic operators.")
+
+
+(defparameter *supported-secundary-arithmetic-operators*
+ (list "+" "-") "Contains all supported arithmetic operators.")
+
+
+(defparameter *supported-compare-operators*
+ (list "=" "!=" "<" "<=" ">" ">=")
"Contains all supported binary operators.")
+(defparameter *supported-join-operators*
+ (list "||" "&&") "Contains all supported join operators.")
+
+
(defparameter *supported-unary-operators*
(list "!" "+" "-") "Contains all supported unary operators")
+(defun *supported-arithmetic-operators* ()
+ (append *supported-primary-arithmetic-operators*
+ *supported-secundary-arithmetic-operators*))
+
+
+(defun *supported-binary-operators* ()
+ (append (*supported-arithmetic-operators*)
+ *supported-compare-operators*
+ *supported-join-operators*))
+
+
(defun *supported-operators* ()
- (union *supported-binary-operators* *supported-unary-operators*
+ (union (*supported-binary-operators*) *supported-unary-operators*
:test #'string=))
@@ -56,37 +79,146 @@
(next-query (getf result-set-boundings :next-query))
(filter-string-unary-ops
(set-unary-operators construct filter-string))
+ ;;TODO: encapsulate all binary operator mehtod in the method set-binary-ops
(filter-string-or-and-ops
(set-or-and-operators construct filter-string-unary-ops
filter-string-unary-ops))
- (filter-string-binary-ops
- (set-binary-operators construct filter-string-or-and-ops))
-
- ))))
+ (filter-string-arithmetic-ops
+ (set-arithmetic-operators construct filter-string-or-and-ops))
+ )
+ filter-string-arithmetic-ops)))
;;TODO: implement
;; **replace () by (progn )
;; **replace ', """, ''' by "
;; **replace !x by (not x)
- ;; **replace +x by (1+ x)
- ;; **replace -x by (1- x)
+ ;; **replace +x by (one+ x)
+ ;; **replace -x by (one- x)
;; **||, &&
- ;; *=, !=, <, >, <=, >=, +, -, *, /
+ ;; **, /
+ ;; +, -
+ ;; *=, !=, <, >, <=, >=
;; *replace function(x), function(x, y), function(x, y, z)
;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z)
;; *check if all functions that will be invoked are allowed
- ;; *add a let with all variables that are used: every variable with $ and ? prefix
- ;; *add a let with (true t) and (false nil)
;; *embrace the final result uris in <> => unit-tests
- ;; *create and store this filter object
+ ;; *create and store this filter object => store the created string and implement
+ ;; a method "invoke-filter(SPARQL-Triple filter-string)" so that the variables
+ ;; are automatically contained in a letafterwards the eval function can be called
+ ;; this method should also have a let with (true t) and (false nil)
+
+
+(defgeneric set-arithmetic-operators (construct filter-string)
+ (:documentation "Transforms the +, -, *, / operators in the filter
+ string to the the corresponding lisp functions.")
+ (:method ((construct SPARQL-Query) (filter-string String))
+ (let ((filter-string-*/ (set-*-and-/-operators construct filter-string)))
+ (set-+-and---operators construct filter-string-*/))))
+
+
+(defun find-*/-operators (filter-string)
+ "Returns the idx of the first found * or / operator.
+ It must not be in a literal string or directly after a (."
+ (declare (String filter-string))
+ (let ((first-pos (search-first-ignore-literals (list "*" "/") filter-string)))
+ (when first-pos
+ (let ((left-part (trim-whitespace-right (subseq filter-string 0 first-pos))))
+ (if (not (string-ends-with left-part "("))
+ first-pos
+ (let ((next-pos
+ (find-*/-operators (subseq filter-string (1+ first-pos)))))
+ (when next-pos
+ (+ 1 first-pos next-pos))))))))
+
+
+(defgeneric set-*-and-/-operators (construct filter-string)
+ (:documentation "Transforms the *, / operators in the filter
+ string to the the corresponding lisp functions.")
+ (:method ((construct SPARQL-Query) (filter-string String))
+ (let ((op-pos (find-*/-operators filter-string)))
+ (if (not op-pos)
+ filter-string
+ (let* ((op-str (subseq filter-string op-pos (1+ op-pos)))
+ (left-str (subseq filter-string 0 op-pos))
+ (right-str (subseq filter-string (1+ op-pos)))
+ (left-scope (find-*/-left-scope left-str))
+ (right-scope (find-*/-right-scope right-str))
+ (modified-str
+ (concatenate
+ 'string (subseq left-str 0 (- (length left-str)
+ (length left-scope)))
+ "(" op-str " " left-scope " " right-scope ")"
+ (subseq right-str (length right-scope)))))
+ (set-*-and-/-operators construct modified-str))))))
+
+
+(defun find-*/-left-scope (left-string)
+ "Returns the string that is the left part of the binary scope."
+ (declare (String left-string))
+ (let* ((first-bracket
+ (let ((inner-value (search-first-unclosed-paranthesis left-string)))
+ (when inner-value
+ (+ inner-value (1+ (length (name-after-paranthesis
+ (subseq left-string inner-value))))))))
+ (other-anchor
+ (let ((inner-value
+ (search-first-ignore-literals
+ (append *supported-join-operators*
+ *supported-secundary-arithmetic-operators*
+ *supported-compare-operators*)
+ left-string :from-end t)))
+ (when inner-value
+ (1+ inner-value))))
+ (paranthesis-pair-idx
+ (let* ((cleaned-str (trim-whitespace-right left-string))
+ (bracket-scope (reverse-bracket-scope cleaned-str)))
+ (when bracket-scope
+ (- (- (length left-string)
+ (- (length left-string) (length cleaned-str)))
+ (length bracket-scope)))))
+ (start-idx (cond (paranthesis-pair-idx
+ paranthesis-pair-idx)
+ ((and first-bracket other-anchor)
+ (max first-bracket other-anchor))
+ ((or first-bracket other-anchor)
+ (or first-bracket other-anchor))
+ (t 0))))
+ (subseq left-string start-idx)))
+
+
+(defun find-*/-right-scope (right-string)
+ "Returns the string that is the right part of the binary scope."
+ (declare (String right-string))
+ (let* ((first-pos (search-first-ignore-literals
+ (append *supported-join-operators*
+ (*supported-arithmetic-operators*)
+ *supported-compare-operators*)
+ right-string))
+ (first-bracket
+ (let ((inner-value (search-first-unopened-paranthesis right-string)))
+ (when inner-value (1+ inner-value))))
+ (paranthesis-pair-idx
+ (let* ((cleaned-str (trim-whitespace-left right-string))
+ (bracket-scope (bracket-scope cleaned-str)))
+ (when bracket-scope
+ (+ (- (length right-string) (length cleaned-str))
+ (length bracket-scope)))))
+ (end-idx (cond (paranthesis-pair-idx
+ paranthesis-pair-idx)
+ ((and first-pos first-bracket)
+ (min first-pos first-bracket))
+ (first-pos first-pos)
+ (first-bracket first-bracket)
+ (t (if (= (length right-string) 0)
+ (1- (length right-string)))))))
+ (subseq right-string 0 end-idx)))
-(defgeneric set-binary-operators (construct filter-string)
- (:documentation "Transforms the =, !=, <, >, <=, >=, +, -, *, / operators
- in the filter string to the the lisp =, /=, <, >, <=, >=,
- +, -, * and / functions.")
+(defgeneric set-+-and---operators (construct filter-string)
+ (:documentation "Transforms the +, - operators in the filter
+ string to the the corresponding lisp functions.")
(:method ((construct SPARQL-Query) (filter-string String))
;TODO: implement
- ))
+ filter-string))
(defgeneric set-or-and-operators (construct filter-string original-filter-string)
@@ -94,7 +226,8 @@
the the lisp or and and functions.")
(:method ((construct SPARQL-Query) (filter-string String)
(original-filter-string String))
- (let ((op-pos (search-first-ignore-literals (list "||" "&&") filter-string)))
+ (let ((op-pos (search-first-ignore-literals
+ *supported-join-operators* filter-string)))
(if (not op-pos)
filter-string
(let* ((op-str (subseq filter-string op-pos (+ 2 op-pos)))
@@ -122,7 +255,7 @@
(remove-null (map 'list #'(lambda(op-string)
(when (= (length op-string) 2)
op-string))
- *supported-binary-operators*)))
+ (*supported-binary-operators*))))
(operator-str (subseq filter-string idx)))
(if (string-starts-with-one-of operator-str 2-ops)
(subseq operator-str 0 2)
@@ -169,22 +302,43 @@
(defun find-or-and-right-scope (right-string)
"Returns the string that is the right part of the binary scope."
(declare (String right-string))
- (let* ((first-pos (search-first-ignore-literals (list "||" "&&") right-string))
+ (let* ((first-pos (search-first-ignore-literals
+ *supported-join-operators* right-string))
(first-bracket
(let ((inner-value (search-first-unopened-paranthesis right-string)))
(when inner-value (1+ inner-value))))
- (end-idx (cond ((and first-pos first-bracket)
- (min first-pos first-bracket))
- (first-pos first-pos)
- (first-bracket first-bracket)
- (t (if (= (length right-string) 0)
- (1- (length right-string)))))))
+ (paranthesis-pair-idx
+ (let* ((cleaned-str (trim-whitespace-left right-string))
+ (bracket-scope (bracket-scope cleaned-str)))
+ (when bracket-scope
+ (+ (- (length right-string) (length cleaned-str))
+ (length bracket-scope)))))
+ (end-idx
+ (cond ((and first-pos first-bracket)
+ (if (< first-pos first-bracket)
+ (if paranthesis-pair-idx
+ (if (< first-pos paranthesis-pair-idx)
+ paranthesis-pair-idx
+ first-pos)
+ first-pos)
+ first-bracket))
+ (first-bracket first-bracket)
+ (first-pos
+ (if paranthesis-pair-idx
+ (if (< first-pos paranthesis-pair-idx)
+ paranthesis-pair-idx
+ first-pos)
+ first-pos))
+ (t
+ (if (= (length right-string) 0)
+ 0
+ (length right-string))))))
(subseq right-string 0 end-idx)))
(defgeneric set-unary-operators (construct filter-string)
(:documentation "Transforms the unary operators !, +, - to (not ),
- (1+ ) and (1- ). The return value is a modified filter
+ (one+ ) and (one- ). The return value is a modified filter
string.")
(:method ((construct SPARQL-Query) (filter-string String))
(let ((result-string ""))
@@ -210,7 +364,7 @@
(string-ends-with-one-of string-before
(*supported-operators*)))
(let ((result (unary-operator-scope filter-string idx)))
- (push-string (concatenate 'string "(1" current-char " ")
+ (push-string (concatenate 'string "(one" current-char " ")
result-string)
(push-string (set-unary-operators construct
(getf result :scope))
@@ -317,6 +471,29 @@
str))))
+(defun reverse-bracket-scope (str &key (open-bracket "(") (close-bracket ")"))
+ "If str ends with close-bracket there will be returned the substring until
+ the matching open-bracket is found. Otherwise the return value is nil."
+ (declare (String str open-bracket close-bracket))
+ (when (string-ends-with str close-bracket)
+ (let ((local-str (subseq str 0 (1- (length str))))
+ (result ")")
+ (close-brackets 1))
+ (do ((idx (1- (length local-str)))) ((< idx 0))
+ (let ((current-char (subseq local-str idx (1+ idx))))
+ (push-string current-char result)
+ (cond ((string= current-char open-bracket)
+ (when (not (in-literal-string-p local-str idx))
+ (decf close-brackets))
+ (when (= close-brackets 0)
+ (setf idx 0)))
+ ((string= current-char close-bracket)
+ (when (not (in-literal-string-p local-str idx))
+ (incf close-brackets)))))
+ (decf idx))
+ (reverse result))))
+
+
(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."
Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp (original)
+++ trunk/src/base-tools/base-tools.lisp Fri Dec 17 19:53:11 2010
@@ -321,19 +321,48 @@
quotation))))))))
-(defun search-first-ignore-literals (search-strings main-string)
+;(defun search-first-ignore-literals (search-strings main-string)
+; (declare (String main-string)
+; (List search-strings))
+; (let ((first-pos (search-first search-strings main-string)))
+; (when first-pos
+; (if (not (in-literal-string-p main-string first-pos))
+; first-pos
+; (let* ((literal-start (search-first (list "\"" "'") main-string))
+; (sub-str (subseq main-string literal-start))
+; (literal-result (get-literal sub-str))
+; (next-str (getf literal-result :next-string)))
+; (let ((next-pos
+; (search-first-ignore-literals search-strings next-str)))
+; (when next-pos
+; (+ (- (length main-string) (length next-str)) next-pos))))))))
+
+
+(defun search-first-ignore-literals (search-strings main-string &key from-end)
(declare (String main-string)
- (List search-strings))
- (let ((first-pos (search-first search-strings main-string)))
+ (List search-strings)
+ (Boolean from-end))
+ (let ((first-pos
+ (search-first search-strings main-string :from-end from-end)))
(when first-pos
(if (not (in-literal-string-p main-string first-pos))
first-pos
- (let* ((literal-start (search-first (list "\"" "'") main-string))
- (sub-str (subseq main-string literal-start))
- (literal-result (get-literal sub-str))
- (next-str (getf literal-result :next-string)))
+ (let* ((literal-start
+ (search-first (list "\"" "'") (subseq main-string 0 first-pos)
+ :from-end from-end))
+ (next-str
+ (if from-end
+
+
+ (subseq main-string 0 literal-start)
+
+
+ (let* ((sub-str (subseq main-string literal-start))
+ (literal-result (get-literal sub-str)))
+ (getf literal-result :next-string)))))
(let ((next-pos
- (search-first-ignore-literals search-strings next-str)))
+ (search-first-ignore-literals search-strings next-str
+ :from-end from-end)))
(when next-pos
(+ (- (length main-string) (length next-str)) next-pos))))))))
@@ -417,7 +446,7 @@
(next-idx
(when l-result
(- (length filter-string)
- (length (getf l-result :next-query))))))
+ (length (getf l-result :next-string))))))
(when (and next-idx (< pos next-idx))
(setf result t)
(setf idx (length filter-string)))
@@ -468,7 +497,8 @@
(cond ((string= current-char "(")
(when (or ignore-literals
(not (in-literal-string-p str idx)))
- (decf closed-brackets)))
+ (decf closed-brackets)
+ (setf result-idx nil)))
((string= current-char ")")
(when (or ignore-literals
(not (in-literal-string-p str idx)))
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp (original)
+++ trunk/src/unit_tests/sparql_test.lisp Fri Dec 17 19:53:11 2010
@@ -33,7 +33,8 @@
:test-result
:test-set-boundings
:test-set-unary-operators
- :test-set-or-and-operators))
+ :test-set-or-and-operators
+ :test-set-*-and-/-operators))
(in-package :sparql-test)
@@ -1122,20 +1123,22 @@
(is-true result-6-1)
(is (string=
result-1-1
- "BOUND(?var1)||(progn (not (progn (1+ (progn (1- (progn ?var1)))))))"))
+ "BOUND(?var1)||(progn (not (progn (one+ (progn (one- (progn ?var1)))))))"))
(is (string= result-2-1 "(not BOUND(?var1)) = false"))
- (is (string= result-3-1 "(1+ ?var1)=(1- $var2)"))
- (is (string= result-4-1 "(not \"a\\\"b\\\"c\") && (progn (1+ 12) = (1- 14))"))
- (is (string= result-5-1 "(not \"a(+c)\") && (progn (1+ 12) = (1- 14))"))
+ (is (string= result-3-1 "(one+ ?var1)=(one- $var2)"))
+ (is (string= result-4-1 "(not \"a\\\"b\\\"c\") && (progn (one+ 12) = (one- 14))"))
+ (is (string= result-5-1 "(not \"a(+c)\") && (progn (one+ 12) = (one- 14))"))
(is (string= result-6-1 "(not \"abc)def\")"))))
(test test-set-or-and-operators
- "Tests various cases of the function set-unary-operators."
+ "Tests various cases of the function set-or-and-operators."
(let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " "))
(str-1 "isLITERAL(STR(?var))||?var = 12 && true}")
(str-2 "(true != false || !false ) && 12 < 14 || !isLITERAL(?var)}")
(str-3 "isLITERAL('a(bc||def') && 'abc)def'}")
+ (str-4 "(a && (b || c))}")
+ (str-5 "(b || c) && a}")
(result-1
(getf (tm-sparql::set-boundings dummy-object str-1) :filter-string))
(result-1-1 (tm-sparql::set-or-and-operators dummy-object result-1 result-1))
@@ -1144,19 +1147,91 @@
(result-2-1 (tm-sparql::set-or-and-operators dummy-object result-2 result-2))
(result-3
(getf (tm-sparql::set-boundings dummy-object str-3) :filter-string))
- (result-3-1 (tm-sparql::set-or-and-operators dummy-object result-3 result-3)))
+ (result-3-1 (tm-sparql::set-or-and-operators dummy-object result-3 result-3))
+ (result-4
+ (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string))
+ (result-4-1 (tm-sparql::set-or-and-operators dummy-object result-4 result-4))
+ (result-5
+ (getf (tm-sparql::set-boundings dummy-object str-5) :filter-string))
+ (result-5-1 (tm-sparql::set-or-and-operators dummy-object result-5 result-5)))
(is-true result-1)
(is-true result-1-1)
(is-true result-2)
(is-true result-2-1)
(is-true result-3)
(is-true result-3-1)
+ (is-true result-4)
+ (is-true result-4-1)
+ (is-true result-5)
+ (is-true result-5-1)
(is (string= (string-replace result-1-1 " " "")
"(and(progn(or(prognisLITERAL(STR(?var)))(progn?var=12)))(progntrue))"))
(is (string= (string-replace result-2-1 " " "")
"(or(progn(and(progn(progn(or(progntrue!=false)(progn!false))))(progn12<14)))(progn!isLITERAL(?var)))"))
(is (string= (string-replace result-3-1 " " "")
- "(and(prognisLITERAL(\"a(bc||def\"))(progn\"abc)def\"))"))))
+ "(and(prognisLITERAL(\"a(bc||def\"))(progn\"abc)def\"))"))
+ (is (string= (string-replace result-4-1 " " "")
+ "(progn(and(progna)(progn(progn(or(prognb)(prognc))))))"))
+ (is (string= (string-replace result-5-1 " " "")
+ "(and(progn(progn(or(prognb)(prognc))))(progna))"))))
+
+
+(test test-set-*-and-/-operators
+ "Tests various cases of the function set-*-and-/-operators."
+ (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " "))
+ (str-1 "x = a + b * c && y = a / 3 + b * 2 || 0 = 12 - 14 + 2 * 3 / 3}")
+ (str-2 "x = 2 && (2 + 2) * 2 + 12 * 4 / 2 - 10 + 2 * (12 - 3) + (12 * 3)}")
+ (str-3 "(x < a || ( a = 4 && 4 = x / y + (+1)) && -1)}")
+ (str-4 "isLITERAL(((1 + '(13+4*5))') * 3) / 4) && (12 = 13 + 14 * 15 || 2 * 3 = 1)}")
+ (result-1
+ (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string))
+ (result-1-1
+ (tm-sparql::set-unary-operators dummy-object result-1))
+ (result-1-2
+ (tm-sparql::set-or-and-operators dummy-object result-1-1 result-1))
+ (result-1-3
+ (tm-sparql::set-*-and-/-operators dummy-object result-1-2))
+ (result-2
+ (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string))
+ (result-2-1
+ (tm-sparql::set-unary-operators dummy-object result-2))
+ (result-2-2
+ (tm-sparql::set-or-and-operators dummy-object result-2-1 result-2))
+ (result-2-3
+ (tm-sparql::set-*-and-/-operators dummy-object result-2-2))
+ (result-3
+ (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string))
+ (result-3-1
+ (tm-sparql::set-unary-operators dummy-object result-3))
+ (result-3-2
+ (tm-sparql::set-or-and-operators dummy-object result-3-1 result-3))
+ (result-3-3
+ (tm-sparql::set-*-and-/-operators dummy-object result-3-2))
+ (result-4
+ (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string))
+ (result-4-1
+ (tm-sparql::set-unary-operators dummy-object result-4))
+ (result-4-2
+ (tm-sparql::set-or-and-operators dummy-object result-4-1 result-4))
+ (result-4-3
+ (tm-sparql::set-*-and-/-operators dummy-object result-4-2)))
+ (is-true result-1) (is-true result-1-1)
+ (is-true result-1-2) (is-true result-1-3)
+ (is-true result-2) (is-true result-2-1)
+ (is-true result-2-2) (is-true result-2-3)
+ (is-true result-3) (is-true result-3-1)
+ (is-true result-3-2) (is-true result-3-3)
+ (is-true result-4) (is-true result-4-1)
+ (is-true result-4-2) (is-true result-4-3)
+ (is (string= (string-replace result-1-3 " " "")
+ "(or(progn(and(prognx=a+(*bc))(progny=(/a3)+(*b2))))(progn0=12-14+(/(*23)3)))"))
+ (is (string= (string-replace result-2-3 " " "")
+ "(and(prognx=2)(progn(*(progn2+2)2)+(/(*124)2)-10+(*2(progn12-3))+(progn(*123))))"))
+ (is (string= (string-replace result-3-3 " " "")
+ "(progn(and(progn(or(prognx<a)(progn(progn(and(progna=4)(progn4=(/xy)+(progn(one+1))))))))(progn(one-1))))"))
+ (is (string= (string-replace result-4-3 " " "")
+ "(and(prognisLITERAL((/(progn(*(progn1+\"(13+4*5))\")3))4)))(progn(progn(or(progn12=13+(*1415))(progn(*23)=1)))))"))))
+
(defun run-sparql-tests ()
